From 5592c24ff8a6fb40691d6d215adc8393c2b9ce2c Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Tue, 10 Mar 2015 17:36:54 -0400
Subject: examples: Clean up minesweeper demo.

* examples/mines/mines.scm: Miscellaneous clean up.
---
 examples/mines/mines.scm | 73 ++++++++++++++++++++++++++++++------------------
 1 file changed, 46 insertions(+), 27 deletions(-)

(limited to 'examples')

diff --git a/examples/mines/mines.scm b/examples/mines/mines.scm
index 663e146..e10fba5 100644
--- a/examples/mines/mines.scm
+++ b/examples/mines/mines.scm
@@ -63,8 +63,7 @@
 (define (compact lst)
   (filter identity lst))
 
-(define (nonzero? n)
-  (not (= n 0)))
+(define nonzero? (negate zero?))
 
 ;;;
 ;;; Model
@@ -78,6 +77,21 @@
   (flag tile-flag)
   (mine-count tile-mine-count))
 
+(define (tile-shown-mine? tile)
+  (and (tile-shown? tile)
+       (tile-mine? tile)))
+
+(define (tile-hidden-mine? tile)
+  (and (not (tile-shown? tile))
+       (tile-mine? tile)))
+
+(define (tile-shown-not-mine? tile)
+  (and (tile-shown? tile)
+       (not (tile-mine? tile))))
+
+(define (tile-neighboring-mines? tile)
+  (nonzero? (tile-mine-count tile)))
+
 (define tile-show
   (match-lambda
    (($ <tile> mine? _ flag mine-count)
@@ -106,6 +120,12 @@
 (define (tile-flagged? tile)
   (not (eq? (tile-flag tile) 'none)))
 
+(define (tile-flagged-mine? tile)
+  (eq? (tile-flag tile) 'flag))
+
+(define (tile-flagged-maybe? tile)
+  (eq? (tile-flag tile) 'maybe))
+
 (define (make-board size mine-count)
   (define (random-mine)
     (vector2 (random size) (random size)))
@@ -134,9 +154,10 @@
 
 (define board-ref
   (case-lambda
-    ((board x y) (list-ref (list-ref board y) x))
-    ((board p)
-     (list-ref (list-ref board (vy p)) (vx p)))))
+    ((board x y)
+     (list-ref (list-ref board y) x))
+    ((board v)
+     (list-ref (list-ref board (vy v)) (vx v)))))
 
 (define (board-update board position tile)
   (match position
@@ -178,7 +199,7 @@
              (board (board-update board position tile)))
         ;; Recursively reveal neighboring tiles if the chosen tile
         ;; does not border a mine.
-        (if (= mine-count 0)
+        (if (zero? mine-count)
             (fold (lambda (pos prev) (board-reveal prev pos))
                   board neighbors)
             board))))))
@@ -188,18 +209,15 @@
                 (tile-toggle-flag (board-ref board position))))
 
 (define (board-win? board)
-  (every (match-lambda
-          ((or ($ <tile> #f #t _ _)
-               ($ <tile> #t #f _ _))
-           #t)
-          (else #f))
-         (concatenate board)))
+  (every (lambda (row)
+           (every (lambda (tile)
+                    (or (tile-shown-not-mine? tile)
+                        (tile-hidden-mine? tile)))
+                  row))
+         board))
 
 (define (board-lose? board)
-  (any (match-lambda
-        (($ <tile> #t #t _ _) #t)
-        (else #f))
-       (concatenate board)))
+  (any (cut any tile-shown-mine? <>) board))
 
 ;;;
 ;;; State
@@ -241,7 +259,7 @@
    (make-signal 'null)
    (signal-map (cut list 'reveal <>) reveal-clicks)
    (signal-map (cut list 'flag <>) flag-clicks)
-   (signal-map (lambda _ 'restart) (key-down? 'n))))
+   (signal-constant 'restart (key-down? 'n))))
 
 (define (make-fresh-board)
   (make-board (signal-ref board-size) 10))
@@ -312,18 +330,19 @@
 
 (define (tile-base-sprite tile)
   (sprite-ref
-   (match tile
-     (($ <tile> _ #t _ _) 'tile-down)
-     (_ 'tile-up))))
+   (if (tile-shown? tile)
+       'tile-down
+       'tile-up)))
 
 (define (tile-overlay-sprite tile)
-  (and=> (match tile
-           (($ <tile> #t #t _ _) 'exploded)
-           (($ <tile> _ #f 'flag _) 'flag)
-           (($ <tile> _ #f 'maybe _) 'maybe)
-           (($ <tile> #f #t _ (? nonzero? mine-count))
-            mine-count)
-           (_ #f))
+  (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))
          sprite-ref))
 
 (define draw-tile
-- 
cgit v1.2.3