Add renderer system

game.scm

@@ -36,6 +36,7 @@
         (math vector)
         (ces entity)
         (ces system)
+        (ces system renderer)
         (ces system-manager)
         (ces entity-manager)
         (game-core))

modules/ces/component/sprite.scm

@@ -4,10 +4,14 @@
   #:use-module (dom image)
   #:export (sprite?
             make-sprite
-            sprite-image))
+            sprite-image
+            sprite-width
+            sprite-height))
 
 (define-record-type <sprite>
-    (make-sprite entity-id image)
+    (make-sprite entity-id image width height)
   sprite?
   (entity-id sprite-entity-id)
-  (image sprite-image))
+  (image sprite-image)
+  (width sprite-width)
+  (height sprite-height))

modules/ces/system/renderer.scm

@@ -0,0 +1,43 @@
+;; Renders an entity to a canvas
+
+(define-module (ces system renderer)
+  #:pure
+  #:use-module (scheme base)
+  #:use-module (ces system)
+  #:use-module (ces component sprite)
+  #:use-module (ces component position)
+  #:use-module (ces entity)
+  #:use-module (dom canvas)
+  #:export (create-rendering-system))
+
+(define desired-components '('position 'sprite))
+
+(define (wants-entity? entity)
+  (and (game-entity? entity)
+       (apply has-components? desired-components)))
+
+(define (%draw-image context image x y width height)
+  "Wraps around the full call, since we are showing the whole thing."
+  (draw-image context image 0.0 0.0 width height x y width height))
+
+(define (render-entity context entity)
+  (let ((sprite (get-component entity 'sprite))
+        (position (get-component entity 'position)))
+    (when (and (position? position) (sprite? sprite))
+      (let ((width (sprite-width sprite))
+            (height (sprite-height sprite))
+            (image (sprite-image sprite))
+            (x (position-x position))
+            (y (position-y position)))
+        (%draw-image context image x y width height)))))
+
+(define (render context draw-callback entity dt)
+  "Renders the entity to context. dt is unused."
+  (render-entity context entity))
+
+(define (create-rendering-system draw-context draw-callback)
+  "Renders an entity which has a position and sprite component to the draw context,
+and then immediately calls draw-callback. draw-callback should be a thunk."
+  (make-system wants-entity?
+               (lambda (entity dt)
+                 (render draw-context draw-callback entity dt))))