Add tests for (chickadee math rect) module.

2 files changed, 175 insertions, 0 deletions

diff --git a/Makefile.am b/Makefile.am
index 04b56a0..55f626e 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -103,6 +103,7 @@ SOURCES = 					\
 
 TESTS =						\
   tests/vector.scm				\
+  tests/rect.scm				\
   tests/matrix.scm				\
   tests/array-list.scm				\
   tests/heap.scm				\
diff --git a/tests/rect.scm b/tests/rect.scm
new file mode 100644
index 0000000..6da72fc
--- /dev/null
+++ b/tests/rect.scm
@@ -0,0 +1,174 @@
+;;; Chickadee Game Toolkit
+;;; Copyright © 2022 David Thompson <dthompson2@worcester.edu>
+;;;
+;;; Chickadee is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published
+;;; by the Free Software Foundation, either version 3 of the License,
+;;; or (at your option) any later version.
+;;;
+;;; Chickadee is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (tests rect)
+  #:use-module (tests utils)
+  #:use-module (srfi srfi-64)
+  #:use-module (chickadee math)
+  #:use-module (chickadee math rect)
+  #:use-module (chickadee math vector))
+
+(with-tests "rect"
+  (let ((r (make-rect 1.0 2.0 3.0 4.0)))
+    (test-equal "rect-x" (rect-x r) 1.0)
+    (test-equal "rect-y" (rect-y r) 2.0)
+    (test-equal "rect-width" (rect-width r) 3.0)
+    (test-equal "rect-height" (rect-height r) 4.0)
+    (test-equal "rect-left" (rect-left r) 1.0)
+    (test-equal "rect-right" (rect-right r) 4.0)
+    (test-equal "rect-bottom" (rect-bottom r) 2.0)
+    (test-equal "rect-top" (rect-top r) 6.0)
+    (test-equal "rect-center-x" (rect-center-x r) 2.5)
+    (test-equal "rect-center-y" (rect-center-y r) 4.0)
+    (test-equal "rect-area" (rect-area r) 12.0)
+    (test-group "rect-clamp-x"
+      (test-equal "left" (rect-clamp-x r 0.5) 1.0)
+      (test-equal "right" (rect-clamp-x r 4.5) 4.0)
+      (test-equal "between" (rect-clamp-x r 2.0) 2.0))
+    (test-group "rect-clamp-y"
+      (test-equal "below" (rect-clamp-y r 1.0) 2.0)
+      (test-equal "above" (rect-clamp-y r 7.0) 6.0)
+      (test-equal "between" (rect-clamp-y r 3.0) 3.0)))
+  (test-equal "set-rect-x!"
+    (let ((r (make-null-rect)))
+      (set-rect-x! r 1.5)
+      (rect-x r))
+    1.5)
+  (test-equal "set-rect-y!"
+    (let ((r (make-null-rect)))
+      (set-rect-y! r 1.5)
+      (rect-y r))
+    1.5)
+  (test-equal "set-rect-width!"
+    (let ((r (make-null-rect)))
+      (set-rect-width! r 1.5)
+      (rect-width r))
+    1.5)
+  (test-equal "set-rect-height!"
+    (let ((r (make-null-rect)))
+      (set-rect-height! r 1.5)
+      (rect-height r))
+    1.5)
+  (test-equal "rect-move!"
+    (let ((r (make-null-rect)))
+      (rect-move! r 1.0 2.0)
+      r)
+    (make-rect 1.0 2.0 0.0 0.0))
+  (test-equal "rect-move-vec2!"
+    (let ((r (make-null-rect)))
+      (rect-move-vec2! r (vec2 1.0 2.0))
+      r)
+    (make-rect 1.0 2.0 0.0 0.0))
+  (test-equal "rect-move-by!"
+    (let ((r (make-rect 3.0 4.0 0.0 0.0)))
+      (rect-move-by! r 1.0 2.0)
+      r)
+    (make-rect 4.0 6.0 0.0 0.0))
+  (test-equal "rect-move-by-vec2!"
+    (let ((r (make-rect 3.0 4.0 0.0 0.0)))
+      (rect-move-by-vec2! r (vec2 1.0 2.0))
+      r)
+    (make-rect 4.0 6.0 0.0 0.0))
+  (test-equal "rect-inflate!"
+    (let ((r (make-rect 1.0 1.0 1.0 1.0)))
+      (rect-inflate! r 2.0 3.0)
+      r)
+    (make-rect 0.0 -0.5 3.0 4.0))
+  (test-equal "rect-union!"
+    (let ((r (make-rect 1.0 2.0 1.0 2.0)))
+      (rect-union! r (make-rect 3.0 4.0 1.0 1.0))
+      r)
+    (make-rect 1.0 2.0 3.0 3.0))
+  (test-group "rect-clip!"
+    (test-equal "overlapping"
+      (let ((r (make-rect 0.0 0.0 4.0 5.0)))
+        (rect-clip! r (make-rect 3.0 4.0 3.0 3.0))
+        r)
+      (make-rect 3.0 4.0 1.0 1.0))
+    (test-equal "non-overlapping"
+      (let ((r (make-rect 0.0 0.0 1.0 1.0)))
+        (rect-clip! r (make-rect 3.0 4.0 1.0 1.0))
+        r)
+      (make-rect 3.0 4.0 0.0 0.0)))
+  (test-equal "vec2-clamp-to-rect!"
+    (let ((v (vec2 0.0 0.0)))
+      (vec2-clamp-to-rect! v (make-rect 1.0 2.0 1.0 1.0))
+      v)
+    (vec2 1.0 2.0))
+  (test-equal "rect-clamp!"
+    (let ((r (make-rect 0.0 0.0 1.0 2.0)))
+      (rect-clamp! r (make-rect 3.0 4.0 5.0 6.0))
+      r)
+    (make-rect 3.0 4.0 1.0 2.0))
+  (test-equal "rect-move"
+    (rect-move (make-null-rect) 1.0 2.0)
+    (make-rect 1.0 2.0 0.0 0.0))
+  (test-equal "rect-move-vec2"
+    (rect-move-vec2 (make-null-rect) (vec2 1.0 2.0))
+    (make-rect 1.0 2.0 0.0 0.0))
+  (test-equal "rect-move-by"
+    (rect-move-by (make-rect 3.0 4.0 0.0 0.0) 1.0 2.0)
+    (make-rect 4.0 6.0 0.0 0.0))
+  (test-equal "rect-move-by-vec2"
+    (rect-move-by-vec2 (make-rect 3.0 4.0 0.0 0.0) (vec2 1.0 2.0))
+    (make-rect 4.0 6.0 0.0 0.0))
+  (test-equal "rect-inflate"
+    (rect-inflate (make-rect 1.0 1.0 1.0 1.0) 2.0 3.0)
+    (make-rect 0.0 -0.5 3.0 4.0))
+  (test-equal "rect-union"
+    (rect-union (make-rect 1.0 2.0 1.0 2.0) (make-rect 3.0 4.0 1.0 1.0))
+    (make-rect 1.0 2.0 3.0 3.0))
+  (test-group "rect-clip"
+    (test-equal "overlapping"
+      (rect-clip (make-rect 0.0 0.0 4.0 5.0) (make-rect 3.0 4.0 3.0 3.0))
+      (make-rect 3.0 4.0 1.0 1.0))
+    (test-equal "non-overlapping"
+      (rect-clip (make-rect 0.0 0.0 1.0 1.0) (make-rect 3.0 4.0 1.0 1.0))
+      (make-rect 3.0 4.0 0.0 0.0)))
+  (test-equal "vec2-clamp-to-rect"
+    (vec2-clamp-to-rect (vec2 0.0 0.0) (make-rect 1.0 2.0 1.0 1.0))
+    (vec2 1.0 2.0))
+  (test-equal "rect-clamp"
+    (rect-clamp (make-rect 0.0 0.0 1.0 2.0) (make-rect 3.0 4.0 5.0 6.0))
+    (make-rect 3.0 4.0 1.0 2.0))
+  (test-group "rect-within?"
+    (test-assert "no overlap"
+      (not (rect-within? (make-rect 0.0 0.0 1.0 1.0)
+                         (make-rect 2.0 2.0 1.0 1.0))))
+    (test-assert "some overlap"
+      (not (rect-within? (make-rect 1.5 1.5 1.0 1.0)
+                         (make-rect 2.0 2.0 1.0 1.0))))
+    (test-assert "full overlap"
+      (rect-within? (make-rect 0.0 0.0 4.0 4.0)
+                    (make-rect 2.0 2.0 1.0 1.0))))
+  (test-group "rect-intersects?"
+    (test-assert "no overlap"
+      (not (rect-intersects? (make-rect 0.0 0.0 1.0 1.0)
+                             (make-rect 2.0 2.0 1.0 1.0))))
+    (test-assert "overlap"
+      (rect-intersects? (make-rect 1.5 1.5 1.0 1.0)
+                        (make-rect 2.0 2.0 1.0 1.0))))
+  (test-group "rect-contains?"
+    (test-assert "outside"
+      (not (rect-contains? (make-rect 1.0 2.0 3.0 4.0) 5.0 1.0)))
+    (test-assert "inside"
+      (rect-contains? (make-rect 1.0 2.0 3.0 4.0) 3.0 4.0)))
+  (test-group "rect-contains-vec2?"
+    (test-assert "outside"
+      (not (rect-contains-vec2? (make-rect 1.0 2.0 3.0 4.0) (vec2 5.0 1.0))))
+    (test-assert "inside"
+      (rect-contains-vec2? (make-rect 1.0 2.0 3.0 4.0) (vec2 3.0 4.0)))))