engine/core.scm

@@ -162,7 +162,7 @@
 (define (make-system name priority mode criteria process)
   (assert (symbol? name))
   (assert (integer? priority))
-  (assert (member mode '(entity batch)))
+  (assert (member mode '(entity batch global)))
   (assert (every symbol? criteria))
   (assert (procedure? process))
   (int:make-system name priority mode criteria process))
@@ -266,10 +266,12 @@
 ;; Execute a single system
 (define (execute-system system)
   (assert (system? system))
-  (let ((entities (map get-entity (set->list (apply query-by-components (system-criteria system))))))
-    (cond 
-     ((eqv? (system-mode system) 'batch) ((system-process system) entities))
-     ((eqv? (system-mode system) 'entity) (for-each (lambda (e) ((system-process system) e)) entities)))))
+  (if (eqv? (system-mode system) 'global)
+      ((system-process system))
+      (let ((entities (map get-entity (set->list (apply query-by-components (system-criteria system))))))
+	(cond
+	 ((eqv? (system-mode system) 'batch) ((system-process system) entities))
+	 ((eqv? (system-mode system) 'entity) (for-each (lambda (e) ((system-process system) e)) entities))))))
 
 (define (execute-systems)
   (for-each

samples/bounce.scm

@@ -51,8 +51,6 @@
 	      '(<rigidbody-2d>)
 	      (lambda (body)
 		(let ((rbody (find rigidbody-2d? body)))
-		  (display (get-fps))
-		  (newline)
 		  (set-rigidbody-2d-velocity! rbody
 					      (vector-+ (rigidbody-2d-velocity rbody)
 							(vector-*
@@ -110,6 +108,40 @@
 				 (vector-+ (rigidbody-2d-velocity rbody)
 					   (position transform)))))))
 
+(define-record-type <key-press>
+  (make-key-press key)
+  key-press?
+  (key key-press-key))
+
+(add-system
+ (make-system 'input
+	      0
+	      'global
+	      '()
+	      (lambda ()
+		(when (key-pressed? KEY_SPACE)
+		  (push-event 'input 'boost (make-key-press 'space))))))
+
+(add-system
+ (make-system 'boost-rigidbody
+	      2
+	      'entity
+	      '(<rigidbody-2d>)
+	      (lambda (ball)
+		(let ((rbody (find rigidbody-2d? ball)))
+		  (when (peek-event 'input 'boost)
+		    (set-rigidbody-2d-velocity! rbody
+						(vector-* (make-vector2 2 2)
+							  (rigidbody-2d-velocity rbody))))))))
+
+(add-system
+ (make-system 'clear-boost-input
+	      10
+	      'global
+	      '()
+	      (lambda ()
+		(pop-event 'input 'boost))))
+
 (create-entity
  (make-visual-2d
   (make-circle-2d