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))