;;;; 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)))