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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

sf_code/esrgpcpj/shared/tk_base/tkscale.c revision 25 by dashley, Sat Oct 8 06:43:03 2016 UTC projs/trunk/shared_source/c_tk_base_7_5_w_mods/tkscale.c revision 71 by dashley, Sat Nov 5 11:07:06 2016 UTC
# Line 1  Line 1 
 /* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tk_base/tkscale.c,v 1.1.1.1 2001/06/13 05:07:45 dtashley Exp $ */  
   
 /*  
  * tkScale.c --  
  *  
  *      This module implements a scale widgets for the Tk toolkit.  
  *      A scale displays a slider that can be adjusted to change a  
  *      value;  it also displays numeric labels and a textual label,  
  *      if desired.  
  *        
  *      The modifications to use floating-point values are based on  
  *      an implementation by Paul Mackerras.  The -variable option  
  *      is due to Henning Schulzrinne.  All of these are used with  
  *      permission.  
  *  
  * Copyright (c) 1990-1994 The Regents of the University of California.  
  * Copyright (c) 1994-1997 Sun Microsystems, Inc.  
  * Copyright (c) 1998-2000 by Scriptics Corporation.  
  *  
  * See the file "license.terms" for information on usage and redistribution  
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.  
  *  
  * RCS: @(#) $Id: tkscale.c,v 1.1.1.1 2001/06/13 05:07:45 dtashley Exp $  
  */  
   
 #include "tkPort.h"  
 #include "default.h"  
 #include "tkInt.h"  
 #include "tclMath.h"  
 #include "tkScale.h"  
   
 /*  
  * The following table defines the legal values for the -orient option.  
  * It is used together with the "enum orient" declaration in tkScale.h.  
  */  
   
 static char *orientStrings[] = {  
     "horizontal", "vertical", (char *) NULL  
 };  
   
 /*  
  * The following table defines the legal values for the -state option.  
  * It is used together with the "enum state" declaration in tkScale.h.  
  */  
   
 static char *stateStrings[] = {  
     "active", "disabled", "normal", (char *) NULL  
 };  
   
 static Tk_OptionSpec optionSpecs[] = {  
     {TK_OPTION_BORDER, "-activebackground", "activeBackground", "Foreground",  
         DEF_SCALE_ACTIVE_BG_COLOR, -1, Tk_Offset(TkScale, activeBorder),  
         0, (ClientData) DEF_SCALE_ACTIVE_BG_MONO, 0},  
     {TK_OPTION_BORDER, "-background", "background", "Background",  
         DEF_SCALE_BG_COLOR, -1, Tk_Offset(TkScale, bgBorder),  
         0, (ClientData) DEF_SCALE_BG_MONO, 0},  
     {TK_OPTION_DOUBLE, "-bigincrement", "bigIncrement", "BigIncrement",  
         DEF_SCALE_BIG_INCREMENT, -1, Tk_Offset(TkScale, bigIncrement),  
         0, 0, 0},  
     {TK_OPTION_SYNONYM, "-bd", (char *) NULL, (char *) NULL,  
         (char *) NULL, 0, -1, 0, (ClientData) "-borderwidth", 0},  
     {TK_OPTION_SYNONYM, "-bg", (char *) NULL, (char *) NULL,  
         (char *) NULL, 0, -1, 0, (ClientData) "-background", 0},  
     {TK_OPTION_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",  
         DEF_SCALE_BORDER_WIDTH, -1, Tk_Offset(TkScale, borderWidth),  
         0, 0, 0},  
     {TK_OPTION_STRING, "-command", "command", "Command",  
         DEF_SCALE_COMMAND, -1, Tk_Offset(TkScale, command),  
         TK_OPTION_NULL_OK, 0, 0},  
     {TK_OPTION_CURSOR, "-cursor", "cursor", "Cursor",  
         DEF_SCALE_CURSOR, -1, Tk_Offset(TkScale, cursor),  
         TK_OPTION_NULL_OK, 0, 0},  
     {TK_OPTION_INT, "-digits", "digits", "Digits",  
         DEF_SCALE_DIGITS, -1, Tk_Offset(TkScale, digits),  
         0, 0, 0},  
     {TK_OPTION_SYNONYM, "-fg", "foreground", (char *) NULL,  
         (char *) NULL, 0, -1, 0, (ClientData) "-foreground", 0},  
     {TK_OPTION_FONT, "-font", "font", "Font",  
         DEF_SCALE_FONT, -1, Tk_Offset(TkScale, tkfont), 0, 0, 0},  
     {TK_OPTION_COLOR, "-foreground", "foreground", "Foreground",  
         DEF_SCALE_FG_COLOR, -1, Tk_Offset(TkScale, textColorPtr), 0,  
         (ClientData) DEF_SCALE_FG_MONO, 0},  
     {TK_OPTION_DOUBLE, "-from", "from", "From", DEF_SCALE_FROM, -1,  
         Tk_Offset(TkScale, fromValue), 0, 0, 0},  
     {TK_OPTION_BORDER, "-highlightbackground", "highlightBackground",  
         "HighlightBackground", DEF_SCALE_HIGHLIGHT_BG_COLOR,  
         -1, Tk_Offset(TkScale, highlightBorder),  
         0, (ClientData) DEF_SCALE_HIGHLIGHT_BG_MONO, 0},  
     {TK_OPTION_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",  
         DEF_SCALE_HIGHLIGHT, -1, Tk_Offset(TkScale, highlightColorPtr),  
         0, 0, 0},  
     {TK_OPTION_PIXELS, "-highlightthickness", "highlightThickness",  
         "HighlightThickness", DEF_SCALE_HIGHLIGHT_WIDTH, -1,  
         Tk_Offset(TkScale, highlightWidth), 0, 0, 0},  
     {TK_OPTION_STRING, "-label", "label", "Label",  
         DEF_SCALE_LABEL, -1, Tk_Offset(TkScale, label),  
         TK_OPTION_NULL_OK, 0, 0},  
     {TK_OPTION_PIXELS, "-length", "length", "Length",  
         DEF_SCALE_LENGTH, -1, Tk_Offset(TkScale, length), 0, 0, 0},  
     {TK_OPTION_STRING_TABLE, "-orient", "orient", "Orient",  
         DEF_SCALE_ORIENT, -1, Tk_Offset(TkScale, orient),  
         0, (ClientData) orientStrings, 0},  
     {TK_OPTION_RELIEF, "-relief", "relief", "Relief",  
         DEF_SCALE_RELIEF, -1, Tk_Offset(TkScale, relief), 0, 0, 0},  
     {TK_OPTION_INT, "-repeatdelay", "repeatDelay", "RepeatDelay",  
         DEF_SCALE_REPEAT_DELAY, -1, Tk_Offset(TkScale, repeatDelay),  
         0, 0, 0},  
     {TK_OPTION_INT, "-repeatinterval", "repeatInterval", "RepeatInterval",  
         DEF_SCALE_REPEAT_INTERVAL, -1, Tk_Offset(TkScale, repeatInterval),  
         0, 0, 0},  
     {TK_OPTION_DOUBLE, "-resolution", "resolution", "Resolution",  
         DEF_SCALE_RESOLUTION, -1, Tk_Offset(TkScale, resolution),  
         0, 0, 0},  
     {TK_OPTION_BOOLEAN, "-showvalue", "showValue", "ShowValue",  
         DEF_SCALE_SHOW_VALUE, -1, Tk_Offset(TkScale, showValue),  
         0, 0, 0},  
     {TK_OPTION_PIXELS, "-sliderlength", "sliderLength", "SliderLength",  
         DEF_SCALE_SLIDER_LENGTH, -1, Tk_Offset(TkScale, sliderLength),  
         0, 0, 0},  
     {TK_OPTION_RELIEF, "-sliderrelief", "sliderRelief", "SliderRelief",  
         DEF_SCALE_SLIDER_RELIEF, -1, Tk_Offset(TkScale, sliderRelief),  
         0, 0, 0},  
     {TK_OPTION_STRING_TABLE, "-state", "state", "State",  
         DEF_SCALE_STATE, -1, Tk_Offset(TkScale, state),  
         0, (ClientData) stateStrings, 0},  
     {TK_OPTION_STRING, "-takefocus", "takeFocus", "TakeFocus",  
         DEF_SCALE_TAKE_FOCUS, Tk_Offset(TkScale, takeFocusPtr), -1,  
         TK_OPTION_NULL_OK, 0, 0},  
     {TK_OPTION_DOUBLE, "-tickinterval", "tickInterval", "TickInterval",  
         DEF_SCALE_TICK_INTERVAL, -1, Tk_Offset(TkScale, tickInterval),  
         0, 0, 0},  
     {TK_OPTION_DOUBLE, "-to", "to", "To",  
         DEF_SCALE_TO, -1, Tk_Offset(TkScale, toValue), 0, 0, 0},  
     {TK_OPTION_COLOR, "-troughcolor", "troughColor", "Background",  
         DEF_SCALE_TROUGH_COLOR, -1, Tk_Offset(TkScale, troughColorPtr),  
         0, (ClientData) DEF_SCALE_TROUGH_MONO, 0},  
     {TK_OPTION_STRING, "-variable", "variable", "Variable",  
         DEF_SCALE_VARIABLE, Tk_Offset(TkScale, varNamePtr), -1,  
         TK_OPTION_NULL_OK, 0, 0},  
     {TK_OPTION_PIXELS, "-width", "width", "Width",  
         DEF_SCALE_WIDTH, -1, Tk_Offset(TkScale, width), 0, 0, 0},  
     {TK_OPTION_END, (char *) NULL, (char *) NULL, (char *) NULL,  
         (char *) NULL, 0, -1, 0, 0, 0}  
 };  
   
 /*  
  * The following tables define the scale widget commands and map the  
  * indexes into the string tables into a single enumerated type used  
  * to dispatch the scale widget command.  
  */  
   
 static char *commandNames[] = {  
     "cget", "configure", "coords", "get", "identify", "set", (char *) NULL  
 };  
   
 enum command {  
     COMMAND_CGET, COMMAND_CONFIGURE, COMMAND_COORDS, COMMAND_GET,  
     COMMAND_IDENTIFY, COMMAND_SET  
 };  
   
 /*  
  * Forward declarations for procedures defined later in this file:  
  */  
   
 static void             ComputeFormat _ANSI_ARGS_((TkScale *scalePtr));  
 static void             ComputeScaleGeometry _ANSI_ARGS_((TkScale *scalePtr));  
 static int              ConfigureScale _ANSI_ARGS_((Tcl_Interp *interp,  
                             TkScale *scalePtr, int objc,  
                             Tcl_Obj *CONST objv[]));  
 static void             DestroyScale _ANSI_ARGS_((char *memPtr));  
 static void             ScaleCmdDeletedProc _ANSI_ARGS_((  
                             ClientData clientData));  
 static void             ScaleEventProc _ANSI_ARGS_((ClientData clientData,  
                             XEvent *eventPtr));  
 static char *           ScaleVarProc _ANSI_ARGS_((ClientData clientData,  
                             Tcl_Interp *interp, char *name1, char *name2,  
                             int flags));  
 static int              ScaleWidgetObjCmd _ANSI_ARGS_((ClientData clientData,  
                             Tcl_Interp *interp, int objc,  
                             Tcl_Obj *CONST objv[]));  
 static void             ScaleWorldChanged _ANSI_ARGS_((  
                             ClientData instanceData));  
 static void             ScaleSetVariable _ANSI_ARGS_((TkScale *scalePtr));  
   
 /*  
  * The structure below defines scale class behavior by means of procedures  
  * that can be invoked from generic window code.  
  */  
   
 static TkClassProcs scaleClass = {  
     NULL,                       /* createProc. */  
     ScaleWorldChanged,          /* geometryProc. */  
     NULL                        /* modalProc. */  
 };  
   
   
 /*  
  *--------------------------------------------------------------  
  *  
  * Tk_ScaleObjCmd --  
  *  
  *      This procedure is invoked to process the "scale" Tcl  
  *      command.  See the user documentation for details on what  
  *      it does.  
  *  
  * Results:  
  *      A standard Tcl result.  
  *  
  * Side effects:  
  *      See the user documentation.  
  *  
  *--------------------------------------------------------------  
  */  
   
 int  
 Tk_ScaleObjCmd(clientData, interp, objc, objv)  
     ClientData clientData;      /* Either NULL or pointer to option table. */  
     Tcl_Interp *interp;         /* Current interpreter. */  
     int objc;                   /* Number of arguments. */  
     Tcl_Obj *CONST objv[];      /* Argument values. */  
 {  
     register TkScale *scalePtr;  
     Tk_OptionTable optionTable;  
     Tk_Window tkwin;  
   
     optionTable = (Tk_OptionTable) clientData;  
     if (optionTable == NULL) {  
         Tcl_CmdInfo info;  
         char *name;  
   
         /*  
          * We haven't created the option table for this widget class  
          * yet.  Do it now and save the table as the clientData for  
          * the command, so we'll have access to it in future  
          * invocations of the command.  
          */  
   
         optionTable = Tk_CreateOptionTable(interp, optionSpecs);  
         name = Tcl_GetString(objv[0]);  
         Tcl_GetCommandInfo(interp, name, &info);  
         info.objClientData = (ClientData) optionTable;  
         Tcl_SetCommandInfo(interp, name, &info);  
     }  
   
     if (objc < 2) {  
         Tcl_WrongNumArgs(interp, 1, objv, "pathName ?options?");  
         return TCL_ERROR;  
     }  
   
     tkwin = Tk_CreateWindowFromPath(interp, Tk_MainWindow(interp),  
             Tcl_GetString(objv[1]), (char *) NULL);  
     if (tkwin == NULL) {  
         return TCL_ERROR;  
     }  
   
     Tk_SetClass(tkwin, "Scale");  
     scalePtr = TkpCreateScale(tkwin);  
   
     /*  
      * Initialize fields that won't be initialized by ConfigureScale,  
      * or which ConfigureScale expects to have reasonable values  
      * (e.g. resource pointers).  
      */  
   
     scalePtr->tkwin             = tkwin;  
     scalePtr->display           = Tk_Display(tkwin);  
     scalePtr->interp            = interp;  
     scalePtr->widgetCmd         = Tcl_CreateObjCommand(interp,  
             Tk_PathName(scalePtr->tkwin), ScaleWidgetObjCmd,  
             (ClientData) scalePtr, ScaleCmdDeletedProc);  
     scalePtr->optionTable       = optionTable;  
     scalePtr->orient            = ORIENT_VERTICAL;  
     scalePtr->width             = 0;  
     scalePtr->length            = 0;  
     scalePtr->value             = 0.0;  
     scalePtr->varNamePtr        = NULL;  
     scalePtr->fromValue         = 0.0;  
     scalePtr->toValue           = 0.0;  
     scalePtr->tickInterval      = 0.0;  
     scalePtr->resolution        = 1.0;  
     scalePtr->digits            = 0;  
     scalePtr->bigIncrement      = 0.0;  
     scalePtr->command           = NULL;  
     scalePtr->repeatDelay       = 0;  
     scalePtr->repeatInterval    = 0;  
     scalePtr->label             = NULL;  
     scalePtr->labelLength       = 0;  
     scalePtr->state             = STATE_NORMAL;  
     scalePtr->borderWidth       = 0;  
     scalePtr->bgBorder          = NULL;  
     scalePtr->activeBorder      = NULL;  
     scalePtr->sliderRelief      = TK_RELIEF_RAISED;  
     scalePtr->troughColorPtr    = NULL;  
     scalePtr->troughGC          = None;  
     scalePtr->copyGC            = None;  
     scalePtr->tkfont            = NULL;  
     scalePtr->textColorPtr      = NULL;  
     scalePtr->textGC            = None;  
     scalePtr->relief            = TK_RELIEF_FLAT;  
     scalePtr->highlightWidth    = 0;  
     scalePtr->highlightBorder   = NULL;  
     scalePtr->highlightColorPtr = NULL;  
     scalePtr->inset             = 0;  
     scalePtr->sliderLength      = 0;  
     scalePtr->showValue         = 0;  
     scalePtr->horizLabelY       = 0;  
     scalePtr->horizValueY       = 0;  
     scalePtr->horizTroughY      = 0;  
     scalePtr->horizTickY        = 0;  
     scalePtr->vertTickRightX    = 0;  
     scalePtr->vertValueRightX   = 0;  
     scalePtr->vertTroughX       = 0;  
     scalePtr->vertLabelX        = 0;  
     scalePtr->fontHeight        = 0;  
     scalePtr->cursor            = None;  
     scalePtr->takeFocusPtr      = NULL;  
     scalePtr->flags             = NEVER_SET;  
   
     TkSetClassProcs(scalePtr->tkwin, &scaleClass, (ClientData) scalePtr);  
     Tk_CreateEventHandler(scalePtr->tkwin,  
             ExposureMask|StructureNotifyMask|FocusChangeMask,  
             ScaleEventProc, (ClientData) scalePtr);  
   
     if ((Tk_InitOptions(interp, (char *) scalePtr, optionTable, tkwin)  
             != TCL_OK) ||  
             (ConfigureScale(interp, scalePtr, objc - 2, objv + 2) != TCL_OK)) {  
         Tk_DestroyWindow(scalePtr->tkwin);  
         return TCL_ERROR;  
     }  
   
     Tcl_SetResult(interp, Tk_PathName(scalePtr->tkwin), TCL_STATIC);  
     return TCL_OK;  
 }  
   
 /*  
  *--------------------------------------------------------------  
  *  
  * ScaleWidgetObjCmd --  
  *  
  *      This procedure is invoked to process the Tcl command  
  *      that corresponds to a widget managed by this module.  
  *      See the user documentation for details on what it does.  
  *  
  * Results:  
  *      A standard Tcl result.  
  *  
  * Side effects:  
  *      See the user documentation.  
  *  
  *--------------------------------------------------------------  
  */  
   
 static int  
 ScaleWidgetObjCmd(clientData, interp, objc, objv)  
     ClientData clientData;              /* Information about scale  
                                          * widget. */  
     Tcl_Interp *interp;                 /* Current interpreter. */  
     int objc;                           /* Number of arguments. */  
     Tcl_Obj *CONST objv[];              /* Argument strings. */  
 {  
     TkScale *scalePtr = (TkScale *) clientData;  
     Tcl_Obj *objPtr;  
     int index, result;  
   
     if (objc < 2) {  
         Tcl_WrongNumArgs(interp, 1, objv, "option ?arg arg ...?");  
         return TCL_ERROR;  
     }  
     result = Tcl_GetIndexFromObj(interp, objv[1], commandNames,  
             "option", 0, &index);  
     if (result != TCL_OK) {  
         return result;  
     }  
     Tcl_Preserve((ClientData) scalePtr);  
   
     switch (index) {  
         case COMMAND_CGET: {  
             if (objc != 3) {  
                 Tcl_WrongNumArgs(interp, 1, objv, "cget option");  
                 goto error;  
             }  
             objPtr = Tk_GetOptionValue(interp, (char *) scalePtr,  
                     scalePtr->optionTable, objv[2], scalePtr->tkwin);  
             if (objPtr == NULL) {  
                  goto error;  
             } else {  
                 Tcl_SetObjResult(interp, objPtr);  
             }  
             break;  
         }  
         case COMMAND_CONFIGURE: {  
             if (objc <= 3) {  
                 objPtr = Tk_GetOptionInfo(interp, (char *) scalePtr,  
                         scalePtr->optionTable,  
                         (objc == 3) ? objv[2] : (Tcl_Obj *) NULL,  
                         scalePtr->tkwin);  
                 if (objPtr == NULL) {  
                     goto error;  
                 } else {  
                     Tcl_SetObjResult(interp, objPtr);  
                 }  
             } else {  
                 result = ConfigureScale(interp, scalePtr, objc-2, objv+2);  
             }  
             break;  
         }  
         case COMMAND_COORDS: {  
             int x, y ;  
             double value;  
             char buf[TCL_INTEGER_SPACE * 2];  
   
             if ((objc != 2) && (objc != 3)) {  
                 Tcl_WrongNumArgs(interp, 1, objv, "coords ?value?");  
                 goto error;  
             }  
             if (objc == 3) {  
                 if (Tcl_GetDoubleFromObj(interp, objv[2], &value)  
                         != TCL_OK) {  
                     goto error;  
                 }  
             } else {  
                 value = scalePtr->value;  
             }  
             if (scalePtr->orient == ORIENT_VERTICAL) {  
                 x = scalePtr->vertTroughX + scalePtr->width/2  
                         + scalePtr->borderWidth;  
                 y = TkScaleValueToPixel(scalePtr, value);  
             } else {  
                 x = TkScaleValueToPixel(scalePtr, value);  
                 y = scalePtr->horizTroughY + scalePtr->width/2  
                         + scalePtr->borderWidth;  
             }  
             sprintf(buf, "%d %d", x, y);  
             Tcl_SetResult(interp, buf, TCL_VOLATILE);  
             break;  
         }  
         case COMMAND_GET: {  
             double value;  
             int x, y;  
             char buf[TCL_DOUBLE_SPACE];  
   
             if ((objc != 2) && (objc != 4)) {  
                 Tcl_WrongNumArgs(interp, 1, objv, "get ?x y?");  
                 goto error;  
             }  
             if (objc == 2) {  
                 value = scalePtr->value;  
             } else {  
                 if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK)  
                         || (Tcl_GetIntFromObj(interp, objv[3], &y)  
                         != TCL_OK)) {  
                     goto error;  
                 }  
                 value = TkScalePixelToValue(scalePtr, x, y);  
             }  
             sprintf(buf, scalePtr->format, value);  
             Tcl_SetResult(interp, buf, TCL_VOLATILE);  
             break;  
         }  
         case COMMAND_IDENTIFY: {  
             int x, y, thing;  
   
             if (objc != 4) {  
                 Tcl_WrongNumArgs(interp, 1, objv, "identify x y");  
                 goto error;  
             }  
             if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK)  
                     || (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)) {  
                 goto error;  
             }  
             thing = TkpScaleElement(scalePtr, x,y);  
             switch (thing) {  
                 case TROUGH1:  
                     Tcl_SetResult(interp, "trough1", TCL_STATIC);  
                     break;  
                 case SLIDER:  
                     Tcl_SetResult(interp, "slider", TCL_STATIC);  
                     break;  
                 case TROUGH2:  
                     Tcl_SetResult(interp, "trough2", TCL_STATIC);  
                     break;  
             }  
             break;  
         }  
         case COMMAND_SET: {  
             double value;  
   
             if (objc != 3) {  
                 Tcl_WrongNumArgs(interp, 1, objv, "set value");  
                 goto error;  
             }  
             if (Tcl_GetDoubleFromObj(interp, objv[2], &value) != TCL_OK) {  
                 goto error;  
             }  
             if (scalePtr->state != STATE_DISABLED) {  
               TkScaleSetValue(scalePtr, value, 1, 1);  
             }  
             break;  
         }  
     }  
     Tcl_Release((ClientData) scalePtr);  
     return result;  
   
     error:  
     Tcl_Release((ClientData) scalePtr);  
     return TCL_ERROR;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * DestroyScale --  
  *  
  *      This procedure is invoked by Tcl_EventuallyFree or Tcl_Release  
  *      to clean up the internal structure of a button at a safe time  
  *      (when no-one is using it anymore).  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      Everything associated with the scale is freed up.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static void  
 DestroyScale(memPtr)  
     char *memPtr;       /* Info about scale widget. */  
 {  
     register TkScale *scalePtr = (TkScale *) memPtr;  
   
     scalePtr->flags |= SCALE_DELETED;  
   
     Tcl_DeleteCommandFromToken(scalePtr->interp, scalePtr->widgetCmd);  
     if (scalePtr->flags & REDRAW_PENDING) {  
         Tcl_CancelIdleCall(TkpDisplayScale, (ClientData) scalePtr);  
     }  
   
     /*  
      * Free up all the stuff that requires special handling, then  
      * let Tk_FreeOptions handle all the standard option-related  
      * stuff.  
      */  
   
     if (scalePtr->varNamePtr != NULL) {  
         Tcl_UntraceVar(scalePtr->interp, Tcl_GetString(scalePtr->varNamePtr),  
                 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,  
                 ScaleVarProc, (ClientData) scalePtr);  
     }  
     if (scalePtr->troughGC != None) {  
         Tk_FreeGC(scalePtr->display, scalePtr->troughGC);  
     }  
     if (scalePtr->copyGC != None) {  
         Tk_FreeGC(scalePtr->display, scalePtr->copyGC);  
     }  
     if (scalePtr->textGC != None) {  
         Tk_FreeGC(scalePtr->display, scalePtr->textGC);  
     }  
     Tk_FreeConfigOptions((char *) scalePtr, scalePtr->optionTable,  
             scalePtr->tkwin);  
     scalePtr->tkwin = NULL;  
     TkpDestroyScale(scalePtr);  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * ConfigureScale --  
  *  
  *      This procedure is called to process an argv/argc list, plus  
  *      the Tk option database, in order to configure (or  
  *      reconfigure) a scale widget.  
  *  
  * Results:  
  *      The return value is a standard Tcl result.  If TCL_ERROR is  
  *      returned, then the interp's result contains an error message.  
  *  
  * Side effects:  
  *      Configuration information, such as colors, border width,  
  *      etc. get set for scalePtr;  old resources get freed,  
  *      if there were any.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static int  
 ConfigureScale(interp, scalePtr, objc, objv)  
     Tcl_Interp *interp;         /* Used for error reporting. */  
     register TkScale *scalePtr; /* Information about widget;  may or may  
                                  * not already have values for some fields. */  
     int objc;                   /* Number of valid entries in objv. */  
     Tcl_Obj *CONST objv[];      /* Argument values. */  
 {  
     Tk_SavedOptions savedOptions;  
     Tcl_Obj *errorResult = NULL;  
     int error;  
     double oldValue = scalePtr->value;  
   
     /*  
      * Eliminate any existing trace on a variable monitored by the scale.  
      */  
   
     if (scalePtr->varNamePtr != NULL) {  
         Tcl_UntraceVar(interp, Tcl_GetString(scalePtr->varNamePtr),  
                 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,  
                 ScaleVarProc, (ClientData) scalePtr);  
     }  
   
     for (error = 0; error <= 1; error++) {  
         if (!error) {  
             /*  
              * First pass: set options to new values.  
              */  
   
             if (Tk_SetOptions(interp, (char *) scalePtr,  
                     scalePtr->optionTable, objc, objv,  
                     scalePtr->tkwin, &savedOptions, (int *) NULL) != TCL_OK) {  
                 continue;  
             }  
         } else {  
             /*  
              * Second pass: restore options to old values.  
              */  
   
             errorResult = Tcl_GetObjResult(interp);  
             Tcl_IncrRefCount(errorResult);  
             Tk_RestoreSavedOptions(&savedOptions);  
         }  
   
         /*  
          * If the scale is tied to the value of a variable, then set  
          * the scale's value from the value of the variable, if it exists  
          * and it holds a valid double value.  
          */  
   
         if (scalePtr->varNamePtr != NULL) {  
             double value;  
             Tcl_Obj *valuePtr;  
   
             valuePtr = Tcl_ObjGetVar2(interp, scalePtr->varNamePtr, NULL,  
                     TCL_GLOBAL_ONLY);  
             if ((valuePtr != NULL) &&  
                     (Tcl_GetDoubleFromObj(NULL, valuePtr, &value) == TCL_OK)) {  
                 scalePtr->value = TkRoundToResolution(scalePtr, value);  
             }  
         }  
   
         /*  
          * Several options need special processing, such as parsing the  
          * orientation and creating GCs.  
          */  
   
         scalePtr->fromValue = TkRoundToResolution(scalePtr,  
                 scalePtr->fromValue);  
         scalePtr->toValue = TkRoundToResolution(scalePtr, scalePtr->toValue);  
         scalePtr->tickInterval = TkRoundToResolution(scalePtr,  
                 scalePtr->tickInterval);  
   
         /*  
          * Make sure that the tick interval has the right sign so that  
          * addition moves from fromValue to toValue.  
          */  
   
         if ((scalePtr->tickInterval < 0)  
                 ^ ((scalePtr->toValue - scalePtr->fromValue) <  0)) {  
           scalePtr->tickInterval = -scalePtr->tickInterval;  
         }  
   
         ComputeFormat(scalePtr);  
   
         scalePtr->labelLength = scalePtr->label ? strlen(scalePtr->label) : 0;  
   
         Tk_SetBackgroundFromBorder(scalePtr->tkwin, scalePtr->bgBorder);  
   
         if (scalePtr->highlightWidth < 0) {  
             scalePtr->highlightWidth = 0;  
         }  
         scalePtr->inset = scalePtr->highlightWidth + scalePtr->borderWidth;  
         break;  
     }  
     if (!error) {  
         Tk_FreeSavedOptions(&savedOptions);  
     }  
   
     /*  
      * Set the scale value to itself;  all this does is to make sure  
      * that the scale's value is within the new acceptable range for  
      * the scale.  We don't set the var here because we need to make  
      * special checks for possibly changed varNamePtr.  
      */  
   
     TkScaleSetValue(scalePtr, scalePtr->value, 0, 1);  
   
     /*  
      * Reestablish the variable trace, if it is needed.  
      */  
   
     if (scalePtr->varNamePtr != NULL) {  
         Tcl_Obj *valuePtr;  
   
         /*  
          * Set the associated variable only when the new value differs  
          * from the current value, or the variable doesn't yet exist  
          */  
         valuePtr = Tcl_ObjGetVar2(interp, scalePtr->varNamePtr, NULL,  
                 TCL_GLOBAL_ONLY);  
         if ((valuePtr == NULL) || (scalePtr->value != oldValue)  
                 || (Tcl_GetDoubleFromObj(NULL, valuePtr, &oldValue) != TCL_OK)  
                 || (scalePtr->value != oldValue)) {  
             ScaleSetVariable(scalePtr);  
         }  
         Tcl_TraceVar(interp, Tcl_GetString(scalePtr->varNamePtr),  
                 TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,  
                 ScaleVarProc, (ClientData) scalePtr);  
     }  
   
     ScaleWorldChanged((ClientData) scalePtr);  
     if (error) {  
         Tcl_SetObjResult(interp, errorResult);  
         Tcl_DecrRefCount(errorResult);  
         return TCL_ERROR;  
     } else {  
         return TCL_OK;  
     }  
 }  
   
 /*  
  *---------------------------------------------------------------------------  
  *  
  * ScaleWorldChanged --  
  *  
  *      This procedure is called when the world has changed in some  
  *      way and the widget needs to recompute all its graphics contexts  
  *      and determine its new geometry.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      Scale will be relayed out and redisplayed.  
  *  
  *---------------------------------------------------------------------------  
  */  
   
 static void  
 ScaleWorldChanged(instanceData)  
     ClientData instanceData;    /* Information about widget. */  
 {  
     XGCValues gcValues;  
     GC gc;  
     TkScale *scalePtr;  
   
     scalePtr = (TkScale *) instanceData;  
   
     gcValues.foreground = scalePtr->troughColorPtr->pixel;  
     gc = Tk_GetGC(scalePtr->tkwin, GCForeground, &gcValues);  
     if (scalePtr->troughGC != None) {  
         Tk_FreeGC(scalePtr->display, scalePtr->troughGC);  
     }  
     scalePtr->troughGC = gc;  
   
     gcValues.font = Tk_FontId(scalePtr->tkfont);  
     gcValues.foreground = scalePtr->textColorPtr->pixel;  
     gc = Tk_GetGC(scalePtr->tkwin, GCForeground | GCFont, &gcValues);  
     if (scalePtr->textGC != None) {  
         Tk_FreeGC(scalePtr->display, scalePtr->textGC);  
     }  
     scalePtr->textGC = gc;  
   
     if (scalePtr->copyGC == None) {  
         gcValues.graphics_exposures = False;  
         scalePtr->copyGC = Tk_GetGC(scalePtr->tkwin, GCGraphicsExposures,  
             &gcValues);  
     }  
     scalePtr->inset = scalePtr->highlightWidth + scalePtr->borderWidth;  
   
     /*  
      * Recompute display-related information, and let the geometry  
      * manager know how much space is needed now.  
      */  
   
     ComputeScaleGeometry(scalePtr);  
   
     TkEventuallyRedrawScale(scalePtr, REDRAW_ALL);  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * ComputeFormat --  
  *  
  *      This procedure is invoked to recompute the "format" field  
  *      of a scale's widget record, which determines how the value  
  *      of the scale is converted to a string.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      The format field of scalePtr is modified.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static void  
 ComputeFormat(scalePtr)  
     TkScale *scalePtr;                  /* Information about scale widget. */  
 {  
     double maxValue, x;  
     int mostSigDigit, numDigits, leastSigDigit, afterDecimal;  
     int eDigits, fDigits;  
   
     /*  
      * Compute the displacement from the decimal of the most significant  
      * digit required for any number in the scale's range.  
      */  
   
     maxValue = fabs(scalePtr->fromValue);  
     x = fabs(scalePtr->toValue);  
     if (x > maxValue) {  
         maxValue = x;  
     }  
     if (maxValue == 0) {  
         maxValue = 1;  
     }  
     mostSigDigit = (int) floor(log10(maxValue));  
   
     /*  
      * If the number of significant digits wasn't specified explicitly,  
      * compute it. It's the difference between the most significant  
      * digit needed to represent any number on the scale and the  
      * most significant digit of the smallest difference between  
      * numbers on the scale.  In other words, display enough digits so  
      * that at least one digit will be different between any two adjacent  
      * positions of the scale.  
      */  
   
     numDigits = scalePtr->digits;  
     if (numDigits <= 0) {  
         if  (scalePtr->resolution > 0) {  
             /*  
              * A resolution was specified for the scale, so just use it.  
              */  
   
             leastSigDigit = (int) floor(log10(scalePtr->resolution));  
         } else {  
             /*  
              * No resolution was specified, so compute the difference  
              * in value between adjacent pixels and use it for the least  
              * significant digit.  
              */  
   
             x = fabs(scalePtr->fromValue - scalePtr->toValue);  
             if (scalePtr->length > 0) {  
                 x /= scalePtr->length;  
             }  
             if (x > 0){  
                 leastSigDigit = (int) floor(log10(x));  
             } else {  
                 leastSigDigit = 0;  
             }  
         }  
         numDigits = mostSigDigit - leastSigDigit + 1;  
         if (numDigits < 1) {  
             numDigits = 1;  
         }  
     }  
   
     /*  
      * Compute the number of characters required using "e" format and  
      * "f" format, and then choose whichever one takes fewer characters.  
      */  
   
     eDigits = numDigits + 4;  
     if (numDigits > 1) {  
         eDigits++;                      /* Decimal point. */  
     }  
     afterDecimal = numDigits - mostSigDigit - 1;  
     if (afterDecimal < 0) {  
         afterDecimal = 0;  
     }  
     fDigits = (mostSigDigit >= 0) ? mostSigDigit + afterDecimal : afterDecimal;  
     if (afterDecimal > 0) {  
         fDigits++;                      /* Decimal point. */  
     }  
     if (mostSigDigit < 0) {  
         fDigits++;                      /* Zero to left of decimal point. */  
     }  
     if (fDigits <= eDigits) {  
         sprintf(scalePtr->format, "%%.%df", afterDecimal);  
     } else {  
         sprintf(scalePtr->format, "%%.%de", numDigits-1);  
     }  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * ComputeScaleGeometry --  
  *  
  *      This procedure is called to compute various geometrical  
  *      information for a scale, such as where various things get  
  *      displayed.  It's called when the window is reconfigured.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      Display-related numbers get changed in *scalePtr.  The  
  *      geometry manager gets told about the window's preferred size.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static void  
 ComputeScaleGeometry(scalePtr)  
     register TkScale *scalePtr;         /* Information about widget. */  
 {  
     char valueString[PRINT_CHARS];  
     int tmp, valuePixels, x, y, extraSpace;  
     Tk_FontMetrics fm;  
   
     Tk_GetFontMetrics(scalePtr->tkfont, &fm);  
     scalePtr->fontHeight = fm.linespace + SPACING;  
   
     /*  
      * Horizontal scales are simpler than vertical ones because  
      * all sizes are the same (the height of a line of text);  
      * handle them first and then quit.  
      */  
   
     if (scalePtr->orient == ORIENT_HORIZONTAL) {  
         y = scalePtr->inset;  
         extraSpace = 0;  
         if (scalePtr->labelLength != 0) {  
             scalePtr->horizLabelY = y + SPACING;  
             y += scalePtr->fontHeight;  
             extraSpace = SPACING;  
         }  
         if (scalePtr->showValue) {  
             scalePtr->horizValueY = y + SPACING;  
             y += scalePtr->fontHeight;  
             extraSpace = SPACING;  
         } else {  
             scalePtr->horizValueY = y;  
         }  
         y += extraSpace;  
         scalePtr->horizTroughY = y;  
         y += scalePtr->width + 2*scalePtr->borderWidth;  
         if (scalePtr->tickInterval != 0) {  
             scalePtr->horizTickY = y + SPACING;  
             y += scalePtr->fontHeight + SPACING;  
         }  
         Tk_GeometryRequest(scalePtr->tkwin,  
                 scalePtr->length + 2*scalePtr->inset, y + scalePtr->inset);  
         Tk_SetInternalBorder(scalePtr->tkwin, scalePtr->inset);  
         return;  
     }  
   
     /*  
      * Vertical scale:  compute the amount of space needed to display  
      * the scales value by formatting strings for the two end points;  
      * use whichever length is longer.  
      */  
   
     sprintf(valueString, scalePtr->format, scalePtr->fromValue);  
     valuePixels = Tk_TextWidth(scalePtr->tkfont, valueString, -1);  
   
     sprintf(valueString, scalePtr->format, scalePtr->toValue);  
     tmp = Tk_TextWidth(scalePtr->tkfont, valueString, -1);  
     if (valuePixels < tmp) {  
         valuePixels = tmp;  
     }  
   
     /*  
      * Assign x-locations to the elements of the scale, working from  
      * left to right.  
      */  
   
     x = scalePtr->inset;  
     if ((scalePtr->tickInterval != 0) && (scalePtr->showValue)) {  
         scalePtr->vertTickRightX = x + SPACING + valuePixels;  
         scalePtr->vertValueRightX = scalePtr->vertTickRightX + valuePixels  
                 + fm.ascent/2;  
         x = scalePtr->vertValueRightX + SPACING;  
     } else if (scalePtr->tickInterval != 0) {  
         scalePtr->vertTickRightX = x + SPACING + valuePixels;  
         scalePtr->vertValueRightX = scalePtr->vertTickRightX;  
         x = scalePtr->vertTickRightX + SPACING;  
     } else if (scalePtr->showValue) {  
         scalePtr->vertTickRightX = x;  
         scalePtr->vertValueRightX = x + SPACING + valuePixels;  
         x = scalePtr->vertValueRightX + SPACING;  
     } else {  
         scalePtr->vertTickRightX = x;  
         scalePtr->vertValueRightX = x;  
     }  
     scalePtr->vertTroughX = x;  
     x += 2*scalePtr->borderWidth + scalePtr->width;  
     if (scalePtr->labelLength == 0) {  
         scalePtr->vertLabelX = 0;  
     } else {  
         scalePtr->vertLabelX = x + fm.ascent/2;  
         x = scalePtr->vertLabelX + fm.ascent/2  
             + Tk_TextWidth(scalePtr->tkfont, scalePtr->label,  
                     scalePtr->labelLength);  
     }  
     Tk_GeometryRequest(scalePtr->tkwin, x + scalePtr->inset,  
             scalePtr->length + 2*scalePtr->inset);  
     Tk_SetInternalBorder(scalePtr->tkwin, scalePtr->inset);  
 }  
   
 /*  
  *--------------------------------------------------------------  
  *  
  * ScaleEventProc --  
  *  
  *      This procedure is invoked by the Tk dispatcher for various  
  *      events on scales.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      When the window gets deleted, internal structures get  
  *      cleaned up.  When it gets exposed, it is redisplayed.  
  *  
  *--------------------------------------------------------------  
  */  
   
 static void  
 ScaleEventProc(clientData, eventPtr)  
     ClientData clientData;      /* Information about window. */  
     XEvent *eventPtr;           /* Information about event. */  
 {  
     TkScale *scalePtr = (TkScale *) clientData;  
   
     if ((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0)) {  
         TkEventuallyRedrawScale(scalePtr, REDRAW_ALL);  
     } else if (eventPtr->type == DestroyNotify) {  
         DestroyScale((char *) clientData);  
     } else if (eventPtr->type == ConfigureNotify) {  
         ComputeScaleGeometry(scalePtr);  
         TkEventuallyRedrawScale(scalePtr, REDRAW_ALL);  
     } else if (eventPtr->type == FocusIn) {  
         if (eventPtr->xfocus.detail != NotifyInferior) {  
             scalePtr->flags |= GOT_FOCUS;  
             if (scalePtr->highlightWidth > 0) {  
                 TkEventuallyRedrawScale(scalePtr, REDRAW_ALL);  
             }  
         }  
     } else if (eventPtr->type == FocusOut) {  
         if (eventPtr->xfocus.detail != NotifyInferior) {  
             scalePtr->flags &= ~GOT_FOCUS;  
             if (scalePtr->highlightWidth > 0) {  
                 TkEventuallyRedrawScale(scalePtr, REDRAW_ALL);  
             }  
         }  
     }  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * ScaleCmdDeletedProc --  
  *  
  *      This procedure is invoked when a widget command is deleted.  If  
  *      the widget isn't already in the process of being destroyed,  
  *      this command destroys it.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      The widget is destroyed.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 static void  
 ScaleCmdDeletedProc(clientData)  
     ClientData clientData;      /* Pointer to widget record for widget. */  
 {  
     TkScale *scalePtr = (TkScale *) clientData;  
     Tk_Window tkwin = scalePtr->tkwin;  
   
     /*  
      * This procedure could be invoked either because the window was  
      * destroyed and the command was then deleted (in which case tkwin  
      * is NULL) or because the command was deleted, and then this procedure  
      * destroys the widget.  
      */  
   
     if (!(scalePtr->flags & SCALE_DELETED)) {  
         scalePtr->flags |= SCALE_DELETED;  
         Tk_DestroyWindow(tkwin);  
     }  
 }  
   
 /*  
  *--------------------------------------------------------------  
  *  
  * TkEventuallyRedrawScale --  
  *  
  *      Arrange for part or all of a scale widget to redrawn at  
  *      the next convenient time in the future.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      If "what" is REDRAW_SLIDER then just the slider and the  
  *      value readout will be redrawn;  if "what" is REDRAW_ALL  
  *      then the entire widget will be redrawn.  
  *  
  *--------------------------------------------------------------  
  */  
   
 void  
 TkEventuallyRedrawScale(scalePtr, what)  
     register TkScale *scalePtr; /* Information about widget. */  
     int what;                   /* What to redraw:  REDRAW_SLIDER  
                                  * or REDRAW_ALL. */  
 {  
     if ((what == 0) || (scalePtr->tkwin == NULL)  
             || !Tk_IsMapped(scalePtr->tkwin)) {  
         return;  
     }  
     if (!(scalePtr->flags & REDRAW_PENDING)) {  
         scalePtr->flags |= REDRAW_PENDING;  
         Tcl_DoWhenIdle(TkpDisplayScale, (ClientData) scalePtr);  
     }  
     scalePtr->flags |= what;  
 }  
   
 /*  
  *--------------------------------------------------------------  
  *  
  * TkRoundToResolution --  
  *  
  *      Round a given floating-point value to the nearest multiple  
  *      of the scale's resolution.  
  *  
  * Results:  
  *      The return value is the rounded result.  
  *  
  * Side effects:  
  *      None.  
  *  
  *--------------------------------------------------------------  
  */  
   
 double  
 TkRoundToResolution(scalePtr, value)  
     TkScale *scalePtr;          /* Information about scale widget. */  
     double value;               /* Value to round. */  
 {  
     double rem, new, tick;  
   
     if (scalePtr->resolution <= 0) {  
         return value;  
     }  
     tick = floor(value/scalePtr->resolution);  
     new = scalePtr->resolution * tick;  
     rem = value - new;  
     if (rem < 0) {  
         if (rem <= -scalePtr->resolution/2) {  
             new = (tick - 1.0) * scalePtr->resolution;  
         }  
     } else {  
         if (rem >= scalePtr->resolution/2) {  
             new = (tick + 1.0) * scalePtr->resolution;  
         }  
     }  
     return new;  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * ScaleVarProc --  
  *  
  *      This procedure is invoked by Tcl whenever someone modifies a  
  *      variable associated with a scale widget.  
  *  
  * Results:  
  *      NULL is always returned.  
  *  
  * Side effects:  
  *      The value displayed in the scale will change to match the  
  *      variable's new value.  If the variable has a bogus value then  
  *      it is reset to the value of the scale.  
  *  
  *----------------------------------------------------------------------  
  */  
   
     /* ARGSUSED */  
 static char *  
 ScaleVarProc(clientData, interp, name1, name2, flags)  
     ClientData clientData;      /* Information about button. */  
     Tcl_Interp *interp;         /* Interpreter containing variable. */  
     char *name1;                /* Name of variable. */  
     char *name2;                /* Second part of variable name. */  
     int flags;                  /* Information about what happened. */  
 {  
     register TkScale *scalePtr = (TkScale *) clientData;  
     char *resultStr;  
     double value;  
     Tcl_Obj *valuePtr;  
     int result;  
   
     /*  
      * If the variable is unset, then immediately recreate it unless  
      * the whole interpreter is going away.  
      */  
   
     if (flags & TCL_TRACE_UNSETS) {  
         if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {  
             Tcl_TraceVar(interp, Tcl_GetString(scalePtr->varNamePtr),  
                     TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,  
                     ScaleVarProc, clientData);  
             scalePtr->flags |= NEVER_SET;  
             TkScaleSetValue(scalePtr, scalePtr->value, 1, 0);  
         }  
         return (char *) NULL;  
     }  
   
     /*  
      * If we came here because we updated the variable (in TkScaleSetValue),  
      * then ignore the trace.  Otherwise update the scale with the value  
      * of the variable.  
      */  
   
     if (scalePtr->flags & SETTING_VAR) {  
         return (char *) NULL;  
     }  
     resultStr = NULL;  
     valuePtr = Tcl_ObjGetVar2(interp, scalePtr->varNamePtr, NULL,  
             TCL_GLOBAL_ONLY);  
     result = Tcl_GetDoubleFromObj(interp, valuePtr, &value);  
     if (result != TCL_OK) {  
         resultStr = "can't assign non-numeric value to scale variable";  
         ScaleSetVariable(scalePtr);  
     } else {  
         scalePtr->value = TkRoundToResolution(scalePtr, value);  
   
         /*  
          * This code is a bit tricky because it sets the scale's value before  
          * calling TkScaleSetValue.  This way, TkScaleSetValue won't bother  
          * to set the variable again or to invoke the -command.  However, it  
          * also won't redisplay the scale, so we have to ask for that  
          * explicitly.  
          */  
   
         TkScaleSetValue(scalePtr, scalePtr->value, 1, 0);  
     }  
     TkEventuallyRedrawScale(scalePtr, REDRAW_SLIDER);  
   
     return resultStr;  
 }  
   
 /*  
  *--------------------------------------------------------------  
  *  
  * TkScaleSetValue --  
  *  
  *      This procedure changes the value of a scale and invokes  
  *      a Tcl command to reflect the current position of a scale  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      A Tcl command is invoked, and an additional error-processing  
  *      command may also be invoked.  The scale's slider is redrawn.  
  *  
  *--------------------------------------------------------------  
  */  
   
 void  
 TkScaleSetValue(scalePtr, value, setVar, invokeCommand)  
     register TkScale *scalePtr; /* Info about widget. */  
     double value;               /* New value for scale.  Gets adjusted  
                                  * if it's off the scale. */  
     int setVar;                 /* Non-zero means reflect new value through  
                                  * to associated variable, if any. */  
     int invokeCommand;          /* Non-zero means invoked -command option  
                                  * to notify of new value, 0 means don't. */  
 {  
     value = TkRoundToResolution(scalePtr, value);  
     if ((value < scalePtr->fromValue)  
             ^ (scalePtr->toValue < scalePtr->fromValue)) {  
         value = scalePtr->fromValue;  
     }  
     if ((value > scalePtr->toValue)  
             ^ (scalePtr->toValue < scalePtr->fromValue)) {  
         value = scalePtr->toValue;  
     }  
     if (scalePtr->flags & NEVER_SET) {  
         scalePtr->flags &= ~NEVER_SET;  
     } else if (scalePtr->value == value) {  
         return;  
     }  
     scalePtr->value = value;  
     if (invokeCommand) {  
         scalePtr->flags |= INVOKE_COMMAND;  
     }  
     TkEventuallyRedrawScale(scalePtr, REDRAW_SLIDER);  
   
     if (setVar && scalePtr->varNamePtr) {  
         ScaleSetVariable(scalePtr);  
     }  
 }  
   
 /*  
  *--------------------------------------------------------------  
  *  
  * ScaleSetVariable --  
  *  
  *      This procedure sets the variable associated with a scale, if any.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      Other write traces on the variable will trigger.  
  *  
  *--------------------------------------------------------------  
  */  
   
 static void  
 ScaleSetVariable(scalePtr)  
     register TkScale *scalePtr; /* Info about widget. */  
 {  
     if (scalePtr->varNamePtr != NULL) {  
         char string[PRINT_CHARS];  
         sprintf(string, scalePtr->format, scalePtr->value);  
         scalePtr->flags |= SETTING_VAR;  
         Tcl_ObjSetVar2(scalePtr->interp, scalePtr->varNamePtr, NULL,  
                 Tcl_NewStringObj(string, -1), TCL_GLOBAL_ONLY);  
         scalePtr->flags &= ~SETTING_VAR;  
     }  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TkScalePixelToValue --  
  *  
  *      Given a pixel within a scale window, return the scale  
  *      reading corresponding to that pixel.  
  *  
  * Results:  
  *      A double-precision scale reading.  If the value is outside  
  *      the legal range for the scale then it's rounded to the nearest  
  *      end of the scale.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 double  
 TkScalePixelToValue(scalePtr, x, y)  
     register TkScale *scalePtr;         /* Information about widget. */  
     int x, y;                           /* Coordinates of point within  
                                          * window. */  
 {  
     double value, pixelRange;  
   
     if (scalePtr->orient == ORIENT_VERTICAL) {  
         pixelRange = Tk_Height(scalePtr->tkwin) - scalePtr->sliderLength  
                 - 2*scalePtr->inset - 2*scalePtr->borderWidth;  
         value = y;  
     } else {  
         pixelRange = Tk_Width(scalePtr->tkwin) - scalePtr->sliderLength  
                 - 2*scalePtr->inset - 2*scalePtr->borderWidth;  
         value = x;  
     }  
   
     if (pixelRange <= 0) {  
         /*  
          * Not enough room for the slider to actually slide:  just return  
          * the scale's current value.  
          */  
   
         return scalePtr->value;  
     }  
     value -= scalePtr->sliderLength/2 + scalePtr->inset  
                 + scalePtr->borderWidth;  
     value /= pixelRange;  
     if (value < 0) {  
         value = 0;  
     }  
     if (value > 1) {  
         value = 1;  
     }  
     value = scalePtr->fromValue +  
                 value * (scalePtr->toValue - scalePtr->fromValue);  
     return TkRoundToResolution(scalePtr, value);  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * TkScaleValueToPixel --  
  *  
  *      Given a reading of the scale, return the x-coordinate or  
  *      y-coordinate corresponding to that reading, depending on  
  *      whether the scale is vertical or horizontal, respectively.  
  *  
  * Results:  
  *      An integer value giving the pixel location corresponding  
  *      to reading.  The value is restricted to lie within the  
  *      defined range for the scale.  
  *  
  * Side effects:  
  *      None.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 int  
 TkScaleValueToPixel(scalePtr, value)  
     register TkScale *scalePtr;         /* Information about widget. */  
     double value;                       /* Reading of the widget. */  
 {  
     int y, pixelRange;  
     double valueRange;  
   
     valueRange = scalePtr->toValue - scalePtr->fromValue;  
     pixelRange = ((scalePtr->orient == ORIENT_VERTICAL)  
             ? Tk_Height(scalePtr->tkwin) : Tk_Width(scalePtr->tkwin))  
         - scalePtr->sliderLength - 2*scalePtr->inset - 2*scalePtr->borderWidth;  
     if (valueRange == 0) {  
         y = 0;  
     } else {  
         y = (int) ((value - scalePtr->fromValue) * pixelRange  
                   / valueRange + 0.5);  
         if (y < 0) {  
             y = 0;  
         } else if (y > pixelRange) {  
             y = pixelRange;  
         }  
     }  
     y += scalePtr->sliderLength/2 + scalePtr->inset + scalePtr->borderWidth;  
     return y;  
 }  
   
   
 /* $History: tkScale.c $  
  *  
  * *****************  Version 1  *****************  
  * User: Dtashley     Date: 1/02/01    Time: 3:03a  
  * Created in $/IjuScripter, IjuConsole/Source/Tk Base  
  * Initial check-in.  
  */  
   
 /* End of TKSCALE.C */  
1    /* $Header$ */
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    /* End of tkscale.c */

Legend:
Removed from v.25  
changed lines
  Added in v.71

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25