Primitive game loop with some basic scenes

diff --git a/gacela/game.scm b/gacela/game.scm
new file mode 100644 (file)
index 0000000..0b0981d
--- /dev/null
+++ b/gacela/game.scm
@@ -0,0 +1,148 @@
+;;; Gacela, a GNU Guile extension for fast games development
+;;; Copyright (C) 2016 by Javier Sancho Fernandez <jsf at jsancho dot org>
+;;;
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+
+(define-module (gacela game)
+  #:use-module (gacela math)
+  #:use-module ((sdl2) #:prefix sdl2:)
+  #:use-module ((sdl2 render) #:prefix sdl2:)
+  #:use-module ((sdl2 surface) #:prefix sdl2:)
+  #:use-module ((sdl2 video) #:prefix sdl2:)
+  #:use-module (gl)
+  #:use-module (srfi srfi-11)
+  #:export (run-game-loop))
+
+
+;;; Based on Sly code. Thank you so much!!
+
+(define %root-scene #f)
+
+(define (interval rate)
+  (floor (/ 1000 rate)))
+
+(define* (run-game-loop scene #:key
+                        (frame-rate 60)
+                        (tick-rate 60)
+                        (max-ticks-per-frame 4))
+  "Run the game loop.  SCENE is a signal which contains the current
+scene renderer procedure.  FRAME-RATE specifies the optimal number of
+frames to draw SCENE per second.  TICK-RATE specifies the optimal game
+logic updates per second.  Both FRAME-RATE and TICK-RATE are 60 by
+default.  MAX-TICKS-PER-FRAME is the maximum number of times the game
+loop will update game state in a single frame.  When this upper bound
+is reached due to poor performance, the game will start to slow down
+instead of becoming completely unresponsive and possibly crashing."
+
+  (let ((tick-interval  (interval tick-rate))
+        (frame-interval (interval frame-rate)))
+
+    (define (draw dt alpha)
+      "Render a frame."
+      (let ((size (sdl2:window-size %sdl-window)))
+       (gl-viewport 0 0 (car size) (cadr size)))
+      (gl-clear (clear-buffer-mask color-buffer depth-buffer))
+      (if %root-scene
+         (%root-scene))
+      ;;(run-hook draw-hook dt alpha)
+      ;(with-graphics gfx
+       ;(set-graphics-alpha! gfx alpha)
+       ;((signal-ref scene) gfx)
+;      )
+      (sdl2:swap-gl-window %sdl-window))
+
+    (define (update lag)
+      "Call the update callback. The update callback will be called as
+many times as tick-interval can divide LAG. The return value is the
+unused accumulator time."
+      (define (iter lag ticks)
+       (cond ((>= ticks max-ticks-per-frame)
+              lag)
+             ((>= lag tick-interval)
+                                       ;(process-events)
+                                       ;(agenda-tick!)
+              (iter (- lag tick-interval) (1+ ticks)))
+             (else
+              lag)))
+      (iter lag 0))
+
+    (define (alpha lag)
+      "Calculate interpolation factor in the range [0, 1] for the
+leftover frame time LAG."
+      (clamp 0 1 (/ lag tick-interval)))
+
+    (define (frame-sleep time)
+      "Sleep for the remainder of the frame that started at TIME."
+      (let ((t (- (+ time frame-interval)
+                 (sdl2:sdl-ticks))))
+       (usleep (max 0 (* t 1000)))))
+
+    (define (process-frame previous-time lag)
+      "Render and/or update the game as needed, integrating from the
+PREVIOUS-TIME to the current time, and updating using a game tick
+accumulator initialized to LAG.  Returns a timestamp to be used as the
+starting point of the next delta time calculation and the leftover
+time in the game tick accumulator."
+      (let* ((current-time (sdl2:sdl-ticks))
+            (dt (- current-time previous-time))
+            (lag (update (+ lag dt))))
+       (draw dt (alpha lag))
+       (frame-sleep current-time)
+       (values current-time lag)))
+  
+    (define (game-loop previous-time lag)
+      "Update game state, and render.  PREVIOUS-TIME is the time in
+milliseconds of the last iteration of the game loop."
+      (let-values (((time lag)
+                   (process-frame previous-time lag)))
+       (game-loop time lag)))
+  
+    (call-with-prompt
+       'game-loop-prompt
+      (lambda ()
+       ;; Catch SIGINT and kill the loop
+       (sigaction SIGINT
+         (lambda (signum)
+           (stop-game-loop)))
+       (set! %root-scene scene)
+       (init-window)
+       (open-window)
+       (game-loop (sdl2:sdl-ticks) 0))
+      (lambda (cont callback)
+       (when (procedure? callback)
+         (callback cont))))))
+
+(define (stop-game-loop)
+  "Abort the game loop"
+  (abort-to-prompt 'game-loop-prompt #f))
+
+(define %sdl-window #f)
+(define %gl-context #f)
+
+(define (init-window)
+  (sdl2:sdl-init)
+  (set! %sdl-window (sdl2:make-window #:opengl? #t #:show? #t))
+  (sdl2:set-gl-attribute! 'context-major-version 3)
+  (sdl2:set-gl-attribute! 'context-minor-version 2)
+  (sdl2:set-gl-attribute! 'double-buffer 1)
+  (sdl2:set-gl-attribute! 'depth-size 24)
+  (set! %gl-context (sdl2:make-gl-context %sdl-window))
+  (sdl2:set-gl-swap-interval! 'vsync))
+
+(define* (open-window #:key (title "Untitled") (resolution '(640 480)) (fullscreen? #f))
+  (sdl2:set-window-title! %sdl-window title)
+  (sdl2:set-window-size! %sdl-window resolution)
+  (sdl2:set-window-fullscreen! %sdl-window fullscreen?)
+  (sdl2:show-window! %sdl-window))

diff --git a/gacela/image.scm b/gacela/image.scm
new file mode 100644 (file)
index 0000000..6a97101
--- /dev/null
+++ b/gacela/image.scm
@@ -0,0 +1,37 @@
+;;; Gacela, a GNU Guile extension for fast games development
+;;; Copyright (C) 2016 by Javier Sancho Fernandez <jsf at jsancho dot org>
+;;;
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+
+(define-module (gacela image)
+  #:use-module (gacela scene)
+  #:use-module ((sdl2 surface) #:prefix sdl2:)
+  #:export (import-bitmap
+           move-xy))
+
+(define-syntax-rule (import-bitmap filename)
+  (make-scene
+   "bitmap"
+   (let ((surface (sdl2:load-bmp filename)))
+     (let ((a 0))
+       (lambda ()
+        (set! a (+ a 1))
+        (format #t "Steps: ~a~%" a))))))
+
+(define-syntax-rule (move-xy x y scene)
+  (make-scene
+   "move-xy"
+   (lambda ()
+     (display-scene scene))))

diff --git a/gacela/scene.scm b/gacela/scene.scm
index 0cf05e430993202a45890b8ba3427cc1de968e1a..9145907347b4e505a935fbb17d2614c5d37463fc 100644 (file)
--- a/gacela/scene.scm
+++ b/gacela/scene.scm
@@ -16,6 +16,7 @@
 
 
 (define-module (gacela scene)
+  #:use-module (gacela game)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-9 gnu)
   #:export (make-scene
@@ -42,4 +43,5 @@
   ((scene-procedure scene)))
 
 (define (run-scene scene)
-  ((scene-procedure scene)))
+  (run-game-loop
+   (scene-procedure scene)))