gacela/game.scm

   1 ;;; Gacela, a GNU Guile extension for fast games development
   2 ;;; Copyright (C) 2016 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 game)
  19   #:use-module (gacela math)
  20   #:use-module (gacela event)
  21   #:use-module ((sdl2) #:prefix sdl2:)
  22   #:use-module ((sdl2 render) #:prefix sdl2:)
  23   #:use-module ((sdl2 surface) #:prefix sdl2:)
  24   #:use-module ((sdl2 video) #:prefix sdl2:)
  25   #:use-module (gl)
  26   #:use-module (srfi srfi-11)
  27   #:export (start-game
  28             stop-game
  29             %sdl-renderer))
  30
  31
  32 ;;; Based on Sly code. Thank you so much!!
  33
  34 (define %root-scene #f)
  35
  36 (define (interval rate)
  37   (floor (/ 1000 rate)))
  38
  39 (define* (run-game-loop scene #:key
  40                         (frame-rate 60)
  41                         (tick-rate 60)
  42                         (max-ticks-per-frame 4)
  43                         (when-quit #f))
  44   "Run the game loop.  SCENE is a signal which contains the current
  45 scene renderer procedure.  FRAME-RATE specifies the optimal number of
  46 frames to draw SCENE per second.  TICK-RATE specifies the optimal game
  47 logic updates per second.  Both FRAME-RATE and TICK-RATE are 60 by
  48 default.  MAX-TICKS-PER-FRAME is the maximum number of times the game
  49 loop will update game state in a single frame.  When this upper bound
  50 is reached due to poor performance, the game will start to slow down
  51 instead of becoming completely unresponsive and possibly crashing."
  52
  53   (let ((tick-interval  (interval tick-rate))
  54         (frame-interval (interval frame-rate)))
  55
  56     (define (draw dt alpha)
  57       "Render a frame."
  58       (let ((size (sdl2:window-size %sdl-window)))
  59         (resize-window (car size) (cadr size)))
  60       (if %root-scene
  61           (%root-scene))
  62       ;;(run-hook draw-hook dt alpha)
  63       ;(with-graphics gfx
  64         ;(set-graphics-alpha! gfx alpha)
  65         ;((signal-ref scene) gfx)
  66 ;       )
  67       (sdl2:swap-gl-window %sdl-window))
  68
  69     (define (update lag)
  70       "Call the update callback. The update callback will be called as
  71 many times as tick-interval can divide LAG. The return value is the
  72 unused accumulator time."
  73       (define (iter lag ticks)
  74         (cond ((>= ticks max-ticks-per-frame)
  75                lag)
  76               ((>= lag tick-interval)
  77                (process-events)
  78                (if (and (quit-event?) (procedure? when-quit))
  79                    (when-quit))
  80                                         ;(agenda-tick!)
  81                (iter (- lag tick-interval) (1+ ticks)))
  82               (else
  83                lag)))
  84       (clear-events)
  85       (iter lag 0))
  86
  87     (define (alpha lag)
  88       "Calculate interpolation factor in the range [0, 1] for the
  89 leftover frame time LAG."
  90       (clamp 0 1 (/ lag tick-interval)))
  91
  92     (define (frame-sleep time)
  93       "Sleep for the remainder of the frame that started at TIME."
  94       (let ((t (- (+ time frame-interval)
  95                   (sdl2:sdl-ticks))))
  96         (usleep (max 0 (* t 1000)))))
  97
  98     (define (process-frame previous-time lag)
  99       "Render and/or update the game as needed, integrating from the
 100 PREVIOUS-TIME to the current time, and updating using a game tick
 101 accumulator initialized to LAG.  Returns a timestamp to be used as the
 102 starting point of the next delta time calculation and the leftover
 103 time in the game tick accumulator."
 104       (let* ((current-time (sdl2:sdl-ticks))
 105              (dt (- current-time previous-time))
 106              (lag (update (+ lag dt))))
 107         (draw dt (alpha lag))
 108         (frame-sleep current-time)
 109         (values current-time lag)))
 110
 111     (define (game-loop previous-time lag)
 112       "Update game state, and render.  PREVIOUS-TIME is the time in
 113 milliseconds of the last iteration of the game loop."
 114       (let-values (((time lag)
 115                     (process-frame previous-time lag)))
 116         (game-loop time lag)))
 117
 118     (call-with-prompt
 119         'game-loop-prompt
 120       (lambda ()
 121         ;; Catch SIGINT and kill the loop
 122         (sigaction SIGINT
 123           (lambda (signum)
 124             (stop-game-loop)))
 125         (set! %root-scene scene)
 126         (game-loop (sdl2:sdl-ticks) 0))
 127       (lambda (cont callback)
 128         (when (procedure? callback)
 129           (callback cont))))))
 130
 131 (define (stop-game-loop)
 132   "Abort the game loop"
 133   (abort-to-prompt 'game-loop-prompt #f))
 134
 135 (define %sdl-window #f)
 136 (define %sdl-renderer #f)
 137 (define %gl-context #f)
 138
 139 (define (init-window)
 140   (sdl2:sdl-init)
 141   (sdl2:set-gl-attribute! 'context-major-version 3)
 142   (sdl2:set-gl-attribute! 'context-minor-version 2)
 143   (sdl2:set-gl-attribute! 'double-buffer 1)
 144   (sdl2:set-gl-attribute! 'depth-size 24)
 145   (set! %sdl-window (sdl2:make-window #:opengl? #t #:show? #t))
 146   (set! %sdl-renderer (sdl2:make-renderer %sdl-window))
 147   (set! %gl-context (sdl2:make-gl-context %sdl-window))
 148   (sdl2:set-gl-swap-interval! 'vsync)
 149   (init-gl))
 150
 151 (define (init-gl)
 152   (set-gl-matrix-mode (matrix-mode projection))
 153   (gl-load-identity)
 154   (set-gl-matrix-mode (matrix-mode modelview))
 155   (gl-load-identity)
 156   (set-gl-clear-color 0 0 0 1))
 157
 158 (define (open-window title resolution fullscreen?)
 159   (sdl2:set-window-title! %sdl-window title)
 160   (sdl2:set-window-size! %sdl-window resolution)
 161   (sdl2:set-window-fullscreen! %sdl-window fullscreen?)
 162   (sdl2:show-window! %sdl-window))
 163
 164 (define (close-window)
 165   (sdl2:hide-window! %sdl-window)
 166   (sdl2:sdl-quit))
 167
 168 (define (resize-window width height)
 169   (gl-viewport 0 0 width height)
 170   (set-gl-matrix-mode (matrix-mode projection))
 171   (gl-load-identity)
 172   (let ((w (/ width 2))
 173         (h (/ height 2)))
 174     (gl-ortho (- w) w (- h) h 0 1))
 175   (set-gl-matrix-mode (matrix-mode modelview))
 176   (gl-clear (clear-buffer-mask color-buffer depth-buffer))
 177   (gl-load-identity))
 178
 179 (define* (start-game scene #:key
 180                     (title "Untitled")
 181                     (resolution '(640 480))
 182                     (fullscreen? #f)
 183                     (when-quit (lambda () (stop-game))))
 184   (init-window)
 185   (open-window title resolution fullscreen?)
 186   (run-game-loop scene #:when-quit when-quit)
 187   (close-window))
 188
 189 (define (stop-game)
 190   (stop-game-loop))