diff --git a/game.scm b/game.scm index b68e44b..617d5eb 100644 --- a/game.scm +++ b/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)) diff --git a/modules/ces/system/html-canvas-renderer.scm b/modules/ces/system/html-canvas-renderer.scm index b78aeb4..bec40b3 100644 --- a/modules/ces/system/html-canvas-renderer.scm +++ b/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 diff --git a/modules/game-core.scm b/modules/game-core.scm index 4c6a14a..1c0f01d 100644 --- a/modules/game-core.scm +++ b/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) diff --git a/modules/game/game-manager.scm b/modules/game/game-manager.scm index 338d4c9..f20f41a 100644 --- a/modules/game/game-manager.scm +++ b/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))) diff --git a/modules/game/level-manager.scm b/modules/game/level-manager.scm index dad9fbb..12d6c76 100644 --- a/modules/game/level-manager.scm +++ b/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)) diff --git a/modules/media.scm b/modules/media.scm new file mode 100644 index 0000000..8c55eae --- /dev/null +++ b/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 + (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)))