IT COMPILES AGAIN!

game.scm

@@ -46,7 +46,8 @@
         (game-core)
         (game game-objects)
         (game game-manager)
-        (logging))
+        (logging)
+        (media))
 
 ;; Canvas settings
 (define canvas (get-element-by-id "canvas"))
@@ -55,17 +56,30 @@
 (define game-width 640.0)
 (define game-height 480.0)
 
-(parameterize ((*logger* #f))
+(define media-library (create-media-library))
+
+
+
+(parameterize ((*logger* #f)
+               (*media-library* media-library))
+
+  (define game-images `(('player . ,(get-image "assets/sprites/player.png"))
+                        ('barrel . ,(get-image "assets/sprites/barrel.png"))
+                        ('bricks . ,(get-image "assets/sprites/bricks.png"))
+                        ('stones . ,(get-image "assets/sprites/stones.png"))
+                        ('card-back . ,(get-image "assets/sprites/bricks.png"))))
+
+  (add-images! game-images)
+  
   (write-log! "Creating entity manager")
   (define e-manager
-    (create-entity-manager (init-game-entities)))
+    (create-entity-manager #;(init-game-entities)
+     ))
 
   (write-log! "Creating system manager")
   (define s-manager
-    (create-system-manager (init-game-systems context)))
-
-  (write-log! "Getting player image.")
-  (define image:player       (make-image "assets/images/ball.png"))
+    (create-system-manager #;(init-game-systems context)
+     ))
 
   (write-log! "Creating game")
   (define game (make-game e-manager s-manager 0))
@@ -84,12 +98,13 @@
   
   (write-log! "Defining game loop.")
   (define (update-game-loop)
-    (write-log! "Heartbeat")
-    (let* ((last-game-state (atomic-box-ref game-atom))
-           (next-game-state (step-game! last-game-state dt)))
-      (write-log! "Looped")
-      (atomic-box-set! game-atom next-game-state)
-      (timeout timeout-callback dt)))
+    (parameterize ((*media-library* media-library))
+      (write-log! "Heartbeat")
+      (let* ((last-game-state (atomic-box-ref game-atom))
+             (next-game-state (step-game! last-game-state dt)))
+        (write-log! "Looped")
+        (atomic-box-set! game-atom next-game-state)
+        (timeout timeout-callback dt))))
 
   (write-log! "Defining update callback")
   (define timeout-callback (procedure->external update-game-loop))

modules/ces/system/html-canvas-renderer.scm

@@ -8,8 +8,8 @@
   #:use-module (ces system sprite-renderer)
   #:use-module (ces system tilemap-renderer)
   #:use-module (ces system-manager)
-  #:use-module (dom canvas)
-  #:use-module (game-core))
+  #:use-module (game-core)
+  #:export (create-html-canvas-renderer))
 
 ;; The canvas renderer requires an entity to have a position,
 ;; but also to have at least one of the renderable components
@@ -19,7 +19,7 @@
            (has-component? entity 'tilemap))))
 
 
-(define (make-image-renderer canvas-context)
+(define (make-image-renderer draw-function canvas-context)
   "Returns a proceedure which calls the underlying html5 canvas
  drawImage function. Arities include:
  (image x y width height)
@@ -29,13 +29,13 @@
  definition, so everything must specify a width."
   (case-lambda
     ((image x y width height)
-     (draw-image canvas-context image 0 0 width height x y width height))
+     (draw-function canvas-context image 0 0 width height x y width height))
     ((image sx sy swidth sheight x y width height)
-     (draw-image canvas-context image sx sy swidth sheight x y width height))))
+     (draw-function canvas-context image sx sy swidth sheight x y width height))))
 
-(define (%make-rendering-systems canvas-context)
+(define (%make-rendering-systems draw-function canvas-context)
   "Returns a list of rendering systems."
-  (let ((draw-proc (make-image-renderer canvas-context)))
+  (let ((draw-proc (make-image-renderer draw-function canvas-context)))
     (list (create-tilemap-renderer draw-proc)
           (create-sprite-rendering-system draw-proc))))
 
@@ -60,10 +60,9 @@
     (%add-entity-to-renderer! entity)
     (%run-rendering-subsystems! dt)))
 
-(define (create-html-canvas-renderer context)
-  (let* ((rendering-subsystems (%make-rendering-systems context))
-         (rendering-subsystem-manager (create-system-manager rendering-subsystems))
-         (renderer (%make-rendering-systems context)))
+(define (create-html-canvas-renderer draw-function context)
+  (let* ((rendering-subsystems (%make-rendering-systems draw-function context))
+         (rendering-subsystem-manager (create-system-manager rendering-subsystems)))
     (parameterize ((*system-manager-parameter* rendering-subsystem-manager))
       (create-system wants-entity?
                      %system-process-proc

modules/game-core.scm

@@ -6,6 +6,7 @@
   #:use-module (logging)
   #:use-module (scheme base)
   #:use-module (hoot debug)
+  #:use-module (hoot hashtables)
   #:use-module (ces system)
   #:use-module (ces component)
   #:use-module (ces entity)

modules/game/game-manager.scm

@@ -1,27 +1,20 @@
 (define-module (game game-manager)
   #:pure
   #:use-module (scheme base)
-  #:use-module (dom document)
-  #:use-module (dom element)
-  #:use-module (dom image)
-  #:use-module (dom window)
-  #:use-module (dom canvas)
   #:use-module (ces system html-canvas-renderer)
+  #:use-module (dom image)
+  #:use-module (media)
   #:use-module (game level-manager)
   #:export (init-game-entities
             init-game-systems))
 
-(define canvas (get-element-by-id "canvas"))
-(define context (get-context canvas "2d"))
-
-(define room-background (make-image "assets/backgrounds/background.png"))
-
 (define (init-game-entities)
-    "Returns a list of initial game entities.  "
+  "Returns a list of initial game entities.  "
+  (let ((room-background (get-image 'room-background)))
     (list (create-player!)
-          (create-room! room-background 0 0 128 64)))
+          (create-room! room-background 0 0 128 64))))
 
-(define (init-game-systems) 
+(define (init-game-systems draw-proc context) 
   "Returns a list of initial game systems.  
 Note: Systems are executed sequentially.  "
-  (list (create-html-canvas-renderer context)))
+  (list (create-html-canvas-renderer draw-proc context)))

modules/game/level-manager.scm

@@ -2,42 +2,44 @@
   #:pure
   #:use-module (scheme base)
   #:use-module (ces component)
+  #:use-module (ces component inputs)
   #:use-module (ces component hitbox)
   #:use-module (ces component position)
   #:use-module (ces component sprite)
   #:use-module (ces entity)
   #:use-module (ces entity-manager)
-  #:use-module (dom image)
   #:use-module (game game-objects)
+  #:use-module (game-core)
+  #:use-module (media)
   #:export (create-player!
             create-room!))
 
 ;; Player
-;;(define (player? entity)
-;;    (and (game-object? entity)
-;;         (has-components? entity 'keyboard-input)))
+(define (player? entity)
+  (and (game-object? entity)
+       (has-components? entity 'keyboard-input)))
 
-(define player-sprite (make-image "assets/sprites/player.png"))
 (define (create-player!)
-    (let ((initial-entity (create-game-object! 0 0 16 16 player-sprite)))
-         (add-component initial-entity 'keyboard-input 
-            (make-inputs '() '() '()))))
+  (let* ((player-sprite (get-image 'player))
+         (initial-entity (create-game-object! 0 0 16 16 player-sprite)))
+    (set-component initial-entity 'keyboard-input
+                   (create-inputs))))
 
 ;; Room
-;;(define (room? entity)
-;;    (has-components? entity 'hitbox 'sprite)) ;; + 'room-objects ?
+(define (room? entity)
+  (has-components? entity 'hitbox 'sprite)) ;; + 'room-objects ?
 ;; As it stands a game object is technically also a room.  
 ;; This will not be the case in the future -- especially once tilemaps work.  
 
 (define (add-background entity entity-id image width height)
-    (set-component entity 'sprite (make-sprite entity-id image width height)))
+  (set-component entity 'sprite (make-sprite entity-id image width height)))
 
 (define (add-bounding-box entity entity-id x y width height)
-    (set-component entity 'hitbox (make-hitbox entity-id x y width height)))
+  (set-component entity 'hitbox (make-hitbox entity-id x y width height)))
 
 (define (add-room-components entity background x y width height)
   (let* ((room-entity-id (game-entity-id entity))
-         (entity (add-background entity room-entity-id sprite width height))
+         (entity (add-background entity room-entity-id background width height))
          (entity (add-bounding-box entity room-entity-id x y width height)))
     entity))
 

modules/media.scm

@@ -0,0 +1,41 @@
+(define-module (media)
+  #:pure
+  #:use-module (scheme base)
+  #:use-module (hoot hashtables)
+  #:use-module (hoot match)
+  #:export (add-image!
+            get-image
+            add-images!
+
+            create-media-library
+            *media-library*))
+
+
+(define-record-type <media-manager>
+    (make-media-manager images audio)
+  media-manager?
+  (images media-images)
+  (audio media-audio))
+
+(define *media-library* (make-parameter #f))
+
+(define (get-media-library)
+  (*media-library*))
+
+(define (create-media-library)
+  (make-media-manager (make-eq-hashtable)
+                      (make-eq-hashtable)))
+
+(define (add-image! image-symbol image)
+  (let ((manager (get-media-library)))
+    (hashtable-set! (media-images manager) image-symbol image)))
+
+(define (add-images! images)
+  (let ((manager (get-media-library)))
+    (for-each (lambda (k v)
+                (add-image! k v))
+              images)))
+
+(define (get-image image-symbol)
+  (let ((manager (get-media-library)))
+    (hashtable-ref (media-images manager) image-symbol #f)))