Add scene system and update example

engine/core.scm

@@ -293,7 +293,7 @@
 
 ;; Event bus interface
 (export register-event-bus remove-event-bus fetch-event-bus
-	push-event peek-event pop-event)
+	clear-event-bus push-event peek-event pop-event)
 
 ;; Register a new event bus
 (define (register-event-bus name)
@@ -315,6 +315,18 @@
 	name)
       #f))
 
+(define (clear-event-bus name)
+  (assert (symbol? name))
+  (let ((event-bus (fetch-event-bus name)))
+    (if event-bus
+	(begin
+	  (for-each
+	   (lambda (key)
+	     (hash-table-delete! event-bus key))
+	   (hash-table-keys event-bus))
+	  #t)
+	#f)))
+
 ;; Fetch an event bus by name, or #f if it doesn't exist
 (define (fetch-event-bus name)
   (assert (symbol? name))
@@ -366,7 +378,7 @@
   (key key-press-key))
 
 ;; Add a new action to the input actions alist
-(export register-action)
+(export register-action push-actions)
 (define (register-action name type . data)
   (assert (symbol? name))
   (assert (member type '(key-press)))
@@ -378,22 +390,22 @@
 	  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))
-	 (when (key-pressed? (key-press-key (cdr action)))
-	   (push-event 'input
-		       (car action)
-		       (cdr action))))))
-     input-actions))))
+(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)

engine/scene.scm

@@ -0,0 +1,42 @@
+(module (engine scene) ()
+(import scheme
+	(chicken base)
+	(chicken module)
+	(engine core)
+	(srfi 1)
+	(srfi 99))
+
+;; This is just for easier serialization
+(define-record-type <entity>
+  (make-entity name components)
+  entity?
+  (name entity-name)
+  (components entity-components))
+
+(export entity named-entity)
+(define (entity . components)
+  (apply make-entity (cons '() (list components))))
+
+(define (named-entity name . components)
+  (apply make-entity (cons name (list components))))
+
+(export scene)
+;; Every element of items here is either an entity record or system
+(define (scene . items)
+  (lambda ()
+    (clear-world)
+    (clear-systems)
+    (clear-event-bus 'input)
+    (for-each
+     (lambda (entity)
+       (if (null? (entity-name entity))
+	   (apply create-entity (entity-components entity))
+	   (apply create-named-entity (cons (entity-name entity)
+					    (entity-components entity)))))
+     (filter entity? items))
+    (for-each
+     (lambda (system)
+       (add-system system))
+     (filter system? items))))
+
+)