diff options
| -rw-r--r-- | 2d/game-loop.scm | 265 | ||||
| -rw-r--r-- | 2d/game.scm | 243 | ||||
| -rw-r--r-- | 2d/repl/repl.scm | 2 |
3 files changed, 241 insertions, 269 deletions
diff --git a/2d/game-loop.scm b/2d/game-loop.scm deleted file mode 100644 index a14459e..0000000 --- a/2d/game-loop.scm +++ /dev/null @@ -1,265 +0,0 @@ -;;; guile-2d -;;; Copyright (C) 2013 David Thompson <dthompson2@worcester.edu> -;;; -;;; Guile-2d is free software: you can redistribute it and/or modify it -;;; under the terms of the GNU Lesser General Public License as -;;; published by the Free Software Foundation, either version 3 of the -;;; License, or (at your option) any later version. -;;; -;;; Guile-2d is distributed in the hope that it will be useful, but -;;; WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;;; Lesser General Public License for more details. -;;; -;;; You should have received a copy of the GNU Lesser General Public -;;; License along with this program. If not, see -;;; <http://www.gnu.org/licenses/>. - -;;; Commentary: -;; -;; Game loop. -;; -;;; Code: - -(define-module (2d game-loop) - #:use-module (ice-9 match) - #:use-module (srfi srfi-2) - #:use-module (srfi srfi-11) - #:use-module ((sdl sdl) #:prefix SDL:) - #:use-module (figl gl) - #:use-module (2d agenda) - #:use-module (2d coroutine) - #:use-module (2d game) - #: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 - run-game - quit-game - pause-game - resume-game - game-running? - game-paused?)) - -;;; -;;; Game Loop -;;; - -(define running? #f) -(define paused? #f) - -(define (update-and-render stage dt accumulator) - (let ((remainder (update stage accumulator))) - (run-repl) - (render stage dt) - remainder)) - -(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))) - (if stage - (update-and-render stage dt accumulator) - (quit-game)))) - (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 -;;; - -(define target-fps 60) -(define tick-interval (floor (/ 1000 target-fps))) - -;;; -;;; 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 (state key mod unicode) - (when (eq? key 'escape) - (pop-scene)))) - (quit . ,(lambda (state) - (quit-game))))) - -(define handle-events - (let ((e (SDL:make-event))) - (lambda (stage) - "Handle all events in the SDL event queue." - (while (SDL:poll-event e) - (handle-event stage e))))) - -(define (handle-event stage e) - "Call the relevant callbacks for the event, E." - (case (SDL:event:type e) - ((active) - (stage-trigger stage 'active)) - ((video-resize) - (stage-trigger stage - 'resize - (SDL:event:resize:w e) - (SDL:event:resize:h e))) - ((quit) - (stage-trigger stage 'quit)) - ((key-down) - (stage-trigger stage - 'key-down - (SDL:event:key:keysym:sym e) - (SDL:event:key:keysym:mod e) - (SDL:event:key:keysym:unicode e))) - ((key-up) - (stage-trigger stage - 'key-up - (SDL:event:key:keysym:sym e) - (SDL:event:key:keysym:mod e) - (SDL:event:key:keysym:unicode e))) - ((mouse-motion) - (stage-trigger stage - 'mouse-motion - (SDL:event:motion:state e) - (SDL:event:motion:x e) - (SDL:event:motion:y e) - (SDL:event:motion:xrel e) - (SDL:event:motion:yrel e))) - ((mouse-button-down) - (stage-trigger stage - 'mouse-press - (SDL:event:button:button e) - (SDL:event:button:x e) - (SDL:event:button:y e))) - ((mouse-button-up) - (stage-trigger stage - 'mouse-click - (SDL:event:button:button e) - (SDL:event:button:x e) - (SDL:event:button:y e))))) - -;;; -;;; Frames Per Second -;;; - -(define game-fps 0) - -(define accumulate-fps! - (let* ((elapsed-time 0) - (fps 0)) - (lambda (dt) - "Increment the frames-per-second counter. Resets to 0 every -second." - (let ((new-time (+ elapsed-time dt)) - (new-fps (1+ fps))) - (if (>= new-time 1000) - (begin - (set! game-fps new-fps) - (set! fps 0) - (set! elapsed-time 0)) - (begin - (set! fps new-fps) - (set! elapsed-time new-time))))))) - -(define (current-fps) - "Return the current FPS value." - game-fps) - -;;; -;;; Update and Render -;;; - -(define (render stage dt) - "Render a frame." - (set-gl-matrix-mode (matrix-mode modelview)) - (gl-load-identity) - (gl-clear (clear-buffer-mask color-buffer depth-buffer)) - (draw-stage stage) - (SDL:gl-swap-buffers) - (accumulate-fps! dt)) - -(define (update stage accumulator) - "Call the update callback. The update callback will be called as -many times as `tick-interval` can divide ACCUMULATOR. The return value -is the unused accumulator time." - (if (>= accumulator tick-interval) - (begin - (handle-events stage) - (update-agenda) - (update-stage stage) - (update stage (- accumulator tick-interval))) - accumulator)) - -;;; -;;; REPL -;;; - -(define (run-repl-thunk thunk input output error stack) - "Run THUNK with the given REPL STACK. I/O is redirected to the given -INPUT, OUTPUT, and ERROR ports." - (put-mvar - repl-output-mvar - (with-input-from-port input - (lambda () - (with-output-to-port output - (lambda () - (with-error-to-port error - (lambda () - (with-fluids ((*repl-stack* stack)) - (thunk)))))))))) - -(define (run-repl) - "Execute a thunk from the REPL is there is one." - (unless (mvar-empty? repl-input-mvar) - (and-let* ((vals (try-take-mvar repl-input-mvar))) - (apply run-repl-thunk vals)))) diff --git a/2d/game.scm b/2d/game.scm index 4c91b1b..aa19e44 100644 --- a/2d/game.scm +++ b/2d/game.scm @@ -22,17 +22,34 @@ ;;; Code: (define-module (2d game) + #:use-module (srfi srfi-2) #:use-module (srfi srfi-9) - #:use-module (2d helpers) - #:use-module (2d observer) + #:use-module ((sdl sdl) #:prefix SDL:) + #:use-module (figl gl) + #:use-module (2d agenda) + #:use-module (2d coroutine) + #:use-module (2d game) + #: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 vector2) + #:use-module (2d window) #:export (<game> make-game game? game-title game-resolution game-fullscreen? - game-first-scene)) + game-first-scene + current-fps + run-game + quit-game + pause-game + resume-game + game-running? + game-paused?)) ;;; ;;; Games @@ -54,3 +71,223 @@ "Return a new game. All game properties have some reasonable default value." (%make-game title resolution fullscreen? first-scene)) + +(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)) + +;;; +;;; Game Loop +;;; + +(define running? #f) +(define paused? #f) + +(define (update-and-render stage dt accumulator) + (let ((remainder (update stage accumulator))) + (run-repl) + (render stage dt) + remainder)) + +(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))) + (if stage + (update-and-render stage dt accumulator) + (quit-game)))) + (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 (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 +;;; + +(define target-fps 60) +(define tick-interval (floor (/ 1000 target-fps))) + +;;; +;;; 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 (state key mod unicode) + (when (eq? key 'escape) + (pop-scene)))) + (quit . ,(lambda (state) + (quit-game))))) + +(define handle-events + (let ((e (SDL:make-event))) + (lambda (stage) + "Handle all events in the SDL event queue." + (while (SDL:poll-event e) + (handle-event stage e))))) + +(define (handle-event stage e) + "Call the relevant callbacks for the event, E." + (case (SDL:event:type e) + ((active) + (stage-trigger stage 'active)) + ((video-resize) + (stage-trigger stage + 'resize + (SDL:event:resize:w e) + (SDL:event:resize:h e))) + ((quit) + (stage-trigger stage 'quit)) + ((key-down) + (stage-trigger stage + 'key-down + (SDL:event:key:keysym:sym e) + (SDL:event:key:keysym:mod e) + (SDL:event:key:keysym:unicode e))) + ((key-up) + (stage-trigger stage + 'key-up + (SDL:event:key:keysym:sym e) + (SDL:event:key:keysym:mod e) + (SDL:event:key:keysym:unicode e))) + ((mouse-motion) + (stage-trigger stage + 'mouse-motion + (SDL:event:motion:state e) + (SDL:event:motion:x e) + (SDL:event:motion:y e) + (SDL:event:motion:xrel e) + (SDL:event:motion:yrel e))) + ((mouse-button-down) + (stage-trigger stage + 'mouse-press + (SDL:event:button:button e) + (SDL:event:button:x e) + (SDL:event:button:y e))) + ((mouse-button-up) + (stage-trigger stage + 'mouse-click + (SDL:event:button:button e) + (SDL:event:button:x e) + (SDL:event:button:y e))))) + +;;; +;;; Frames Per Second +;;; + +(define game-fps 0) + +(define accumulate-fps! + (let* ((elapsed-time 0) + (fps 0)) + (lambda (dt) + "Increment the frames-per-second counter. Resets to 0 every +second." + (let ((new-time (+ elapsed-time dt)) + (new-fps (1+ fps))) + (if (>= new-time 1000) + (begin + (set! game-fps new-fps) + (set! fps 0) + (set! elapsed-time 0)) + (begin + (set! fps new-fps) + (set! elapsed-time new-time))))))) + +(define (current-fps) + "Return the current FPS value." + game-fps) + +;;; +;;; Update and Render +;;; + +(define (render stage dt) + "Render a frame." + (set-gl-matrix-mode (matrix-mode modelview)) + (gl-load-identity) + (gl-clear (clear-buffer-mask color-buffer depth-buffer)) + (draw-stage stage) + (SDL:gl-swap-buffers) + (accumulate-fps! dt)) + +(define (update stage accumulator) + "Call the update callback. The update callback will be called as +many times as `tick-interval` can divide ACCUMULATOR. The return value +is the unused accumulator time." + (if (>= accumulator tick-interval) + (begin + (handle-events stage) + (update-agenda) + (update-stage stage) + (update stage (- accumulator tick-interval))) + accumulator)) + +;;; +;;; REPL +;;; + +(define (run-repl-thunk thunk input output error stack) + "Run THUNK with the given REPL STACK. I/O is redirected to the given +INPUT, OUTPUT, and ERROR ports." + (put-mvar + repl-output-mvar + (with-input-from-port input + (lambda () + (with-output-to-port output + (lambda () + (with-error-to-port error + (lambda () + (with-fluids ((*repl-stack* stack)) + (thunk)))))))))) + +(define (run-repl) + "Execute a thunk from the REPL is there is one." + (unless (mvar-empty? repl-input-mvar) + (and-let* ((vals (try-take-mvar repl-input-mvar))) + (apply run-repl-thunk vals)))) diff --git a/2d/repl/repl.scm b/2d/repl/repl.scm index 4ff8f52..df0b8fe 100644 --- a/2d/repl/repl.scm +++ b/2d/repl/repl.scm @@ -30,7 +30,7 @@ #:use-module (system repl command) #:use-module (ice-9 control) #:use-module (2d mvars) - #:use-module (2d game-loop) + #:use-module (2d game) #:export (repl-input-mvar repl-output-mvar start-repl run-repl)) |