engine/core.scm

@@ -356,6 +356,44 @@
 	  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)
+(define (register-action name type . data)
+  (assert (symbol? name))
+  (assert (member type '(key-press)))
+  (set! input-actions
+    (cons (list name
+		(apply (cond
+			((eqv? type 'key-press) make-key-press))
+		       data))
+	  input-actions)))
+
+;; Default global system for simple input management
+(add-system
+ (make-system
+  'push-actions
+  0
+  'global
+  '()
+  (lambda ()
+    (for-each
+     (lambda (action)
+       (cond
+	((key-press? (cdr action))
+	 (push-event 'input
+		     (car action)
+		     (cdr action)))))
+     input-actions))))
+
 ;; Render queue exports
 (export register-render-queue push-render-object evaluate-render-queue)