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