diff options
| -rw-r--r-- | wheelwork.lisp | 40 |
1 files changed, 24 insertions, 16 deletions
diff --git a/wheelwork.lisp b/wheelwork.lisp index d23cd7f..6de9d6b 100644 --- a/wheelwork.lisp +++ b/wheelwork.lisp @@ -115,15 +115,30 @@ order). Makes sure to remove the unit from its current container if necessary." (set-projection app) (setf (listener app) (make-instance 'listener))) +(defun fire-blur-event-on (thing) + (when-let (blur-handler (and thing (get-handler-for thing 'blur))) + (funcall blur-handler thing))) + +(defun fire-focus-event-on (thing) + (when-let (focus-handler (and thing (get-handler-for thing 'focus))) + (funcall focus-handler thing))) + +(defmethod (setf closer-mop:slot-value-using-class ) :before + (new-value class (app application) slot) + (case (closer-mop:slot-definition-name slot) + (focus + (when (slot-boundp app 'focus) + (unless (eq new-value (slot-value app 'focus)) + (fire-blur-event-on (slot-value app 'focus)) + (fire-focus-event-on new-value)))))) + (defmethod (setf closer-mop:slot-value-using-class) :after (new-value class (app application) slot) - (let ((slot-name - (closer-mop:slot-definition-name slot))) - (cond - ((member slot-name '(scale width height)) - (set-projection app)) - ((eql slot-name 'fps) - (setf (slot-value app 'frame-wait) (/ 1.0 new-value)))))) + (case (closer-mop:slot-definition-name slot) + ((scale width height) + (set-projection app)) + (fps + (setf (slot-value app 'frame-wait) (/ 1.0 new-value))))) (defgeneric boot (app) @@ -316,16 +331,9 @@ order). Makes sure to remove the unit from its current container if necessary." are keyed by UNIT and hold Event-Handler instances.")) - - (defun refocus-on (target &optional (app *application*)) - "Handles changing application focus, calling appropriate blur and focus handlers." - (when-let (blur-handler (and (application-focus app) - (get-handler-for (application-focus app) 'blur))) - (funcall blur-handler (application-focus app))) - (setf (application-focus app) target) - (when-let (focus-handler (get-handler-for target 'focus)) - (funcall focus-handler target))) + "Sets focus of application to target" + (setf (application-focus app) target)) (defun get-focus (&optional (app *application*)) (or (application-focus app) app)) |