]> git.jsancho.org Git - gacela.git/blob - src/gacela.scm
d5a7c6e6b2957b10f962aa9d116fc4591aa240cd
[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 (define-module (gacela gacela)
19   #:use-module (gacela events)
20   #:use-module (gacela video)
21   #:use-module (gacela audio)
22   #:use-module (ice-9 optargs)
23   #:export (load-texture
24             load-font)
25   #:re-export (get-current-color
26                set-current-color
27                with-color
28                progn-textures
29                draw
30                draw-texture
31                draw-line
32                draw-quad
33                draw-rectangle
34                draw-square
35                draw-cube
36                translate
37                rotate
38                to-origin
39                add-light
40                set-camera
41                camera-look
42                render-text
43                init-video
44                quit-video))
45
46
47 ;;; Default values for Gacela
48
49 (define *title* "Gacela")
50 (define *width-screen* 640)
51 (define *height-screen* 480)
52 (define *bpp-screen* 32)
53 (define *frames-per-second* 20)
54 (define *mode* '2d)
55
56
57 ;;; Resources Cache
58
59 (define resources-cache (make-weak-value-hash-table))
60
61 (define from-cache #f)
62 (define into-cache #f)
63
64 (let ()
65   (set! from-cache
66         (lambda (key)
67           (hash-ref resources-cache key)))
68
69   (set! into-cache
70         (lambda (key res)
71           (hash-set! resources-cache key res))))
72
73 (define-macro (use-cache-with module proc)
74   (let* ((pwc (string->symbol (string-concatenate (list (symbol->string proc) "-without-cache")))))
75     `(begin
76        (define ,pwc (@ ,module ,proc))
77        (define (,proc . param)
78          (let* ((key param)
79                 (res (from-cache key)))
80            (cond (res
81                   res)
82                  (else
83                   (set! res (apply ,pwc param))
84                   (into-cache key res)
85                   res)))))))
86
87 (use-cache-with (gacela video) load-texture)
88 (use-cache-with (gacela video) load-font)
89
90
91 ;;; GaCeLa Functions
92
93 (define set-game-properties! #f)
94 (define get-game-properties #f)
95
96 (let ((ptitle *title*) (pwidth *width-screen*) (pheight *height-screen*) (pbpp *bpp-screen*) (pfps *frames-per-second*) (pmode *mode*))
97   (set! set-game-properties!
98         (lambda* (#:key title width height bpp fps mode)
99 ;         (init-video-mode)
100           (if title
101               (begin
102                 (set! ptitle title)
103                 (if (video-mode-on?) (SDL_WM_SetCaption title ""))))
104           (if (or width height bpp)
105               (begin
106                 (if width (set! pwidth width))
107                 (if height (set! pheight height))
108                 (if bpp (set! pbpp bpp))
109                 (if (video-mode-on?) (resize-screen pwidth pheight pbpp))))
110           (if fps
111               (begin
112                 (set! pfps fps)
113                 (set-frames-per-second fps)))
114           (if mode
115               (begin
116                 (set! pmode mode)
117                 (if (video-mode-on?)
118                     (if (eq? mode '3d) (set-3d-mode) (set-2d-mode)))))
119           (get-game-properties)))
120
121   (set! get-game-properties
122         (lambda ()
123           `((title . ,ptitle) (width . ,pwidth) (height . ,pheight) (bpp . ,pbpp) (fps . ,pfps) (mode . ,pmode)))))
124
125
126 (define-macro (run-game . code)
127   `(let ((game-function ,(if (null? code)
128                              `(lambda () #f)
129                              `(lambda () ,@code))))
130      (init-video-mode)
131      (set-game-code game-function)
132      (cond ((not (game-running?))
133             (game-loop)))))
134
135 (define game-loop #f)
136 (define game-running? #f)
137 (define set-game-code #f)
138
139 (let ((running #f) (game-code #f))
140   (set! game-loop
141         (lambda ()
142           (refresh-active-mobs)
143           (set! running #t)
144           (quit! #f)
145           (do () ((quit?))
146             (init-frame-time)
147             (check-connections)
148             (eval-from-clients)
149             (process-events)
150             (cond ((not (quit?))
151                    (cond ((video-mode-on?)
152                           (glClear (+ GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT))
153                           (to-origin)))
154                    (refresh-active-mobs)
155                    (if (procedure? game-code)
156                        (catch #t
157                               (lambda () (game-code))
158                               (lambda (key . args) #f)))
159                    (cond ((video-mode-on?)
160                           (run-mobs)
161                           (SDL_GL_SwapBuffers)))
162                    (delay-frame))))
163           (set! running #f)))
164
165   (set! game-running?
166         (lambda ()
167           running))
168
169   (set! set-game-code
170         (lambda (game-function)
171           (set! game-code game-function))))