Render queues and some test fixes

README.org

@@ -51,7 +51,7 @@ When drawing the next frame, the system iterates and executes every drawing thun
 The 3D queue is executed first, followed by the 2D queue, followed by the screen queue.
 The order of execution can be changed by modifying the ~render-priority~ list.
 The render-priority list contains pairs where the first symbol in the pair is a reference to the render queue in the ~render-queues~ hash table, and the second symbol is either ~screen~, ~2d~, or ~3d~. The order of items in this list informs Imugi of the order in which to execute the queues, and the second symbol of each pair tells Imugi what draw mode to use for each thunk.
-For 2D and 3D drawing, systems can set the currently active camera object on the parameters ~*active-camera-2d*~ and ~*active-camera-3d*~.
+For 2D and 3D drawing, systems can set the currently active camera object on the parameters ~*active-camera-2d*~ and ~*active-camera-3d*~. If a 3D or 2D render is queued but no corresponding camera for the mode is set, the render will not occur but the render queue will still be emptied.
 
 ** Resources
 When a resource, such as a font or texture, is loaded from the filesystem, the pointer is stored in an SRFI-69 hash table ~resources~ keyed by the path.

engine/components.scm

@@ -49,34 +49,34 @@
 
 ;; Type safe color constructor
 (define (make-color r g b a)
-  (assert (and (number r) (<= 0 r 1)))
-  (assert (and (number g) (<= 0 g 1)))
-  (assert (and (number b) (<= 0 b 1)))
-  (assert (and (number a) (<= 0 a 1)))
+  (assert (and (number? r) (<= 0 r 1)))
+  (assert (and (number? g) (<= 0 g 1)))
+  (assert (and (number? b) (<= 0 b 1)))
+  (assert (and (number? a) (<= 0 a 1)))
   (int:make-color r g b a))
 
 ;; Type safe color setter
 (define (set-color-r! color r)
   (assert (color? color))
-  (assert (and (number r) (<= 0 r 1)))
+  (assert (and (number? r) (<= 0 r 1)))
   (int:set-color-r! color r))
 
 ;; Type safe color setter
 (define (set-color-g! color g)
   (assert (color? color))
-  (assert (and (number g) (<= 0 g 1)))
+  (assert (and (number? g) (<= 0 g 1)))
   (int:set-color-g! color g))
 
 ;; Type safe color setter
 (define (set-color-b! color b)
   (assert (color? color))
-  (assert (and (number b) (<= 0 b 1)))
+  (assert (and (number? b) (<= 0 b 1)))
   (int:set-color-b! color b))
 
 ;; Type safe color setter
 (define (set-color-a! color a)
   (assert (color? color))
-  (assert (and (number a) (<= 0 a 1)))
+  (assert (and (number? a) (<= 0 a 1)))
   (int:set-color-a! color a))
 
 ;; Screen transform record and exports
@@ -98,7 +98,7 @@
 (define (make-screen-transform position rotation scale anchor parent)
   (assert (vector2? position))
   (assert (real? rotation))
-  (assert (Vector2? scale))
+  (assert (vector2? scale))
   (assert (and (symbol? anchor) (member anchor '(top-left top-middle top-right
 							  center-left center center-right
 							  bottom-left bottom-middle bottom-right))))
@@ -118,8 +118,8 @@
 (define (set-position! component position)
   (assert (record? component))
   (cond
-   ((screen-transform? component) (assert (vector2? positon))))
-  ((rtd-mutator (record-rtd component) 'positon) component position))
+   ((screen-transform? component) (assert (vector2? position))))
+  ((rtd-mutator (record-rtd component) 'position) component position))
 
 (define (pivot component)
   (assert (record? component))

engine/core.scm

@@ -14,7 +14,7 @@
 ;; We export the world, component sets, systems, and event buses so that the core can be extended to
 ;; include serialization functions across all.
 ;; NOTE: direct read/write to these is undefined, and will cause problems.
-(export world component-sets systems event-buses)
+(export world component-sets systems event-buses render-queues render-priority)
 
 ;; The world hash table
 (define world (make-hash-table))
@@ -69,6 +69,7 @@
 
 ;; Add an entity to the incoming queue
 ;; TODO: append! doesn't work here and IDK why
+;; TODO: this could be done with cons anyway because we don't care about the order
 (define (queue-add-entity id components-lst)
   (set! add-entity-queue
     (append add-entity-queue (list (cons id components-lst)))))
@@ -152,25 +153,25 @@
   (assert (integer? priority))
   (assert (every symbol? criteria))
   (assert (procedure? process))
-  (internal-make-system name priority criteria process))
+  (int:make-system name priority criteria process))
 
 ;; Type-checked system priority mutator
 (define (set-system-priority! system priority)
   (assert (system? system))
   (assert (integer? priority))
-  (internal-set-system-priority! system priority))
+  (int:set-system-priority! system priority))
 
 ;; Type-checked system criteria mutator
 (define (set-system-criteria! system criteria)
   (assert (system? system))
   (assert (every symbol? criteria))
-  (internal-set-system-criteria! system criteria))
+  (int:set-system-criteria! system criteria))
 
 ;; Type-checked system process mutator
 (define (set-system-process! system process)
   (assert (system? system))
   (assert (procedure? process))
-  (internal-set-system-process! system process))
+  (int:set-system-process! system process))
 
 ;; The systems list
 (define systems '())
@@ -329,8 +330,69 @@
 	  event)
 	#f)))
 
