1 ;;; Gacela, a GNU Guile extension for fast games development
2 ;;; Copyright (C) 2009 by Javier Sancho Fernandez <jsf at jsancho dot org>
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.
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.
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/>.
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
47 #:re-export (get-current-color
70 (define resources-cache (make-weak-value-hash-table))
72 (define (from-cache key)
73 (hash-ref resources-cache key))
75 (define (into-cache key res)
76 (hash-set! resources-cache key res))
78 (define-macro (use-cache-with module proc)
79 (let* ((pwc (string->symbol (string-concatenate (list (symbol->string proc) "-without-cache")))))
81 (define ,pwc (@ ,module ,proc))
82 (define (,proc . param)
84 (res (from-cache key)))
88 (set! res (apply ,pwc param))
92 (use-cache-with (gacela video) load-texture)
93 (use-cache-with (gacela video) load-font)
100 (define game-loop-thread #f)
102 (define-macro (game . code)
103 `(let ((game-function ,(if (null? code)
105 `(lambda () ,@code))))
106 (set-game-code game-function)
107 (cond ((not (game-running?))
110 (define-macro (run-in-game-loop . code)
111 `(if game-loop-thread
112 (system-async-mark (lambda () ,@code) game-loop-thread)
115 (define (init-gacela)
116 (set! game-loop-thread (call-with-new-thread (lambda () (game)))))
118 (define (quit-gacela)
119 (set! game-loop-thread #f)
123 (refresh-active-mobs)
125 (init-video *width-screen* *height-screen* *bpp-screen* #:title *title* #:mode *mode* #:fps *frames-per-second*)
128 ; (check-connections)
130 (cond ((quit-signal?)
135 (refresh-active-mobs)
136 (if (procedure? game-code)
138 (lambda () (game-code))
139 (lambda (key . args) #f)))
145 (define (game-running?)
148 (define (set-game-code game-function)
149 (set! game-code game-function))
154 (define *title* "Gacela")
155 (define *width-screen* 640)
156 (define *height-screen* 480)
157 (define *bpp-screen* 32)
158 (define *frames-per-second* 20)
161 (define* (set-game-properties! #:key title width height bpp fps mode)
163 (set-screen-title! title))
165 (run-in-game-loop (set-screen-bpp! bpp)))
166 (if (or width height)
168 (if (not width) (set! width (get-screen-width)))
169 (if (not height) (set! height (get-screen-height)))
170 (run-in-game-loop (resize-screen width height))))
172 (set-frames-per-second! fps))
174 (if (eq? mode '3d) (set-3d-mode) (set-2d-mode))))
176 (define (get-game-properties)
177 `((title . ,(get-screen-title)) (width . ,(get-screen-width)) (height . ,(get-screen-height)) (bpp . ,(get-screen-bpp)) (fps . ,(get-frames-per-second)) (mode . ,(if (3d-mode?) '3d '2d))))
182 (define mobs-table (make-hash-table))
183 (define active-mobs '())
184 (define mobs-changed #f)
186 (define (show-mob-hash mob)
187 (hash-set! mobs-table (mob 'get-mob-id) mob)
188 (set! mobs-changed #t))
190 (define (hide-mob-hash mob-id)
191 (hash-remove! mobs-table mob-id)
192 (set! mobs-changed #t))
194 (define (refresh-active-mobs)
196 (set! mobs-changed #f)
197 (set! active-mobs (hash-map->list (lambda (k v) v) mobs-table)))))
199 (define (get-active-mobs)
202 (define (hide-all-mobs)
203 (set! mobs-changed #t)
204 (hash-clear! mobs-table))
206 (define (mobs-changed?)
210 (define-macro (show-mob mob)
215 `(show-mob-hash (lambda* (#:optional (option #f)) (,mob option))))))
217 (define-macro (hide-mob mob)
220 (hide-mob-hash (m 'get-mob-id))))
222 `(hide-mob-hash (,mob 'get-mob-id)))))
224 (define* (run-mobs #:optional (mobs (get-active-mobs)))
227 (glmatrix-block (m)))
233 (define-macro (the-mob type attr publish . body)
234 (let ((mob-id-symbol (gensym))
235 (type-symbol (gensym))
236 (time-symbol (gensym))
237 (data-symbol (gensym)))
238 `(let ((,mob-id-symbol (gensym))
243 (lambda* (#:optional (option #f))
245 (hide-mob-hash ,mob-id-symbol))
247 (let ((time (get-frame-time)))
248 (cond ((not (= time ,time-symbol))
249 (set! ,time-symbol time)
250 (set! ,data-symbol ,(cons 'list (map (lambda (x) `(cons ',(car x) ,(car x))) publish)))))))
253 (define (filter-mobs type fun)
255 (define (map-mobs fun type)
256 (let ((mobs (filter (lambda (m) (and (eq? (m 'get-type) type) (not (eq? (m 'get-mob-id) ,mob-id-symbol)))) (get-active-mobs))))
257 (map (lambda (m) (fun (m 'get-data))) mobs)))
270 (lambda (key . args) #f))))))))
272 (define-macro (define-mob mob-head . body)
273 (let ((name (car mob-head)) (attr (cdr mob-head)))
274 `(define ,(string->symbol (string-concatenate (list "make-" (symbol->string name))))
275 (lambda* ,(if (null? attr) '() `(#:key ,@attr))
276 (the-mob ',name () ,attr ,@body)))))
278 (define-macro (lambda-mob attr . body)
279 `(the-mob 'undefined ,attr '() ,@body))
284 ;; (define-macro (lambda-mob-data attr . body)
285 ;; `(lambda ,attr ,@body))
287 ;; (define-macro (define-collision-check name mobs . body)
288 ;; `(defmacro* ,name (#:optional m)
289 ;; `(let ,(cond (m `((mob-id (,m 'get-mob-id)) (mob-type (,m 'get-type))))