开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Windows编程 > 通讯编程 > 查看源码
tkScale.c
资源名称：ns-allinone-2.33.tar.gz　[点击查看]
上传用户：rrhhcc
上传日期：2015-12-11
资源大小：54129k
文件大小：42k
源码类别：

通讯编程

开发平台：

Visual C++

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