add a clamp word to math.order, use clamp word throughout libraries

diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor
index aba8dc9eda147937fd0a79cd2cafa5d287c389af..9cb0e412918f37f201e8fc47f89b5cc3458e8d00 100644 (file)
--- a/basis/compiler/tree/propagation/propagation-tests.factor
+++ b/basis/compiler/tree/propagation/propagation-tests.factor
@@ -197,7 +197,7 @@ IN: compiler.tree.propagation.tests
         { fixnum byte-array } declare
         [ nth-unsafe ] 2keep [ nth-unsafe ] 2keep nth-unsafe
         [ [ 298 * ] dip 100 * - ] dip 208 * - 128 + -8 shift
-        255 min 0 max
+        0 255 clamp
     ] final-classes
 ] unit-test
 
@@ -210,7 +210,7 @@ IN: compiler.tree.propagation.tests
 ] unit-test
 
 [ V{ 1.5 } ] [
-    [ /f 1.5 min 1.5 max ] final-literals
+    [ /f 1.5 1.5 clamp ] final-literals
 ] unit-test
 
 [ V{ 1.5 } ] [
@@ -693,4 +693,4 @@ TUPLE: circle me ;
 [ ] [ circle new dup >>me 1quotation final-info drop ] unit-test
 
 ! Joe found an oversight
-[ V{ integer } ] [ [ >integer ] final-classes ] unit-test
\ No newline at end of file
+[ V{ integer } ] [ [ >integer ] final-classes ] unit-test

diff --git a/basis/math/functions/functions-docs.factor b/basis/math/functions/functions-docs.factor
index 48da8aa6ec66f73ba63d2d24867a75a6d7760f86..41800e46dafdcf514afa4ff15d6f1a49cb0c6d5c 100644 (file)
--- a/basis/math/functions/functions-docs.factor
+++ b/basis/math/functions/functions-docs.factor
@@ -23,9 +23,10 @@ ARTICLE: "arithmetic-functions" "Arithmetic functions"
 "Incrementing, decrementing:"
 { $subsection 1+ }
 { $subsection 1- }
-"Minimum, maximum:"
+"Minimum, maximum, clamping:"
 { $subsection min }
 { $subsection max }
+{ $subsection clamp }
 "Complex conjugation:"
 { $subsection conjugate }
 "Tests:"

diff --git a/basis/math/ranges/ranges.factor b/basis/math/ranges/ranges.factor
index 883be006dc255cbf18dfe0af209692362fd3a25a..d0c918458a97f9cf03ee08804cbe81b7404ea856 100644 (file)
--- a/basis/math/ranges/ranges.factor
+++ b/basis/math/ranges/ranges.factor
@@ -26,12 +26,16 @@ M: range hashcode* tuple-hashcode ;
 
 INSTANCE: range immutable-sequence
 
+<PRIVATE
+
 : twiddle ( a b -- a b step ) 2dup > -1 1 ? ; inline
 
 : (a, ( a b step -- a' b' step ) dup [ + ] curry 2dip ; inline
 
 : ,b) ( a b step -- a' b' step ) dup [ - ] curry dip ; inline
 
+PRIVATE>
+
 : [a,b] ( a b -- range ) twiddle <range> ; inline
 
 : (a,b] ( a b -- range ) twiddle (a, <range> ; inline
@@ -62,7 +66,7 @@ INSTANCE: range immutable-sequence
     dup range-decreasing? first-or-peek ;
 
 : clamp-to-range ( n range -- n )
-    [ range-min max ] [ range-max min ] bi ;
+    [ range-min ] [ range-max ] bi clamp ;
 
 : sequence-index-range  ( seq -- range )
     length [0,b) ;

diff --git a/basis/models/models.factor b/basis/models/models.factor
index 4f7aafe3e33ac1b4093b90a50a152c9593cbbfc8..19b478eaf9b696da29bbd6e4b0bb1cef2794c57a 100644 (file)
--- a/basis/models/models.factor
+++ b/basis/models/models.factor
@@ -109,5 +109,4 @@ GENERIC: set-range-min-value ( value model -- )
 GENERIC: set-range-max-value ( value model -- )
 
 : clamp-value ( value range -- newvalue )
-    [ range-min-value max ] keep
-    range-max-value* min ;
+    [ range-min-value ] [ range-max-value* ] bi clamp ;

diff --git a/core/math/order/order-docs.factor b/core/math/order/order-docs.factor
index 8b2200aa6710fdbb14425acbc5a5e2f0e333c735..368d060eb9239bcb06a20d70d7c088c5d4e0e3bf 100644 (file)
--- a/core/math/order/order-docs.factor
+++ b/core/math/order/order-docs.factor
@@ -51,6 +51,10 @@ HELP: min
 { $values { "x" real } { "y" real } { "z" real } }
 { $description "Outputs the smallest of two real numbers." } ;
 
+HELP: clamp
+{ $values { "x" real } { "min" real } { "max" real } { "y" real } }
+{ $description "Outputs " { $snippet "x" } " if contained in the interval " { $snippet "[min,max]" } " or outputs one of the endpoints." } ;
+
 HELP: between?
 { $values { "x" real } { "y" real } { "z" real } { "?" "a boolean" } }
 { $description "Tests if " { $snippet "x" } " is in the interval " { $snippet "[y,z]" } "." }
@@ -105,6 +109,7 @@ ARTICLE: "math.order" "Linear order protocol"
 { $subsection "order-specifiers" }
 "Utilities for comparing objects:"
 { $subsection after? }
+{ $subsection after? }
 { $subsection before? }
 { $subsection after=? }
 { $subsection before=? }

diff --git a/core/math/order/order-tests.factor b/core/math/order/order-tests.factor
index 665537be5da845de6428800242bbab87f1f629cf..edd50d3f55a68052debc33956e7e16ddd59d7473 100644 (file)
--- a/core/math/order/order-tests.factor
+++ b/core/math/order/order-tests.factor
@@ -7,3 +7,6 @@ IN: math.order.tests
 [ +eq+ ] [ 4 4 <=> ] unit-test
 [ +gt+ ] [ 4 3 <=> ] unit-test
 
+[ 20 ] [ 20 0 100 clamp ] unit-test
+[ 0 ] [ -20 0 100 clamp ] unit-test
+[ 100 ] [ 120 0 100 clamp ] unit-test

diff --git a/core/math/order/order.factor b/core/math/order/order.factor
index a06209bf63cf983ea42e94de6d5b7d38a40d0e30..435eec9b96102af3922ad6b492ada0bbe04568d6 100644 (file)
--- a/core/math/order/order.factor
+++ b/core/math/order/order.factor
@@ -34,6 +34,7 @@ M: real after=? ( obj1 obj2 -- ? ) >= ;
 
 : min ( x y -- z ) [ before? ] most ; inline 
 : max ( x y -- z ) [ after? ] most ; inline
+: clamp ( x min max -- y ) [ max ] dip min ; inline
 
 : between? ( x y z -- ? )
     pick after=? [ after=? ] [ 2drop f ] if ; inline

diff --git a/extra/math/compare/compare-tests.factor b/extra/math/compare/compare-tests.factor
index 272471fe5d1819d59d24c2d114d64c4c92464cd8..5b30af0e63dd36de79d3e4502681d9144f6cf99a 100644 (file)
--- a/extra/math/compare/compare-tests.factor
+++ b/extra/math/compare/compare-tests.factor
@@ -14,8 +14,3 @@ IN: math.compare.tests
 [ 0 ] [ 1 3 negmin ] unit-test
 [ -3 ] [ 1 -3 negmin ] unit-test
 [ -1 ] [ -1 3 negmin ] unit-test
-
-[ 0 ] [ 0 -1 2 clamp ] unit-test
-[ 1 ] [ 0 1 2 clamp ] unit-test
-[ 2 ] [ 0 3 2 clamp ] unit-test
-

diff --git a/extra/math/compare/compare.factor b/extra/math/compare/compare.factor
index 826f0ecf165cd6f08094a9f5c82f8a7e0daee2e1..b48641d723b19bce1fcb19c9b18cec54679a4c92 100644 (file)
--- a/extra/math/compare/compare.factor
+++ b/extra/math/compare/compare.factor
@@ -14,6 +14,3 @@ IN: math.compare
 
 : negmin ( a b -- x )
     0 min min ;
-
-: clamp ( a value b -- x )
-    min max ;

diff --git a/extra/terrain/terrain.factor b/extra/terrain/terrain.factor
index 5847426faea30543b0000c041bbe3f0588afb225..42aa7e903a00b27c89761e27d54c32e415181237 100644 (file)
--- a/extra/terrain/terrain.factor
+++ b/extra/terrain/terrain.factor
@@ -88,7 +88,7 @@ M: terrain-world tick-length
     yaw>> 0.0
     ${ MOVEMENT-SPEED 0.0 0.0 } eye-rotate ;
 : clamp-pitch ( pitch -- pitch' )
-    90.0 min -90.0 max ;
+    -90.0 90.0 clamp ;
 
 : walk-forward ( player -- )
     dup forward-vector [ v+ ] curry change-velocity drop ;