[modify] on-* macros to make arguments optional

2 files changed, 135 insertions, 51 deletions

diff --git a/examples/02-moving-bitmp.lisp b/examples/02-moving-bitmp.lisp
index 5d33de8..200a1d1 100644
--- a/examples/02-moving-bitmp.lisp
+++ b/examples/02-moving-bitmp.lisp
@@ -9,28 +9,28 @@
 (defclass bitmap-display (ww::application ) ())
 
 (ww::defhandler move-thing
-    (ww::on-keydown (unit code mods)
-      (case code
-        (:scancode-left (decf (ww::unit-x unit) (ww::unit-width unit)))
-        (:scancode-right (incf (ww::unit-x unit) (ww::unit-width unit)))
-        (:scancode-down (decf (ww::unit-y unit) (ww::unit-height unit)))
-        (:scancode-up (incf (ww::unit-y unit) (ww::unit-height unit)))
+    (ww::on-keydown ()
+      (case scancode
+        (:scancode-left (decf (ww::unit-x target) (ww::unit-width target)))
+        (:scancode-right (incf (ww::unit-x target) (ww::unit-width target)))
+        (:scancode-down (decf (ww::unit-y target) (ww::unit-height target)))
+        (:scancode-up (incf (ww::unit-y target) (ww::unit-height target)))
         (:scancode-equals
-         (when (or (member :lshift mods) (member :rshift mods))
-           (incf (ww::unit-height unit) 20.0)
-           (incf                  (ww::unit-width unit) 20.0)))
+         (when (or (member :lshift modifiers) (member :rshift modifiers))
+           (incf (ww::unit-height target) 20.0)
+           (incf                  (ww::unit-width target) 20.0)))
         (:scancode-minus
-         (decf (ww::unit-height unit) 20.0)
-         (decf                (ww::unit-width unit) 20.0)))
+         (decf (ww::unit-height target) 20.0)
+         (decf                (ww::unit-width target) 20.0)))
       (format t "ghoul pos: ~a,~a~%"
-              (ww::unit-x unit) (ww::unit-y unit))))
+              (ww::unit-x target) (ww::unit-y target))))
 
 (ww::defhandler thing-clicked
-    (ww::on-mousedown (unit x y clicks button)
-      (format t "~a was clicked at ~a,~a!~%" unit x y)))
+    (ww::on-mousedown ()
+      (format t "~a was clicked at ~a,~a!~%" target x y)))
 
 (ww::defhandler mouse-over
-    (ww::on-mousemotion (target x y xrel yrel state)
+    (ww::on-mousemotion ()
       (print (list target x y xrel yrel state))))
 
 (defmethod ww::boot ((app bitmap-display))
diff --git a/wheelwork.lisp b/wheelwork.lisp
index 34efd3c..f742fdd 100644
--- a/wheelwork.lisp
+++ b/wheelwork.lisp
@@ -338,24 +338,25 @@ order). Makes sure to remove the unit from its current container if necessary."
   (with-slots (height scale) app
     (list (/ x scale) (/ (- height y) scale))))
 
-(defun eventloop-mousebuttondown (app x y clicks button)
+(defun eventloop-mousebuttondown (app wx wy clicks button)
   "Searches for a handler to handle applies it if found.
 
 Additionally, if the APPLICATION's REFOCUS-ON-MOUSEDOWN-P is T, try to
 give focus to whatever was clicked."
-  (destructuring-bind (x y) (screen-to-world x y)
+  (destructuring-bind (x y) (screen-to-world wx wy)
     (when-let (target (unit-under app x y))
       (when (refocus-on-mousedown-p app)
         (refocus-on target))              
       (when-let (handler (get-handler-for target 'mousedown))
-        (funcall handler target x y clicks button)))))
+        (funcall handler target x y clicks button wx wy)))))
 
