blob: bf966ab40f3551a17560b36e3be4c16d9116a4d5 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
|
;;; 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:
;;
;; Stages represent the game state at the present time.
;;
;;; Code:
(define-module (2d stage)
#:use-module (srfi srfi-9)
#:use-module (2d agenda)
#:use-module (2d scene)
#:export (make-stage
stage?
stage-agenda
stage-observer
stage-env
stage-scene
enter-stage
exit-stage
draw-stage
update-stage
stage-trigger
make-stage-variable
define-stage-variable
stage-on
stage-off
current-stage
push-scene
pop-scene
replace-scene))
(define-record-type <stage>
(%make-stage agenda scene state)
stage?
(agenda stage-agenda)
(scene stage-scene)
(state stage-state))
(define (make-stage scene)
"Create a new stage object for SCENE."
(%make-stage (make-agenda) scene (init-scene scene)))
;;;
;;; Scene callbacks
;;;
(define (enter-stage stage)
"Call the scene enter callback for STAGE."
(with-agenda (stage-agenda stage)
(enter-scene (stage-scene stage)
(stage-state stage))))
(define (exit-stage stage)
"Call the scene exit callback for STAGE."
(with-agenda (stage-agenda stage)
(exit-scene (stage-scene stage)
(stage-state stage))))
(define (update-stage stage)
"Call the scene update callback for STAGE."
(with-agenda (stage-agenda stage)
(update-agenda)
(update-scene (stage-scene stage)
(stage-state stage))))
(define (draw-stage stage)
"Call the scene draw callback for STAGE."
(with-agenda (stage-agenda stage)
(draw-scene (stage-scene stage)
(stage-state stage))))
(define (stage-trigger stage event . args)
(with-agenda (stage-agenda stage)
(apply scene-trigger
(stage-scene stage)
(stage-state stage)
event
args)))
;;;
;;; Stage management
;;;
(define stack '())
(define (current-stage)
"Return the top of the stage stack or #f if the stack is empty."
(if (null? stack) #f (car stack)))
(define (push-scene scene)
"Make STAGE active and push it to the top of the stack."
(let ((prev-stage (current-stage))
(stage (make-stage scene)))
(when prev-stage
(exit-stage prev-stage))
(set! stack (cons stage stack))
(enter-stage stage)))
(define (pop-scene)
"Replace the current stage with the next one on the stack, if
present."
(let ((prev-stage (current-stage)))
(when prev-stage
(exit-stage prev-stage))
(set! stack (cdr stack))
(when (current-stage)
(enter-stage (current-stage)))))
(define (replace-scene scene)
"Replace the current stage with STAGE."
(let ((prev-stage (current-stage))
(stage (make-stage scene)))
(when prev-stage
(exit-stage prev-stage))
(set! stack (cons stage (cdr stack)))
(enter-stage stage)))
|
