blob: 3182d04ac339da18e5513633fea1c716eb25c650 (
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
|
;;; 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 loop.
;;
;;; Code:
(define-module (2d game-loop)
#:use-module ((sdl sdl) #:prefix SDL:)
#:use-module (figl gl)
#:export (set-render-callback
set-update-callback
set-key-up-callback
set-key-down-callback
run-game-loop))
(define target-fps 60)
;;;
;;; Callbacks
;;;
(define render-callback (lambda () #t))
(define update-callback (lambda () #t))
(define key-up-callback (lambda (key) #t))
(define key-down-callback (lambda (key) #t))
(define (set-render-callback callback)
"Sets the render callback procedure."
(set! render-callback callback))
(define (set-update-callback callback)
"Sets the update callback procedure."
(set! update-callback callback))
(define (set-key-up-callback callback)
"Sets the key up callback procedure."
(set! key-up-callback callback))
(define (set-key-down-callback callback)
"Sets the key down callback procedure."
(set! key-down-callback callback))
;;;
;;; Event Handling
;;;
(define handle-events
(let ((e (SDL:make-event)))
(lambda ()
"Handles all events in the SDL event queue."
(while (SDL:poll-event e)
(handle-event e)))))
(define (handle-event e)
"Calls the relevant callback for the event."
(case (SDL:event:type e)
((SDL_KEYDOWN)
(key-down-callback (SDL:event:key:keysym:sym e)))
((SDL_KEYUP)
(key-up-callback (SDL:event:key:keysym:sym e)))))
;;;
;;; Update and Render
;;;
(define (render)
"Renders a frame."
(set-gl-matrix-mode (matrix-mode modelview))
(gl-load-identity)
(gl-clear (clear-buffer-mask color-buffer depth-buffer))
(render-callback)
(SDL:gl-swap-buffers))
(define accumulate-fps
(let ((last-time (SDL:get-ticks))
(fps 0))
(lambda ()
"Calculates frames per second."
(let ((time (SDL:get-ticks)))
(set! fps (1+ fps))
(when (>= time (+ last-time 1000))
(pk 'FPS fps)
(set! last-time time)
(set! fps 0))))))
(define update-and-render
(let ((last-update (SDL:get-ticks))
(update-interval (/ 1000 target-fps)))
(lambda ()
"Calls update and draw callback when enough time has passed since
the last tick."
(let ((time (SDL:get-ticks)))
(when (>= time (+ last-update update-interval))
(set! last-update time)
(update-callback)
(accumulate-fps)
(render))))))
;;;
;;; Game Loop
;;;
(define (run-game-loop)
"Runs event handling, update, and render loop."
(while #t
(handle-events)
(update-and-render)))
|
