]> git.jsancho.org Git - gacela.git/blob - src/gacela.scm
Game properties.
[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             set-game-properties!
26             get-game-properties
27             init-gacela
28             quit-gacela
29             game-loop
30             game-running?
31             set-game-code)
32   #:export-syntax (game)
33   #:re-export (get-current-color
34                set-current-color
35                with-color
36                progn-textures
37                draw
38                draw-texture
39                draw-line
40                draw-quad
41                draw-rectangle
42                draw-square
43                draw-cube
44                translate
45                rotate
46                to-origin
47                add-light
48                set-camera
49                camera-look
50                render-text))
51
52
53 ;;; Resources Cache
54
55 (define resources-cache (make-weak-value-hash-table))
56
57 (define (from-cache key)
58   (hash-ref resources-cache key))
59
60 (define (into-cache key res)
61   (hash-set! resources-cache key res))
62
63 (define-macro (use-cache-with module proc)
64   (let* ((pwc (string->symbol (string-concatenate (list (symbol->string proc) "-without-cache")))))
65     `(begin
66        (define ,pwc (@ ,module ,proc))
67        (define (,proc . param)
68          (let* ((key param)
69                 (res (from-cache key)))
70            (cond (res
71                   res)
72                  (else
73                   (set! res (apply ,pwc param))
74                   (into-cache key res)
75                   res)))))))
76
77 (use-cache-with (gacela video) load-texture)
78 (use-cache-with (gacela video) load-font)
79
80
81 ;;; Game Properties
82
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)
88 (define mode '2d)
89
90 (define* (set-game-properties! #:key title width height bpp fps mode)
91   (if title
92       (set-screen-title! title))
93   (if bpp
94       (set-screen-bpp! bpp))
95   (if (or width height)
96       (begin
97         (if (not width) (set! width (get-screen-width)))
98         (if (not height) (set! height (get-screen-height)))
99         (resize-screen width height)))
100   (if fps
101       (set-frames-per-second fps))
102   (if mode
103       (if (eq? mode '3d) (set-3d-mode) (set-2d-mode)))
104   (get-game-properties))
105
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)))
108
109
110 ;;; Main Loop
111
112 (define loop-flag #f)
113 (define game-code #f)
114
115 (define-macro (game . code)
116   `(let ((game-function ,(if (null? code)
117                              `(lambda () #f)
118                              `(lambda () ,@code))))
119      (set-game-code game-function)
120      (cond ((not (game-running?))
121             (game-loop)))))
122
123 (define (init-gacela)
124   (call-with-new-thread (lambda () (game))))
125
126 (define (quit-gacela)
127   (set! loop-flag #f))
128
129 (define (game-loop)
130 ;         (refresh-active-mobs)
131   (set! loop-flag #t)
132   (init-video 640 480 32)
133   (while loop-flag
134          (init-frame-time)
135 ;           (check-connections)
136          (process-events)
137          (cond ((not (quit?))
138                 (clear-screen)
139                 (to-origin)
140 ;                  (refresh-active-mobs)
141                 (if (procedure? game-code)
142                     (catch #t
143                            (lambda () (game-code))
144                            (lambda (key . args) #f)))
145 ;                         (run-mobs)
146                 (flip-screen)
147                 (delay-frame))))
148   (quit-video))
149
150 (define (game-running?)
151   loop-flag)
152
153 (define (set-game-code game-function)
154   (set! game-code game-function))