diff --git a/engine/core.scm b/engine/core.scm index bfedf65..613aa9d 100644 --- a/engine/core.scm +++ b/engine/core.scm @@ -304,8 +304,6 @@ (hash-table-set! event-buses name (make-hash-table)) name))) -(register-event-bus 'input) - ;; Remove an event bus (define (remove-event-bus name) (assert (symbol? name)) @@ -368,45 +366,6 @@ event) #f))) -;; Input actions alist -(define input-actions '()) - -;; Key-press type action -(define-record-type - (make-key-press key) - key-press? - (key key-press-key)) - -;; Add a new action to the input actions alist -(export register-action push-actions) -(define (register-action name type . data) - (assert (symbol? name)) - (assert (member type '(key-press))) - (set! input-actions - (cons (cons name - (apply (cond - ((eqv? type 'key-press) make-key-press)) - data)) - input-actions))) - -;; Default global system for simple input management -(define push-actions - (make-system - 'push-actions - 0 - 'global - '() - (lambda () - (for-each - (lambda (action) - (cond - ((key-press? (cdr action)) - (when (key-pressed? (key-press-key (cdr action))) - (push-event 'input - (car action) - (cdr action)))))) - input-actions)))) - ;; Render queue exports (export register-render-queue push-render-object evaluate-render-queue) diff --git a/engine/input.scm b/engine/input.scm new file mode 100644 index 0000000..0cf6abe --- /dev/null +++ b/engine/input.scm @@ -0,0 +1,61 @@ +(module (engine input) () +(import scheme + (chicken base) + (chicken module) + (engine core) + raylib + (srfi 99)) + +(register-event-bus 'input) + +;; Input actions alist +(define input-actions '()) + +;; Key-press type action +(define-record-type + (make-key-press key) + key-press? + (key key-press-key)) + +;; Mouse click type action +(define-record-type + (make-mouse-press button) + mouse-press? + (button mouse-press-button)) + +;; Add a new action to the input actions alist +(export register-action push-actions) +(define (register-action name type . data) + (assert (symbol? name)) + (assert (member type '(key-press mouse-press))) + (set! input-actions + (cons (cons name + (apply (cond + ((eqv? type 'key-press) make-key-press) + ((eqv? type 'mouse-press) make-mouse-press)) + data)) + input-actions))) + +;; Default global system for simple input management +(define push-actions + (make-system + 'push-actions + 0 + 'global + '() + (lambda () + (for-each + (lambda (action) + (cond + ((key-press? (cdr action)) + (when (key-pressed? (key-press-key (cdr action))) + (push-event 'input + (car action) + (cdr action)))) + ((mouse-press? (cdr action)) + (when (mouse-button-pressed? (mouse-press-button (cdr action))) + (push-event 'input + (car action) + (cdr action)))))) + input-actions)))) +) diff --git a/samples/bounce.scm b/samples/bounce.scm index 4562f39..0d93c18 100644 --- a/samples/bounce.scm +++ b/samples/bounce.scm @@ -5,6 +5,7 @@ (engine core) (engine components core) (engine math) + (engine input) (engine drawing) (engine scene) (srfi 1)