math.vectors: new word vclamp for clamping vectors

diff --git a/basis/math/vectors/vectors-docs.factor b/basis/math/vectors/vectors-docs.factor
index 1f4be3508fd8078bb2a1ac5b756bd41ff0bb48f1..5c928f8e5b0144e68411c348972e8b6aad539d31 100644 (file)
--- 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
index 5ff48c59568f42f0d89882237839df56d1fc38fa..fa5a2656072854bfe1cd8e3d70725d858c3722ae 100644 (file)
--- 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
index f30c095d455a91e351dd05e9500e24ae04c3ac11..b4df54150538d8e1e898e08c114642c8ee3fa576 100644 (file)
--- 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
index 2b9e3260250101701d5a49715c7c3d7b53ecf08b..dfc5ffb417a54b2f53783a483b5b2b18d9222486 100644 (file)
--- 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
index e097b2a7bc64b776854a992945b49203d89cba06..0bd9287c9b1893bc1ab57a79838561443d6de4bc 100644 (file)
--- 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