Display images using OpenGL and textures

[gacela.git] / gacela / game.scm

diff --git a/gacela/game.scm b/gacela/game.scm
index dd7886cc150e5f230bf3ed5c3c97318c0aa8f4da..326db782c7651c0bd80cd71524d75db467e7b78b 100644 (file)
--- a/gacela/game.scm
+++ b/gacela/game.scm
@@ -24,7 +24,8 @@
   #:use-module ((sdl2 video) #:prefix sdl2:)
   #:use-module (gl)
   #:use-module (srfi srfi-11)
-  #:export (play-game
+  #:export (start-game
+           stop-game
            %sdl-renderer))
 
 
@@ -38,7 +39,8 @@
 (define* (run-game-loop scene #:key
                         (frame-rate 60)
                         (tick-rate 60)
-                        (max-ticks-per-frame 4))
+                        (max-ticks-per-frame 4)
+                       (when-quit #f))
   "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
@@ -54,8 +56,7 @@ instead of becoming completely unresponsive and possibly crashing."
     (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))
+        (resize-window (car size) (cadr size)))
       (if %root-scene
          (%root-scene))
       ;;(run-hook draw-hook dt alpha)
@@ -74,10 +75,13 @@ unused accumulator time."
               lag)
              ((>= lag tick-interval)
               (process-events)
+              (if (and (quit-event?) (procedure? when-quit))
+                  (when-quit))
                                        ;(agenda-tick!)
               (iter (- lag tick-interval) (1+ ticks)))
              (else
               lag)))
+      (clear-events)
       (iter lag 0))
 
     (define (alpha lag)
@@ -134,16 +138,24 @@ milliseconds of the last iteration of the game loop."
 
 (define (init-window)
   (sdl2:sdl-init)
-  (set! %sdl-window (sdl2:make-window #:opengl? #t #:show? #t))
-  (set! %sdl-renderer (sdl2:make-renderer %sdl-window))
   (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! %sdl-window (sdl2:make-window #:opengl? #t #:show? #t))
+  (set! %sdl-renderer (sdl2:make-renderer %sdl-window))
   (set! %gl-context (sdl2:make-gl-context %sdl-window))
-  (sdl2:set-gl-swap-interval! 'vsync))
+  (sdl2:set-gl-swap-interval! 'vsync)
+  (init-gl))
+
+(define (init-gl)
+  (set-gl-matrix-mode (matrix-mode projection))
+  (gl-load-identity)
+  (set-gl-matrix-mode (matrix-mode modelview))
+  (gl-load-identity)
+  (set-gl-clear-color 0 0 0 1))
 
-(define* (open-window #:key (title "Untitled") (resolution '(640 480)) (fullscreen? #f))
+(define (open-window title resolution fullscreen?)
   (sdl2:set-window-title! %sdl-window title)
   (sdl2:set-window-size! %sdl-window resolution)
   (sdl2:set-window-fullscreen! %sdl-window fullscreen?)
@@ -153,8 +165,26 @@ milliseconds of the last iteration of the game loop."
   (sdl2:hide-window! %sdl-window)
   (sdl2:sdl-quit))
 
-(define (play-game scene)
+(define (resize-window width height)
+  (gl-viewport 0 0 width height)
+  (set-gl-matrix-mode (matrix-mode projection))
+  (gl-load-identity)
+  (let ((w (/ width 2))
+        (h (/ height 2)))
+    (gl-ortho (- w) w (- h) h 0 1))
+  (set-gl-matrix-mode (matrix-mode modelview))
+  (gl-clear (clear-buffer-mask color-buffer depth-buffer))
+  (gl-load-identity))
+
+(define* (start-game scene #:key
+                   (title "Untitled")
+                   (resolution '(640 480))
+                   (fullscreen? #f)
+                   (when-quit (lambda () (stop-game))))
   (init-window)
-  (open-window)
-  (run-game-loop scene)
+  (open-window title resolution fullscreen?)
+  (run-game-loop scene #:when-quit when-quit)
   (close-window))
+
+(define (stop-game)
+  (stop-game-loop))