]> git.jsancho.org Git - gacela.git/blob - src/gacela.scm
a45337a1ad41cd14d92660981ce632faa47b3a70
[gacela.git] / src / gacela.scm
1 ;;; Gacela, a GNU Guile extension for fast games development
2 ;;; Copyright (C) 2009 by Javier Sancho Fernandez <jsf at jsancho dot org>
3 ;;;
4 ;;; This program is free software: you can redistribute it and/or modify
5 ;;; it under the terms of the GNU General Public License as published by
6 ;;; the Free Software Foundation, either version 3 of the License, or
7 ;;; (at your option) any later version.
8 ;;;
9 ;;; This program is distributed in the hope that it will be useful,
10 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
11 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12 ;;; GNU General Public License for more details.
13 ;;;
14 ;;; You should have received a copy of the GNU General Public License
15 ;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
16
17
18 ;;; Default values for Gacela
19
20 (define *title* "Gacela")
21 (define *width-screen* 640)
22 (define *height-screen* 480)
23 (define *bpp-screen* 32)
24 (define *frames-per-second* 20)
25 (define *mode* '2d)
26
27
28 ;;; Resources Cache
29
30 (define resources-cache (make-weak-value-hash-table))
31
32 (define from-cache #f)
33 (define into-cache #f)
34
35 (let ()
36   (set! from-cache
37         (lambda (key)
38           (hash-ref resources-cache key)))
39
40   (set! into-cache
41         (lambda (key res)
42           (hash-set! resources-cache key res))))
43
44
45 ;;; GaCeLa Functions
46
47 (define set-frames-per-second #f)
48 (define init-frame-time #f)
49 (define get-frame-time #f)
50 (define delay-frame #f)
51
52 (let ((time 0) (time-per-frame (/ 1000.0 *frames-per-second*)))
53   (set! set-frames-per-second
54         (lambda (fps)
55           (set! time-per-frame (/ 1000.0 fps))))
56
57   (set! init-frame-time
58         (lambda ()
59           (set! time (SDL_GetTicks))))
60
61   (set! get-frame-time
62         (lambda ()
63           time))
64
65   (set! delay-frame
66         (lambda ()
67           (let ((frame-time (- (SDL_GetTicks) time)))
68             (cond ((< frame-time time-per-frame)
69                    (SDL_Delay (- time-per-frame frame-time))))))))
70
71
72 (define set-game-properties! #f)
73 (define get-game-properties #f)
74
75 (let ((ptitle *title*) (pwidth *width-screen*) (pheight *height-screen*) (pbpp *bpp-screen*) (pfps *frames-per-second*) (pmode *mode*))
76   (set! set-game-properties!
77         (lambda* (#:key title width height bpp fps mode)
78 ;         (init-video-mode)
79           (if title
80               (begin
81                 (set! ptitle title)
82                 (if (video-mode-on?) (SDL_WM_SetCaption title ""))))
83           (if (or width height bpp)
84               (begin
85                 (if width (set! pwidth width))
86                 (if height (set! pheight height))
87                 (if bpp (set! pbpp bpp))
88                 (if (video-mode-on?) (resize-screen pwidth pheight pbpp))))
89           (if fps
90               (begin
91                 (set! pfps fps)
92                 (set-frames-per-second fps)))
93           (if mode
94               (begin
95                 (set! pmode mode)
96                 (if (video-mode-on?)
97                     (if (eq? mode '3d) (set-3d-mode) (set-2d-mode)))))
98           (get-game-properties)))
99
100   (set! get-game-properties
101         (lambda ()
102           `((title . ,ptitle) (width . ,pwidth) (height . ,pheight) (bpp . ,pbpp) (fps . ,pfps) (mode . ,pmode)))))
103
104
105 (define-macro (run-game . code)
106   `(let ((game-function ,(if (null? code)
107                              `(lambda () #f)
108                              `(lambda () ,@code))))
109      (init-video-mode)
110      (set-game-code game-function)
111      (cond ((not (game-running?))
112             (game-loop)))))
113
114 (define game-loop #f)
115 (define game-running? #f)
116 (define set-game-code #f)
117
118 (let ((running #f) (game-code #f))
119   (set! game-loop
120         (lambda ()
121           (refresh-active-mobs)
122           (set! running #t)
123           (quit! #f)
124           (do () ((quit?))
125             (init-frame-time)
126             (check-connections)
127             (eval-from-clients)
128             (process-events)
129             (cond ((not (quit?))
130                    (cond ((video-mode-on?)
131                           (glClear (+ GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
132                           (to-origin)))
133                    (refresh-active-mobs)
134                    (if (procedure? game-code)
135                        (catch #t
136                               (lambda () (game-code))
137                               (lambda (key . args) #f)))
138                    (cond ((video-mode-on?)
139                           (run-mobs)
140                           (SDL_GL_SwapBuffers)))
141                    (delay-frame))))
142           (set! running #f)))
143
144   (set! game-running?
145         (lambda ()
146           running))
147
148   (set! set-game-code
149         (lambda (game-function)
150           (set! game-code game-function))))