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