diff options
author | David Thompson <dthompson2@worcester.edu> | 2014-12-06 12:57:06 -0500 |
---|---|---|
committer | David Thompson <dthompson2@worcester.edu> | 2014-12-06 13:20:49 -0500 |
commit | 3d4e559e27bfab3f7e5ec7123da6f62bb4b2ef31 (patch) | |
tree | b1cab3c7f5af4a36fb8d09e62b7c5166c7863494 | |
parent | 2c821512f1c1a1dde77de9a9df4d861d41cce0f5 (diff) |
math: rect: Add rect-clamp.
* sly/math/rect.scm (rect-clamp): New procedure.
-rw-r--r-- | sly/math/rect.scm | 7 |
1 files changed, 7 insertions, 0 deletions
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)) |