コード例 #1
0
static pascal void
ScaleActionProc(
    ControlRef theControl,	/* Handle to scrollbat control */
    ControlPartCode partCode)	/* Part of scrollbar that was "hit" */
{
    int value;
    TkScale *scalePtr = (TkScale *) GetControlReference(theControl);

#ifdef TK_MAC_DEBUG_SCALE
    TkMacOSXDbgMsg("ScaleActionProc");
#endif
    value = GetControlValue(theControl);
    TkScaleSetValue(scalePtr, value, 1, 1);
    Tcl_Preserve((ClientData) scalePtr);
    TkMacOSXRunTclEventLoop();
    Tcl_Release((ClientData) scalePtr);
}
コード例 #2
0
ファイル: tkScale.c プロジェクト: afmayer/tcl-tk
static int
ScaleWidgetObjCmd(
    ClientData clientData,	/* Information about scale widget. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument strings. */
{
    TkScale *scalePtr = clientData;
    Tcl_Obj *objPtr;
    int index, result;

    if (objc < 2) {
        Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
        return TCL_ERROR;
    }
    result = Tcl_GetIndexFromObj(interp, objv[1], commandNames,
                                 "option", 0, &index);
    if (result != TCL_OK) {
        return result;
    }
    Tcl_Preserve(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;
        }
        Tcl_SetObjResult(interp, objPtr);
        break;
    case COMMAND_CONFIGURE:
        if (objc <= 3) {
            objPtr = Tk_GetOptionInfo(interp, (char *) scalePtr,
                                      scalePtr->optionTable,
                                      (objc == 3) ? objv[2] : NULL, scalePtr->tkwin);
            if (objPtr == NULL) {
                goto error;
            }
            Tcl_SetObjResult(interp, objPtr);
        } else {
            result = ConfigureScale(interp, scalePtr, objc-2, objv+2);
        }
        break;
    case COMMAND_COORDS: {
        int x, y;
        double value;
        Tcl_Obj *coords[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;
        }
        coords[0] = Tcl_NewIntObj(x);
        coords[1] = Tcl_NewIntObj(y);
        Tcl_SetObjResult(interp, Tcl_NewListObj(2, coords));
        break;
    }
    case COMMAND_GET: {
        double value;
        int x, y;

        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);
        }
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(scalePtr->format, value));
        break;
    }
    case COMMAND_IDENTIFY: {
        int x, y;
        const char *zone = "";

        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;
        }
        switch (TkpScaleElement(scalePtr, x, y)) {
        case TROUGH1:
            zone = "trough1";
            break;
        case SLIDER:
            zone = "slider";
            break;
        case TROUGH2:
            zone = "trough2";
            break;
        }
        Tcl_SetObjResult(interp, Tcl_NewStringObj(zone, -1));
        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(scalePtr);
    return result;

error:
    Tcl_Release(scalePtr);
    return TCL_ERROR;
}
コード例 #3
0
ファイル: tkScale.c プロジェクト: afmayer/tcl-tk
static int
ConfigureScale(
    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 varValue;

    /*
     * 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, 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, 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 ? (int)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) || (Tcl_GetDoubleFromObj(NULL,
                                   valuePtr, &varValue) != TCL_OK)) {
            ScaleSetVariable(scalePtr);
        } else {
            char varString[TCL_DOUBLE_SPACE], scaleString[TCL_DOUBLE_SPACE];

            sprintf(varString, scalePtr->format, varValue);
            sprintf(scaleString, scalePtr->format, scalePtr->value);
            if (strcmp(varString, scaleString)) {
                ScaleSetVariable(scalePtr);
            }
        }
        Tcl_TraceVar(interp, Tcl_GetString(scalePtr->varNamePtr),
                     TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
                     ScaleVarProc, scalePtr);
    }

    ScaleWorldChanged(scalePtr);
    if (error) {
        Tcl_SetObjResult(interp, errorResult);
        Tcl_DecrRefCount(errorResult);
        return TCL_ERROR;
    }
    return TCL_OK;
}
コード例 #4
0
ファイル: tkScale.c プロジェクト: afmayer/tcl-tk
/* ARGSUSED */
static char *
ScaleVarProc(
    ClientData clientData,	/* Information about button. */
    Tcl_Interp *interp,		/* Interpreter containing variable. */
    const char *name1,		/* Name of variable. */
    const char *name2,		/* Second part of variable name. */
    int flags)			/* Information about what happened. */
{
    register TkScale *scalePtr = clientData;
    const 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 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 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 (char *) resultStr;
}