Fix [3003895fff] and [1899040fff]: TkRoundToResolution doesn't accoun…

…t for -from
tcltk · Jan 26, 2019 · 591f68c · 591f68c
2 parents 08e04d9 + 303f111
commit 591f68c
Show file tree

Hide file tree

Showing 4 changed files with 81 additions and 32 deletions.
diff --git a/generic/tkScale.c b/generic/tkScale.c
@@ -611,7 +611,7 @@ ConfigureScale(
 		    TCL_GLOBAL_ONLY);
 	    if ((valuePtr != NULL) &&
 		    (Tcl_GetDoubleFromObj(NULL, valuePtr, &value) == TCL_OK)) {
-		scalePtr->value = TkRoundToResolution(scalePtr, value);
+		scalePtr->value = TkRoundValueToResolution(scalePtr, value);
 	    }
 	}
 
@@ -620,10 +620,10 @@ ConfigureScale(
 	 * orientation and creating GCs.
 	 */
 
-	scalePtr->fromValue = TkRoundToResolution(scalePtr,
+	scalePtr->fromValue = TkRoundValueToResolution(scalePtr,
 		scalePtr->fromValue);
-	scalePtr->toValue = TkRoundToResolution(scalePtr, scalePtr->toValue);
-	scalePtr->tickInterval = TkRoundToResolution(scalePtr,
+	scalePtr->toValue = TkRoundValueToResolution(scalePtr, scalePtr->toValue);
+	scalePtr->tickInterval = TkRoundIntervalToResolution(scalePtr,
 		scalePtr->tickInterval);
 
 	/*
@@ -1119,10 +1119,14 @@ TkEventuallyRedrawScale(
 /*
  *--------------------------------------------------------------
  *
- * 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.
@@ -1134,7 +1138,16 @@ TkEventuallyRedrawScale(
  */
 
 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. */
 {
@@ -1147,13 +1160,13 @@ TkRoundToResolution(
     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;
 }
@@ -1238,7 +1251,7 @@ ScaleVarProc(
 	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
@@ -1282,7 +1295,7 @@ TkScaleSetValue(
     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;
@@ -1402,7 +1415,7 @@ TkScalePixelToValue(
     }
     value = scalePtr->fromValue +
 		value * (scalePtr->toValue - scalePtr->fromValue);
-    return TkRoundToResolution(scalePtr, value);
+    return TkRoundValueToResolution(scalePtr, value);
 }
 
 /*

diff --git a/generic/tkScale.h b/generic/tkScale.h
@@ -219,7 +219,8 @@ typedef struct TkScale {
  */
 
 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);

diff --git a/tests/scale.test b/tests/scale.test
@@ -1104,85 +1104,120 @@ test scale-13.6 {SetScaleValue procedure} -body {
 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

diff --git a/unix/tkUnixScale.c b/unix/tkUnixScale.c
@@ -150,11 +150,11 @@ DisplayVerticalScale(
 	    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;
@@ -370,11 +370,11 @@ DisplayHorizontalScale(
 	    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;