From cb39da4b31336bd68d7fe42a684eeb75359458ac Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Lindqvist?= <bjourne@gmail.com>
Date: Mon, 22 Aug 2016 04:08:37 +0200
Subject: [PATCH] math.vectors: new word vclamp for clamping vectors

---
 basis/math/vectors/vectors-docs.factor  | 12 ++++++++++++
 basis/math/vectors/vectors-tests.factor |  5 +++++
 basis/math/vectors/vectors.factor       |  3 +++
 extra/terrain/terrain.factor            |  2 +-
 extra/ui/gadgets/lists/lists.factor     |  2 +-
 5 files changed, 22 insertions(+), 2 deletions(-)

diff --git a/basis/math/vectors/vectors-docs.factor b/basis/math/vectors/vectors-docs.factor
index 1f4be3508f..5c928f8e5b 100644
--- 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 5ff48c5956..fa5a265607 100644
--- 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 f30c095d45..b4df541505 100644
--- 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 2b9e326025..dfc5ffb417 100644
--- 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 e097b2a7bc..0bd9287c9b 100644
--- 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