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