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
38 #:export-syntax (game)
39 #:re-export (get-current-color
61 (define resources-cache (make-weak-value-hash-table))
63 (define (from-cache key)
64 (hash-ref resources-cache key))
66 (define (into-cache key res)
67 (hash-set! resources-cache key res))
69 (define-macro (use-cache-with module proc)
70 (let* ((pwc (string->symbol (string-concatenate (list (symbol->string proc) "-without-cache")))))
72 (define ,pwc (@ ,module ,proc))
73 (define (,proc . param)
75 (res (from-cache key)))
79 (set! res (apply ,pwc param))
83 (use-cache-with (gacela video) load-texture)
84 (use-cache-with (gacela video) load-font)
89 (define *title* "Gacela")
90 (define *width-screen* 640)
91 (define *height-screen* 480)
92 (define *bpp-screen* 32)
93 (define *frames-per-second* 20)
96 (define* (set-game-properties! #:key title width height bpp fps mode)
98 (set-screen-title! title))
100 (set-screen-bpp! bpp))
101 (if (or width height)
103 (if (not width) (set! width (get-screen-width)))
104 (if (not height) (set! height (get-screen-height)))
105 (resize-screen width height)))
107 (set-frames-per-second! fps))
109 (if (eq? mode '3d) (set-3d-mode) (set-2d-mode)))
110 (get-game-properties))
112 (define (get-game-properties)
113 `((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))))
118 (define loop-flag #f)
119 (define game-code #f)
121 (define-macro (game . code)
122 `(let ((game-function ,(if (null? code)
124 `(lambda () ,@code))))
125 (set-game-code game-function)
126 (cond ((not (game-running?))
129 (define (init-gacela)
130 (call-with-new-thread (lambda () (game))))
132 (define (quit-gacela)
136 ; (refresh-active-mobs)
138 (init-video *width-screen* *height-screen* *bpp-screen* #:title *title* #:mode *mode* #:fps *frames-per-second*)
141 ; (check-connections)
143 (cond ((quit-signal?)
148 ; (refresh-active-mobs)
149 (if (procedure? game-code)
151 (lambda () (game-code))
152 (lambda (key . args) #f)))
158 (define (game-running?)
161 (define (set-game-code game-function)
162 (set! game-code game-function))