STRAIGHT. UP. PLAYABLE

and enjoyable!

main.scm

@@ -485,7 +485,7 @@
   (map (lambda (_) (make-square mine? #f #f #f #f))
        (iota n)))
 
-(define-record-type game (fields squares width height num-mines num-flagged))
+(define-record-type game (fields squares width height num-mines (mutable num-flagged) (mutable over?)))
 
 ;unknown pressed mine flag no-mine pressed-mine question pressed-question
 
@@ -505,6 +505,7 @@
   (cons (floor (/ (get-mouse-x) square-width))
 	(floor (/ (get-mouse-y) square-width))))
 
+; not correct (we need to know whether the square is revealed)
 (define (square-pressed? x y)
   (or
    (and (button-down? 'left) (equal? (cons x y) (square-mouse-over)))
@@ -528,8 +529,8 @@
   (and (< -1 x (game-width  game))
        (< -1 y (game-height game))))
 
-(define (game-around game x y)
-  (map (lambda (x/y) (game-square-at game (car x/y) (cdr x/y)))
+(define (game-map-around proc game x y)
+   (map (lambda (x/y) (proc game (car x/y) (cdr x/y)))
        (filter (lambda (x/y) (game-in-bounds? game (car x/y) (cdr x/y)))
 	       (map (lambda (x/y)
 		      (cons (+ x (car x/y)) (+ y (cdr x/y))))
@@ -537,6 +538,9 @@
 		      (-1 .  0)           ( 1 .  0)
 		      (-1 .  1) ( 0 .  1) ( 1 .  1))))))
 
+(define (game-around game x y)
+ (game-map-around game-square-at game x y))
+
 ; remember: prefer functions over macros
 ; game last for consistency with for-each
 (define (game-squares-for-each proc game)
@@ -560,11 +564,19 @@
 (define (new-game mines width height)
   (define squares (list->vector (append (make-squares mines #t)
 					(make-squares (- (* width height) mines) #f))))
-  (define game (make-game squares width height mines 0))
+  (define game (make-game squares width height mines 0 #f))
   (vector-shuffle! squares)
   (fill-game-arounds! game)
   game)
 
+(define (game-reveal! game x y)
+  (define square (game-square-at game x y))
+  (unless (square-revealed? square)
+    (if (square-mine? square)
+	(game-over?-set! game #t)
+	(begin (square-revealed?-set! square #t)
+	       (when (zero? (square-num-adjacent square))
+		 (game-map-around game-reveal! game x y))))))
 
 (define (game-tick! game)
   (define mouse-x (car (square-mouse-over)))
@@ -582,11 +594,37 @@
 	     (button-released? 'right))))
 
   ; not quite perfectly correct
-  (when (and mouse-in-bounds? (button-pressed? 'right))
+  (when (and mouse-in-bounds? (button-pressed? 'right) (not (square-revealed? mouse-square)))
+    (game-num-flagged-set!
+     game
+     ((if (square-flagged? mouse-square) sub1 add1) (game-num-flagged game)))
     (square-flagged?-set! mouse-square (not (square-flagged? mouse-square))))
 
+  (when (and mouse-in-bounds? (or (button-pressed? 'left) (button-pressed? 'middle)))
+    (if (and (square-revealed? mouse-square)
+	     (= (square-num-adjacent mouse-square)
+		(length
+		 (filter square-flagged?
+		  (game-around game mouse-x mouse-y)))))
+	(game-map-around
+	 (lambda (game x y)
+	   (unless (square-flagged? (game-square-at game x y))
+	     (game-reveal! game x y)))
+	 game mouse-x mouse-y)
+	(game-reveal! game mouse-x mouse-y)))
+
   redraw?)
 
+; flags don't actually matter!
+(define (game-won? game)
+  (define won? #t)
+  (vector-for-each
+   (lambda (square)
+     (when (boolean=? (square-mine? square) (square-revealed? square))
+       (set! won? #f)))
+   (game-squares game))
+  won?)
+
 (define (draw-write obj x y size color)
   (draw-text (with-output-to-string (lambda () (write obj)))
 	     x y size color))
@@ -643,8 +681,7 @@
      (set-vector2-x! draw-pos (+ (vector2-x pos) (* x square-width)))
      (set-vector2-y! draw-pos (+ (vector2-y pos) (* y square-width)))
      (blit-square skin (game-square-type-at game x y) draw-pos))
-   game)
-  )
+   game))
 
 (define (game-draw game skin)
   (draw-game-squares game skin vector2-origin))
@@ -654,7 +691,10 @@
 (define (run-game mines width height)
   (init-window (* width square-width) (* height square-width) "mineschemer")
   (set-target-fps 60)
-
+  (let ([seed (time-nanosecond (current-time))])
+    (display "seed: ") (display seed)
+    (newline)
+    (random-seed seed))
   (let ([skin (load-skin "xp-flowers.bmp")]
 	[game (new-game mines width height)])
     ;; (display skin)
@@ -672,7 +712,12 @@
 	      ; seems so
 	      ;; (clear-background BLACK)
 	      ; okay, we could be a bit smarter about what we redraw, but redrawing shouldn't leak *any* memory
-	      (game-draw game skin))
+	      (game-draw game skin)
+	      ; hacky, yeah
+	      (when (game-over? game)
+		(draw-text "GAME OVER" 0 0 20 (color 255 0 0)))
+	      (when (game-won? game)
+		(draw-text "A COMPLETER IS YOU 0 20 20" (color 247 231 54))))
 	    #;(draw-mouse-info BLACK)
 	    ))
     (unload-texture skin)