1/* 2 * tkScale.c -- 3 * 4 * This module implements a scale widgets for the Tk toolkit. 5 * A scale displays a slider that can be adjusted to change a 6 * value; it also displays numeric labels and a textual label, 7 * if desired. 8 * 9 * The modifications to use floating-point values are based on 10 * an implementation by Paul Mackerras. The -variable option 11 * is due to Henning Schulzrinne. All of these are used with 12 * permission. 13 * 14 * Copyright (c) 1990-1994 The Regents of the University of California. 15 * Copyright (c) 1994-1997 Sun Microsystems, Inc. 16 * Copyright (c) 1998-2000 by Scriptics Corporation. 17 * 18 * See the file "license.terms" for information on usage and redistribution 19 * of this file, and for a DISCLAIMER OF ALL WARRANTIES. 20 * 21 * RCS: @(#) $Id: tkScale.c,v 1.17.2.1 2006/06/14 22:15:22 dgp Exp $ 22 */ 23 24#include "tkPort.h" 25#include "default.h" 26#include "tkInt.h" 27#include "tclMath.h" 28#include "tkScale.h" 29 30/* 31 * The following table defines the legal values for the -orient option. 32 * It is used together with the "enum orient" declaration in tkScale.h. 33 */ 34 35static char *orientStrings[] = { 36 "horizontal", "vertical", (char *) NULL 37}; 38 39/* 40 * The following table defines the legal values for the -state option. 41 * It is used together with the "enum state" declaration in tkScale.h. 42 */ 43 44static char *stateStrings[] = { 45 "active", "disabled", "normal", (char *) NULL 46}; 47 48static Tk_OptionSpec optionSpecs[] = { 49 {TK_OPTION_BORDER, "-activebackground", "activeBackground", "Foreground", 50 DEF_SCALE_ACTIVE_BG_COLOR, -1, Tk_Offset(TkScale, activeBorder), 51 0, (ClientData) DEF_SCALE_ACTIVE_BG_MONO, 0}, 52 {TK_OPTION_BORDER, "-background", "background", "Background", 53 DEF_SCALE_BG_COLOR, -1, Tk_Offset(TkScale, bgBorder), 54 0, (ClientData) DEF_SCALE_BG_MONO, 0}, 55 {TK_OPTION_DOUBLE, "-bigincrement", "bigIncrement", "BigIncrement", 56 DEF_SCALE_BIG_INCREMENT, -1, Tk_Offset(TkScale, bigIncrement), 57 0, 0, 0}, 58 {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL, 59 (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0}, 60 {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL, 61 (char *) NULL, 0, -1, 0, (ClientData) "-background", 0}, 62 {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", 63 DEF_SCALE_BORDER_WIDTH, -1, Tk_Offset(TkScale, borderWidth), 64 0, 0, 0}, 65 {TK_OPTION_STRING, "-command", "command", "Command", 66 DEF_SCALE_COMMAND, -1, Tk_Offset(TkScale, command), 67 TK_OPTION_NULL_OK, 0, 0}, 68 {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor", 69 DEF_SCALE_CURSOR, -1, Tk_Offset(TkScale, cursor), 70 TK_OPTION_NULL_OK, 0, 0}, 71 {TK_OPTION_INT, "-digits", "digits", "Digits", 72 DEF_SCALE_DIGITS, -1, Tk_Offset(TkScale, digits), 73 0, 0, 0}, 74 {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL, 75 (char *) NULL, 0, -1, 0, (ClientData) "-foreground", 0}, 76 {TK_OPTION_FONT, "-font", "font", "Font", 77 DEF_SCALE_FONT, -1, Tk_Offset(TkScale, tkfont), 0, 0, 0}, 78 {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground", 79 DEF_SCALE_FG_COLOR, -1, Tk_Offset(TkScale, textColorPtr), 0, 80 (ClientData) DEF_SCALE_FG_MONO, 0}, 81 {TK_OPTION_DOUBLE, "-from", "from", "From", DEF_SCALE_FROM, -1, 82 Tk_Offset(TkScale, fromValue), 0, 0, 0}, 83 {TK_OPTION_BORDER, "-highlightbackground", "highlightBackground", 84 "HighlightBackground", DEF_SCALE_HIGHLIGHT_BG_COLOR, 85 -1, Tk_Offset(TkScale, highlightBorder), 86 0, (ClientData) DEF_SCALE_HIGHLIGHT_BG_MONO, 0}, 87 {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor", 88 DEF_SCALE_HIGHLIGHT, -1, Tk_Offset(TkScale, highlightColorPtr), 89 0, 0, 0}, 90 {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness", 91 "HighlightThickness", DEF_SCALE_HIGHLIGHT_WIDTH, -1, 92 Tk_Offset(TkScale, highlightWidth), 0, 0, 0}, 93 {TK_OPTION_STRING, "-label", "label", "Label", 94 DEF_SCALE_LABEL, -1, Tk_Offset(TkScale, label), 95 TK_OPTION_NULL_OK, 0, 0}, 96 {TK_OPTION_PIXELS, "-length", "length", "Length", 97 DEF_SCALE_LENGTH, -1, Tk_Offset(TkScale, length), 0, 0, 0}, 98 {TK_OPTION_STRING_TABLE, "-orient", "orient", "Orient", 99 DEF_SCALE_ORIENT, -1, Tk_Offset(TkScale, orient), 100 0, (ClientData) orientStrings, 0}, 101 {TK_OPTION_RELIEF, "-relief", "relief", "Relief", 102 DEF_SCALE_RELIEF, -1, Tk_Offset(TkScale, relief), 0, 0, 0}, 103 {TK_OPTION_INT, "-repeatdelay", "repeatDelay", "RepeatDelay", 104 DEF_SCALE_REPEAT_DELAY, -1, Tk_Offset(TkScale, repeatDelay), 105 0, 0, 0}, 106 {TK_OPTION_INT, "-repeatinterval", "repeatInterval", "RepeatInterval", 107 DEF_SCALE_REPEAT_INTERVAL, -1, Tk_Offset(TkScale, repeatInterval), 108 0, 0, 0}, 109 {TK_OPTION_DOUBLE, "-resolution", "resolution", "Resolution", 110 DEF_SCALE_RESOLUTION, -1, Tk_Offset(TkScale, resolution), 111 0, 0, 0}, 112 {TK_OPTION_BOOLEAN, "-showvalue", "showValue", "ShowValue", 113 DEF_SCALE_SHOW_VALUE, -1, Tk_Offset(TkScale, showValue), 114 0, 0, 0}, 115 {TK_OPTION_PIXELS, "-sliderlength", "sliderLength", "SliderLength", 116 DEF_SCALE_SLIDER_LENGTH, -1, Tk_Offset(TkScale, sliderLength), 117 0, 0, 0}, 118 {TK_OPTION_RELIEF, "-sliderrelief", "sliderRelief", "SliderRelief", 119 DEF_SCALE_SLIDER_RELIEF, -1, Tk_Offset(TkScale, sliderRelief), 120 0, 0, 0}, 121 {TK_OPTION_STRING_TABLE, "-state", "state", "State", 122 DEF_SCALE_STATE, -1, Tk_Offset(TkScale, state), 123 0, (ClientData) stateStrings, 0}, 124 {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus", 125 DEF_SCALE_TAKE_FOCUS, Tk_Offset(TkScale, takeFocusPtr), -1, 126 TK_OPTION_NULL_OK, 0, 0}, 127 {TK_OPTION_DOUBLE, "-tickinterval", "tickInterval", "TickInterval", 128 DEF_SCALE_TICK_INTERVAL, -1, Tk_Offset(TkScale, tickInterval), 129 0, 0, 0}, 130 {TK_OPTION_DOUBLE, "-to", "to", "To", 131 DEF_SCALE_TO, -1, Tk_Offset(TkScale, toValue), 0, 0, 0}, 132 {TK_OPTION_COLOR, "-troughcolor", "troughColor", "Background", 133 DEF_SCALE_TROUGH_COLOR, -1, Tk_Offset(TkScale, troughColorPtr), 134 0, (ClientData) DEF_SCALE_TROUGH_MONO, 0}, 135 {TK_OPTION_STRING, "-variable", "variable", "Variable", 136 DEF_SCALE_VARIABLE, Tk_Offset(TkScale, varNamePtr), -1, 137 TK_OPTION_NULL_OK, 0, 0}, 138 {TK_OPTION_PIXELS, "-width", "width", "Width", 139 DEF_SCALE_WIDTH, -1, Tk_Offset(TkScale, width), 0, 0, 0}, 140 {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL, 141 (char *) NULL, 0, -1, 0, 0, 0} 142}; 143 144/* 145 * The following tables define the scale widget commands and map the 146 * indexes into the string tables into a single enumerated type used 147 * to dispatch the scale widget command. 148 */ 149 150static CONST char *commandNames[] = { 151 "cget", "configure", "coords", "get", "identify", "set", (char *) NULL 152}; 153 154enum command { 155 COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_COORDS, COMMAND_GET, 156 COMMAND_IDENTIFY, COMMAND_SET 157}; 158 159/* 160 * Forward declarations for procedures defined later in this file: 161 */ 162 163static void ComputeFormat _ANSI_ARGS_((TkScale *scalePtr)); 164static void ComputeScaleGeometry _ANSI_ARGS_((TkScale *scalePtr)); 165static int ConfigureScale _ANSI_ARGS_((Tcl_Interp *interp, 166 TkScale *scalePtr, int objc, 167 Tcl_Obj *CONST objv[])); 168static void DestroyScale _ANSI_ARGS_((char *memPtr)); 169static void ScaleCmdDeletedProc _ANSI_ARGS_(( 170 ClientData clientData)); 171static void ScaleEventProc _ANSI_ARGS_((ClientData clientData, 172 XEvent *eventPtr)); 173static char * ScaleVarProc _ANSI_ARGS_((ClientData clientData, 174 Tcl_Interp *interp, CONST char *name1, 175 CONST char *name2, int flags)); 176static int ScaleWidgetObjCmd _ANSI_ARGS_((ClientData clientData, 177 Tcl_Interp *interp, int objc, 178 Tcl_Obj *CONST objv[])); 179static void ScaleWorldChanged _ANSI_ARGS_(( 180 ClientData instanceData)); 181static void ScaleSetVariable _ANSI_ARGS_((TkScale *scalePtr)); 182 183/* 184 * The structure below defines scale class behavior by means of procedures 185 * that can be invoked from generic window code. 186 */ 187 188static Tk_ClassProcs scaleClass = { 189 sizeof(Tk_ClassProcs), /* size */ 190 ScaleWorldChanged, /* worldChangedProc */ 191}; 192 193 194/* 195 *-------------------------------------------------------------- 196 * 197 * Tk_ScaleObjCmd -- 198 * 199 * This procedure is invoked to process the "scale" Tcl 200 * command. See the user documentation for details on what 201 * it does. 202 * 203 * Results: 204 * A standard Tcl result. 205 * 206 * Side effects: 207 * See the user documentation. 208 * 209 *-------------------------------------------------------------- 210 */ 211 212int 213Tk_ScaleObjCmd(clientData, interp, objc, objv) 214 ClientData clientData; /* NULL. */ 215 Tcl_Interp *interp; /* Current interpreter. */ 216 int objc; /* Number of arguments. */ 217 Tcl_Obj *CONST objv[]; /* Argument values. */ 218{ 219 register TkScale *scalePtr; 220 Tk_OptionTable optionTable; 221 Tk_Window tkwin; 222 223 if (objc < 2) { 224 Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?"); 225 return TCL_ERROR; 226 } 227 228 tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp), 229 Tcl_GetString(objv[1]), (char *) NULL); 230 if (tkwin == NULL) { 231 return TCL_ERROR; 232 } 233 234 /* 235 * Create the option table for this widget class. If it has already 236 * been created, the cached pointer will be returned. 237 */ 238 239 optionTable = Tk_CreateOptionTable(interp, optionSpecs); 240 241 Tk_SetClass(tkwin, "Scale"); 242 scalePtr = TkpCreateScale(tkwin); 243 244 /* 245 * Initialize fields that won't be initialized by ConfigureScale, 246 * or which ConfigureScale expects to have reasonable values 247 * (e.g. resource pointers). 248 */ 249 250 scalePtr->tkwin = tkwin; 251 scalePtr->display = Tk_Display(tkwin); 252 scalePtr->interp = interp; 253 scalePtr->widgetCmd = Tcl_CreateObjCommand(interp, 254 Tk_PathName(scalePtr->tkwin), ScaleWidgetObjCmd, 255 (ClientData) scalePtr, ScaleCmdDeletedProc); 256 scalePtr->optionTable = optionTable; 257 scalePtr->orient = ORIENT_VERTICAL; 258 scalePtr->width = 0; 259 scalePtr->length = 0; 260 scalePtr->value = 0.0; 261 scalePtr->varNamePtr = NULL; 262 scalePtr->fromValue = 0.0; 263 scalePtr->toValue = 0.0; 264 scalePtr->tickInterval = 0.0; 265 scalePtr->resolution = 1.0; 266 scalePtr->digits = 0; 267 scalePtr->bigIncrement = 0.0; 268 scalePtr->command = NULL; 269 scalePtr->repeatDelay = 0; 270 scalePtr->repeatInterval = 0; 271 scalePtr->label = NULL; 272 scalePtr->labelLength = 0; 273 scalePtr->state = STATE_NORMAL; 274 scalePtr->borderWidth = 0; 275 scalePtr->bgBorder = NULL; 276 scalePtr->activeBorder = NULL; 277 scalePtr->sliderRelief = TK_RELIEF_RAISED; 278 scalePtr->troughColorPtr = NULL; 279 scalePtr->troughGC = None; 280 scalePtr->copyGC = None; 281 scalePtr->tkfont = NULL; 282 scalePtr->textColorPtr = NULL; 283 scalePtr->textGC = None; 284 scalePtr->relief = TK_RELIEF_FLAT; 285 scalePtr->highlightWidth = 0; 286 scalePtr->highlightBorder = NULL; 287 scalePtr->highlightColorPtr = NULL; 288 scalePtr->inset = 0; 289 scalePtr->sliderLength = 0; 290 scalePtr->showValue = 0; 291 scalePtr->horizLabelY = 0; 292 scalePtr->horizValueY = 0; 293 scalePtr->horizTroughY = 0; 294 scalePtr->horizTickY = 0; 295 scalePtr->vertTickRightX = 0; 296 scalePtr->vertValueRightX = 0; 297 scalePtr->vertTroughX = 0; 298 scalePtr->vertLabelX = 0; 299 scalePtr->fontHeight = 0; 300 scalePtr->cursor = None; 301 scalePtr->takeFocusPtr = NULL; 302 scalePtr->flags = NEVER_SET; 303 304 Tk_SetClassProcs(scalePtr->tkwin, &scaleClass, (ClientData) scalePtr); 305 Tk_CreateEventHandler(scalePtr->tkwin, 306 ExposureMask|StructureNotifyMask|FocusChangeMask, 307 ScaleEventProc, (ClientData) scalePtr); 308 309 if ((Tk_InitOptions(interp, (char *) scalePtr, optionTable, tkwin) 310 != TCL_OK) || 311 (ConfigureScale(interp, scalePtr, objc - 2, objv + 2) != TCL_OK)) { 312 Tk_DestroyWindow(scalePtr->tkwin); 313 return TCL_ERROR; 314 } 315 316 Tcl_SetResult(interp, Tk_PathName(scalePtr->tkwin), TCL_STATIC); 317 return TCL_OK; 318} 319 320/* 321 *-------------------------------------------------------------- 322 * 323 * ScaleWidgetObjCmd -- 324 * 325 * This procedure is invoked to process the Tcl command 326 * that corresponds to a widget managed by this module. 327 * See the user documentation for details on what it does. 328 * 329 * Results: 330 * A standard Tcl result. 331 * 332 * Side effects: 333 * See the user documentation. 334 * 335 *-------------------------------------------------------------- 336 */ 337 338static int 339ScaleWidgetObjCmd(clientData, interp, objc, objv) 340 ClientData clientData; /* Information about scale 341 * widget. */ 342 Tcl_Interp *interp; /* Current interpreter. */ 343 int objc; /* Number of arguments. */ 344 Tcl_Obj *CONST objv[]; /* Argument strings. */ 345{ 346 TkScale *scalePtr = (TkScale *) clientData; 347 Tcl_Obj *objPtr; 348 int index, result; 349 350 if (objc < 2) { 351 Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?"); 352 return TCL_ERROR; 353 } 354 result = Tcl_GetIndexFromObj(interp, objv[1], commandNames, 355 "option", 0, &index); 356 if (result != TCL_OK) { 357 return result; 358 } 359 Tcl_Preserve((ClientData) scalePtr); 360 361 switch (index) { 362 case COMMAND_CGET: { 363 if (objc != 3) { 364 Tcl_WrongNumArgs(interp, 1, objv, "cget option"); 365 goto error; 366 } 367 objPtr = Tk_GetOptionValue(interp, (char *) scalePtr, 368 scalePtr->optionTable, objv[2], scalePtr->tkwin); 369 if (objPtr == NULL) { 370 goto error; 371 } else { 372 Tcl_SetObjResult(interp, objPtr); 373 } 374 break; 375 } 376 case COMMAND_CONFIGURE: { 377 if (objc <= 3) { 378 objPtr = Tk_GetOptionInfo(interp, (char *) scalePtr, 379 scalePtr->optionTable, 380 (objc == 3) ? objv[2] : (Tcl_Obj *) NULL, 381 scalePtr->tkwin); 382 if (objPtr == NULL) { 383 goto error; 384 } else { 385 Tcl_SetObjResult(interp, objPtr); 386 } 387 } else { 388 result = ConfigureScale(interp, scalePtr, objc-2, objv+2); 389 } 390 break; 391 } 392 case COMMAND_COORDS: { 393 int x, y ; 394 double value; 395 char buf[TCL_INTEGER_SPACE * 2]; 396 397 if ((objc != 2) && (objc != 3)) { 398 Tcl_WrongNumArgs(interp, 1, objv, "coords ?value?"); 399 goto error; 400 } 401 if (objc == 3) { 402 if (Tcl_GetDoubleFromObj(interp, objv[2], &value) 403 != TCL_OK) { 404 goto error; 405 } 406 } else { 407 value = scalePtr->value; 408 } 409 if (scalePtr->orient == ORIENT_VERTICAL) { 410 x = scalePtr->vertTroughX + scalePtr->width/2 411 + scalePtr->borderWidth; 412 y = TkScaleValueToPixel(scalePtr, value); 413 } else { 414 x = TkScaleValueToPixel(scalePtr, value); 415 y = scalePtr->horizTroughY + scalePtr->width/2 416 + scalePtr->borderWidth; 417 } 418 sprintf(buf, "%d %d", x, y); 419 Tcl_SetResult(interp, buf, TCL_VOLATILE); 420 break; 421 } 422 case COMMAND_GET: { 423 double value; 424 int x, y; 425 char buf[TCL_DOUBLE_SPACE]; 426 427 if ((objc != 2) && (objc != 4)) { 428 Tcl_WrongNumArgs(interp, 1, objv, "get ?x y?"); 429 goto error; 430 } 431 if (objc == 2) { 432 value = scalePtr->value; 433 } else { 434 if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK) 435 || (Tcl_GetIntFromObj(interp, objv[3], &y) 436 != TCL_OK)) { 437 goto error; 438 } 439 value = TkScalePixelToValue(scalePtr, x, y); 440 } 441 sprintf(buf, scalePtr->format, value); 442 Tcl_SetResult(interp, buf, TCL_VOLATILE); 443 break; 444 } 445 case COMMAND_IDENTIFY: { 446 int x, y, thing; 447 448 if (objc != 4) { 449 Tcl_WrongNumArgs(interp, 1, objv, "identify x y"); 450 goto error; 451 } 452 if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK) 453 || (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)) { 454 goto error; 455 } 456 thing = TkpScaleElement(scalePtr, x,y); 457 switch (thing) { 458 case TROUGH1: 459 Tcl_SetResult(interp, "trough1", TCL_STATIC); 460 break; 461 case SLIDER: 462 Tcl_SetResult(interp, "slider", TCL_STATIC); 463 break; 464 case TROUGH2: 465 Tcl_SetResult(interp, "trough2", TCL_STATIC); 466 break; 467 } 468 break; 469 } 470 case COMMAND_SET: { 471 double value; 472 473 if (objc != 3) { 474 Tcl_WrongNumArgs(interp, 1, objv, "set value"); 475 goto error; 476 } 477 if (Tcl_GetDoubleFromObj(interp, objv[2], &value) != TCL_OK) { 478 goto error; 479 } 480 if (scalePtr->state != STATE_DISABLED) { 481 TkScaleSetValue(scalePtr, value, 1, 1); 482 } 483 break; 484 } 485 } 486 Tcl_Release((ClientData) scalePtr); 487 return result; 488 489 error: 490 Tcl_Release((ClientData) scalePtr); 491 return TCL_ERROR; 492} 493 494/* 495 *---------------------------------------------------------------------- 496 * 497 * DestroyScale -- 498 * 499 * This procedure is invoked by Tcl_EventuallyFree or Tcl_Release 500 * to clean up the internal structure of a button at a safe time 501 * (when no-one is using it anymore). 502 * 503 * Results: 504 * None. 505 * 506 * Side effects: 507 * Everything associated with the scale is freed up. 508 * 509 *---------------------------------------------------------------------- 510 */ 511 512static void 513DestroyScale(memPtr) 514 char *memPtr; /* Info about scale widget. */ 515{ 516 register TkScale *scalePtr = (TkScale *) memPtr; 517 518 scalePtr->flags |= SCALE_DELETED; 519 520 Tcl_DeleteCommandFromToken(scalePtr->interp, scalePtr->widgetCmd); 521 if (scalePtr->flags & REDRAW_PENDING) { 522 Tcl_CancelIdleCall(TkpDisplayScale, (ClientData) scalePtr); 523 } 524 525 /* 526 * Free up all the stuff that requires special handling, then 527 * let Tk_FreeOptions handle all the standard option-related 528 * stuff. 529 */ 530 531 if (scalePtr->varNamePtr != NULL) { 532 Tcl_UntraceVar(scalePtr->interp, Tcl_GetString(scalePtr->varNamePtr), 533 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, 534 ScaleVarProc, (ClientData) scalePtr); 535 } 536 if (scalePtr->troughGC != None) { 537 Tk_FreeGC(scalePtr->display, scalePtr->troughGC); 538 } 539 if (scalePtr->copyGC != None) { 540 Tk_FreeGC(scalePtr->display, scalePtr->copyGC); 541 } 542 if (scalePtr->textGC != None) { 543 Tk_FreeGC(scalePtr->display, scalePtr->textGC); 544 } 545 Tk_FreeConfigOptions((char *) scalePtr, scalePtr->optionTable, 546 scalePtr->tkwin); 547 scalePtr->tkwin = NULL; 548 TkpDestroyScale(scalePtr); 549} 550 551/* 552 *---------------------------------------------------------------------- 553 * 554 * ConfigureScale -- 555 * 556 * This procedure is called to process an argv/argc list, plus 557 * the Tk option database, in order to configure (or 558 * reconfigure) a scale widget. 559 * 560 * Results: 561 * The return value is a standard Tcl result. If TCL_ERROR is 562 * returned, then the interp's result contains an error message. 563 * 564 * Side effects: 565 * Configuration information, such as colors, border width, 566 * etc. get set for scalePtr; old resources get freed, 567 * if there were any. 568 * 569 *---------------------------------------------------------------------- 570 */ 571 572static int 573ConfigureScale(interp, scalePtr, objc, objv) 574 Tcl_Interp *interp; /* Used for error reporting. */ 575 register TkScale *scalePtr; /* Information about widget; may or may 576 * not already have values for some fields. */ 577 int objc; /* Number of valid entries in objv. */ 578 Tcl_Obj *CONST objv[]; /* Argument values. */ 579{ 580 Tk_SavedOptions savedOptions; 581 Tcl_Obj *errorResult = NULL; 582 int error; 583 double varValue; 584 585 /* 586 * Eliminate any existing trace on a variable monitored by the scale. 587 */ 588 589 if (scalePtr->varNamePtr != NULL) { 590 Tcl_UntraceVar(interp, Tcl_GetString(scalePtr->varNamePtr), 591 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, 592 ScaleVarProc, (ClientData) scalePtr); 593 } 594 595 for (error = 0; error <= 1; error++) { 596 if (!error) { 597 /* 598 * First pass: set options to new values. 599 */ 600 601 if (Tk_SetOptions(interp, (char *) scalePtr, 602 scalePtr->optionTable, objc, objv, 603 scalePtr->tkwin, &savedOptions, (int *) NULL) != TCL_OK) { 604 continue; 605 } 606 } else { 607 /* 608 * Second pass: restore options to old values. 609 */ 610 611 errorResult = Tcl_GetObjResult(interp); 612 Tcl_IncrRefCount(errorResult); 613 Tk_RestoreSavedOptions(&savedOptions); 614 } 615 616 /* 617 * If the scale is tied to the value of a variable, then set 618 * the scale's value from the value of the variable, if it exists 619 * and it holds a valid double value. 620 */ 621 622 if (scalePtr->varNamePtr != NULL) { 623 double value; 624 Tcl_Obj *valuePtr; 625 626 valuePtr = Tcl_ObjGetVar2(interp, scalePtr->varNamePtr, NULL, 627 TCL_GLOBAL_ONLY); 628 if ((valuePtr != NULL) && 629 (Tcl_GetDoubleFromObj(NULL, valuePtr, &value) == TCL_OK)) { 630 scalePtr->value = TkRoundToResolution(scalePtr, value); 631 } 632 } 633 634 /* 635 * Several options need special processing, such as parsing the 636 * orientation and creating GCs. 637 */ 638 639 scalePtr->fromValue = TkRoundToResolution(scalePtr, 640 scalePtr->fromValue); 641 scalePtr->toValue = TkRoundToResolution(scalePtr, scalePtr->toValue); 642 scalePtr->tickInterval = TkRoundToResolution(scalePtr, 643 scalePtr->tickInterval); 644 645 /* 646 * Make sure that the tick interval has the right sign so that 647 * addition moves from fromValue to toValue. 648 */ 649 650 if ((scalePtr->tickInterval < 0) 651 ^ ((scalePtr->toValue - scalePtr->fromValue) < 0)) { 652 scalePtr->tickInterval = -scalePtr->tickInterval; 653 } 654 655 ComputeFormat(scalePtr); 656 657 scalePtr->labelLength = scalePtr->label ? strlen(scalePtr->label) : 0; 658 659 Tk_SetBackgroundFromBorder(scalePtr->tkwin, scalePtr->bgBorder); 660 661 if (scalePtr->highlightWidth < 0) { 662 scalePtr->highlightWidth = 0; 663 } 664 scalePtr->inset = scalePtr->highlightWidth + scalePtr->borderWidth; 665 break; 666 } 667 if (!error) { 668 Tk_FreeSavedOptions(&savedOptions); 669 } 670 671 /* 672 * Set the scale value to itself; all this does is to make sure 673 * that the scale's value is within the new acceptable range for 674 * the scale. We don't set the var here because we need to make 675 * special checks for possibly changed varNamePtr. 676 */ 677 678 TkScaleSetValue(scalePtr, scalePtr->value, 0, 1); 679 680 /* 681 * Reestablish the variable trace, if it is needed. 682 */ 683 684 if (scalePtr->varNamePtr != NULL) { 685 Tcl_Obj *valuePtr; 686 687 /* 688 * Set the associated variable only when the new value differs 689 * from the current value, or the variable doesn't yet exist 690 */ 691 valuePtr = Tcl_ObjGetVar2(interp, scalePtr->varNamePtr, NULL, 692 TCL_GLOBAL_ONLY); 693 if ((valuePtr == NULL) || (Tcl_GetDoubleFromObj(NULL, 694 valuePtr, &varValue) != TCL_OK)) { 695 ScaleSetVariable(scalePtr); 696 } else { 697 char varString[TCL_DOUBLE_SPACE]; 698 char scaleString[TCL_DOUBLE_SPACE]; 699 sprintf(varString, scalePtr->format, varValue); 700 sprintf(scaleString, scalePtr->format, scalePtr->value); 701 if (strcmp(varString, scaleString)) { 702 ScaleSetVariable(scalePtr); 703 } 704 } 705 Tcl_TraceVar(interp, Tcl_GetString(scalePtr->varNamePtr), 706 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, 707 ScaleVarProc, (ClientData) scalePtr); 708 } 709 710 ScaleWorldChanged((ClientData) scalePtr); 711 if (error) { 712 Tcl_SetObjResult(interp, errorResult); 713 Tcl_DecrRefCount(errorResult); 714 return TCL_ERROR; 715 } else { 716 return TCL_OK; 717 } 718} 719 720/* 721 *--------------------------------------------------------------------------- 722 * 723 * ScaleWorldChanged -- 724 * 725 * This procedure is called when the world has changed in some 726 * way and the widget needs to recompute all its graphics contexts 727 * and determine its new geometry. 728 * 729 * Results: 730 * None. 731 * 732 * Side effects: 733 * Scale will be relayed out and redisplayed. 734 * 735 *--------------------------------------------------------------------------- 736 */ 737 738static void 739ScaleWorldChanged(instanceData) 740 ClientData instanceData; /* Information about widget. */ 741{ 742 XGCValues gcValues; 743 GC gc; 744 TkScale *scalePtr; 745 746 scalePtr = (TkScale *) instanceData; 747 748 gcValues.foreground = scalePtr->troughColorPtr->pixel; 749 gc = Tk_GetGC(scalePtr->tkwin, GCForeground, &gcValues); 750 if (scalePtr->troughGC != None) { 751 Tk_FreeGC(scalePtr->display, scalePtr->troughGC); 752 } 753 scalePtr->troughGC = gc; 754 755 gcValues.font = Tk_FontId(scalePtr->tkfont); 756 gcValues.foreground = scalePtr->textColorPtr->pixel; 757 gc = Tk_GetGC(scalePtr->tkwin, GCForeground | GCFont, &gcValues); 758 if (scalePtr->textGC != None) { 759 Tk_FreeGC(scalePtr->display, scalePtr->textGC); 760 } 761 scalePtr->textGC = gc; 762 763 if (scalePtr->copyGC == None) { 764 gcValues.graphics_exposures = False; 765 scalePtr->copyGC = Tk_GetGC(scalePtr->tkwin, GCGraphicsExposures, 766 &gcValues); 767 } 768 scalePtr->inset = scalePtr->highlightWidth + scalePtr->borderWidth; 769 770 /* 771 * Recompute display-related information, and let the geometry 772 * manager know how much space is needed now. 773 */ 774 775 ComputeScaleGeometry(scalePtr); 776 777 TkEventuallyRedrawScale(scalePtr, REDRAW_ALL); 778} 779 780/* 781 *---------------------------------------------------------------------- 782 * 783 * ComputeFormat -- 784 * 785 * This procedure is invoked to recompute the "format" field 786 * of a scale's widget record, which determines how the value 787 * of the scale is converted to a string. 788 * 789 * Results: 790 * None. 791 * 792 * Side effects: 793 * The format field of scalePtr is modified. 794 * 795 *---------------------------------------------------------------------- 796 */ 797 798static void 799ComputeFormat(scalePtr) 800 TkScale *scalePtr; /* Information about scale widget. */ 801{ 802 double maxValue, x; 803 int mostSigDigit, numDigits, leastSigDigit, afterDecimal; 804 int eDigits, fDigits; 805 806 /* 807 * Compute the displacement from the decimal of the most significant 808 * digit required for any number in the scale's range. 809 */ 810 811 maxValue = fabs(scalePtr->fromValue); 812 x = fabs(scalePtr->toValue); 813 if (x > maxValue) { 814 maxValue = x; 815 } 816 if (maxValue == 0) { 817 maxValue = 1; 818 } 819 mostSigDigit = (int) floor(log10(maxValue)); 820 821 /* 822 * If the number of significant digits wasn't specified explicitly, 823 * compute it. It's the difference between the most significant 824 * digit needed to represent any number on the scale and the 825 * most significant digit of the smallest difference between 826 * numbers on the scale. In other words, display enough digits so 827 * that at least one digit will be different between any two adjacent 828 * positions of the scale. 829 */ 830 831 numDigits = scalePtr->digits; 832 if (numDigits <= 0) { 833 if (scalePtr->resolution > 0) { 834 /* 835 * A resolution was specified for the scale, so just use it. 836 */ 837 838 leastSigDigit = (int) floor(log10(scalePtr->resolution)); 839 } else { 840 /* 841 * No resolution was specified, so compute the difference 842 * in value between adjacent pixels and use it for the least 843 * significant digit. 844 */ 845 846 x = fabs(scalePtr->fromValue - scalePtr->toValue); 847 if (scalePtr->length > 0) { 848 x /= scalePtr->length; 849 } 850 if (x > 0){ 851 leastSigDigit = (int) floor(log10(x)); 852 } else { 853 leastSigDigit = 0; 854 } 855 } 856 numDigits = mostSigDigit - leastSigDigit + 1; 857 if (numDigits < 1) { 858 numDigits = 1; 859 } 860 } 861 862 /* 863 * Compute the number of characters required using "e" format and 864 * "f" format, and then choose whichever one takes fewer characters. 865 */ 866 867 eDigits = numDigits + 4; 868 if (numDigits > 1) { 869 eDigits++; /* Decimal point. */ 870 } 871 afterDecimal = numDigits - mostSigDigit - 1; 872 if (afterDecimal < 0) { 873 afterDecimal = 0; 874 } 875 fDigits = (mostSigDigit >= 0) ? mostSigDigit + afterDecimal : afterDecimal; 876 if (afterDecimal > 0) { 877 fDigits++; /* Decimal point. */ 878 } 879 if (mostSigDigit < 0) { 880 fDigits++; /* Zero to left of decimal point. */ 881 } 882 if (fDigits <= eDigits) { 883 sprintf(scalePtr->format, "%%.%df", afterDecimal); 884 } else { 885 sprintf(scalePtr->format, "%%.%de", numDigits-1); 886 } 887} 888 889/* 890 *---------------------------------------------------------------------- 891 * 892 * ComputeScaleGeometry -- 893 * 894 * This procedure is called to compute various geometrical 895 * information for a scale, such as where various things get 896 * displayed. It's called when the window is reconfigured. 897 * 898 * Results: 899 * None. 900 * 901 * Side effects: 902 * Display-related numbers get changed in *scalePtr. The 903 * geometry manager gets told about the window's preferred size. 904 * 905 *---------------------------------------------------------------------- 906 */ 907 908static void 909ComputeScaleGeometry(scalePtr) 910 register TkScale *scalePtr; /* Information about widget. */ 911{ 912 char valueString[PRINT_CHARS]; 913 int tmp, valuePixels, x, y, extraSpace; 914 Tk_FontMetrics fm; 915 916 Tk_GetFontMetrics(scalePtr->tkfont, &fm); 917 scalePtr->fontHeight = fm.linespace + SPACING; 918 919 /* 920 * Horizontal scales are simpler than vertical ones because 921 * all sizes are the same (the height of a line of text); 922 * handle them first and then quit. 923 */ 924 925 if (scalePtr->orient == ORIENT_HORIZONTAL) { 926 y = scalePtr->inset; 927 extraSpace = 0; 928 if (scalePtr->labelLength != 0) { 929 scalePtr->horizLabelY = y + SPACING; 930 y += scalePtr->fontHeight; 931 extraSpace = SPACING; 932 } 933 if (scalePtr->showValue) { 934 scalePtr->horizValueY = y + SPACING; 935 y += scalePtr->fontHeight; 936 extraSpace = SPACING; 937 } else { 938 scalePtr->horizValueY = y; 939 } 940 y += extraSpace; 941 scalePtr->horizTroughY = y; 942 y += scalePtr->width + 2*scalePtr->borderWidth; 943 if (scalePtr->tickInterval != 0) { 944 scalePtr->horizTickY = y + SPACING; 945 y += scalePtr->fontHeight + SPACING; 946 } 947 Tk_GeometryRequest(scalePtr->tkwin, 948 scalePtr->length + 2*scalePtr->inset, y + scalePtr->inset); 949 Tk_SetInternalBorder(scalePtr->tkwin, scalePtr->inset); 950 return; 951 } 952 953 /* 954 * Vertical scale: compute the amount of space needed to display 955 * the scales value by formatting strings for the two end points; 956 * use whichever length is longer. 957 */ 958 959 sprintf(valueString, scalePtr->format, scalePtr->fromValue); 960 valuePixels = Tk_TextWidth(scalePtr->tkfont, valueString, -1); 961 962 sprintf(valueString, scalePtr->format, scalePtr->toValue); 963 tmp = Tk_TextWidth(scalePtr->tkfont, valueString, -1); 964 if (valuePixels < tmp) { 965 valuePixels = tmp; 966 } 967 968 /* 969 * Assign x-locations to the elements of the scale, working from 970 * left to right. 971 */ 972 973 x = scalePtr->inset; 974 if ((scalePtr->tickInterval != 0) && (scalePtr->showValue)) { 975 scalePtr->vertTickRightX = x + SPACING + valuePixels; 976 scalePtr->vertValueRightX = scalePtr->vertTickRightX + valuePixels 977 + fm.ascent/2; 978 x = scalePtr->vertValueRightX + SPACING; 979 } else if (scalePtr->tickInterval != 0) { 980 scalePtr->vertTickRightX = x + SPACING + valuePixels; 981 scalePtr->vertValueRightX = scalePtr->vertTickRightX; 982 x = scalePtr->vertTickRightX + SPACING; 983 } else if (scalePtr->showValue) { 984 scalePtr->vertTickRightX = x; 985 scalePtr->vertValueRightX = x + SPACING + valuePixels; 986 x = scalePtr->vertValueRightX + SPACING; 987 } else { 988 scalePtr->vertTickRightX = x; 989 scalePtr->vertValueRightX = x; 990 } 991 scalePtr->vertTroughX = x; 992 x += 2*scalePtr->borderWidth + scalePtr->width; 993 if (scalePtr->labelLength == 0) { 994 scalePtr->vertLabelX = 0; 995 } else { 996 scalePtr->vertLabelX = x + fm.ascent/2; 997 x = scalePtr->vertLabelX + fm.ascent/2 998 + Tk_TextWidth(scalePtr->tkfont, scalePtr->label, 999 scalePtr->labelLength); 1000 } 1001 Tk_GeometryRequest(scalePtr->tkwin, x + scalePtr->inset, 1002 scalePtr->length + 2*scalePtr->inset); 1003 Tk_SetInternalBorder(scalePtr->tkwin, scalePtr->inset); 1004} 1005 1006/* 1007 *-------------------------------------------------------------- 1008 * 1009 * ScaleEventProc -- 1010 * 1011 * This procedure is invoked by the Tk dispatcher for various 1012 * events on scales. 1013 * 1014 * Results: 1015 * None. 1016 * 1017 * Side effects: 1018 * When the window gets deleted, internal structures get 1019 * cleaned up. When it gets exposed, it is redisplayed. 1020 * 1021 *-------------------------------------------------------------- 1022 */ 1023 1024static void 1025ScaleEventProc(clientData, eventPtr) 1026 ClientData clientData; /* Information about window. */ 1027 XEvent *eventPtr; /* Information about event. */ 1028{ 1029 TkScale *scalePtr = (TkScale *) clientData; 1030 1031 if ((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0)) { 1032 TkEventuallyRedrawScale(scalePtr, REDRAW_ALL); 1033 } else if (eventPtr->type == DestroyNotify) { 1034 DestroyScale((char *) clientData); 1035 } else if (eventPtr->type == ConfigureNotify) { 1036 ComputeScaleGeometry(scalePtr); 1037 TkEventuallyRedrawScale(scalePtr, REDRAW_ALL); 1038 } else if (eventPtr->type == FocusIn) { 1039 if (eventPtr->xfocus.detail != NotifyInferior) { 1040 scalePtr->flags |= GOT_FOCUS; 1041 if (scalePtr->highlightWidth > 0) { 1042 TkEventuallyRedrawScale(scalePtr, REDRAW_ALL); 1043 } 1044 } 1045 } else if (eventPtr->type == FocusOut) { 1046 if (eventPtr->xfocus.detail != NotifyInferior) { 1047 scalePtr->flags &= ~GOT_FOCUS; 1048 if (scalePtr->highlightWidth > 0) { 1049 TkEventuallyRedrawScale(scalePtr, REDRAW_ALL); 1050 } 1051 } 1052 } 1053} 1054 1055/* 1056 *---------------------------------------------------------------------- 1057 * 1058 * ScaleCmdDeletedProc -- 1059 * 1060 * This procedure is invoked when a widget command is deleted. If 1061 * the widget isn't already in the process of being destroyed, 1062 * this command destroys it. 1063 * 1064 * Results: 1065 * None. 1066 * 1067 * Side effects: 1068 * The widget is destroyed. 1069 * 1070 *---------------------------------------------------------------------- 1071 */ 1072 1073static void 1074ScaleCmdDeletedProc(clientData) 1075 ClientData clientData; /* Pointer to widget record for widget. */ 1076{ 1077 TkScale *scalePtr = (TkScale *) clientData; 1078 Tk_Window tkwin = scalePtr->tkwin; 1079 1080 /* 1081 * This procedure could be invoked either because the window was 1082 * destroyed and the command was then deleted (in which case tkwin 1083 * is NULL) or because the command was deleted, and then this procedure 1084 * destroys the widget. 1085 */ 1086 1087 if (!(scalePtr->flags & SCALE_DELETED)) { 1088 scalePtr->flags |= SCALE_DELETED; 1089 Tk_DestroyWindow(tkwin); 1090 } 1091} 1092 1093/* 1094 *-------------------------------------------------------------- 1095 * 1096 * TkEventuallyRedrawScale -- 1097 * 1098 * Arrange for part or all of a scale widget to redrawn at 1099 * the next convenient time in the future. 1100 * 1101 * Results: 1102 * None. 1103 * 1104 * Side effects: 1105 * If "what" is REDRAW_SLIDER then just the slider and the 1106 * value readout will be redrawn; if "what" is REDRAW_ALL 1107 * then the entire widget will be redrawn. 1108 * 1109 *-------------------------------------------------------------- 1110 */ 1111 1112void 1113TkEventuallyRedrawScale(scalePtr, what) 1114 register TkScale *scalePtr; /* Information about widget. */ 1115 int what; /* What to redraw: REDRAW_SLIDER 1116 * or REDRAW_ALL. */ 1117{ 1118 if ((what == 0) || (scalePtr->tkwin == NULL) 1119 || !Tk_IsMapped(scalePtr->tkwin)) { 1120 return; 1121 } 1122 if (!(scalePtr->flags & REDRAW_PENDING)) { 1123 scalePtr->flags |= REDRAW_PENDING; 1124 Tcl_DoWhenIdle(TkpDisplayScale, (ClientData) scalePtr); 1125 } 1126 scalePtr->flags |= what; 1127} 1128 1129/* 1130 *-------------------------------------------------------------- 1131 * 1132 * TkRoundToResolution -- 1133 * 1134 * Round a given floating-point value to the nearest multiple 1135 * of the scale's resolution. 1136 * 1137 * Results: 1138 * The return value is the rounded result. 1139 * 1140 * Side effects: 1141 * None. 1142 * 1143 *-------------------------------------------------------------- 1144 */ 1145 1146double 1147TkRoundToResolution(scalePtr, value) 1148 TkScale *scalePtr; /* Information about scale widget. */ 1149 double value; /* Value to round. */ 1150{ 1151 double rem, new, tick; 1152 1153 if (scalePtr->resolution <= 0) { 1154 return value; 1155 } 1156 tick = floor(value/scalePtr->resolution); 1157 new = scalePtr->resolution * tick; 1158 rem = value - new; 1159 if (rem < 0) { 1160 if (rem <= -scalePtr->resolution/2) { 1161 new = (tick - 1.0) * scalePtr->resolution; 1162 } 1163 } else { 1164 if (rem >= scalePtr->resolution/2) { 1165 new = (tick + 1.0) * scalePtr->resolution; 1166 } 1167 } 1168 return new; 1169} 1170 1171/* 1172 *---------------------------------------------------------------------- 1173 * 1174 * ScaleVarProc -- 1175 * 1176 * This procedure is invoked by Tcl whenever someone modifies a 1177 * variable associated with a scale widget. 1178 * 1179 * Results: 1180 * NULL is always returned. 1181 * 1182 * Side effects: 1183 * The value displayed in the scale will change to match the 1184 * variable's new value. If the variable has a bogus value then 1185 * it is reset to the value of the scale. 1186 * 1187 *---------------------------------------------------------------------- 1188 */ 1189 1190 /* ARGSUSED */ 1191static char * 1192ScaleVarProc(clientData, interp, name1, name2, flags) 1193 ClientData clientData; /* Information about button. */ 1194 Tcl_Interp *interp; /* Interpreter containing variable. */ 1195 CONST char *name1; /* Name of variable. */ 1196 CONST char *name2; /* Second part of variable name. */ 1197 int flags; /* Information about what happened. */ 1198{ 1199 register TkScale *scalePtr = (TkScale *) clientData; 1200 char *resultStr; 1201 double value; 1202 Tcl_Obj *valuePtr; 1203 int result; 1204 1205 /* 1206 * If the variable is unset, then immediately recreate it unless 1207 * the whole interpreter is going away. 1208 */ 1209 1210 if (flags & TCL_TRACE_UNSETS) { 1211 if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) { 1212 Tcl_TraceVar(interp, Tcl_GetString(scalePtr->varNamePtr), 1213 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS, 1214 ScaleVarProc, clientData); 1215 scalePtr->flags |= NEVER_SET; 1216 TkScaleSetValue(scalePtr, scalePtr->value, 1, 0); 1217 } 1218 return (char *) NULL; 1219 } 1220 1221 /* 1222 * If we came here because we updated the variable (in TkScaleSetValue), 1223 * then ignore the trace. Otherwise update the scale with the value 1224 * of the variable. 1225 */ 1226 1227 if (scalePtr->flags & SETTING_VAR) { 1228 return (char *) NULL; 1229 } 1230 resultStr = NULL; 1231 valuePtr = Tcl_ObjGetVar2(interp, scalePtr->varNamePtr, NULL, 1232 TCL_GLOBAL_ONLY); 1233 result = Tcl_GetDoubleFromObj(interp, valuePtr, &value); 1234 if (result != TCL_OK) { 1235 resultStr = "can't assign non-numeric value to scale variable"; 1236 ScaleSetVariable(scalePtr); 1237 } else { 1238 scalePtr->value = TkRoundToResolution(scalePtr, value); 1239 1240 /* 1241 * This code is a bit tricky because it sets the scale's value before 1242 * calling TkScaleSetValue. This way, TkScaleSetValue won't bother 1243 * to set the variable again or to invoke the -command. However, it 1244 * also won't redisplay the scale, so we have to ask for that 1245 * explicitly. 1246 */ 1247 1248 TkScaleSetValue(scalePtr, scalePtr->value, 1, 0); 1249 } 1250 TkEventuallyRedrawScale(scalePtr, REDRAW_SLIDER); 1251 1252 return resultStr; 1253} 1254 1255/* 1256 *-------------------------------------------------------------- 1257 * 1258 * TkScaleSetValue -- 1259 * 1260 * This procedure changes the value of a scale and invokes 1261 * a Tcl command to reflect the current position of a scale 1262 * 1263 * Results: 1264 * None. 1265 * 1266 * Side effects: 1267 * A Tcl command is invoked, and an additional error-processing 1268 * command may also be invoked. The scale's slider is redrawn. 1269 * 1270 *-------------------------------------------------------------- 1271 */ 1272 1273void 1274TkScaleSetValue(scalePtr, value, setVar, invokeCommand) 1275 register TkScale *scalePtr; /* Info about widget. */ 1276 double value; /* New value for scale. Gets adjusted 1277 * if it's off the scale. */ 1278 int setVar; /* Non-zero means reflect new value through 1279 * to associated variable, if any. */ 1280 int invokeCommand; /* Non-zero means invoked -command option 1281 * to notify of new value, 0 means don't. */ 1282{ 1283 value = TkRoundToResolution(scalePtr, value); 1284 if ((value < scalePtr->fromValue) 1285 ^ (scalePtr->toValue < scalePtr->fromValue)) { 1286 value = scalePtr->fromValue; 1287 } 1288 if ((value > scalePtr->toValue) 1289 ^ (scalePtr->toValue < scalePtr->fromValue)) { 1290 value = scalePtr->toValue; 1291 } 1292 if (scalePtr->flags & NEVER_SET) { 1293 scalePtr->flags &= ~NEVER_SET; 1294 } else if (scalePtr->value == value) { 1295 return; 1296 } 1297 scalePtr->value = value; 1298 if (invokeCommand) { 1299 scalePtr->flags |= INVOKE_COMMAND; 1300 } 1301 TkEventuallyRedrawScale(scalePtr, REDRAW_SLIDER); 1302 1303 if (setVar && scalePtr->varNamePtr) { 1304 ScaleSetVariable(scalePtr); 1305 } 1306} 1307 1308/* 1309 *-------------------------------------------------------------- 1310 * 1311 * ScaleSetVariable -- 1312 * 1313 * This procedure sets the variable associated with a scale, if any. 1314 * 1315 * Results: 1316 * None. 1317 * 1318 * Side effects: 1319 * Other write traces on the variable will trigger. 1320 * 1321 *-------------------------------------------------------------- 1322 */ 1323 1324static void 1325ScaleSetVariable(scalePtr) 1326 register TkScale *scalePtr; /* Info about widget. */ 1327{ 1328 if (scalePtr->varNamePtr != NULL) { 1329 char string[PRINT_CHARS]; 1330 sprintf(string, scalePtr->format, scalePtr->value); 1331 scalePtr->flags |= SETTING_VAR; 1332 Tcl_ObjSetVar2(scalePtr->interp, scalePtr->varNamePtr, NULL, 1333 Tcl_NewStringObj(string, -1), TCL_GLOBAL_ONLY); 1334 scalePtr->flags &= ~SETTING_VAR; 1335 } 1336} 1337 1338/* 1339 *---------------------------------------------------------------------- 1340 * 1341 * TkScalePixelToValue -- 1342 * 1343 * Given a pixel within a scale window, return the scale 1344 * reading corresponding to that pixel. 1345 * 1346 * Results: 1347 * A double-precision scale reading. If the value is outside 1348 * the legal range for the scale then it's rounded to the nearest 1349 * end of the scale. 1350 * 1351 * Side effects: 1352 * None. 1353 * 1354 *---------------------------------------------------------------------- 1355 */ 1356 1357double 1358TkScalePixelToValue(scalePtr, x, y) 1359 register TkScale *scalePtr; /* Information about widget. */ 1360 int x, y; /* Coordinates of point within 1361 * window. */ 1362{ 1363 double value, pixelRange; 1364 1365 if (scalePtr->orient == ORIENT_VERTICAL) { 1366 pixelRange = Tk_Height(scalePtr->tkwin) - scalePtr->sliderLength 1367 - 2*scalePtr->inset - 2*scalePtr->borderWidth; 1368 value = y; 1369 } else { 1370 pixelRange = Tk_Width(scalePtr->tkwin) - scalePtr->sliderLength 1371 - 2*scalePtr->inset - 2*scalePtr->borderWidth; 1372 value = x; 1373 } 1374 1375 if (pixelRange <= 0) { 1376 /* 1377 * Not enough room for the slider to actually slide: just return 1378 * the scale's current value. 1379 */ 1380 1381 return scalePtr->value; 1382 } 1383 value -= scalePtr->sliderLength/2 + scalePtr->inset 1384 + scalePtr->borderWidth; 1385 value /= pixelRange; 1386 if (value < 0) { 1387 value = 0; 1388 } 1389 if (value > 1) { 1390 value = 1; 1391 } 1392 value = scalePtr->fromValue + 1393 value * (scalePtr->toValue - scalePtr->fromValue); 1394 return TkRoundToResolution(scalePtr, value); 1395} 1396 1397/* 1398 *---------------------------------------------------------------------- 1399 * 1400 * TkScaleValueToPixel -- 1401 * 1402 * Given a reading of the scale, return the x-coordinate or 1403 * y-coordinate corresponding to that reading, depending on 1404 * whether the scale is vertical or horizontal, respectively. 1405 * 1406 * Results: 1407 * An integer value giving the pixel location corresponding 1408 * to reading. The value is restricted to lie within the 1409 * defined range for the scale. 1410 * 1411 * Side effects: 1412 * None. 1413 * 1414 *---------------------------------------------------------------------- 1415 */ 1416 1417int 1418TkScaleValueToPixel(scalePtr, value) 1419 register TkScale *scalePtr; /* Information about widget. */ 1420 double value; /* Reading of the widget. */ 1421{ 1422 int y, pixelRange; 1423 double valueRange; 1424 1425 valueRange = scalePtr->toValue - scalePtr->fromValue; 1426 pixelRange = ((scalePtr->orient == ORIENT_VERTICAL) 1427 ? Tk_Height(scalePtr->tkwin) : Tk_Width(scalePtr->tkwin)) 1428 - scalePtr->sliderLength - 2*scalePtr->inset - 2*scalePtr->borderWidth; 1429 if (valueRange == 0) { 1430 y = 0; 1431 } else { 1432 y = (int) ((value - scalePtr->fromValue) * pixelRange 1433 / valueRange + 0.5); 1434 if (y < 0) { 1435 y = 0; 1436 } else if (y > pixelRange) { 1437 y = pixelRange; 1438 } 1439 } 1440 y += scalePtr->sliderLength/2 + scalePtr->inset + scalePtr->borderWidth; 1441 return y; 1442} 1443