blob: 14543e8cf3066550aa300912bfec234761db9f98 (
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
|
;;; guile-2d
;;; 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:
;;
;; Game data structure.
;;
;;; Code:
(define-module (2d game)
#:use-module (srfi srfi-9)
#:use-module ((sdl sdl) #:prefix SDL:)
#:use-module (gl)
#:use-module (2d agenda)
#:use-module (2d event)
#:use-module (2d signal)
#:use-module (2d window)
#:export (ticks-per-second
tick-interval
game-agenda
draw-hook
run-game-loop
quit-game))
;;;
;;; Game Loop
;;;
(define ticks-per-second 60)
(define tick-interval (make-parameter 0))
(define draw-hook (make-hook 2))
(define game-agenda (make-agenda))
(define (run-game-loop)
"Start the game loop."
(parameterize ((tick-interval (floor (/ 1000 ticks-per-second))))
(call-with-prompt
'game-loop-prompt
(lambda ()
(game-loop (SDL:get-ticks) 0))
(lambda (cont callback)
(when (procedure? callback)
(callback cont))))))
(define (draw dt alpha)
"Render a frame."
(let ((width (signal-ref window-width))
(height (signal-ref window-height)))
(gl-viewport 0 0 width height))
(gl-clear (clear-buffer-mask color-buffer depth-buffer))
(run-hook draw-hook dt alpha)
(SDL:gl-swap-buffers))
(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."
(if (>= lag (tick-interval))
(begin
(tick-agenda! game-agenda)
(update (- lag (tick-interval))))
lag))
(define (alpha lag)
"Calculate interpolation factor in the range [0, 1] for the
leftover frame time LAG."
(/ lag (tick-interval)))
(define (frame-sleep time)
"Sleep for the remainder of the frame that started at TIME."
(let ((t (- (+ time (tick-interval))
(SDL:get-ticks))))
(usleep (max 0 (* t 1000)))))
(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* ((current-time (SDL:get-ticks))
(dt (- current-time previous-time)))
(process-events)
(let ((lag (update (+ lag dt))))
(draw dt (alpha lag))
(frame-sleep current-time)
(game-loop current-time lag))))
(define (quit-game)
(abort-to-prompt 'game-loop-prompt #f))
|
