math: rect: Fix rect-union when one of the rectangles has no area.

Rectangles that have no area shouldn't be considered as part of the
union.

1 files changed, 18 insertions, 8 deletions

diff --git a/chickadee/math/rect.scm b/chickadee/math/rect.scm
index 155fc19..b4f1ba4 100644
--- a/chickadee/math/rect.scm
+++ b/chickadee/math/rect.scm
@@ -281,14 +281,24 @@ while keeping the rect centered around the same point."
 (define-inlinable (rect-union! rect1 rect2)
   "Update RECT1 in-place to completely cover the area of RECT1 and
 RECT2."
-  (let ((x1 (min (rect-left rect1) (rect-left rect2)))
-        (x2 (max (rect-right rect1) (rect-right rect2)))
-        (y1 (min (rect-bottom rect1) (rect-bottom rect2)))
-        (y2 (max (rect-top rect1) (rect-top rect2))))
-    (set-rect-x! rect1 x1)
-    (set-rect-y! rect1 y1)
-    (set-rect-width! rect1 (- x2 x1))
-    (set-rect-height! rect1 (- y2 y1))))
+  (cond
+   ;; If rect1 has no area, just copy rect2.
+   ((and (zero? (rect-width rect1))
+         (zero? (rect-height rect1)))
+    (rect-copy! rect2 rect1))
+   ;; Ignore rects that have no area.
+   ((and (zero? (rect-width rect2))
+         (zero? (rect-height rect2)))
+    *unspecified*)
+   (else
+    (let ((x1 (min (rect-left rect1) (rect-left rect2)))
+          (x2 (max (rect-right rect1) (rect-right rect2)))
+          (y1 (min (rect-bottom rect1) (rect-bottom rect2)))
+          (y2 (max (rect-top rect1) (rect-top rect2))))
+      (set-rect-x! rect1 x1)
+      (set-rect-y! rect1 y1)
+      (set-rect-width! rect1 (- x2 x1))
+      (set-rect-height! rect1 (- y2 y1))))))
 
 (define-inlinable (rect-clip! rect1 rect2)
   "Update RECT1 in-place to be the overlapping region of RECT1 and RECT2.