diff options
| -rw-r--r-- | 2d/game-loop.scm | 87 | ||||
| -rw-r--r-- | 2d/game.scm | 95 | ||||
| -rw-r--r-- | 2d/private/game.scm | 87 |
3 files changed, 45 insertions, 224 deletions
diff --git a/2d/game-loop.scm b/2d/game-loop.scm index d8075f8..b55c383 100644 --- a/2d/game-loop.scm +++ b/2d/game-loop.scm @@ -29,15 +29,13 @@ #:use-module (figl gl) #:use-module (2d agenda) #:use-module (2d coroutine) - #:use-module (2d private game) + #:use-module (2d game) + #:use-module (2d mvars) #:use-module (2d repl server) #:use-module (2d repl repl) - #:use-module (2d mvars) + #:use-module (2d stage) #:use-module (2d window) #:export (current-fps - push-scene - replace-scene - pop-scene run-game quit-game pause-game @@ -58,37 +56,38 @@ (define handle-events (let ((e (SDL:make-event))) - (lambda (scene) + (lambda (stage) "Handle all events in the SDL event queue." (while (SDL:poll-event e) - (handle-event scene e))))) + (handle-event stage e))))) -(define (handle-event scene e) +(define (handle-event stage e) "Call the relevant callbacks for the event, E." (case (SDL:event:type e) ((active) - (scene-trigger scene 'active)) + (stage-trigger stage 'active)) ((video-resize) - (scene-trigger scene + (stage-trigger stage 'resize (SDL:event:resize:w e) (SDL:event:resize:h e))) ((quit) - (scene-trigger scene 'quit)) + (quit-game) + (stage-trigger stage 'quit)) ((key-down) - (scene-trigger scene + (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) - (scene-trigger scene + (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) - (scene-trigger scene + (stage-trigger stage 'mouse-motion (SDL:event:motion:state e) (SDL:event:motion:x e) @@ -96,13 +95,13 @@ (SDL:event:motion:xrel e) (SDL:event:motion:yrel e))) ((mouse-button-down) - (scene-trigger scene + (stage-trigger stage 'mouse-press (SDL:event:button:button e) (SDL:event:button:x e) (SDL:event:button:y e))) ((mouse-button-up) - (scene-trigger scene + (stage-trigger stage 'mouse-click (SDL:event:button:button e) (SDL:event:button:x e) @@ -139,25 +138,25 @@ second." ;;; Update and Render ;;; -(define (render scene dt) +(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-scene scene) + (draw-stage stage) (SDL:gl-swap-buffers) (accumulate-fps! dt)) -(define (update scene accumulator) +(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 scene) + (handle-events stage) (update-agenda) - (update-scene scene) - (update scene (- accumulator tick-interval))) + (update-stage stage) + (update stage (- accumulator tick-interval))) accumulator)) ;;; @@ -185,40 +184,6 @@ INPUT, OUTPUT, and ERROR ports." (apply run-repl-thunk vals)))) ;;; -;;; Scene management -;;; - -(define scenes '()) - -(define (current-scene) - (car scenes)) - -(define (push-scene scene) - "Pause the current scene and start SCENE upon next game tick." - (set! scenes (cons scene scenes))) - -(define (replace-scene scene) - (set! scenes (cons scene (cdr scenes)))) - -(define (pop-scene) - "Exit the current scene and resume the previous scene. If there is -no previous scene, the game loop will terminate." - (if (null? scenes) - (quit-game) - (set! scenes (cdr scenes)))) - -(define (switch-scenes-maybe scene) - "Switch scenes if the current scene is not the scene at the top of -the stack." - (unless (eq? scene (current-scene)) - (scene-trigger scene 'stop) - (scene-trigger (current-scene) 'start))) - -(define (set-initial-scene scene) - (set! scenes (list scene)) - (scene-trigger scene 'start)) - -;;; ;;; Game Loop ;;; @@ -234,11 +199,10 @@ the stack." accumulator) (catch #t (lambda () - (let* ((scene (current-scene)) - (remainder (update scene accumulator))) + (let* ((stage (current-stage)) + (remainder (update stage accumulator))) (run-repl) - (render scene dt) - (switch-scenes-maybe scene) + (render stage dt) remainder)) (lambda (key . args) (pause-game) @@ -259,12 +223,13 @@ time in milliseconds that has passed since the last game update." (define (run-game game) "Open a window and start the game loop for GAME." + (pk 'game game) (open-window (game-title game) (game-resolution game) (game-fullscreen? game)) (set! running? #t) (resume-game) - (set-initial-scene ((game-first-scene game))) + (push-stage (make-stage (game-first-scene game))) (spawn-server) (game-loop (SDL:get-ticks) 0) (close-window)) diff --git a/2d/game.scm b/2d/game.scm index 4c58521..4c91b1b 100644 --- a/2d/game.scm +++ b/2d/game.scm @@ -22,92 +22,35 @@ ;;; Code: (define-module (2d game) - #:use-module (2d private game) - #:use-module (2d game-loop) + #:use-module (srfi srfi-9) #:use-module (2d helpers) #:use-module (2d observer) - #:use-module (2d vector2)) - -;;; -;;; Scenes -;;; - -;; When no event callbacks are specified for a scene, these -;; (hopefully) convenient defaults will be used. -(define %default-scene-events - `((quit . ,(lambda (state) (quit-game))) - (key-down . ,(lambda (state key mode unicode) - (when (any-equal? key 'escape 'q) - (quit-game)))))) - -(define (default-scene-events) - (copy-tree %default-scene-events)) - -(define* (make-scene #:optional #:key - (title "A Guile-2D Scene") - (events (default-scene-events)) - (update (lambda (s) #f)) - (draw (lambda (s) #f)) - (state #f)) - "Return a new scene. TITLE is a human readable name for the -scene. EVENTS is an alist of event handlers. UPDATE is a procedure -that updates the scene. DRAW is a procedure that renders the -scene. STATE is an object that encapsulates the scene state." - (%make-scene title (alist->observer events) update draw state)) - -(define-syntax-rule (define-scene name kwargs ...) - "Syntactic sugar over define and make-scene. Return a procedure that -creates a new scene." - (define (name) (make-scene kwargs ...))) - -(re-export <scene> - scene? - scene-title - scene-observer - scene-update-proc - scene-draw-proc - scene-state - scene-trigger - update-scene - draw-scene - push-scene - replace-scene - pop-scene) - -(export make-scene - define-scene - default-scene-events) + #:use-module (2d vector2) + #:export (<game> + make-game + game? + game-title + game-resolution + game-fullscreen? + game-first-scene)) ;;; ;;; Games ;;; +(define-record-type <game> + (%make-game title resolution fullscreen? first-scene) + game? + (title game-title) + (resolution game-resolution) + (fullscreen? game-fullscreen?) + (first-scene game-first-scene)) + (define* (make-game #:optional #:key (title "A Guile-2D Game") (resolution (vector2 640 480)) - (fullscreen #f) + (fullscreen? #f) (first-scene #f)) "Return a new game. All game properties have some reasonable default value." - (%make-game title resolution fullscreen first-scene)) - -(define-syntax-rule (define-game name kwargs ...) - "Syntactic sugar over define and make-game." - (define name (make-game kwargs ...))) - -(re-export <game> - game? - game-title - game-resolution - game-fullscreen? - game-first-scene - run-game - quit-game - pause-game - resume-game - game-running? - game-paused? - current-fps) - -(export make-game - define-game) + (%make-game title resolution fullscreen? first-scene)) diff --git a/2d/private/game.scm b/2d/private/game.scm deleted file mode 100644 index 88a971f..0000000 --- a/2d/private/game.scm +++ /dev/null @@ -1,87 +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 data structure. -;; -;;; Code: - -(define-module (2d private game) - #:use-module (srfi srfi-9) - #:use-module (2d observer)) - -;;; -;;; Scenes -;;; - -(define-record-type <scene> - (%make-scene title observer update-proc draw-proc state) - scene? - (title scene-title) - (observer scene-observer) - (update-proc scene-update-proc) - (draw-proc scene-draw-proc) - (state scene-state)) - -(define (scene-trigger scene event-type . args) - "Trigger an event on the scene observer." - (apply observer-trigger - (scene-observer scene) - event-type - (scene-state scene) - args)) - -(define (draw-scene scene) - "Draw SCENE." - ((scene-draw-proc scene) (scene-state scene))) - -(define (update-scene scene) - "Update SCENE." - ((scene-update-proc scene) (scene-state scene))) - -(export <scene> - %make-scene - scene? - scene-title - scene-observer - scene-update-proc - scene-draw-proc - scene-state - scene-trigger - update-scene - draw-scene) - -;;; -;;; Games -;;; - -(define-record-type <game> - (%make-game title resolution fullscreen first-scene) - game? - (title game-title) - (resolution game-resolution) - (fullscreen game-fullscreen?) - (first-scene game-first-scene)) - -(export <game> - %make-game - game? - game-title - game-resolution - game-fullscreen? - game-first-scene) |