From 266e42e8d9d523f686255882ece65ae1361be2e6 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson@member.fsf.org>
Date: Tue, 13 Aug 2013 07:51:19 -0400
Subject: Expand rect module.

---
 2d/rect.scm | 36 ++++++++++++++++++++++++++++++------
 1 file changed, 30 insertions(+), 6 deletions(-)

(limited to '2d/rect.scm')

diff --git a/2d/rect.scm b/2d/rect.scm
index 85943db..9abbca5 100644
--- a/2d/rect.scm
+++ b/2d/rect.scm
@@ -36,8 +36,12 @@
             rect-move
             rect-inflate
             rect-union
-            rect-contains?
-            rect-collides?))
+            rect-within?
+            rect-intesects?
+            rect-contains?))
+
+;; The rect API is very similar to the Pygame rect API, but rects are
+;; immutable.
 
 (define-record-type <rect>
   (make-rect x y width height)
@@ -48,10 +52,10 @@
   (height rect-height))
 
 (define (rect-x2 rect)
-  (+ (rect-x rect) (rect-width rect)))
+  (+ (rect-x rect) (rect-width rect) -1))
 
 (define (rect-y2 rect)
-  (+ (rect-y rect) (rect-height rect)))
+  (+ (rect-y rect) (rect-height rect) -1))
 
 (define (rect-move rect x y)
   "Moves a rect by the given offset."
@@ -76,7 +80,16 @@ its current center."
         (y2 (max (rect-y2 rect1) (rect-y2 rect2))))
     (make-rect x1 y1 (- x2 x1) (- y2 y1))))
 
-(define (rect-contains? rect1 rect2)
+(define (rect-clip rect1 rect2)
+  "Returns the overlapping region of rect1 and rect2. If the rects do
+not overlap, a rect of size 0 is returned."
+  (let ((x1 (max (rect-x  rect1) (rect-x  rect2)))
+        (x2 (min (rect-x2 rect1) (rect-x2 rect2)))
+        (y1 (max (rect-y  rect1) (rect-y  rect2)))
+        (y2 (min (rect-y2 rect1) (rect-y2 rect2))))
+    (make-rect x1 y1 (max (- x2 x1) 0) (max (- y2 y1) 0))))
+
+(define (rect-within? rect1 rect2)
   "Tests if rect2 is completely within rect1."
   (and (>= (rect-x  rect2) (rect-x  rect1))
        (<= (rect-x  rect2) (rect-x2 rect1))
@@ -87,7 +100,7 @@ its current center."
        (>= (rect-y2 rect2) (rect-y  rect1))
        (<= (rect-y2 rect2) (rect-y2 rect1))))
 
-(define (rect-collides? rect1 rect2)
+(define (rect-intersects? rect1 rect2)
   "Tests if rect2 overlaps rect1."
   (or (and (>= (rect-x  rect2) (rect-x  rect1))
            (<= (rect-x  rect2) (rect-x2 rect1)))
@@ -97,3 +110,14 @@ its current center."
            (<= (rect-y  rect2) (rect-y2 rect1)))
       (and (>= (rect-y2 rect2) (rect-y  rect1))
            (<= (rect-y2 rect2) (rect-y2 rect1)))))
+
+(define (rect-contains? rect x y)
+  "Tests if the given point is within rect."
+  (and (>= x (rect-x  rect))
+       (<= x (rect-x2 rect))
+       (>= x (rect-x  rect))
+       (<= x (rect-x2 rect))
+       (>= y (rect-y  rect))
+       (<= y (rect-y2 rect))
+       (>= y (rect-y  rect))
+       (<= y (rect-y2 rect))))
-- 
cgit v1.2.3