summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson@member.fsf.org>2013-09-08 18:33:51 -0400
committerDavid Thompson <dthompson@member.fsf.org>2013-09-08 18:33:51 -0400
commitfa3a92e27a9699207657bb1c538d55182a667850 (patch)
tree9314eca2205ee7e0e26408b265b4de84ffe858f0
parent18eebb36eb5c2441cd63f3a89fc608f234b9f775 (diff)
Add more vector-friendly procedures to the rect module.
-rw-r--r--2d/rect.scm54
1 files changed, 49 insertions, 5 deletions
diff --git a/2d/rect.scm b/2d/rect.scm
index bbccc0e..1257142 100644
--- a/2d/rect.scm
+++ b/2d/rect.scm
@@ -24,6 +24,7 @@
(define-module (2d rect)
#:use-module (srfi srfi-9)
+ #:use-module (2d vector2)
#:export (<rect>
make-rect
rect?
@@ -33,6 +34,8 @@
rect-y2
rect-width
rect-height
+ rect-position
+ rect-size
rect-move
rect-inflate
rect-union
@@ -41,6 +44,10 @@
rect-intesects?
rect-contains?))
+;;;
+;;; Rectangles
+;;;
+
;; The rect API is very similar to the Pygame rect API, but rects are
;; immutable.
@@ -58,14 +65,34 @@
(define (rect-y2 rect)
(+ (rect-y rect) (rect-height rect) -1))
-(define (rect-move rect x y)
- "Moves a rect by the given offset."
+(define (rect-position rect)
+ "Return the top-left corner of RECT as a vector2."
+ (vector2 (rect-x rect)
+ (rect-y rect)))
+
+(define (rect-size rect)
+ "Return the size of RECT as a vector2."
+ (vector2 (rect-width rect)
+ (rect-height rect)))
+
+(define (%rect-move rect x y)
+ "Move a rect by the given offset."
(make-rect (+ (rect-x rect) x)
(+ (rect-y rect) y)
(rect-width rect)
(rect-height rect)))
-(define (rect-inflate rect width height)
+(define rect-move
+ (case-lambda
+ "Create a new rectangle by moving RECT by the given
+offset. rect-move accepts a vector2 or x and y coordinates as separate
+arguments."
+ ((rect v)
+ (%rect-move rect (vx v) (vy v)))
+ ((rect x y)
+ (%rect-move rect x y))))
+
+(define (%rect-inflate rect width height)
"Grows the rect by the given amount. The rect stays centered around
its current center."
(make-rect (+ (rect-x rect) (/ width 2))
@@ -73,6 +100,16 @@ its current center."
(+ (rect-width rect) width)
(+ (rect-height rect) height)))
+(define rect-inflate
+ (case-lambda
+ "Create a new rectangle by growing RECT by the given amount
+without changing the center point. rect-inflate accepts a vector2 or x
+and y coordinates as separate arguments."
+ ((rect v)
+ (%rect-inflate rect (vx v) (vy v)))
+ ((rect x y)
+ (%rect-inflate rect x y))))
+
(define (rect-union rect1 rect2)
"Returns a rect that covers the area of rect1 and rect2."
(let ((x1 (min (rect-x rect1) (rect-x rect2)))
@@ -112,9 +149,16 @@ not overlap, a rect of size 0 is returned."
(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."
+(define (%rect-contains? rect x y)
(and (>= x (rect-x rect))
(<= x (rect-x2 rect))
(>= y (rect-y rect))
(<= y (rect-y2 rect))))
+
+(define rect-contains?
+ (case-lambda
+ "Tests if the given point is within rect."
+ ((rect v)
+ (%rect-contains? rect (vx v) (vy v)))
+ ((rect x y)
+ (%rect-contains? rect x y))))