107 lines
3.2 KiB
Scheme
107 lines
3.2 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-objects)
|
|
(logging))
|
|
|
|
;; 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)
|
|
|
|
(parameterize ((*logger* log-to-console!))
|
|
|
|
(write-log! "Creating entity manager")
|
|
(define e-manager
|
|
(create-entity-manager))
|
|
|
|
(write-log! "Creating system manager")
|
|
(define s-manager
|
|
(create-system-manager))
|
|
|
|
(write-log! "Getting player image.")
|
|
(define image:player (make-image "assets/images/ball.png"))
|
|
|
|
(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.")
|
|
|
|
(write-log! "Defining game loop.")
|
|
(define (update-game)
|
|
(begin (write-log! "Heartbeat")
|
|
(let* ((last-game-state (atomic-box-ref game-atom))
|
|
(next-game-state (step-game! last-game-state dt)))
|
|
(begin
|
|
(write-log! (string-append "Looped at - " dt))
|
|
(atomic-box-set! game-atom next-game-state)
|
|
(timeout timeout-callback dt)))))
|
|
|
|
(write-log! "Defining update callback")
|
|
(define timeout-callback (procedure->external update-game))
|
|
|
|
(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))
|