math.vectors: new word vclamp for clamping vectors

factor · Aug 22, 2016 · cb39da4 · cb39da4
1 parent 7a4e345
commit cb39da4
Show file tree

Hide file tree

Showing 5 changed files with 22 additions and 2 deletions.
diff --git a/basis/math/vectors/vectors-docs.factor b/basis/math/vectors/vectors-docs.factor
@@ -85,6 +85,7 @@ $nl
     vunordered?
     vmax
     vmin
+    vclamp
     vsupremum
     vinfimum
 }
@@ -302,6 +303,17 @@ HELP: vmin
 { $description "Creates a sequence where each element is the minimum of the corresponding elements from " { $snippet "u" } " and " { $snippet "v" } "." }
 { $examples { $example "USING: math.vectors prettyprint ;" "{ 1 2 5 } { -7 6 3 } vmin ." "{ -7 2 3 }" } } ;
 
+HELP: vclamp
+{ $values { "v" "a sequence of real numbers" } { "min" "a sequence of real numbers" } { "max" "a sequence of real numbers" } }
+{ $description "Creates a sequence where each element is clamped to the minimum and maximum elements of the " { $snippet "min" } " and " { $snippet "max" } " sequences." }
+{ $examples
+  { $example
+    "USING: math.vectors prettyprint ;"
+    "{ -10 30 120 } { 0 0 0 } { 100 100 100 } vclamp ."
+    "{ 0 30 100 }"
+  }
+} ;
+
 HELP: v.
 { $values { "u" "a sequence of real numbers" } { "v" "a sequence of real numbers" } { "x" "a real number" } }
 { $description "Computes the dot product of two vectors." } ;

diff --git a/basis/math/vectors/vectors-tests.factor b/basis/math/vectors/vectors-tests.factor
@@ -47,3 +47,8 @@ SPECIALIZED-ARRAY: int
 { { 1 5 3 } } [
     { t f t } [ { 1 2 3 } ] [ { 4 5 6 } ] vif
 ] unit-test
+
+! vclamp
+{ { 0 30 100 } } [
+    { -10 30 120 } { 0 0 0 } { 100 100 100 } vclamp
+] unit-test
diff --git a/basis/math/vectors/vectors.factor b/basis/math/vectors/vectors.factor
@@ -276,3 +276,6 @@ PRIVATE>
 
 : v~ ( a b epsilon -- ? )
     [ ~ ] curry 2all? ; inline
+
+: vclamp ( v min max -- w )
+    rot vmin vmax ; inline
diff --git a/extra/terrain/terrain.factor b/extra/terrain/terrain.factor
@@ -152,7 +152,7 @@ terrain-world H{
     GRAVITY v+ ;
 
 : clamp-coords ( coords dim -- coords' )
-    [ { 0 0 } vmax ] dip { 2 2 } v- vmin ;
+    { 0 0 } swap { 2 2 } v- vclamp ;
 
 :: pixel-indices ( coords dim -- indices )
     coords vfloor v>integer dim clamp-coords :> floor-coords

diff --git a/extra/ui/gadgets/lists/lists.factor b/extra/ui/gadgets/lists/lists.factor
@@ -101,7 +101,7 @@ M: list focusable-child* drop t ;
     [ list select-index ] when* ;
 
 : clamp-loc ( point max -- point )
-    vmin { 0 0 } vmax ;
+    { 0 0 } swap vclamp ;
 
 : select-at ( point list -- )
     [ dim>> clamp-loc ] keep