add GUI game analysis tool

gui.rkt

@@ -0,0 +1,68 @@
+#lang racket
+
+(require "main.rkt" racket/gui)
+
+; Line -> String
+; Converts a line to a string for the list
+(define (line->string l)
+  (format "~a : ~a,~a-~a,~a"
+          (if (= (line-player l) 0) "R" "B")
+          (point-x (line-from l))
+          (point-y (line-from l))
+          (point-x (line-to l))
+          (point-y (line-to l))))
+
+; GameState
+; opens a window to analyse game.
+(define (analysis-gui game)
+  
+  ; Make a frame by instantiating the frame% class
+  (define g (GameState-grid game))
+  (define t 0)
+  (define frame (new frame%
+                     [label "Game Analysis"]
+                     [width 300]
+                     [height 300]))
+  
+  (define displaypanel (new horizontal-panel% [parent frame]))
+  (define grid (new canvas%
+                    [parent displaypanel]
+                    [paint-callback
+                     (lambda (canvas dc)
+                       (send dc clear)
+                       (render-grid (take g t) dc))]))
+
+  (define log (new list-box%
+                   [label ""]
+                   [parent displaypanel]
+                   [choices (map line->string g)]
+                   [callback (lambda (box event)
+                               (set! t (car (send box get-selections)))
+                               (send grid refresh))]))
+  
+  (define buttonpanel (new horizontal-panel%
+                           [parent frame]
+                           [alignment '(center center)]
+                           [stretchable-height #f]
+                           ))
+  (define backbutton (new button%
+                          [parent buttonpanel]
+                          [label "back"]
+                          [callback (lambda (button state)
+                                      (if (not (= t 0))
+                                          (set! t (sub1 t)) 0)
+                                      (send log select (- t 1))
+                                      (send grid refresh))]))
+   (define forwardbutton (new button%
+                          [parent buttonpanel]
+                          [label "forward"]
+                          [callback (lambda (button state)
+                                     (if (not (= t (length g)))
+                                         (set! t (add1 t)) 0)
+                                     (send log select (- t 1))
+                                     (send grid refresh))]))
+  (send frame show #t))
+
+(define g (play-game (GameState '() 0 '(0 0)) (list random-player random-player)))
+(print (GameState-grid g))
+(analysis-gui g)

main.rkt

@@ -157,11 +157,9 @@
 ; runs the game.
 ; If the game is over, returns the final game state
 ; else, lets a player play a move. If they complete a box, they stay on and earn a point. Else, the other player has a turn.
-; TODO score 2 points for creating 2 boxes at once
 (define (play-game s players)
   (let ([g (GameState-grid s)]
         [p (GameState-player s)])
-    (print (render-grid-bitmap g))
     (cond
       [(= (length g) (length ALL-LINES)) s] ; end of the game
       [else
@@ -185,17 +183,27 @@
 
 ; Grid dc !
 ; renders grid on the given drawing context.
+; TODO setting line color doesn't seem to be always working?
 ; TODO color in squares
 (define (render-grid grid dc)
-  (for ([l (reverse grid)])
+  (define passed '())
+  (for ([l grid]) ; reversed for fill-drawing malarkey.
+    (if (empty? passed) (set! passed (list l)) (set! passed (append passed (list l))))
     (cond
-      [(= (line-player l) 0) (send dc set-pen "red" 4 'solid) (send dc set-brush "red" 'bdiagonal-hatch)] ; player 1 draws in red
-      [(= (line-player l) 1) (send dc set-pen "blue" 4 'solid) (send dc set-brush "blue" 'fdiagonal-hatch)]) ; player 2 draws in blue        
+      [(= (line-player l) 0) (send dc set-pen "red" 4 'solid)] ; player 1 draws in red
+      [(= (line-player l) 1) (send dc set-pen "blue" 4 'solid)]) ; player 2 draws in blue
     (send dc draw-line
           (+ 4 (* GRID-SCALE (point-x (line-from l))))
           (+ 4 (* GRID-SCALE (point-y (line-from l))))
           (+ 4 (* GRID-SCALE (point-x (line-to l))))
-          (+ 4 (* GRID-SCALE (point-y (line-to l)))))) ; draw the line
+          (+ 4 (* GRID-SCALE (point-y (line-to l))))) ; draw the line
+    (let ([boxes (boxes-for l)])
+      (for ([b boxes])
+        (if (= (count-square b passed) 4)
+            (send dc draw-text
+            (if (= (line-player l) 0) "R" "B")
+            (+ 6 (* GRID-SCALE (point-x b)))
+            (+ 3 (* GRID-SCALE (point-y b))))
+            0))))
   (send dc draw-bitmap EMPTY-GRID 0 0)) ; overlay dot grid
 
-(play-game (GameState '() 0 '(0 0)) (list random-player random-player))