Expose modifiers for key, mouse and character input

borodust · Mar 11, 2021 · bb09727 · bb09727
1 parent 5086dec
commit bb09727
Show file tree

Hide file tree

Showing 4 changed files with 13 additions and 7 deletions.
diff --git a/engine/event.lisp b/engine/event.lisp
@@ -3,7 +3,6 @@
 ;;;
 ;;; Events
 ;;;
-
 (defun post (event-or-class &rest initargs &key &allow-other-keys)
   (let ((event (etypecase event-or-class
                  ((or symbol standard-class) (apply #'make-instance event-or-class initargs))

diff --git a/host/events.lisp b/host/events.lisp
@@ -5,15 +5,15 @@
 
 
 (defevent keyboard-event (input-event)
-  (key state))
+  (key state modifiers))
 
 
 (defevent character-input-event (input-event)
-  (character))
+  (character modifiers))
 
 
 (defevent mouse-event (input-event)
-  (button state))
+  (button state modifiers))
 
 
 (defevent cursor-event (input-event)

diff --git a/host/packages.lisp b/host/packages.lisp
@@ -59,6 +59,7 @@
            #:key-from
            #:character-from
            #:button-from
+           #:modifiers-from
            #:controller-from
            #:gamepad-from
 

diff --git a/host/system.lisp b/host/system.lisp
@@ -110,12 +110,18 @@
   (post 'viewport-hiding-event))
 
 
+(defun collect-modifiers (app)
+  (loop for mod in '(:shift :control :alt :super :caps-lock :num-lock)
+        when (bodge-host:modifiers-engaged-p app mod)
+          collect mod))
+
+
 (defmethod bodge-host:on-key-action ((this host-application) key state)
-  (post 'keyboard-event :key key :state state))
+  (post 'keyboard-event :key key :state state :modifiers (collect-modifiers this)))
 
 
 (defmethod bodge-host:on-mouse-action ((this host-application) button state)
-  (post 'mouse-event :button button :state state))
+  (post 'mouse-event :button button :state state :modifiers (collect-modifiers this)))
 
 
 (defmethod bodge-host:on-cursor-movement ((this host-application) x y)
@@ -135,7 +141,7 @@
 
 
 (defmethod bodge-host:on-character-input ((this host-application) character)
-  (post 'character-input-event :character character))
+  (post 'character-input-event :character character :modifiers (collect-modifiers this)))
 
 
 (defun make-host-application (cont)