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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 42 - (show annotations) (download)
Fri Oct 14 01:50:00 2016 UTC (8 years ago) by dashley
Original Path: projs/trunk/shared_source/tk_base/tkscale.c
File MIME type: text/plain
File size: 45298 byte(s)
Move shared source code to commonize.
1 /* $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