From a3d00293cbd731a86751b1f46d994bebab4bd655 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson@member.fsf.org>
Date: Sat, 30 Nov 2013 13:17:15 -0500
Subject: Add with-window form.

* 2d/window.scm (<window>): New record type.
(open-window): Use window object.
(close-window): Change docstring.

* 2d/game.scm (<game>, make-game): Remove window properties.
(run-game): Remove window logic.
---
 2d/game.scm   | 25 +++++++------------------
 2d/window.scm | 46 ++++++++++++++++++++++++++++++++++++----------
 2 files changed, 43 insertions(+), 28 deletions(-)

diff --git a/2d/game.scm b/2d/game.scm
index b59ddee..2e60ba4 100644
--- a/2d/game.scm
+++ b/2d/game.scm
@@ -34,7 +34,6 @@
   #:use-module (2d repl repl)
   #:use-module (2d signals)
   #:use-module (2d vector2)
-  #:use-module (2d window)
   #:export (<game>
             make-game
             game?
@@ -54,38 +53,28 @@
 ;;;
 
 (define-record-type <game>
-  (%make-game title resolution fullscreen? draw)
+  (%make-game  draw)
   game?
-  (title game-title)
-  (resolution game-resolution)
-  (fullscreen? game-fullscreen?)
   (draw game-draw))
 
 (define (default-draw)
   #f)
 
 (define* (make-game #:optional #:key
-                    (title "A Guile-2D Game")
-                    (resolution (vector2 640 480))
-                    (fullscreen? #f)
                     (draw default-draw))
-  "Return a new game. All game properties have some reasonable default
-value."
-  (%make-game title resolution fullscreen? draw))
+  "Create a new game."
+  (%make-game draw))
 
 (define (draw-game game)
   ((game-draw game)))
 
-(define (run-game game)
-  "Open a window and start the game loop for GAME."
-  (open-window (game-title game)
-               (game-resolution game)
-               (game-fullscreen? game))
+(define* (run-game #:optional #:key
+                   (draw default-draw))
+  "Start the game loop."
   (set! running? #t)
   (resume-game)
   (spawn-server)
-  (game-loop game (SDL:get-ticks) 0)
-  (close-window))
+  (game-loop (make-game #:draw draw) (SDL:get-ticks) 0))
 
 ;;;
 ;;; Game Loop
diff --git a/2d/window.scm b/2d/window.scm
index 094314b..4c967de 100644
--- a/2d/window.scm
+++ b/2d/window.scm
@@ -22,26 +22,46 @@
 ;;; Code:
 
 (define-module (2d window)
+  #:use-module (srfi srfi-9)
   #:use-module (figl gl)
   #:use-module ((sdl sdl) #:prefix SDL:)
   #:use-module ((sdl mixer) #:prefix SDL:)
   #:use-module (2d vector2)
-  #:export (open-window
-            close-window))
+  #:export (<window>
+            make-window
+            window?
+            window-title
+            window-resolution
+            window-fullscreen?
+            open-window
+            close-window
+            with-window))
 
-(define* (open-window title resolution fullscreen)
-  "Open the game window with the given TITLE and RESOLUTION. If
-FULLSCREEN is #t, open a fullscreen window."
-  (let ((flags (if fullscreen '(opengl fullscreen) 'opengl))
-        (width (vx resolution))
-        (height (vy resolution)))
+(define-record-type <window>
+  (%make-window title resolution fullscreen?)
+  window?
+  (title window-title)
+  (resolution window-resolution)
+  (fullscreen? window-fullscreen?))
+
+(define* (make-window #:optional #:key
+                      (title "Guile-2D Window")
+                      (resolution (vector2 640 480))
+                      (fullscreen? #f))
+  (%make-window title resolution fullscreen?))
+
+(define* (open-window window)
+  "Open the game window using the settings in WINDOW."
+  (let ((flags (if (window-fullscreen? window) '(opengl fullscreen) 'opengl))
+        (width (vx (window-resolution window)))
+        (height (vy (window-resolution window))))
     ;; Initialize everything
     (SDL:enable-unicode #t)
     (SDL:init 'everything)
     (SDL:open-audio)
     ;; Open SDL window in OpenGL mode.
     (SDL:set-video-mode width height 24 flags)
-    (SDL:set-caption title)
+    (SDL:set-caption (window-title window))
     ;; Initialize OpenGL orthographic view
     (gl-viewport 0 0 width height)
     (set-gl-matrix-mode (matrix-mode projection))
@@ -56,6 +76,12 @@ FULLSCREEN is #t, open a fullscreen window."
                            (blending-factor-dest one-minus-src-alpha))))
 
 (define (close-window)
-  "Close the game window and audio."
+  "Close the currently open window and audio."
   (SDL:close-audio)
   (SDL:quit))
+
+(define-syntax-rule (with-window window body ...)
+  (begin
+    (open-window window)
+    body ...
+    (close-window)))
-- 
cgit v1.2.3