diff options
| -rw-r--r-- | 2d/game-loop.scm | 144 | ||||
| -rw-r--r-- | 2d/scene.scm | 21 | ||||
| -rw-r--r-- | 2d/stage.scm | 2 |
3 files changed, 92 insertions, 75 deletions
diff --git a/2d/game-loop.scm b/2d/game-loop.scm index 39fde9e..79e09b7 100644 --- a/2d/game-loop.scm +++ b/2d/game-loop.scm @@ -33,6 +33,7 @@ #:use-module (2d mvars) #:use-module (2d repl server) #:use-module (2d repl repl) + #:use-module (2d scene) #:use-module (2d stage) #:use-module (2d window) #:export (current-fps @@ -44,6 +45,74 @@ game-paused?)) ;;; +;;; Game Loop +;;; + +(define running? #f) +(define paused? #f) + +(define (tick dt accumulator) + "Advance the game by one frame." + (if paused? + (begin + (run-repl) + (SDL:delay tick-interval) + accumulator) + (catch #t + (lambda () + (let* ((stage (current-stage)) + (remainder (update stage accumulator))) + (run-repl) + (render stage dt) + remainder)) + (lambda (key . args) + (pause-game) + accumulator) + (lambda (key . args) + (display-backtrace (make-stack #t) + (current-output-port)))))) + +(define (game-loop last-time accumulator) + "Update game state, and render. LAST-TIME is the time in +milliseconds of the last iteration of the loop. ACCUMULATOR is the +time in milliseconds that has passed since the last game update." + (when running? + (let* ((current-time (SDL:get-ticks)) + (dt (- current-time last-time)) + (accumulator (+ accumulator dt))) + (game-loop current-time (tick dt accumulator))))) + +(define (run-game game) + "Open a window and start the game loop for GAME." + (open-window (game-title game) + (game-resolution game) + (game-fullscreen? game)) + (set! running? #t) + (resume-game) + (push-scene (game-first-scene game)) + (spawn-server) + (game-loop (SDL:get-ticks) 0) + (close-window)) + +(define (game-running?) + (running?)) + +(define (game-paused?) + (paused?)) + +(define (pause-game) + "Pauses the game loop. Useful when developing." + (set! paused? #t)) + +(define (resume-game) + "Resumes the game loop." + (set! paused? #f)) + +(define (quit-game) + "Finish the current frame and terminate the game loop." + (set! running? #f)) + +;;; ;;; Constants ;;; @@ -54,6 +123,12 @@ ;;; Event Handling ;;; +;; By default, pressing the escape key will pop the current scene, and +;; closing the window will quit the game. +(default-events `((key-down . ,(lambda (key mod unicode) + (pop-scene))) + (quit . ,quit-game))) + (define handle-events (let ((e (SDL:make-event))) (lambda (stage) @@ -72,7 +147,6 @@ (SDL:event:resize:w e) (SDL:event:resize:h e))) ((quit) - (quit-game) (stage-trigger stage 'quit)) ((key-down) (stage-trigger stage @@ -182,71 +256,3 @@ INPUT, OUTPUT, and ERROR ports." (unless (mvar-empty? repl-input-mvar) (and-let* ((vals (try-take-mvar repl-input-mvar))) (apply run-repl-thunk vals)))) - -;;; -;;; Game Loop -;;; - -(define running? #f) -(define paused? #f) - -(define (tick dt accumulator) - "Advance the game by one frame." - (if paused? - (begin - (run-repl) - (SDL:delay tick-interval) - accumulator) - (catch #t - (lambda () - (let* ((stage (current-stage)) - (remainder (update stage accumulator))) - (run-repl) - (render stage dt) - remainder)) - (lambda (key . args) - (pause-game) - accumulator) - (lambda (key . args) - (display-backtrace (make-stack #t) - (current-output-port)))))) - -(define (game-loop last-time accumulator) - "Update game state, and render. LAST-TIME is the time in -milliseconds of the last iteration of the loop. ACCUMULATOR is the -time in milliseconds that has passed since the last game update." - (when running? - (let* ((current-time (SDL:get-ticks)) - (dt (- current-time last-time)) - (accumulator (+ accumulator dt))) - (game-loop current-time (tick dt accumulator))))) - -(define (run-game game) - "Open a window and start the game loop for GAME." - (open-window (game-title game) - (game-resolution game) - (game-fullscreen? game)) - (set! running? #t) - (resume-game) - (push-scene (game-first-scene game)) - (spawn-server) - (game-loop (SDL:get-ticks) 0) - (close-window)) - -(define (game-running?) - (running?)) - -(define (game-paused?) - (paused?)) - -(define (pause-game) - "Pauses the game loop. Useful when developing." - (set! paused? #t)) - -(define (resume-game) - "Resumes the game loop." - (set! paused? #f)) - -(define (quit-game) - "Finish the current frame and terminate the game loop." - (set! running? #f)) diff --git a/2d/scene.scm b/2d/scene.scm index 076897a..7415f80 100644 --- a/2d/scene.scm +++ b/2d/scene.scm @@ -23,6 +23,7 @@ (define-module (2d scene) #:use-module (srfi srfi-9) + #:use-module (2d observer) #:export (<scene> make-scene scene? @@ -32,23 +33,28 @@ scene-exit scene-draw scene-update + scene-observer init-scene enter-scene exit-scene draw-scene - update-scene)) + update-scene + scene-trigger + default-events)) (define-record-type <scene> - (%make-scene name init enter exit draw update) + (%make-scene name init enter exit draw update observer) scene? (name scene-name) (init scene-init) (enter scene-enter) (exit scene-exit) (draw scene-draw) - (update scene-update)) + (update scene-update) + (observer scene-observer)) (define no-op (lambda args #f)) +(define default-events (make-parameter '())) (define* (make-scene name #:optional #:key @@ -56,9 +62,11 @@ (enter no-op) (exit no-op) (draw no-op) - (update no-op)) + (update no-op) + (events (default-events))) "Create a new scene object. All callbacks default to a no-op." - (%make-scene name init enter exit draw update)) + (%make-scene name init enter exit draw update + (alist->observer events))) (define (init-scene scene) "Return the value returned by the state constructor thunk for @@ -80,3 +88,6 @@ SCENE." (define (update-scene scene state) "Call the update callback for SCENE with STATE." ((scene-update scene) state)) + +(define (scene-trigger scene event . args) + (apply observer-trigger (scene-observer scene) event args)) diff --git a/2d/stage.scm b/2d/stage.scm index 27b29ba..fee18a3 100644 --- a/2d/stage.scm +++ b/2d/stage.scm @@ -87,7 +87,7 @@ (define (stage-trigger stage event . args) (with-agenda (stage-agenda stage) - #f)) + (apply scene-trigger (stage-scene stage) event args))) ;;; ;;; Stage management |