diff options
| -rw-r--r-- | gui/button.lisp | 6 | ||||
| -rw-r--r-- | gui/menus.lisp | 16 | ||||
| -rw-r--r-- | src/application.lisp | 28 | ||||
| -rw-r--r-- | src/canvas-language.lisp | 12 | ||||
| -rw-r--r-- | src/core/unit.lisp | 34 | ||||
| -rw-r--r-- | src/grid-geometry.lisp | 80 | ||||
| -rw-r--r-- | src/interactive/canvas.lisp | 13 | ||||
| -rw-r--r-- | src/interactive/frameset.lisp | 50 | ||||
| -rw-r--r-- | src/interactive/interactive.lisp | 5 | ||||
| -rw-r--r-- | src/interactive/sprite.lisp | 15 | ||||
| -rw-r--r-- | src/pre-exit-hooks.lisp | 4 | ||||
| -rw-r--r-- | src/utils.lisp | 70 | ||||
| -rw-r--r-- | src/wheelwork.lisp | 48 |
13 files changed, 193 insertions, 188 deletions
diff --git a/gui/button.lisp b/gui/button.lisp index bebea08..dfb6a06 100644 --- a/gui/button.lisp +++ b/gui/button.lisp @@ -76,12 +76,12 @@ (macrolet ((def-accessors (&rest accessor-names) (let ((defs - (loop for accessor-name in accessor-names - collect + (loop :for accessor-name :in accessor-names + :collect `(defmethod ,accessor-name ((button button)) (,accessor-name (button-up button))) - collect + :collect `(defmethod (setf ,accessor-name) (newval (button button)) (setf (,accessor-name (button-up button)) newval (,accessor-name (button-down button)) newval) diff --git a/gui/menus.lisp b/gui/menus.lisp index a477dd9..e9188f1 100644 --- a/gui/menus.lisp +++ b/gui/menus.lisp @@ -11,7 +11,7 @@ :required :type region)) (defmethod cleanup :after ((menu menu)) - (loop for item in (menu-items menu) do (cleanup item))) + (map 'nil #'cleanup (menu-items menu))) (defmethod initialize-instance :after ((menu menu) &key) (with-slots (base-width base-height region) menu @@ -32,12 +32,12 @@ (macrolet ((def-menu-accessors (&rest accessor-names) (let ((defs - (loop for name in accessor-names - collect + (loop :for name :in accessor-names + :collect `(defmethod ,name ((menu menu)) (,name (unit-region menu))) - collect + :collect `(defmethod (setf ,name) (newval (menu menu)) (let ((diff (- newval (,name menu)))) (setf (,name (unit-region menu)) newval) @@ -96,9 +96,9 @@ (defmethod (setf vert-scroll) :after (val (vs vscroller)) (loop - for o in (menu-items vs) - for y = (+ (y vs) (height vs) val) then (- y (height o)) - do (setf (y o) y))) + :for o :in (menu-items vs) + :for y := (+ (y vs) (height vs) val) :then (- y (height o)) + :do (setf (y o) y))) (defhandler vscroller-scroll (on-mousewheel (vs horiz vert) @@ -110,7 +110,7 @@ (- oh h)))))) (defun vscroller-items-height (vs) - (loop for o in (menu-items vs) summing (height o))) + (loop :for o :in (menu-items vs) :summing (height o))) (defmethod add-menu-item :before ((vs vscroller) item) (setf (x item) (x vs) diff --git a/src/application.lisp b/src/application.lisp index f33bb9f..8c86fad 100644 --- a/src/application.lisp +++ b/src/application.lisp @@ -88,27 +88,33 @@ focus-table blur-table perframe-table)) (defmethod cleanup ((app application)) - (loop for asset being the hash-value of (application-assets app) - do (cleanup asset)) + ;; run cleanup on assets + (loop :for asset :being :the :hash-value :of (application-assets app) + :do (cleanup asset)) + ;; drop all current handlers (let ((listener (listener app))) (dolist (table +listener-table-slot-names+) (setf (slot-value listener table) (make-hash-table :synchronized t)))) - (loop for unit across (application-scene app) - do - (drop-unit unit) - (cleanup unit)) + + ;; then cleanup units + (loop :for unit :across (application-scene app) :do + (drop-unit unit) + (cleanup unit)) + + ;; finally run the exit hooks (pre-exit-hooks)) (defun run-perframe (app) "Runs all of the handlers objects listening for perframe events if they are in the scene." (let ((table (perframe-table (listener app))) (time (sdl2:get-ticks))) - (loop for target being the hash-key of table - for handlers = (slot-value (listener target) 'perframe) + (loop :for target :being :the :hash-key :of table + :for handlers := (slot-value (listener target) 'perframe) ;; only fire perframe when target is in scene - when (or (eq app target) (unit-in-scene-p target)) - do (loop for handler in handlers do (funcall handler target time))))) + :when (or (eq app target) (unit-in-scene-p target)) + :do (loop :for handler :in handlers + :do (funcall handler target time))))) (defmethod render ((app application)) (run-perframe app) @@ -119,7 +125,7 @@ (gl:blend-func :src-alpha :one-minus-src-alpha ) (with-slots (scene) app (when (plusp (length scene)) - (loop for unit across scene do (render unit)))) + (loop :for unit :across scene :do (render unit)))) (sdl2:gl-swap-window (application-window app)) (sleep (frame-wait app))) diff --git a/src/canvas-language.lisp b/src/canvas-language.lisp index 1a8b12e..5bdf1c8 100644 --- a/src/canvas-language.lisp +++ b/src/canvas-language.lisp @@ -95,7 +95,7 @@ integer." (defun rel-to-current-pos (path) (destructuring-bind (cx cy) *current-pen-position* - (loop for (x y) in path collect (list (+ cx x) (+ cy y))))) + (loop :for (x y) :in path :collect (list (+ cx x) (+ cy y))))) (defun move-pen-to (x y) "Sets the pen's position without drawing. " @@ -152,11 +152,11 @@ the pen relative to its antecedent, look at STROKE-STEPS" (defun steps-to-concrete-points (steps) (loop - with (cx cy) = *current-pen-position* - for (dx dy) in steps - do (incf cx dx) - (incf cy dy) - collect (list cx cy))) + :with (cx cy) := *current-pen-position* + :for (dx dy) :in steps + :do (incf cx dx) + (incf cy dy) + :collect (list cx cy))) (defun stroke-steps (steps) "STEPS is a list of (dx dy) steps. The pen starts at the current diff --git a/src/core/unit.lisp b/src/core/unit.lisp index 308b715..ded1e41 100644 --- a/src/core/unit.lisp +++ b/src/core/unit.lisp @@ -110,23 +110,25 @@ (defmethod get-rect ((unit unit)) (or (cached-rectangle unit) - (setf (cached-rectangle unit) - (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)) + (setf + (cached-rectangle unit) + (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)) - (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)))))))) + (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/grid-geometry.lisp b/src/grid-geometry.lisp index f66a41f..ec4edd2 100644 --- a/src/grid-geometry.lisp +++ b/src/grid-geometry.lisp @@ -8,30 +8,30 @@ connecting the integer point START-X , START-Y and END-X, END-Y. " (with-gensyms (sx sy ex ey distance step progress xdiff ydiff) `(loop - with ,sx = ,start-x - with ,sy = ,start-y - with ,ex = ,end-x - with ,ey = ,end-y - with ,xdiff = (- ,ex ,sx) - with ,ydiff = (- ,ey, sy) - with ,distance = (max (abs ,xdiff) (abs ,ydiff)) - for ,step from 0 to ,distance - for ,progress = (if (zerop ,distance) 0.0 (/ ,step ,distance)) - for ,x = (round (+ ,start-x (* ,progress ,xdiff))) - for ,y = (round (+ ,start-y (* ,progress ,ydiff))) - do (progn ,@body)))) + :with ,sx := ,start-x + :with ,sy := ,start-y + :with ,ex := ,end-x + :with ,ey := ,end-y + :with ,xdiff := (- ,ex ,sx) + :with ,ydiff := (- ,ey, sy) + :with ,distance := (max (abs ,xdiff) (abs ,ydiff)) + :for ,step :from 0 :to ,distance + :for ,progress := (if (zerop ,distance) 0.0 (/ ,step ,distance)) + :for ,x := (round (+ ,start-x (* ,progress ,xdiff))) + :for ,y := (round (+ ,start-y (* ,progress ,ydiff))) + :do (progn ,@body)))) (defun grid-bbox-for (poly) "POLY is a list of pairs of xy coordinates. Return a pair of pairs, ((min-x min-y) (max-x max-y)), representing the bottom left and top right corners of the bounding box for POLY " - (loop for (x y) in poly - minimizing x into x-min - maximizing x into x-max - minimizing y into y-min - maximizing y into y-max - finally (return (list (list x-min y-min) - (list x-max y-max))))) + (loop :for (x y) :in poly + :minimizing x :into x-min + :maximizing x :into x-max + :minimizing y :into y-min + :maximizing y :into y-max + :finally (return (list (list x-min y-min) + (list x-max y-max))))) (defun grid-counterclockwisep (a b c) (> (* (- (first b) (first a)) @@ -49,11 +49,11 @@ top right corners of the bounding box for POLY " (list x y)) (corner (list -1 x))) - (loop for (p1 p2 . more) on poly - while p2 - when (grid-segments-intersect-p p1 p2 pt corner) - count 1 into intersection-count - finally + (loop :for (p1 p2 . more) :on poly + :while p2 + :when (grid-segments-intersect-p p1 p2 pt corner) + :count 1 :into intersection-count + :finally (progn (when (grid-segments-intersect-p p1 (first poly) pt corner) (incf intersection-count)) @@ -71,23 +71,23 @@ top right corners of the bounding box for POLY " (interior-clause (when interiorp `(destructuring-bind ((,x1 ,y1) (,x2 ,y2)) (grid-bbox-for ,points) - (loop for ,x from ,x1 to ,x2 do - (loop for ,y from ,y1 to ,y2 - when (grid-poly-contains-p ,points ,x ,y) - do ,@body)))))) + (loop :for ,x :from ,x1 :to ,x2 :do + (loop :for ,y :from ,y1 :to ,y2 + :when (grid-poly-contains-p ,points ,x ,y) + :do ,@body)))))) `(let ((,points ,path)) (loop - for ((,x1 ,y1) (,x2 ,y2) . ,more) on ,points - while ,x2 do + :for ((,x1 ,y1) (,x2 ,y2) . ,more) :on ,points + :while ,x2 :do (with-grid-line (,x ,y) (,x1 ,y1) (,x2 ,y2) ,@body) - finally (progn - ,autoclose-clause - ,interior-clause)))))) + :finally (progn + ,autoclose-clause + ,interior-clause)))))) (defmacro with-grid-rect ((x y) (left bottom right top) &body body) - `(loop for ,x from (floor ,left) to (floor ,right) do - (loop for ,y from (floor ,bottom) to (floor ,top) do ,@body ))) + `(loop :for ,x :from (floor ,left) :to (floor ,right) :do + (loop :for ,y :from (floor ,bottom) :to (floor ,top) :do ,@body))) (defmacro with-grid-circle ((x y) (cx cy radius &key interiorp) &body body) @@ -95,8 +95,8 @@ top right corners of the bounding box for POLY " (let ((comparator (if interiorp '>= '=))) `(let ((,sx ,cx) (,sy ,cy) (,rad ,radius)) - (loop for ,x from (- ,sx ,rad) to (+ ,sx ,rad) do - (loop for ,y from (- ,sy ,rad) to (+ ,sy ,rad) do + (loop :for ,x :from (- ,sx ,rad) :to (+ ,sx ,rad) :do + (loop :for ,y :from (- ,sy ,rad) :to (+ ,sy ,rad) :do (when (,comparator ,rad (round (euclidean-dist ,x ,y ,sx ,sy))) ,@body))))))) @@ -118,7 +118,7 @@ Evaluates the BODY with X Y bound to a point on the bezier curve. ,control-pts) (,fn (apply #'bezier-lambda ,points))) - (loop for ,a from 0.0 to (+ 1.0 ,step) by ,step - for (,x ,y) = (mapcar #'round (funcall ,fn (clamp 0 ,a 1.0))) - do ,@body)))) + (loop :for ,a :from 0.0 :to (+ 1.0 ,step) :by ,step + :for (,x ,y) := (mapcar #'round (funcall ,fn (clamp 0 ,a 1.0))) + :do ,@body)))) diff --git a/src/interactive/canvas.lisp b/src/interactive/canvas.lisp index f4b2b74..2accb8a 100644 --- a/src/interactive/canvas.lisp +++ b/src/interactive/canvas.lisp @@ -75,13 +75,12 @@ (,g (aref ,px 1)) (,b (aref ,px 2)) (,a (aref ,px 3))) - (loop for ,x from (if ,lv ,lv 0) below (if ,rv ,rv (pixel-width ,pxs)) do - (loop for ,y from (if ,bv ,bv 0) below (if ,tv ,tv (pixel-height ,pxs)) - do (progn - (setf ,px (adjust-array ,px 4 - :displaced-to (pixels-data ,pxs) - :displaced-index-offset (pixel-offset ,x ,y ,pxs))) - ,@body))))))) + (loop :for ,x :from (if ,lv ,lv 0) :below (if ,rv ,rv (pixel-width ,pxs)) :do + (loop :for ,y :from (if ,bv ,bv 0) :below (if ,tv ,tv (pixel-height ,pxs)) :do + (setf ,px (adjust-array ,px 4 + :displaced-to (pixels-data ,pxs) + :displaced-index-offset (pixel-offset ,x ,y ,pxs))) + ,@body)))))) (defun clear-canvas (canvas &key (r 0) (g 0) (b 0) (a 255)) (with-pixels-rect (x y pr pg pb pa) (canvas) diff --git a/src/interactive/frameset.lisp b/src/interactive/frameset.lisp index 65762c7..c6abb4b 100644 --- a/src/interactive/frameset.lisp +++ b/src/interactive/frameset.lisp @@ -36,21 +36,21 @@ (incf (frameset-next-time target) (frameset-wait-time target))))) (defmethod cleanup ((frameset frameset)) - (loop for frame across (frameset-frames frameset) do (cleanup frame))) + (loop :for frame :across (frameset-frames frameset) :do (cleanup frame))) (defmethod initialize-instance :after ((fs frameset) &key) (add-handler fs #'check-advance-frameset-index) (with-slots (index sequence count frames x y scale-x scale-y rotation) fs (setf index 0 count (length sequence)) - (loop for frame across frames - when frame - do (setf (unit-in-scene-p frame) fs - (x frame) x - (y frame) y - (scale-x frame) scale-x - (scale-y frame) scale-y - (rotation frame) rotation)))) + (loop :for frame :across frames + :when frame + :do (setf (unit-in-scene-p frame) fs + (x frame) x + (y frame) y + (scale-x frame) scale-x + (scale-y frame) scale-y + (rotation frame) rotation)))) (defun current-frame-unit (fs) "Returns the unit be currently displaayed as the animation's frame." @@ -63,16 +63,16 @@ (macrolet ((def-frameset-accessors (&rest accessor-names) (let ((defs - (loop for accessor-name in accessor-names - collect + (loop :for accessor-name :in accessor-names + :collect `(defmethod ,accessor-name ((fs frameset)) (,accessor-name (current-frame-unit fs))) - collect + :collect `(defmethod (setf ,accessor-name) (newval (fs frameset)) - (loop for frame across (frameset-frames fs) - when frame - do (setf (,accessor-name frame) newval)) + (loop :for frame :across (frameset-frames fs) + :when frame + :do (setf (,accessor-name frame) newval)) newval)))) `(progn ,@defs)))) @@ -86,16 +86,16 @@ (let* ((asset-names (remove-duplicates sequenced-assets :test #'equal)) (images - (loop for name in asset-names - collect + (loop :for name :in asset-names + :collect (make-instance - 'image - :texture (get-asset name :asset-args asset-args)))) + 'image + :texture (get-asset name :asset-args asset-args)))) (sequence - (loop for name in sequenced-assets - collect (position name asset-names :test #'equal)))) + (loop :for name :in sequenced-assets + :collect (position name asset-names :test #'equal)))) (make-instance - 'frameset - :frames (make-array (length images) :initial-contents images) - :sequence (make-array (length sequence) :initial-contents sequence) - :wait-time (/ 1000.0 fps)))) + 'frameset + :frames (make-array (length images) :initial-contents images) + :sequence (make-array (length sequence) :initial-contents sequence) + :wait-time (/ 1000.0 fps)))) diff --git a/src/interactive/interactive.lisp b/src/interactive/interactive.lisp index 74a22d1..8355329 100644 --- a/src/interactive/interactive.lisp +++ b/src/interactive/interactive.lisp @@ -12,8 +12,9 @@ (defun remove-all-handlers (interactive) (loop - for type in '(keydown keyup mousedown mouseup mousemotion mousewheel focus blur perframe) - do (remove-handler interactive type))) + :for type + :in '(keydown keyup mousedown mouseup mousemotion mousewheel focus blur perframe) + :do (remove-handler interactive type))) (defmethod cleanup :after ((ob interactive)) (remove-all-handlers ob)) diff --git a/src/interactive/sprite.lisp b/src/interactive/sprite.lisp index dd9b2a1..c212418 100644 --- a/src/interactive/sprite.lisp +++ b/src/interactive/sprite.lisp @@ -15,8 +15,9 @@ (defmethod initialize-instance :after ((sprite sprite) &key) (with-slots (framesets frameset-key) sprite - (loop for (name fs . more) on framesets by #'cddr - do (setf (unit-in-scene-p fs) sprite)) + (loop :for (name fs . more) :on framesets :by #'cddr :do + (setf (unit-in-scene-p fs) sprite)) + (unless frameset-key (setf frameset-key (first framesets))))) @@ -30,15 +31,15 @@ (macrolet ((def-sprite-accessors (&rest accessor-names) (let ((defs - (loop for accessor-name in accessor-names - collect + (loop :for accessor-name :in accessor-names + :collect `(defmethod ,accessor-name ((sprite sprite)) (,accessor-name (current-frameset sprite))) - collect + :collect `(defmethod (setf ,accessor-name) (newval (sprite sprite)) - (loop for (key fs . more) on (sprite-framesets sprite) by #'cddr - do (setf (,accessor-name fs) newval)) + (loop :for (key fs . more) :on (sprite-framesets sprite) :by #'cddr + :do (setf (,accessor-name fs) newval)) newval)))) `(progn ,@defs)))) diff --git a/src/pre-exit-hooks.lisp b/src/pre-exit-hooks.lisp index 42e4195..1f14d97 100644 --- a/src/pre-exit-hooks.lisp +++ b/src/pre-exit-hooks.lisp @@ -12,5 +12,5 @@ thunk)) (defun pre-exit-hooks () - (loop for thunk being the hash-value of *pre-exit-hooks* - do (funcall thunk))) + (loop :for thunk :being :the :hash-value :of *pre-exit-hooks* :do + (funcall thunk))) diff --git a/src/utils.lisp b/src/utils.lisp index f6af42c..910f962 100644 --- a/src/utils.lisp +++ b/src/utils.lisp @@ -46,11 +46,11 @@ and B intersects the linesegment between C and D, NIL otherwise." (defun paths-intersect-p (path1 path2) "Paths are lists of vectors, each of which represents a 2d point." (declare (optimize (speed 3) (safety 0) )) - (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)))) + (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) @@ -66,12 +66,12 @@ and B intersects the linesegment between C and D, NIL otherwise." (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 + :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) @@ -92,20 +92,20 @@ bounds and width and height as a plist of the form 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 (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)) - 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 + :with max-x := nil + :and max-y := nil + :and min-x := nil + :and min-y := nil + :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)) + :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))))) @@ -148,17 +148,17 @@ the path." (let* ((n (1- (length points))) (bin-coeffs - (loop for i from 0 to n collect (binomial-coefficient n i)))) + (loop :for i :from 0 :to n :collect (binomial-coefficient n i)))) (lambda (a) - (loop for (x y) in points - for i from 0 - for bin-coeff in bin-coeffs - for coeff = (* bin-coeff - (expt (- 1 a) (- n i)) - (expt a i)) - sum (* coeff x) into bx - sum (* coeff y) into by - finally (return (list bx by)))))) + (loop :for (x y) :in points + :for i :from 0 + :for bin-coeff :in bin-coeffs + :for coeff := (* bin-coeff + (expt (- 1 a) (- n i)) + (expt a i)) + :sum (* coeff x) :into bx + :sum (* coeff y) :into by + :finally (return (list bx by)))))) (defun clamp (lo val hi) "Returns VAL if (< LO VAL HI), otherwise returns LO or HI depending diff --git a/src/wheelwork.lisp b/src/wheelwork.lisp index 506ba9b..88ea772 100644 --- a/src/wheelwork.lisp +++ b/src/wheelwork.lisp @@ -115,19 +115,19 @@ position. The list always contains the app itself as the last element." single elemtn list, or nil if none found" (with-slots (scene) app (loop - for idx from (1- (length scene)) downto 0 - for u = (elt scene idx) - when (unit-visibly-contains-p u x y) - return (list u)))) + :for idx :from (1- (length scene)) :downto 0 + :for u := (elt scene idx) + :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" (with-slots (scene) app (loop - for idx from (1- (length scene)) downto 0 - for u = (elt scene idx) - when (unit-visibly-contains-p u x y) - collect u))) + :for idx :from (1- (length scene)) :downto 0 + :for u := (elt scene idx) + :when (unit-visibly-contains-p u x y) + :collect u))) (defvar *event-still-bubbling-p* nil "Controls whether an event is bubbling") @@ -140,7 +140,7 @@ single elemtn list, or nil if none found" "Scales the screen point - the literal pixel position relative to the top corner of the application window - to reflect the application's scaling factor" - (declare (optimize (speed 3) (saftey 0))) + (declare (optimize (speed 3) (safety 0))) (with-slots (height scale) app (list (/ x scale) (/ (- height y) scale)))) @@ -156,24 +156,21 @@ give focus to whatever was clicked." (when (and (refocus-on-mousedown-p app) (focusablep (first candidate-targets))) (refocus-on (first candidate-targets))) - (let ((*event-still-bubbling-p* - (mouse-button-events-bubble-p app))) - (loop for target in candidate-targets - do - (dolist (handler (get-handlers-for target 'mousedown)) - (funcall handler target x y clicks button wx wy)) - while *event-still-bubbling-p*))))) + (let ((*event-still-bubbling-p* (mouse-button-events-bubble-p app))) + (loop :for target :in candidate-targets :do + (dolist (handler (get-handlers-for target 'mousedown)) + (funcall handler target x y clicks button wx wy)) + :while *event-still-bubbling-p*))))) (defun eventloop-mousebuttonup (app wx wy clicks button) (when (should-listen-for-p 'mouseup app) (destructuring-bind (x y) (screen-to-world wx wy) (let ((*event-still-bubbling-p* (mouse-button-events-bubble-p app))) - (loop for target in (mouse-event-targets app x y (mouse-button-events-bubble-p app)) - do - (dolist (handler (get-handlers-for target 'mouseup)) - (funcall handler target x y clicks button wx wy)) - while *event-still-bubbling-p*))))) + (loop :for target :in (mouse-event-targets app x y (mouse-button-events-bubble-p app)) :do + (dolist (handler (get-handlers-for target 'mouseup)) + (funcall handler target x y clicks button wx wy)) + :while *event-still-bubbling-p*))))) (defun eventloop-mousemotion (app wx wy wxrel wyrel state) (when (should-listen-for-p 'mousemotion app) @@ -183,11 +180,10 @@ give focus to whatever was clicked." (yrel (* -1 (/ wyrel scale)))) (let ((*event-still-bubbling-p* (mouse-motion-events-bubble-p app))) - (loop for target in (mouse-event-targets app x y (mouse-motion-events-bubble-p app)) - do - (dolist (handler (get-handlers-for target 'mousemotion)) - (funcall handler target x y xrel yrel state wx wy wxrel wyrel)) - while *event-still-bubbling-p*)))))) + (loop :for target :in (mouse-event-targets app x y (mouse-motion-events-bubble-p app)) :do + (dolist (handler (get-handlers-for target 'mousemotion)) + (funcall handler target x y xrel yrel state wx wy wxrel wyrel)) + :while *event-still-bubbling-p*)))))) (defun eventloop-mousewheel (app wx wy dir) (when (should-listen-for-p 'mousewheel app) |