From 37c03fd4a4847b4a46fd1f93db55ed3e87f0a57c Mon Sep 17 00:00:00 2001 From: David Thompson Date: Thu, 25 May 2023 19:05:45 -0400 Subject: node-2d: Add world->local method. --- catbird/node-2d.scm | 22 +++++++++++++--------- 1 file changed, 13 insertions(+), 9 deletions(-) diff --git a/catbird/node-2d.scm b/catbird/node-2d.scm index 868604a..79a0dba 100644 --- a/catbird/node-2d.scm +++ b/catbird/node-2d.scm @@ -102,6 +102,7 @@ teleport world-bounding-box world-matrix + world->local texture @@ -602,19 +603,22 @@ (define-method (follow-bezier-path (node ) path duration) (follow-bezier-path node path duration #t)) +(define-method (world->local (node ) p) + (matrix4-transform-vec2 (inverse-world-matrix node) p)) + (define-method (pick (node ) p) (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)) + ;; Multiply the cursor position by the inverse world matrix to + ;; translate world coordinates into node-local coordinates. + (let* ((p* (world->local node p)) + (x (vec2-x p*)) + (y (vec2-y p*))) + (and (>= x 0.0) + (< x (width node)) + (>= y 0.0) + (< y (height node)) node))) ((child . rest) (let ((o (origin node))) -- cgit v1.2.3