blob: 8dc73866b815dd43ef307c057aaf38c17a4a79e0 (
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
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
|
;;; 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-env
stage-scene
init-stage
enter-stage
exit-stage
draw-stage
update-stage
stage-trigger
stage-define
stage-ref
stage-set!
current-stage
push-stage
pop-stage
replace-stage))
(define-record-type <stage>
(%make-stage agenda env scene)
stage?
(agenda stage-agenda)
(env stage-env)
(scene stage-scene))
(define (make-stage scene)
"Create a new stage object for SCENE."
(%make-stage (make-agenda) (make-hash-table) scene))
;;;
;;; Scene callbacks
;;;
(define (init-stage stage)
"Call the scene init callback for STAGE."
((scene-init (stage-scene stage))))
(define (enter-stage stage)
"Call the scene enter callback for STAGE."
((scene-enter (stage-scene stage))))
(define (exit-stage stage)
"Call the scene exit callback for STAGE."
((scene-exit (stage-scene stage))))
(define (update-stage stage)
"Call the scene update callback for STAGE."
((scene-update (stage-scene stage))))
(define (draw-stage stage)
"Call the scene draw callback for STAGE."
((scene-draw (stage-scene stage))))
(define (stage-trigger stage event . args)
#f)
;;;
;;; Stage environment
;;;
(define (%stage-define stage key value)
"Define a new variable on STAGE with the specified symbolic name KEY
and arbitrary VALUE. An error is thrown when there is already a value
associated with KEY."
(let ((env (stage-env stage)))
(if (hash-get-handle env key)
(error 'stage-already-defined-variable key)
(hash-set! env key value))))
(define (%stage-ref stage key)
"Return the value stored in STAGE associated with KEY. An error is
thrown if there is no value associated with KEY."
(let ((handle (hash-get-handle (stage-env stage) key)))
(if handle
(cdr handle)
(error 'stage-unbound-variable key))))
(define (%stage-set! stage key value)
"Associate KEY with VALUE in the STAGE environment. An error is
thrown if there is no value associated with KEY."
(let ((handle (hash-get-handle (stage-env stage) key)))
(if handle
(set-cdr! handle value)
(error 'stage-unbound-variable key))))
(define-syntax-rule (stage-define key value)
"Define the variable KEY with VALUE in the current stage
environment."
(%stage-define (current-stage) 'key value))
(define-syntax-rule (stage-ref key)
"Return the value bound to KEY in the current stage environment."
(%stage-ref (current-stage) 'key))
(define-syntax-rule (stage-set! key value)
"Assign VALUE to the variable bound to KEY in the current stage
environment."
(%stage-set! (current-stage) 'key value))
;;;
;;; 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-stage stage)
"Make STAGE active and push it to the top of the stack."
(let ((prev-stage (current-stage)))
(when prev-stage
(exit-stage prev-stage))
(set! stack (cons stage stack))
(init-stage stage)
(enter-stage stage)))
(define (pop-stage)
"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 (car stack)))))
(define (replace-stage stage)
"Replace the current stage with STAGE."
(let ((prev-stage (current-stage)))
(when prev-stage
(exit-stage prev-stage))
(set! stack (cons stage (cdr stack)))
(init-stage stage)
(enter-stage stage)))
|
