;;;; event-handler.lisp (in-package #:wheelwork) (defclass/std event-handler () ((event-type handler-function :ri)) (:metaclass closer-mop:funcallable-standard-class)) (defmethod initialize-instance :after ((eh event-handler) &key) (with-slots (handler-function) eh (closer-mop:set-funcallable-instance-function eh handler-function))) (defmacro defhandler (name handler) "Defines a handler - binds (FDEFINITION NAME) to HANDLER, which should be an expression that evaluates to an instance of EVENT-HANDLER, which is funcallable. It is define such that handlers can be redefined using this form to support interactive development." (let ((handler-var (gensym))) `(let ((,handler-var ,handler)) (if-let (extant (and (fboundp ',name) (fdefinition ',name))) (closer-mop:set-funcallable-instance-function extant (handler-function ,handler-var)) (setf (fdefinition ',name) ,handler-var))))) (defmacro on-perframe ((&optional (target 'target) (time 'time)) &body body) "Creates a handler for 'PERFRAME events. All variable arguments supplied to this handler form are optional. You may supply your own variables to use in your BODY or you may just refer to the defaults - they will be interned in the appropriate package. TARGET - the object currently handling the event TIME - The current time in milliseconds " `(make-instance 'event-handler :event-type 'wheelwork::perframe :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 ((&optional (target 'target) (scancode 'scancode) (modifiers 'modifiers)) &body body) "Creates a lambda suitable for the value of a keydown event handler. All variable arguments supplied to this handler form are optional. You may supply your own variables to use in your BODY or you may just refer to the defaults - they will be interned in the appropriate package. The function accepts two positional arguments TARGET and SCANCODE and one &REST argument MODIFIERS. SCANCODE will be a keyword of the form :SCANCODE-A, :SCANCODE-B ... The members of MODIFIERS look like :LSHIFT, :RCTRL, RALT, etc" `(make-instance 'event-handler :event-type 'wheelwork::keydown :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 ((&optional (target 'target) (scancode 'scancode) (modifiers 'modifiers)) &body body) "Creates a lambda suitable for the value of a keyup event handler. All variable arguments supplied to this handler form are optional. You may supply your own variables to use in your BODY or you may just refer to the defaults - they will be interned in the appropriate package. The function accepts two positional arguments TARGET and SCANCODE and one &REST argument MODIFIERS. SCANCODE will be a keyword of the form :SCANCODE-A, :SCANCODE-B ... The members of MODIFIERS look like :LSHIFT, :RCTRL, RALT, etc" `(make-instance 'event-handler :event-type 'wheelwork::keyup :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 ((&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) "ON-MOUSEMOTION defines a mouse motion event handler. All variable arguments supplied to this handler form are optional. You may supply your own variables to use in your BODY or you may just refer to the defaults - they will be interned in the appropriate package. - TARGET is the object ontowhich the handler was installed - X and Y are the scaled screen coordinates - XREL and YREL are the relative motion of the X and Y positions since the last event, in scaled coordinates - STATE is the button state, see the SDL2 docs - WIN-* variables are the unscaled event values, if you require them. " `(make-instance 'event-handler :event-type 'wheelwork::mousemotion :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 ((&optional (target 'target) (x 'x) (y 'y) (clicks 'clicks) (button 'button) (win-x 'win-x) (win-y 'win-y)) &body body) "Creates a handler for MOUSEDOWN events. All variable arguments supplied to this handler form are optional. You may supply your own variables to use in your BODY or you may just refer to the defaults - they will be interned in the appropriate package. - TARGET is the object ontowhich the handler was installed - X and Y are the scaled screen coordinates - BUTTON is a code for the mouse button pressed (see sdl docs) - CLICKS is the number of clicks 1 for single, 2 for double. - WIN-* variables are the unscaled event values, if you require them. " `(make-instance 'event-handler :event-type 'wheelwork::mousedown :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 ((&optional (target 'target) (x 'x) (y 'y) (clicks 'clicks) (button 'button) (win-x 'win-x) (win-y 'win-y)) &body body) "Creates a handler for MOUSEUP events All variable arguments supplied to this handler form are optional. You may supply your own variables to use in your BODY or you may just refer to the defaults - they will be interned in the appropriate package. - TARGET is the object ontowhich the handler was installed - X and Y are the scaled screen coordinates - BUTTON is a code for the mouse button pressed (see sdl docs) - CLICKS is the number of clicks 1 for single, 2 for double. - WIN-* variables are the unscaled event values, if you require them. " `(make-instance 'event-handler :event-type 'wheelwork::mouseup :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 ((&optional (target 'target) (horiz 'horiz) (vert 'vert) (dir 'dir)) &body body) "Creates a handler for MOUSEWHEEL events All variable arguments supplied to this handler form are optional. You may supply your own variables to use in your BODY or you may just refer to the defaults - they will be interned in the appropriate package. - TARGET is the object ontowhich the handler was installed - HORIZ, VERT are 1 or -1 - DIR is normal or flipped, see https://wiki.libsdl.org/SDL_MouseWheelEvent " `(make-instance 'event-handler :event-type 'wheelwork::mousewheel :handler-function (lambda (,(intern (symbol-name target)) ,(intern (symbol-name horiz)) ,(intern (symbol-name vert)) ,(intern (symbol-name dir))) (declare (ignorable ,(intern (symbol-name target)) ,(intern (symbol-name horiz)) ,(intern (symbol-name vert)) ,(intern (symbol-name dir)))) ,@body))) (defmacro on-blur ((&optional (target 'target)) &body body) "Creates a handler for BLUR events. BLUR is a psuedo event that fires whenever an object loses focus. All variable arguments supplied to this handler form are optional. You may supply your own variables to use in your BODY or you may just refer to the defaults - they will be interned in the appropriate package. " `(make-instance 'event-handler :event-type 'wheelwork::blur :handler-function (lambda (,(intern (symbol-name target))) (declare (ignorable ,(intern (symbol-name target)))) ,@body))) (defmacro on-focus ((&optional (target 'target)) &body body) "Creates a handler for a FOCUS event. FOCUS is a pusedo event that fires when the FOCUS slot of the current APPLICATION instance is changed. All variable arguments supplied to this handler form are optional. You may supply your own variables to use in your BODY or you may just refer to the defaults - they will be interned in the appropriate package. " `(make-instance 'event-handler :event-type 'wheelwork::focus :handler-function (lambda (,(intern (symbol-name target))) (declare (ignorable ,(intern (symbol-name target)))) ,@body))) (defmacro on-before-dropped ((&optional (target 'target)) &body body) "Creates a handler for BEFORE-DROPPED events, which fire before a unit is removed from its container. All variable arguments supplied to this handler form are optional. You may supply your own variables to use in your BODY or you may just refer to the defaults - they will be interned in the appropriate package. " `(make-instance 'event-handler :event-type 'wheelwork::before-dropped :handler-function (lambda (,(intern (symbol-name target))) (declare (ignorable ,(intern (symbol-name target)))) ,@body))) (defmacro on-before-added ((&optional (target 'target) (container 'container)) &body body) "Creates a handler for BEFORE-ADDED events, which fire before a unit TARGET is added to CONTAINER. All variable arguments supplied to this handler form are optional. You may supply your own variables to use in your BODY or you may just refer to the defaults - they will be interned in the appropriate package. " `(make-instance 'event-handler :event-type 'wheelwork::before-added :handler-function (lambda (,(intern (symbol-name container)) ,(intern (symbol-name target))) (declare (ignorable ,(intern (symbol-name container)) ,(intern (symbol-name target)))) ,@body))) (defmacro on-after-added ((&optional (target 'target) (container 'container)) &body body) "Creates a handler for AFTER-ADDED events, which fire after a unit is added to a container. All variable arguments supplied to this handler form are optional. You may supply your own variables to use in your BODY or you may just refer to the defaults - they will be interned in the appropriate package. " `(make-instance 'event-handler :event-type 'wheelwork::after-added :handler-function (lambda (,(intern (symbol-name container)) ,(intern (symbol-name target))) (declare (ignorable ,(intern (symbol-name container)) ,(intern (symbol-name target)))) ,@body)))