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