aboutsummaryrefslogtreecommitdiffhomepage
path: root/src
diff options
context:
space:
mode:
authorcolin <colin@cicadas.surf>2024-12-14 12:29:29 -0800
committercolin <colin@cicadas.surf>2024-12-14 12:29:29 -0800
commit543704f0f54cbb1de78754ad8a323c482ab6829c (patch)
tree7528c0105516a2a2800e432de9f4f1a6c3fe506e /src
parent3a2217263d581be9a7f629b10d75aa8e3d581890 (diff)
Loop style nitsHEADmain
Diffstat (limited to 'src')
-rw-r--r--src/application.lisp28
-rw-r--r--src/canvas-language.lisp12
-rw-r--r--src/core/unit.lisp34
-rw-r--r--src/grid-geometry.lisp80
-rw-r--r--src/interactive/canvas.lisp13
-rw-r--r--src/interactive/frameset.lisp50
-rw-r--r--src/interactive/interactive.lisp5
-rw-r--r--src/interactive/sprite.lisp15
-rw-r--r--src/pre-exit-hooks.lisp4
-rw-r--r--src/utils.lisp70
-rw-r--r--src/wheelwork.lisp48
11 files changed, 182 insertions, 177 deletions
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)