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
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
|
;;; Sly
;;; Copyright (C) 2013, 2014 David Thompson <dthompson2@worcester.edu>
;;;
;;; This program is free software: you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License as
;;; published by the Free Software Foundation, either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; This program 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
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program. If not, see
;;; <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; The game loop.
;;
;;; Code:
(define-module (sly game)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (sdl2)
#:use-module ((sdl2 video) #:prefix sdl2:)
#:use-module (gl)
#:use-module (sly agenda)
#:use-module (sly event)
#:use-module (sly guardian)
#:use-module (sly math)
#:use-module (sly signal)
#:use-module (sly math vector)
#:use-module (sly window)
#:use-module (sly render)
#:use-module (sly records)
#:export (game
game?
game-window
game-scene
game-start-hook
draw-hook
after-game-loop-error-hook
game-started?
on-start
run-game-loop
stop-game-loop))
;;;
;;; Game specification
;;;
(define-record-type* <game>
%game game
game?
(window game-window (make-window))
(scene game-scene #f))
;;;
;;; Hooks and initializers
;;;
(define game-start-hook (make-hook))
(define draw-hook (make-hook 2))
(define after-game-loop-error-hook (make-hook))
(define-signal game-started?
(hook->signal game-start-hook #f (lambda () #t)))
(define-syntax on-start
(syntax-rules ()
"Create a signal that evaluates EXP once the game loop has started.
If INIT is specified, the signal uses the result of this expression as
its initial value, otherwise #f is the initial value."
((_ exp)
(signal-if game-started? exp #f))
((_ exp init)
(signal-if game-started? exp init))))
;;;
;;; Game Loop
;;;
(define (interval rate)
(floor (/ 1000 rate)))
(define (display-game-loop-error stack key . args)
"Display a backtrace and error message using the current error port
for the given STACK and error KEY with additional arguments ARGS."
(let ((cep (current-error-port)))
(display "Sly game loop error!\n\n" cep)
(display "Backtrace:\n" cep)
(display-backtrace stack cep)
(newline cep)
(apply display-error (stack-ref stack 0) cep args)
(newline cep)))
(define* (run-game-loop scene #:key
(frame-rate 60)
(tick-rate 60)
(max-ticks-per-frame 4))
"Run the game loop. SCENE is a signal which contains the current
scene renderer procedure. FRAME-RATE specifies the optimal number of
frames to draw SCENE per second. TICK-RATE specifies the optimal game
logic updates per second. Both FRAME-RATE and TICK-RATE are 60 by
default. MAX-TICKS-PER-FRAME is the maximum number of times the game
loop will update game state in a single frame. When this upper bound
is reached due to poor performance, the game will start to slow down
instead of becoming completely unresponsive and possibly crashing."
(let ((tick-interval (interval tick-rate))
(frame-interval (interval frame-rate))
(gfx (make-graphics)))
(define (draw dt alpha)
"Render a frame."
(let ((size (signal-ref window-size)))
(gl-viewport 0 0 (vx size) (vy size)))
(gl-clear (clear-buffer-mask color-buffer depth-buffer))
(run-hook draw-hook dt alpha)
(with-graphics gfx
(set-graphics-alpha! gfx alpha)
((signal-ref scene) gfx))
(swap-window))
(define (update lag)
"Call the update callback. The update callback will be called as
many times as tick-interval can divide LAG. The return value is the
unused accumulator time."
(define (iter lag ticks)
(cond ((>= ticks max-ticks-per-frame)
lag)
((>= lag tick-interval)
(process-events)
(agenda-tick!)
(iter (- lag tick-interval) (1+ ticks)))
(else
lag)))
(iter lag 0))
(define (alpha lag)
"Calculate interpolation factor in the range [0, 1] for the
leftover frame time LAG."
(clamp 0 1 (/ lag tick-interval)))
(define (frame-sleep time)
"Sleep for the remainder of the frame that started at TIME."
(let ((t (- (+ time frame-interval)
(sdl-ticks))))
(usleep (max 0 (* t 1000)))))
(define (process-frame previous-time lag)
"Render and/or update the game as needed, integrating from the
PREVIOUS-TIME to the current time, and updating using a game tick
accumulator initialized to LAG. Returns a timestamp to be used as the
starting point of the next delta time calculation and the leftover
time in the game tick accumulator."
(let* ((current-time (sdl-ticks))
(dt (- current-time previous-time)))
(catch #t
(lambda ()
(let ((lag (update (+ lag dt))))
(draw dt (alpha lag))
(frame-sleep current-time)
(values current-time lag)))
(lambda (key . args)
(if (hook-empty? after-game-loop-error-hook)
;; Rethrow error if there's nothing to handle it.
(apply throw key args)
(begin
(run-hook after-game-loop-error-hook)
;; An unknown amount of time has passed since running the
;; hook, so let's start with a fresh timer.
(values (sdl-ticks) 0))))
(lambda (key . args)
;; Strip out 3 stack frames to get to the frame where the
;; error happened. The stripped frames include the throw
;; call, and the make-stack call.
(apply display-game-loop-error (make-stack #t 3) key args)))))
(define (game-loop previous-time lag)
"Update game state, and render. PREVIOUS-TIME is the time in
milliseconds of the last iteration of the game loop."
(let-values (((time lag)
(process-frame previous-time lag)))
(game-loop time lag)))
(call-with-prompt
'game-loop-prompt
(lambda ()
;; Catch SIGINT and kill the loop.
(sigaction SIGINT
(lambda (signum)
(stop-game-loop)))
;; Let's play!
(run-hook game-start-hook)
(run-guardian)
(game-loop (sdl-ticks) 0))
(lambda (cont callback)
(when (procedure? callback)
(callback cont))))))
(define (stop-game-loop)
"Abort the game loop."
(abort-to-prompt 'game-loop-prompt #f))
|
