137 lines
5 KiB
Scheme
137 lines
5 KiB
Scheme
;;; Copyright (C) 2024 David Thompson <dave@spritely.institute>
|
|
;;;
|
|
;;; Licensed under the Apache License, Version 2.0 (the "License");
|
|
;;; you may not use this file except in compliance with the License.
|
|
;;; You may obtain a copy of the License at
|
|
;;;
|
|
;;; http://www.apache.org/licenses/LICENSE-2.0
|
|
;;;
|
|
;;; Unless required by applicable law or agreed to in writing, software
|
|
;;; distributed under the License is distributed on an "AS IS" BASIS,
|
|
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
|
;;; See the License for the specific language governing permissions and
|
|
;;; limitations under the License.
|
|
|
|
;;; Commentary:
|
|
;;;
|
|
;;; Example game showing off several common game programming things.
|
|
;;;
|
|
;;; Code:
|
|
|
|
(import (scheme base)
|
|
(scheme inexact)
|
|
(hoot atomics)
|
|
(hoot debug)
|
|
(hoot ffi)
|
|
(hoot hashtables)
|
|
(hoot match)
|
|
(dom canvas)
|
|
(dom console)
|
|
(dom document)
|
|
(dom element)
|
|
(dom event)
|
|
(dom image)
|
|
(dom media)
|
|
(dom window)
|
|
(math)
|
|
(math rect)
|
|
(math vector)
|
|
(ces entity)
|
|
(ces system)
|
|
(ces system sprite-renderer)
|
|
(ces system keyboard-reader)
|
|
(ces system tilemap-renderer)
|
|
(ces system-manager)
|
|
(ces entity-manager)
|
|
(game-core)
|
|
(game game-manager)
|
|
(logging)
|
|
(media))
|
|
|
|
;; Canvas settings
|
|
(define canvas (get-element-by-id "canvas"))
|
|
(define context (get-context canvas "2d"))
|
|
|
|
(define game-width 640.0)
|
|
(define game-height 480.0)
|
|
|
|
(define game-images `((player . ,(make-image "assets/sprites/player.png"))
|
|
(barrel . ,(make-image "assets/sprites/barrel.png"))
|
|
(bricks . ,(make-image "assets/sprites/bricks.png"))
|
|
(stones . ,(make-image "assets/sprites/stones.png"))
|
|
(card-back . ,(make-image "assets/sprites/bricks.png"))
|
|
(tile-blank . ,(make-image "assets/tiles/blank.png"))
|
|
(tile-floor . ,(make-image "assets/tiles/floor-light.png"))
|
|
(tile-wall . ,(make-image "assets/tiles/bricks-light.png"))
|
|
(tile-door . ,(make-image "assets/tiles/door-light.png"))))
|
|
|
|
(parameterize ((*logger* #f))
|
|
(parameterize ((*media-library* (create-media-library)))
|
|
(add-images! (get-media-library) game-images)
|
|
|
|
(write-log! "Creating bootstrap managers")
|
|
(define bootstrap-entity-manager (create-entity-manager))
|
|
(define bootstrap-system-manager (create-entity-manager))
|
|
(write-log! "Creating entity manager")
|
|
(define e-manager (parameterize ((*entity-manager-parameter* bootstrap-entity-manager)
|
|
(*system-manager-parameter* bootstrap-system-manager))
|
|
(write-log! "Entering e-manager creation")
|
|
(let ((init-entities (init-game-entities)))
|
|
(write-log! "Got initial game entities.")
|
|
(create-entity-manager init-entities))))
|
|
|
|
(write-log! "Creating system manager")
|
|
(define s-manager (parameterize ((*entity-manager-parameter* e-manager))
|
|
(create-system-manager
|
|
(init-game-systems draw-image context))))
|
|
|
|
(pk "System information"
|
|
"Systems: " (system-manager-systems s-manager)
|
|
"System-manager proc table" (system-manager-proc-table s-manager))
|
|
|
|
(write-log! "Creating game")
|
|
(define game (make-game e-manager s-manager 0))
|
|
(define dt (/ 1000.0 60.0))
|
|
(define game-atom (make-atomic-box #f))
|
|
(atomic-box-set! game-atom (initialize-game! game))
|
|
(write-log! "Initialized game.")
|
|
|
|
(define number->string*
|
|
(let ((cache (make-eq-hashtable))) ; assuming fixnums only
|
|
(lambda (x)
|
|
(or (hashtable-ref cache x)
|
|
(let ((str (number->string x)))
|
|
(hashtable-set! cache x str)
|
|
str)))))
|
|
|
|
(write-log! "Defining game loop.")
|
|
(define (update-game-loop)
|
|
(parameterize ((*logger* #f))
|
|
(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))
|
|
|
|
(write-log! "Setting canvas size")
|
|
(set-element-width! canvas (exact game-width))
|
|
(set-element-height! canvas (exact game-height))
|
|
|
|
(write-log! "Starting game")
|
|
(timeout timeout-callback dt)))
|
|
|
|
|
|
;; Canvas and event loop setup
|
|
;; Preserved for reference.
|
|
;;
|
|
;;(add-event-listener! (current-document) "keydown"
|
|
;; (procedure->external on-key-down))
|
|
;;(add-event-listener! (current-document) "keyup"
|
|
;; (procedure->external on-key-up))
|
|
;;(timeout update-callback dt)
|
|
;;(define draw-callback (procedure->external draw))
|