/[dtapublic]/projs/trunk/shared_source/c_tk_base_7_5_w_mods/tkscale.c
ViewVC logotype

Annotation of /projs/trunk/shared_source/c_tk_base_7_5_w_mods/tkscale.c

Parent Directory Parent Directory | Revision Log Revision Log


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

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25