diff options
Diffstat (limited to 'src/wheelwork.lisp')
| -rw-r--r-- | src/wheelwork.lisp | 80 |
1 files changed, 15 insertions, 65 deletions
diff --git a/src/wheelwork.lisp b/src/wheelwork.lisp index ffcb242..cc70053 100644 --- a/src/wheelwork.lisp +++ b/src/wheelwork.lisp @@ -23,7 +23,8 @@ (sdl2:with-gl-context (ctx window) (sdl2:gl-make-current window ctx) (gl:viewport 0 0 (application-width app) (application-height app)) - ;(gl:enable :depth-test) + ;(gl:enable :depth-test) + (gl:enable :scissor-test) (let ((*application* app)) (unwind-protect (progn @@ -64,64 +65,8 @@ TARGET is FOCUSABLEP" (sdl2:scancode sdl-keysym) (sdl2:mod-keywords (sdl2:mod-value sdl-keysym))))))) -(defun get-rect (unit) - "Returns a list of vectors representing the path of the smallest -rectangle that encloses the unit. The rectangle is scaled and rotated." - (with-accessors ((x x) (y y) (w width) (h height) (r rotation)) unit - (let ((m - (mat:meye 4)) - (tr - (vec:vec (+ x (* 0.5 w)) (+ y (* 0.5 h)) 0.0))) - (mat:nmtranslate m tr) - (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)))))) - -(defun counterclockwisep (a b c) - (> (* (- (vec:vx b) (vec:vx a)) - (- (vec:vy c) (vec:vy a))) - (* (- (vec:vy b) (vec:vy a)) - (- (vec:vx c) (vec:vx a))))) - - -(defun intersectp (a b c d) - (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 path-bounds (path) - "Path is a list of vectors representing 2d points. Returns the -bounds and width and height as a plist of the form - -(:top N :left N :right N :bottom N :width N :height N) - -This is the smallest UNROTATED RECTANGLE that contains the points in -the path." - (loop - with max-x = nil - 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) - when (or (null max-x) (< max-x x)) - do (setf max-x x) - when (or (null min-x) (< x min-x)) - do (setf min-x x) - when (or (null max-y) (< max-y y)) - do (setf max-y y) - when (or (null min-y) (< y min-y)) - do (setf min-y y) - finally - (return (list :top max-y :left min-x :right max-x :bottom min-y - :width (- max-x min-x) - :height (- max-y min-y))))) + + (defun contains-point-p (unit px py) (let* ((pt @@ -144,17 +89,22 @@ the path." (return (oddp intersection-count)))))) (defun unit-under (app x y) + "Finds the visible unit that contains the point x y." (labels ((finder (thing) - (etypecase thing - (container - (find-if #'finder (container-units thing) :from-end t)) - (unit - (when (contains-point-p thing x y) - (return-from unit-under thing)))))) + (when (unit-visiblep thing) + (etypecase thing + (container + (find-if #'finder (container-units thing) :from-end t)) + (unit + (when (contains-point-p thing x y) + (return-from unit-under thing))))))) (finder app))) (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." (with-slots (height scale) app (list (/ x scale) (/ (- height y) scale)))) |