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
32 #:export-syntax (game)
33 #:re-export (get-current-color
55 (define resources-cache (make-weak-value-hash-table))
57 (define (from-cache key)
58 (hash-ref resources-cache key))
60 (define (into-cache key res)
61 (hash-set! resources-cache key res))
63 (define-macro (use-cache-with module proc)
64 (let* ((pwc (string->symbol (string-concatenate (list (symbol->string proc) "-without-cache")))))
66 (define ,pwc (@ ,module ,proc))
67 (define (,proc . param)
69 (res (from-cache key)))
73 (set! res (apply ,pwc param))
77 (use-cache-with (gacela video) load-texture)
78 (use-cache-with (gacela video) load-font)
83 (define title "Gacela")
84 (define width-screen 640)
85 (define height-screen 480)
86 (define bpp-screen 32)
87 (define frames-per-second 20)
90 (define* (set-game-properties! #:key title width height bpp fps mode)
92 (set-screen-title! title))
94 (set-screen-bpp! bpp))
97 (if (not width) (set! width (get-screen-width)))
98 (if (not height) (set! height (get-screen-height)))
99 (resize-screen width height)))
101 (set-frames-per-second fps))
103 (if (eq? mode '3d) (set-3d-mode) (set-2d-mode)))
104 (get-game-properties))
106 (define (get-game-properties)
107 `((title . ,(get-screen-title)) (width . ,(get-screen-width)) (height . ,(get-screen-height)) (bpp . ,(get-screen-bpp)) (fps . ,pfps) (mode . ,pmode)))
112 (define loop-flag #f)
113 (define game-code #f)
115 (define-macro (game . code)
116 `(let ((game-function ,(if (null? code)
118 `(lambda () ,@code))))
119 (set-game-code game-function)
120 (cond ((not (game-running?))
123 (define (init-gacela)
124 (call-with-new-thread (lambda () (game))))
126 (define (quit-gacela)
130 ; (refresh-active-mobs)
132 (init-video 640 480 32)
135 ; (check-connections)
140 ; (refresh-active-mobs)
141 (if (procedure? game-code)
143 (lambda () (game-code))
144 (lambda (key . args) #f)))
150 (define (game-running?)
153 (define (set-game-code game-function)
154 (set! game-code game-function))