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