From 450df6c018a560fdc71b9f6c6dd1ec842b4bf402 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Mon, 26 Sep 2022 15:47:01 -0400
Subject: node-2d: Use inverse matrix to improve picking.

Now picking works for nodes that are not axis-aligned.
---
 starling/node-2d.scm | 49 ++++++++++++++++++++++++++++++++++---------------
 1 file changed, 34 insertions(+), 15 deletions(-)

diff --git a/starling/node-2d.scm b/starling/node-2d.scm
index 0c16977..30e5549 100644
--- a/starling/node-2d.scm
+++ b/starling/node-2d.scm
@@ -361,7 +361,9 @@
   ;; Lazily computed transformation matrices.
   (local-matrix #:getter local-matrix #:init-form (make-identity-matrix4))
   (world-matrix #:getter world-matrix #:init-form (make-identity-matrix4))
+  (inverse-world-matrix #:getter inverse-world-matrix #:init-form (make-identity-matrix4))
   (dirty-matrix? #:accessor dirty-matrix? #:init-form #t)
+  (dirty-inverse-world-matrix? #:accessor dirty-inverse-world-matrix? #:init-form #t)
   ;; Node dimensions.  Stored as a rectangle for convenience
   ;; elsewhere, so it can be used as a bounding box that doesn't take
   ;; any transformation matrix into consideration.
@@ -392,6 +394,7 @@
 
 (define-method (dirty! (node <node-2d>))
   (set! (dirty-matrix? node) #t)
+  (set! (dirty-inverse-world-matrix? node) #t)
   (set! (dirty-bounding-box? node) #t))
 
 (define-method (refresh-local-matrix (node <node-2d>))
@@ -405,6 +408,9 @@
 (define-method (refresh-world-matrix (node <node-2d>) (parent <node-2d>))
   (matrix4-mult! (world-matrix node) (local-matrix node) (world-matrix parent)))
 
+(define-method (refresh-inverse-world-matrix (node <node-2d>))
+  (matrix4-inverse! (world-matrix node) (inverse-world-matrix node)))
+
 ;; If a node has no parent or the parent is a 2D node, we simply copy
 ;; the local matrix as the world matrix.
 (define-method (refresh-world-matrix (node <node-2d>) parent)
@@ -416,6 +422,12 @@
   (refresh-local-matrix node)
   (refresh-world-matrix node (parent node)))
 
+(define-method (inverse-world-matrix* (node <node-2d>))
+  (when (dirty-inverse-world-matrix? node)
+    (refresh-inverse-world-matrix node)
+    (set! (dirty-inverse-world-matrix? node) #f))
+  (inverse-world-matrix node))
+
 ;; Size and bounding box
 
 (define-method (default-width (node <node-2d>)) 0.0)
@@ -443,12 +455,12 @@
           (set-rect-y! bb (- (vec2-y p) (vec2-y o)))
           (set-rect-width! bb (* w (vec2-x s)))
           (set-rect-height! bb (* h (vec2-y s))))
-        ;; Slow path: Node is rotated, skewed, or both.
+        ;; Slow path: Node is rotated, sheared, or both.
         (let* ((m (local-matrix node))
-               (x0 (- (vec2-x p) (vec2-x o)))
-               (y0 (- (vec2-y p) (vec2-y o)))
-               (x1 (+ x0 w))
-               (y1 (+ y0 h))
+               (x0 0.0)
+               (y0 0.0)
+               (x1 w)
+               (y1 h)
                (x2 (matrix4-transform-x m x0 y0))
                (y2 (matrix4-transform-y m x0 y0))
                (x3 (matrix4-transform-x m x1 y0))
@@ -606,16 +618,23 @@
 
 (define-method (pick (node <node-2d>) p pred)
   (and (pred node)
-       (let ((bb (bounding-box node)))
-         (let loop ((kids (reverse (children node))))
-           (match kids
-             (()
-              (and (rect-contains-vec2? bb p)
-                   node))
-             ((child . rest)
-              (let ((o (origin node)))
-                (or (pick child (vec2- p (position node)) pred)
-                    (loop rest)))))))))
+       (let loop ((kids (reverse (children node))))
+         (match kids
+           (()
+            (let* ((m (inverse-world-matrix* node))
+                   (x (vec2-x p))
+                   (y (vec2-y p))
+                   (tx (matrix4-transform-x m x y))
+                   (ty (matrix4-transform-y m x y)))
+              (and (>= tx 0.0)
+                   (< tx (width node))
+                   (>= ty 0.0)
+                   (< ty (height node))
+                   node)))
+           ((child . rest)
+            (let ((o (origin node)))
+              (or (pick child p pred)
+                  (loop rest))))))))
 
 ;; Events
 
-- 
cgit v1.2.3