Move input to its own module
This commit is contained in:
parent
f54f9c4b40
commit
6ec23c8ff9
3 changed files with 62 additions and 41 deletions
|
|
@ -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 <key-press>
|
||||
(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)
|
||||
|
||||
|
|
|
|||
61
engine/input.scm
Normal file
61
engine/input.scm
Normal file
|
|
@ -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 <key-press>
|
||||
(make-key-press key)
|
||||
key-press?
|
||||
(key key-press-key))
|
||||
|
||||
;; Mouse click type action
|
||||
(define-record-type <mouse-press>
|
||||
(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))))
|
||||
)
|
||||
Loading…
Add table
Add a link
Reference in a new issue