diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/core/unit.lisp | 12 | ||||
| -rw-r--r-- | src/utils.lisp | 89 | ||||
| -rw-r--r-- | src/wheelwork.lisp | 35 |
3 files changed, 71 insertions, 65 deletions
diff --git a/src/core/unit.lisp b/src/core/unit.lisp index 8fe6521..1102f20 100644 --- a/src/core/unit.lisp +++ b/src/core/unit.lisp @@ -101,11 +101,13 @@ (mat:nmrotate m vec:+vz+ r) (mat:nmtranslate m (vec:v* -1.0 tr)) - (list (mat:m* m (vec:vec x y 0.0 1.0)) - (mat:m* m (vec:vec x (+ y h) 0.0 1.0)) - (mat:m* m (vec:vec (+ x w) (+ y h) 0.0 1.0)) - (mat:m* m (vec:vec (+ x w) y 0.0 1.0)) - (mat:m* m (vec:vec x y 0.0 1.0)))))))) + (loop for vec in (list (mat:m* m (vec:vec x y 0.0 1.0)) + (mat:m* m (vec:vec x (+ y h) 0.0 1.0)) + (mat:m* m (vec:vec (+ x w) (+ y h) 0.0 1.0)) + (mat:m* m (vec:vec (+ x w) y 0.0 1.0)) + (mat:m* m (vec:vec x y 0.0 1.0))) + collect (list (vec:vx vec) + (vec:vy vec)))))))) (defun units-intersect-p (au1 au2) "Returns T if the two units AU1 an AU2 intersect. Both must implement GET-RECT." diff --git a/src/utils.lisp b/src/utils.lisp index 4ace1b8..7357325 100644 --- a/src/utils.lisp +++ b/src/utils.lisp @@ -2,11 +2,10 @@ (in-package #:wheelwork) -(define-symbol-macro +pi-over-180+ 0.017453292519943295d0) - +(declaim (inline radians counterclockwisep points-equal-p)) (defun radians (degrees) "Converse DEGREES to radians" - (* degrees +pi-over-180+)) + (* degrees 0.017453292519943295d0)) (defun safe-slot (object slot &optional default) (if-let (val (and (slot-exists-p object slot) @@ -15,61 +14,69 @@ val default)) -(defun counterclockwisep (a b c) +(defun counterclockwisep (ax ay bx by cx cy) "A B and C are vectors created by 3d-vectors:vec, each representing a 2d point. Returns T if the three are supplied in counterclockwise order, nil if not." - (> (* (- (vec:vx b) (vec:vx a)) - (- (vec:vy c) (vec:vy a))) - (* (- (vec:vy b) (vec:vy a)) - (- (vec:vx c) (vec:vx a))))) + (> (* (- bx ax) + (- cy ay)) + (* (- by ay) + (- cx ax)))) +(defun points-equal-p (x1 y1 x2 y2) + (and (= x1 x2)) (= y1 y2)) -(defun segments-intersect-p (a b c d) +(defun segments-intersect-p (ax ay bx by cx cy dx dy) "A B C and D are vectors of the sort created by 3d-vectors:vec, each representing a 2d point. Returns T if the line segment between A and B intersects the linesegment between C and D, NIL otherwise." - (or (vec:v= a c) (vec:v= a d) (vec:v= b c) (vec:v= b d) - (and (not (eq (counterclockwisep a c d) (counterclockwisep b c d))) - (not (eq (counterclockwisep a b c) (counterclockwisep a b d)))))) - -(defun paths-intersect-p (path-a path-b) + (or (points-equal-p ax ay cx cy) + (points-equal-p ax ay dx dy) + (points-equal-p bx by cx cy) + (points-equal-p bx by dx dy) + (and (not (eq (counterclockwisep ax ay cx cy dx dy) + (counterclockwisep bx by cx cy dx dy))) + (not (eq (counterclockwisep ax ay bx by cx cy) + (counterclockwisep ax ay bx by dx dy)))))) + +(defun paths-intersect-p (path1 path2) "Paths are lists of vectors, each of which represents a 2d point." - (loop for (a1 a2 . more-a) on path-a - while a2 - thereis (loop for (b1 b2 . b-more) on path-b - while b2 - thereis (segments-intersect-p a1 a2 b1 b2)))) + (loop for ((ax ay) (bx by) . more1) on path1 + while bx + thereis (loop for ((cx cy) (dx dy) . more2) on path2 + while dx + thereis (segments-intersect-p ax ay bx by cx cy dx dy)))) (defun closed-path-p (path) (equalp (first path) (first (last path)))) -(defun path-encloses-point-p (path pt) - "Path is a list of vectors, pt is a single vector." +(defun path-encloses-point-p (path px py) + "Path is a list of points, pt is a single vector." (assert (closed-path-p path) () "Enclosing path must be a closed path.") (let* ((bounds (path-bounds path)) (corner ;; creating a point guaranteed to be outside of the path - (vec:vec (- (getf bounds :left) (getf bounds :width)) - (- (getf bounds :bottom) (getf bounds :height)) - 0.0 1.0))) - (loop for (p1 p2 . more) on path - while p2 - when (segments-intersect-p p1 p2 pt corner) - count 1 into intersection-count - finally - (return (oddp intersection-count))))) - -(defun path-encloses-path-p (path-a path-b) - "T if path-b is totally contained in path-a and does not intersect path-a" - (assert (closed-path-p path-a) () "Enclosing path must be a closed path.") - (and - (loop for (p1 p2 . more) on path-b - while p2 - always (path-encloses-point-p path-a p1)) - (not (paths-intersect-p path-a path-b)))) + (list (- (getf bounds :left) (getf bounds :width)) + (- (getf bounds :bottom) (getf bounds :height))))) + (loop + with (cx cy) = corner + for ((ax ay) (bx by) . more) on path + while bx + when (segments-intersect-p ax ay bx by px py cx cy) + count 1 into intersection-count + finally + (return (oddp intersection-count))))) + +;; (defun path-encloses-path-p (path-a path-b) +;; "T if path-b is totally contained in path-a and does not intersect path-a" +;; (assert (closed-path-p path-a) () "Enclosing path must be a closed path.") +;; (and +;; (loop for (p1 p2 . more) on path-b +;; while p2 +;; always (path-encloses-point-p path-a p1)) +;; (not (paths-intersect-p path-a path-b)))) (defun path-bounds (path) "Path is a list of vectors representing 2d points. Returns the @@ -84,9 +91,7 @@ the path." and max-y = nil and min-x = nil and min-y = nil - for vec in path - for x = (vec:vx vec) - for y = (vec:vy vec) + for (x y) in path when (or (null max-x) (< max-x x)) do (setf max-x x) when (or (null min-x) (< x min-x)) diff --git a/src/wheelwork.lisp b/src/wheelwork.lisp index 154adaa..8a534ed 100644 --- a/src/wheelwork.lisp +++ b/src/wheelwork.lisp @@ -84,13 +84,13 @@ TARGET is FOCUSABLEP" (sdl2:mod-keywords (sdl2:mod-value sdl-keysym))))))) -(defun region-contains-point-p (region pt) +(defun region-contains-point-p (region x y) (with-slots (left right bottom top) region - (and (<= left (vec:vx pt) right) - (<= bottom (vec:vy pt) top)))) + (and (<= left x right) + (<= bottom y top)))) -(defun unit-contains-point-p (unit pt) - (path-encloses-point-p (get-rect unit) pt)) +(defun unit-contains-point-p (unit x y) + (path-encloses-point-p (get-rect unit) x y)) (defun mouse-event-targets (app x y &optional bubblep) "Returns a list of one or more objects found under the x y @@ -101,26 +101,23 @@ position. The list always contains the app itself as the last element." (list app))) -(defun unit-visibly-contains-p (unit pt) +(defun unit-visibly-contains-p (unit x y) (and (unit-visiblep unit) - (region-contains-point-p (unit-region unit) pt) - (unit-contains-point-p unit pt))) + (region-contains-point-p (unit-region unit) x y) + (unit-contains-point-p unit x y))) (defun unit-under (app x y) "Finds the visible unit that contains the point x y, returns it as a single elemtn list, or nil if none found" - (let ((xy (vec:vec x y 0.0 1.0))) - (loop for u in (application-scene app) - when (unit-visibly-contains-p u xy) - return (list u)))) + (loop for u in (application-scene app) + when (unit-visibly-contains-p u x y) + return (list u))) (defun all-units-under (app x y) "Finds all units under the point x y" - (let ((xy - (vec:vec x y 0.0 1.0))) - (loop for u in (application-scene app) - when (unit-visibly-contains-p u xy) - collect u))) + (loop for u in (application-scene app) + when (unit-visibly-contains-p u x y) + collect u)) (defvar *event-still-bubbling-p* nil "Controls whether an event is bubbling") @@ -132,7 +129,8 @@ single elemtn list, or nil if none found" (defun screen-to-world (x y &optional (app *application*)) "Scales the screen point - the literal pixel position relative to the top corner of the application window - to reflect the -application's scaling factor." +application's scaling factor" + (declare (optimize (speed 3) (saftey 0))) (with-slots (height scale) app (list (/ x scale) (/ (- height y) scale)))) @@ -187,6 +185,7 @@ give focus to whatever was clicked." (funcall handler focus wx wy dir))))) (defun eventloop (app) + (declare (optimize (speed 3) (safety 0))) (sdl2:with-event-loop (:method :poll) (:mousebuttondown (:x x :y y :clicks clicks :button button) |