|
| 1 | +(in-package :mortar-combat) |
| 2 | + |
| 3 | + |
| 4 | +;; fixme: don't forget to make thread safe for generalization |
| 5 | +(defclass keymap (lockable) |
| 6 | + ((callbacks :initform nil) |
| 7 | + (cursor-action :initform nil) |
| 8 | + (key-table :initform (make-hash-table :test 'eq)))) |
| 9 | + |
| 10 | + |
| 11 | +(defun enable-keymap (keymap) |
| 12 | + (with-slots (callbacks cursor-action key-table) keymap |
| 13 | + (when callbacks |
| 14 | + (error "Keymap already enabled")) |
| 15 | + (let ((eve (events))) |
| 16 | + (flet ((register-callback (class action) |
| 17 | + (push (cons class (subscribe-to class action eve)) callbacks)) |
| 18 | + (process-button-event (ev) |
| 19 | + (when-let ((action (gethash (key-from ev) key-table))) |
| 20 | + (funcall action (state-from ev)))) |
| 21 | + (process-cursor-event (ev) |
| 22 | + (when cursor-action |
| 23 | + (funcall cursor-action (x-from ev) (y-from ev))))) |
| 24 | + (register-callback 'keyboard-event #'process-button-event) |
| 25 | + (register-callback 'mouse-event #'process-button-event) |
| 26 | + (register-callback 'cursor-event #'process-cursor-event))))) |
| 27 | + |
| 28 | + |
| 29 | +(defun disable-keymap (keymap) |
| 30 | + (with-slots (callbacks) keymap |
| 31 | + (unless callbacks |
| 32 | + (error "Keymap already disabled")) |
| 33 | + (loop with eve = (events) |
| 34 | + for (class . cb) in callbacks |
| 35 | + do (unsubscribe-from class cb eve)) |
| 36 | + (setf callbacks nil))) |
| 37 | + |
| 38 | + |
| 39 | +(defun bind-button (keymap button action) |
| 40 | + (with-slots (key-table) keymap |
| 41 | + (setf (gethash button key-table) action))) |
| 42 | + |
| 43 | + |
| 44 | +(defun bind-cursor (keymap action) |
| 45 | + (with-slots (cursor-action) keymap |
| 46 | + (setf cursor-action action))) |
0 commit comments