+;; Render queue exports
+(export register-render-queue push-render-object evaluate-render-queue)
+
+;; Render queues
+(define render-queues (make-hash-table))
+(define render-priority '())
+
+;; Register a new render queue
+(define (register-render-queue name drawing)
+  (assert (symbol? name))
+  (assert (and (symbol? drawing) (member drawing '(screen 2d 3d))))
+  (if (hash-table-exists? render-queues name)
+      #f
+      (begin
+	(hash-table-set! render-queues name '())
+	(set! render-priority (cons (cons name drawing) render-priority))
+	name)))
+
+;; Default render queues
+(register-render-queue '3d '3d)
+(register-render-queue '2d '2d)
+(register-render-queue 'screen 'screen)
+
+;; TODO: camera selection needs a better solution, ideally treating the camera
+;; as an entity.
+(define *active-camera-2d* (make-parameter '()))
+(define *active-camera-3d* (make-parameter '()))
+
+;; Push a render call to the queue
+(define (push-render-object queue-name layer thunk)
+  (assert (symbol? queue-name))
+  (assert (integer? layer))
+  (assert (procedure? thunk))
+  (set! (hash-table-ref render-queues queue-name)
+    (cons (cons layer thunk) (hash-table-ref render-queues queue-name))))
+
+;; Evaluate a single render queue with a specific mode.
+;; Render objects are sorted by their layer
+(define (evaluate-render-queue queue-name mode)
+  (assert (symbol? queue-name))
+  (assert (symbol? mode) (member mode '(screen 2d 3d)))
+  (when (or (eq? mode 'screen)
+	    (and (eq? mode '2d) (not (null? (*active-camera-2d*))))
+	    (and (eq? mode '3d) (not (null? (*active-camera-3d*)))))
+    (let ((queue (hash-table-ref render-queues queue-name)))
+      (when (eq? mode '2d)
+	(begin-mode-2d (*active-camera-2d*)))
+      (when (eq? mode '3d)
+	(begin-mode-3d (*active-camera-3d*)))
+      (for-each
+       (lambda (x) (x))
+       (sort queue
+	     (lambda (render-obj-a render-obj-b)
+	       (< (car render-obj-a)
+		  (car render-obj-b)))))
+      (when (eq? mode '2d)
+	(end-mode-2d))
+      (when (eq? mode '3d)
+	(end-mode-3d))))
+  (set! queue '()))
+
 ;; Frame generation and game loop
-(export resolve-queues next-frame *clear-color*)
+(export resolve-queues next-frame *clear-color* perform-render)
 
 ;; Utility function for guarding parameter values
 (define (guarded-parameter default predicate)
@@ -347,13 +409,21 @@
 ;; Clear color
 (define *clear-color* (guarded-parameter RAYWHITE u8vector?))
 
+;; Render all queues
+(define (perform-render)
+  (begin-drawing)
+  (clear-background (*clear-color*))
+  (for-each
+   (lambda (queue-spec)
+     (evaluate-render-queue (car queue-spec)
+			    (cdr queue-spec)))
+   render-priority)
+  (end-drawing))
+
 ;; Generate the next frame, for use in the main game loop
 (define (next-frame)
   (resolve-queues)
-  (with-drawing
-   (lambda ()
-     (clear-background (*clear-color*))
-     (execute-systems))))
+  (perform-render))
 
 ;; Window creation
 (export *window-size* *window-title* create-window)

test/engine.scm

@@ -40,8 +40,8 @@
 ;; System addition and state modification
 (check (length systems) => 0) ;; Systems list starts empty
 
-(define sys-1 (make-system 'foo '3d 0 '() void))
-(define sys-2 (make-system 'bar '2d 1 '() void))
+(define sys-1 (make-system 'foo 0 '() void))
+(define sys-2 (make-system 'bar 1 '() void))
 (add-system sys-1)
 (check (length systems) => 0) ;; Systems list is not immediately updated