From 3d4e559e27bfab3f7e5ec7123da6f62bb4b2ef31 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Sat, 6 Dec 2014 12:57:06 -0500
Subject: math: rect: Add rect-clamp.

* sly/math/rect.scm (rect-clamp): New procedure.
---
 sly/math/rect.scm | 7 +++++++
 1 file changed, 7 insertions(+)

diff --git a/sly/math/rect.scm b/sly/math/rect.scm
index d822891..4e57ea6 100644
--- a/sly/math/rect.scm
+++ b/sly/math/rect.scm
@@ -52,6 +52,7 @@
             rect-inflate
             rect-union
             rect-clip
+            rect-clamp
             rect-within?
             rect-intersects?
             rect-contains?))
@@ -183,6 +184,12 @@ not overlap, a rect of size 0 is returned."
         (y2 (min (rect-bottom rect1) (rect-bottom rect2))))
     (make-rect x1 y1 (max (- x2 x1) 0) (max (- y2 y1) 0))))
 
+(define rect-clamp
+  (match-lambda*
+   ((($ <rect> rx ry width height) ($ <vector2> x y))
+    (vector2 (clamp rx (+ rx width) x)
+             (clamp ry (+ ry height) y)))))
+
 (define (rect-within? rect1 rect2)
   "Return #t if RECT2 is completely within RECT1."
   (and (>= (rect-left   rect2) (rect-left   rect1))
-- 
cgit v1.2.3