From 4b1370fc286db564e32a8e2e890061bc3ed413ac Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Wed, 10 Feb 2016 22:00:02 -0500
Subject: examples: Update everything to use deferred GL resource loading.

---
 examples/mines/mines.scm | 133 ++++++++++++++++++++++++++---------------------
 1 file changed, 75 insertions(+), 58 deletions(-)

(limited to 'examples/mines')

diff --git a/examples/mines/mines.scm b/examples/mines/mines.scm
index 502d780..0b93473 100644
--- a/examples/mines/mines.scm
+++ b/examples/mines/mines.scm
@@ -289,17 +289,7 @@
 ;;; View
 ;;;
 
-(init-window)
-(enable-fonts)
-
-(define font (load-default-font))
-
-;; Minefield is 8x8, and there are 2 layers of tile graphics.
-(define batch (make-sprite-batch (* 8 8 2)))
-
-(define tileset (load-tileset "images/tiles.png" 32 32))
-
-(define tiles
+(define (make-tiles tileset)
   (map (match-lambda
          ((key . tile-index)
           (cons key (tileset-ref tileset tile-index))))
@@ -318,66 +308,92 @@
          (tile-up . 13)
          (tile-down . 12))))
 
-(define (tile-ref key)
+(define (tile-ref tiles key)
   (assoc-ref tiles key))
 
-(define (tile-base tile)
-  (tile-ref
-   (if (tile-shown? tile)
-       'tile-down
-       'tile-up)))
-
-(define (tile-overlay tile)
-  (and=> (cond
-          ((tile-shown-mine? tile) 'exploded)
-          ((tile-flagged-mine? tile) 'flag)
-          ((tile-flagged-maybe? tile) 'maybe)
-          ((and (tile-shown-not-mine? tile)
-                (tile-neighboring-mines? tile))
-           (tile-mine-count tile))
-          (else #f))
-         tile-ref))
+(define (tile-base tiles tile)
+  (tile-ref tiles
+            (if (tile-shown? tile)
+                'tile-down
+                'tile-up)))
+
+(define (tile-overlay tiles tile)
+  (let ((type (cond
+               ((tile-shown-mine? tile) 'exploded)
+               ((tile-flagged-mine? tile) 'flag)
+               ((tile-flagged-maybe? tile) 'maybe)
+               ((and (tile-shown-not-mine? tile)
+                     (tile-neighboring-mines? tile))
+                (tile-mine-count tile))
+               (else #f))))
+    (tile-ref tiles type)))
 
 (define tile-rect (make-rect 0 0 32 32))
 
-(define-signal board-view
-  (signal-let ((board board))
-    (lambda (gfx)
-      (with-sprite-batch batch gfx
-        (enumerate-each
-         (lambda (row y)
-           (enumerate-each
-            (lambda (tile x)
-              (let ((rect (rect-move tile-rect
-                                     (* x tile-size)
-                                     (* y tile-size)))
-                    (base-tex (tile-base tile))
-                    (overlay-tex (tile-overlay tile)))
-                (sprite-batch-add! batch gfx base-tex rect)
-                (when overlay-tex
-                  (sprite-batch-add! batch gfx overlay-tex rect))))
-            row))
-         board)))))
-
-(define (render-message message)
+(define (render-board board tiles batch)
+  (lambda (gfx)
+    (with-sprite-batch batch gfx
+      (enumerate-each
+       (lambda (row y)
+         (enumerate-each
+          (lambda (tile x)
+            (let ((rect (rect-move tile-rect
+                                   (* x tile-size)
+                                   (* y tile-size)))
+                  (base-tex (tile-base tiles tile))
+                  (overlay-tex (tile-overlay tiles tile)))
+              (sprite-batch-add! batch gfx base-tex rect)
+              (when overlay-tex
+                (sprite-batch-add! batch gfx overlay-tex rect))))
+          row))
+       board))))
+
+(define (render-message font message)
   (move (vector2 (/ (vx resolution) 2)
                  (- (vy resolution) 64))
         (render-sprite
          (make-label font message #:anchor 'center))))
 
-(define-signal status-message
-  (let ((game-over (render-message "GAME OVER - Press N to play again"))
-        (you-win   (render-message "YOU WIN! - Press N to play again")))
-    (signal-let ((board board))
-      (cond
-       ((board-lose? board) game-over)
-       ((board-win? board) you-win)
-       (else render-nothing)))))
+(define (render-message-maybe message)
+  (signal-map-maybe (lambda (font)
+                      (render-message font message))
+                    font))
 
 (define camera
   (2d-camera #:area (make-rect (vector2 0 0) resolution)
              #:clear-color tango-dark-plum))
 
+(define-signal font
+  (on-start (load-default-font)))
+
+;; Minefield is 8x8, and there are 2 layers of tile graphics.
+(define-signal batch
+  (on-start (make-sprite-batch (* 8 8 2))))
+
+(define-signal tileset
+  (on-start (load-tileset "images/tiles.png" 32 32)))
+
+(define-signal tiles
+  (signal-map-maybe make-tiles tileset))
+
+(define-signal board-view
+  (signal-map-maybe render-board board tiles batch))
+
+(define-signal status-message
+  (signal-let ((game-over (render-message-maybe
+                           "GAME OVER - Press N to play again"))
+               (you-win   (render-message-maybe
+                           "YOU WIN! - Press N to play again"))
+               (board board))
+    (cond
+     ((not (or game-over you-win)) ; assets not loaded
+      render-nothing)
+     ((board-lose? board)
+      game-over)
+     ((board-win? board)
+      you-win)
+     (else render-nothing))))
+
 (define-signal scene
   (signal-let ((view   board-view)
                (status status-message)
@@ -385,17 +401,18 @@
     (with-camera camera
       (render-begin
        status
-       (move center view)))))
+       (move center (or view render-nothing))))))
 
 ;;;
 ;;; Initialization
 ;;;
 
-(start-sly-repl)
+;;(start-sly-repl)
 
 (add-hook! window-close-hook stop-game-loop)
 
 (with-window (make-window #:title "Mines" #:resolution resolution)
+  (enable-fonts)
   (run-game-loop scene))
 
 ;;; Local Variables:
-- 
cgit v1.2.3