Index: generic/tkScale.c ================================================================== --- generic/tkScale.c +++ generic/tkScale.c @@ -609,23 +609,21 @@ 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); + scalePtr->value = TkRoundValueToResolution(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, + /* + * The fromValue shall not be rounded to the resolution, but the + * toValue and tickInterval do. + */ + + scalePtr->toValue = TkRoundValueToResolution(scalePtr, scalePtr->toValue); + scalePtr->tickInterval = TkRoundIntervalToResolution(scalePtr, scalePtr->tickInterval); /* * Make sure that the tick interval has the right sign so that * addition moves from fromValue to toValue. @@ -1117,14 +1115,18 @@ } /* *-------------------------------------------------------------- * - * TkRoundToResolution -- + * TkRoundValueToResolution, TkRoundIntervalToResolution -- * * Round a given floating-point value to the nearest multiple of the * scale's resolution. + * TkRoundValueToResolution rounds an absolute value based on the from + * value as a reference. + * TkRoundIntervalToResolution rounds a relative value without + * reference, i.e. it rounds an interval. * * Results: * The return value is the rounded result. * * Side effects: @@ -1132,11 +1134,20 @@ * *-------------------------------------------------------------- */ double -TkRoundToResolution( +TkRoundValueToResolution( + TkScale *scalePtr, /* Information about scale widget. */ + double value) /* Value to round. */ +{ + return TkRoundIntervalToResolution(scalePtr, value - scalePtr->fromValue) + + scalePtr->fromValue; +} + +double +TkRoundIntervalToResolution( TkScale *scalePtr, /* Information about scale widget. */ double value) /* Value to round. */ { double rem, rounded, tick; @@ -1145,17 +1156,17 @@ } tick = floor(value/scalePtr->resolution); rounded = scalePtr->resolution * tick; rem = value - rounded; if (rem < 0) { - if (rem <= -scalePtr->resolution/2) { - rounded = (tick - 1.0) * scalePtr->resolution; - } + if (rem <= -scalePtr->resolution/2) { + rounded = (tick - 1.0) * scalePtr->resolution; + } } else { - if (rem >= scalePtr->resolution/2) { - rounded = (tick + 1.0) * scalePtr->resolution; - } + if (rem >= scalePtr->resolution/2) { + rounded = (tick + 1.0) * scalePtr->resolution; + } } return rounded; } /* @@ -1236,11 +1247,11 @@ 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); + scalePtr->value = TkRoundValueToResolution(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 @@ -1280,11 +1291,11 @@ 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); + value = TkRoundValueToResolution(scalePtr, value); if ((value < scalePtr->fromValue) ^ (scalePtr->toValue < scalePtr->fromValue)) { value = scalePtr->fromValue; } if ((value > scalePtr->toValue) @@ -1400,11 +1411,11 @@ if (value > 1) { value = 1; } value = scalePtr->fromValue + value * (scalePtr->toValue - scalePtr->fromValue); - return TkRoundToResolution(scalePtr, value); + return TkRoundValueToResolution(scalePtr, value); } /* *---------------------------------------------------------------------- * Index: generic/tkScale.h ================================================================== --- generic/tkScale.h +++ generic/tkScale.h @@ -217,11 +217,12 @@ /* * Declaration of procedures used in the implementation of the scale widget. */ MODULE_SCOPE void TkEventuallyRedrawScale(TkScale *scalePtr, int what); -MODULE_SCOPE double TkRoundToResolution(TkScale *scalePtr, double value); +MODULE_SCOPE double TkRoundValueToResolution(TkScale *scalePtr, double value); +MODULE_SCOPE double TkRoundIntervalToResolution(TkScale *scalePtr, double value); MODULE_SCOPE TkScale * TkpCreateScale(Tk_Window tkwin); MODULE_SCOPE void TkpDestroyScale(TkScale *scalePtr); MODULE_SCOPE void TkpDisplayScale(ClientData clientData); MODULE_SCOPE int TkpScaleElement(TkScale *scalePtr, int x, int y); MODULE_SCOPE void TkScaleSetValue(TkScale *scalePtr, double value, Index: tests/scale.test ================================================================== --- tests/scale.test +++ tests/scale.test @@ -1102,88 +1102,123 @@ # Widget used in 14.* tests destroy .s pack [scale .s] update -test scale-14.1 {RoundToResolution procedure} -body { +test scale-14.1 {RoundValueToResolution procedure} -body { .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 \ -orient horizontal -resolution 4.0 update .s get 84 152 } -result 72 -test scale-14.2 {RoundToResolution procedure} -body { +test scale-14.2 {RoundValueToResolution procedure} -body { .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 \ -orient horizontal -resolution 4.0 update .s get 86 152 } -result 76 -test scale-14.3 {RoundToResolution procedure} -body { +test scale-14.3 {RoundValueToResolution procedure} -body { .s configure -from 100 -to 0 -sliderlength 10 -length 114 -bd 2 \ -orient horizontal -resolution 4.0 update .s get 84 152 } -result 28 -test scale-14.4 {RoundToResolution procedure} -body { +test scale-14.4 {RoundValueToResolution procedure} -body { .s configure -from 100 -to 0 -sliderlength 10 -length 114 -bd 2 \ -orient horizontal -resolution 4.0 update .s get 86 152 } -result 24 -test scale-14.5 {RoundToResolution procedure} -body { +test scale-14.5 {RoundValueToResolution procedure} -body { .s configure -from -100 -to 0 -sliderlength 10 -length 114 -bd 2 \ -orient horizontal -resolution 4.0 update .s get 84 152 } -result {-28} -test scale-14.6 {RoundToResolution procedure} -body { +test scale-14.6 {RoundValueToResolution procedure} -body { .s configure -from -100 -to 0 -sliderlength 10 -length 114 -bd 2 \ -orient horizontal -resolution 4.0 update .s get 86 152 } -result {-24} -test scale-14.7 {RoundToResolution procedure} -body { +test scale-14.7 {RoundValueToResolution procedure} -body { .s configure -from 0 -to -100 -sliderlength 10 -length 114 -bd 2 \ -orient horizontal -resolution 4.0 update .s get 84 152 } -result {-72} -test scale-14.8 {RoundToResolution procedure} -body { +test scale-14.8 {RoundValueToResolution procedure} -body { .s configure -from 0 -to -100 -sliderlength 10 -length 114 -bd 2 \ -orient horizontal -resolution 4.0 update .s get 86 152 } -result {-76} -test scale-14.9 {RoundToResolution procedure} -body { +test scale-14.9 {RoundValueToResolution procedure} -body { .s configure -from 0 -to 2.25 -sliderlength 10 -length 114 -bd 2 \ -orient horizontal -resolution 0 update .s get 84 152 } -result {1.64} -test scale-14.10 {RoundToResolution procedure} -body { +test scale-14.10 {RoundValueToResolution procedure} -body { .s configure -from 0 -to 2.25 -sliderlength 10 -length 114 -bd 2 \ -orient horizontal -resolution 0 update .s get 86 152 } -result {1.69} -test scale-14.11 {RoundToResolution procedure} -body { +test scale-14.11 {RoundValueToResolution procedure} -body { .s configure -from 0 -to 225 -sliderlength 10 -length 114 -bd 2 \ -orient horizontal -resolution 0 -digits 5 update .s get 84 152 } -result {164.25} -test scale-14.12 {RoundToResolution procedure} -body { +test scale-14.12 {RoundValueToResolution procedure} -body { .s configure -from 0 -to 225 -sliderlength 10 -length 114 -bd 2 \ -orient horizontal -resolution 0 -digits 5 update .s get 86 152 } -result {168.75} destroy .s + +test scale-14.13 {RoundValueToResolution procedure, round-off errors} -setup { + # see [220665ffff], and duplicates [220265ffff] and [779559ffff] + set x NotSet + pack [scale .s -orient horizontal -resolution .1 -from -180 -to 180 -command "set x"] + update +} -body { + .s configure -background red + update + set x +} -cleanup { + destroy .s +} -result {NotSet} + +test scale-14a.1 {RoundValueToResolution, RoundIntervalToResolution procedures} -setup { + pack [scale .s -orient horizontal] + update +} -body { + .s configure -length 400 -bd 0 -from 1 -to 9 -resolution 2 -tickinterval 1 + update + .s get 200 0 +} -cleanup { + destroy .s +} -result {5} +test scale-14a.2 {RoundValueToResolution, RoundIntervalToResolution procedures} -setup { + pack [scale .s -orient horizontal] + update +} -body { + .s configure -length 400 -bd 0 -from -1.5 -to 1.5 -resolution 1 \ + -tickinterval 1 -digits 2 + update + .s get 250 0 +} -cleanup { + destroy .s +} -result {0.5} test scale-15.1 {ScaleVarProc procedure} -setup { deleteWindows } -body { Index: unix/tkUnixScale.c ================================================================== --- unix/tkUnixScale.c +++ unix/tkUnixScale.c @@ -148,15 +148,15 @@ tickInterval *= (ticks / maxTicks); } for (tickValue = scalePtr->fromValue; ; tickValue += tickInterval) { /* - * The TkRoundToResolution call gets rid of accumulated + * The TkRoundValueToResolution call gets rid of accumulated * round-off errors, if any. */ - tickValue = TkRoundToResolution(scalePtr, tickValue); + tickValue = TkRoundValueToResolution(scalePtr, tickValue); if (scalePtr->toValue >= scalePtr->fromValue) { if (tickValue > scalePtr->toValue) { break; } } else { @@ -368,15 +368,15 @@ tickInterval *= (ticks / maxTicks); } for (tickValue = scalePtr->fromValue; ; tickValue += tickInterval) { /* - * The TkRoundToResolution call gets rid of accumulated + * The TkRoundValueToResolution call gets rid of accumulated * round-off errors, if any. */ - tickValue = TkRoundToResolution(scalePtr, tickValue); + tickValue = TkRoundValueToResolution(scalePtr, tickValue); if (scalePtr->toValue >= scalePtr->fromValue) { if (tickValue > scalePtr->toValue) { break; } } else {