summaryrefslogtreecommitdiff
path: root/2d
diff options
context:
space:
mode:
Diffstat (limited to '2d')
-rw-r--r--2d/game-loop.scm87
-rw-r--r--2d/game.scm95
-rw-r--r--2d/private/game.scm87
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)