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