-(defun eventloop-mousemotion (app x y xrel yrel state)
+(defun eventloop-mousemotion (app wx wy wxrel wyrel state)
   (when (should-listen-for-p 'mousemotion app)
-    (destructuring-bind (x y) (screen-to-world x y)
-      (when-let* ((target (unit-under app x y))
-                  (handler (get-handler-for target 'mousemotion)))
-        (funcall handler target x y xrel yrel state)))))
+    (destructuring-bind (x y) (screen-to-world wx wy)
+      (destructuring-bind (xrel yrel) (screen-to-world wxrel wyrel)
+        (when-let* ((target (unit-under app x y))
+                    (handler (get-handler-for target 'mousemotion)))
+          (funcall handler target x y xrel yrel state wx wy wxrel wyrel))))))
 
 (defun eventloop (app)
   (sdl2:with-event-loop (:method :poll)
@@ -528,18 +529,19 @@ disk."
          (setf (fdefinition ',name) ,handler-var)))))
 
 
-
 (defmacro on-perframe
-    ((target time) &body body)
+    ((&optional (target 'target) (time 'time)) &body body)
   `(make-instance
     'event-handler
     :event-type 'wheelwork::perframe
-    :handler-function (lambda (,target ,time)
-                        (declare (ignorable ,target ,time))
+    :handler-function (lambda (,(intern (symbol-name target))
+                               ,(intern (symbol-name time)))
+                        (declare (ignorable ,(intern (symbol-name target))
+                                            ,(time (intern (symbol-name time)))))
                         ,@body)))
 
 (defmacro on-keydown
-    ((target scancode modifiers) &body body)
+    ((&optional (target 'target) (scancode 'scancode) (modifiers 'modifiers)) &body body)
   "Creates a lambda suitable for the value of a keydown event
   handler. The function accepts two positional arguments TARGET and
   SCANCODE and one &REST argument MODIFIERS.
@@ -550,11 +552,16 @@ disk."
   `(make-instance
     'event-handler
     :event-type 'wheelwork::keydown
-    :handler-function (lambda (,target ,scancode &rest ,modifiers)
-                        (declare (ignorable ,target ,scancode ,modifiers))
+    :handler-function (lambda (,(intern (symbol-name target))
+                               ,(intern (symbol-name scancode))
+                               &rest ,(intern (symbol-name modifiers)))
+                        (declare (ignorable ,(intern (symbol-name target))
+                                            ,(intern (symbol-name scancode))
+                                            ,(intern (symbol-name modifiers))))
                         ,@body)))
 
-(defmacro on-keyup ((target scancode modifiers) &body body)
+(defmacro on-keyup
+    ((&optional (target 'target) (scancode 'scancode) (modifiers 'modifiers)) &body body)
   "Creates a lambda suitable for the value of a keyup event
   handler. The function accepts two positional arguments TARGET and
   SCANCODE and one &REST argument MODIFIERS.
@@ -565,60 +572,137 @@ disk."
   `(make-instance
     'event-handler
     :event-type 'wheelwork::keyup
-    :handler-function (lambda (,target ,scancode &rest ,modifiers)
-                        (declare (ignorable ,target ,scancode ,modifiers))
+    :handler-function (lambda (,(intern (symbol-name target))
+                               ,(intern (symbol-name scancode))
+                               &rest ,(intern (symbol-name modifiers)))
+                        (declare (ignorable ,(intern (symbol-name target))
+                                            ,(intern (symbol-name scancode))
+                                            ,(intern (symbol-name modifiers))))
                         ,@body)))
 
 (defmacro on-mousemotion
-    ((target x y xrel yrel state) &body body)
+    ((&optional
+        (target 'target)
+        (x 'x) (y 'y)
+        (xrel 'xrel) (yrel 'yrel)
+        (state 'state)
+        (win-x 'win-x) (win-y 'win-y)
+        (win-xrel 'win-xrel) (win-yrel 'win-yrel))
+     &body body)
   `(make-instance
     'event-handler
     :event-type 'wheelwork::mousemotion
-    :handler-function (lambda (,target ,x ,y ,xrel ,yrel ,state)
-                        (declare (ignorable ,target ,x ,y ,xrel ,yrel ,state))
+    :handler-function (lambda (,(intern (symbol-name target))
+                               ,(intern (symbol-name x))
+                               ,(intern (symbol-name y))
+                               ,(intern (symbol-name xrel))
+                               ,(intern (symbol-name yrel))
+                               ,(intern (symbol-name state))
+                               ,(intern (symbol-name win-x))
+                               ,(intern (symbol-name win-y))
+                               ,(intern (symbol-name win-xrel))
+                               ,(intern (symbol-name win-yrel)))
+                        (declare (ignorable ,(intern (symbol-name target))
+                                            ,(intern (symbol-name x))
+                                            ,(intern (symbol-name y))
+                                            ,(intern (symbol-name xrel))
+                                            ,(intern (symbol-name yrel))
+                                            ,(intern (symbol-name state))
+                                            ,(intern (symbol-name win-x))
+                                            ,(intern (symbol-name win-y))
+                                            ,(intern (symbol-name win-xrel))
+                                            ,(intern (symbol-name win-yrel))))
                         ,@body)))
 
 (defmacro on-mousedown
-    ((target x y clicks button) &body body)
+    ((&optional (target 'target)
+        (x 'x) (y 'y)
+        (clicks 'clicks) (button 'button)
+        (win-x 'win-x) (win-y 'win-y))
+     &body body)
   `(make-instance
     'event-handler
     :event-type 'wheelwork::mousedown
-    :handler-function (lambda (,target ,x ,y ,clicks ,button)
-                        (declare (ignorable ,target ,x ,y ,clicks ,button))
+    :handler-function (lambda
+                          (,(intern (symbol-name target))
+                               ,(intern (symbol-name x))
+                               ,(intern (symbol-name y))
+                               ,(intern (symbol-name clicks))
+                               ,(intern (symbol-name button))
+                               ,(intern (symbol-name win-x))
+                               ,(intern (symbol-name win-y)))
+                        (declare
+                         (ignorable ,(intern (symbol-name target))
+                                            ,(intern (symbol-name x))
+                                            ,(intern (symbol-name y))
+                                            ,(intern (symbol-name clicks))
+                                            ,(intern (symbol-name button))
+                                            ,(intern (symbol-name win-x))
+                                            ,(intern (symbol-name win-y))))
                         ,@body)))
 
 (defmacro on-mouseup
-    ((target x y clicks button) &body body)
+    ((&optional (target 'target)
+        (x 'x) (y 'y)
+        (clicks 'clicks) (button 'button)
+        (win-x 'win-x) (win-y 'win-y))
+     &body body)
   `(make-instance
     'event-handler
     :event-type 'wheelwork::mouseup
-    :handler-function (lambda (,target ,x ,y ,clicks ,button)
-                        (declare (ignorable ,target ,x ,y ,clicks ,button))
+    :handler-function (lambda
+                          (,(intern (symbol-name target))
+                               ,(intern (symbol-name x))
+                               ,(intern (symbol-name y))
+                               ,(intern (symbol-name clicks))
+                               ,(intern (symbol-name button))
+                               ,(intern (symbol-name win-x))
+                               ,(intern (symbol-name win-y)))
+                        (declare
+                         (ignorable ,(intern (symbol-name target))
+                                            ,(intern (symbol-name x))
+                                            ,(intern (symbol-name y))
+                                            ,(intern (symbol-name clicks))
+                                            ,(intern (symbol-name button))
+                                            ,(intern (symbol-name win-x))
+                                            ,(intern (symbol-name win-y))))
                         ,@body)))
 
 (defmacro on-mousewheel
-    ((target x y dir) &body body)
+    ((&optional (target 'target) (x 'x) (y 'y) (dir 'dir)) &body body)
   `(make-instance
     'event-handler
     :event-type 'wheelwork::mousewheel
-    :handler-function (lambda (,target ,x ,y ,dir)
-                        (declare (ignorable ,target ,x ,y ,dir))
+    :handler-function (lambda
+                          (,(intern (symbol-name target))
+                               ,(intern (symbol-name x))
+                               ,(intern (symbol-name y))
+                               ,(intern (symbol-name dir)))
+                        (declare
+                         (ignorable ,(intern (symbol-name target))
+                                            ,(intern (symbol-name x))
+                                            ,(intern (symbol-name y))
+                                            ,(intern (symbol-name dir))))
                         ,@body)))
 
 (defmacro on-blur
-    ((target) &body body)
+    ((&optional (target 'target)) &body body)
   `(make-instance
     'event-handler
     :event-type 'wheelwork::blur
-    :handler-function (lambda (,target)
-                        (declare (ignorable ,target))
+    :handler-function (lambda
+                          (,(intern (symbol-name target)))
+                        (declare
+                         (ignorable ,(intern (symbol-name target))))
                         ,@body)))
 
 (defmacro on-focus
-    ((target) &body body)
+    ((&optional (target 'target)) &body body)
   `(make-instance
     'event-handler
     :event-type 'wheelwork::focus
-    :handler-function (lambda (,target)
-                        (declare (ignorable ,target))
+    :handler-function (lambda
+                          (,(intern (symbol-name target)))
+                        (declare
+                         (ignorable ,(intern (symbol-name target))))
                         ,@body)))