a day's hacking with a whole bunch of stuff going on

This is intended to be the limit to GUI functions. It's just a viewer.
I hope it stays that way, I'm going to work on players now.

arena.rkt

@@ -0,0 +1,9 @@
+#lang racket
+
+; runs all the players against each other as both first and second player.
+
+(require "main.rkt" "players.rkt")
+
+(define all-players '(player-random player-first player-last))
+
+(define matchups (append (combinations all-players 2) (map reverse (combinations all-players 2))))

gui.rkt

@@ -1,5 +1,11 @@
 #lang racket
 
+(define game (GameState (grid '() 6 6) 0 '(0 0) (list (player "None" 0) (player "None" 0))))
+(define g 0)
+(define w 6)
+(define h 6)
+(define t 0)
+
 (require "main.rkt" racket/gui)
 
 ; Line -> String
@@ -12,61 +18,85 @@
           (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 (grid-lines (GameState-grid game)))
-  (define w (grid-width (GameState-grid game)))
-  (define h (grid-height (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-canvas (new canvas%
-                    [parent displaypanel]
-                    [paint-callback
-                     (lambda (canvas dc)
-                       (send dc clear)
-                       (render-grid (grid (take g t) w h) 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-canvas 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-canvas 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-canvas refresh))]))
-  (define score (new message%
-                    [parent buttonpanel]
-                    [label (format "Final Score: R: ~a, B: ~a" (first (GameState-scores game)) (last (GameState-scores game)))]))
-  (send frame show #t))
+(define (load-game-gui! ng)
+  (set! game ng)
+  (set! g (grid-lines (GameState-grid ng)))
+  (set! w (grid-width (GameState-grid ng)))
+  (set! h (grid-height (GameState-grid ng)))
+  (set! t 0))
 
-(define g (load-game! "/tmp/test.dbn"))
-(analysis-gui g)
+(load-game-gui! game)
+
+(define (status-label game)
+  (format "~a vs ~a, ~a:~a"
+                                  (player-name (first (GameState-players game)))
+                                  (player-name (last (GameState-players game)))
+                                  (first (GameState-scores game)) (last (GameState-scores game))))
+
+(define frame (new frame%
+                   [label "DBN Viewer"]
+                   [width 300]
+                   [height 300]))
+
+(define menu-bar (new menu-bar%
+                      [parent frame]))
+  
+(define file-menu (new menu%
+                       (label "&File")
+                       (parent menu-bar)))
+
+(new menu-item%
+     [label "&Load"]
+     [parent file-menu]
+     [callback (lambda (m event)
+                 (let ([f (get-file "Load Game" #f #f #f ".dbn" '() '(("Dots and Boxes Notation" "*.dbn")))])
+                   (if (eq? #f f) 0 (load-game-gui! (load-game! f)))
+                   (send grid-canvas refresh)
+                   (send log set (map line->string g))
+                   (send score set-label (status-label game))
+                   (set! t 0)))])
+
+(define displaypanel (new horizontal-panel% [parent frame]))
+(define grid-canvas (new canvas%
+                         [parent displaypanel]
+                         [paint-callback
+                          (lambda (canvas dc)
+                            (send dc clear)
+                            (render-grid (grid (take g t) w h) 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-canvas 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-canvas 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-canvas refresh))]))
+(define score (new message%
+                   [parent buttonpanel]
+                   [label (status-label game)]))
+
+
+(send frame show #t)

main.rkt

@@ -2,7 +2,7 @@
 
 (provide (all-defined-out)) ; for testing module
 
-(require racket/draw racket/random)
+(require racket/draw racket/random file/gif)
 
 ; a Grid contains:
 ; -- a list of lines. All lines in a grid must be specified as moving left to right, top to bottom ("to" coordinate higher than "from" coordinate")
@@ -122,15 +122,6 @@
     (not (out-of-bounds? (line-from line) grid))
     (not (out-of-bounds? (line-to line) grid)))))
 
-; a Player that plays random moves
-(define random-player
-  (player
-   "Random"
-   (lambda (g n)
-     (let ([m (car (random-sample (valid-moves g) 1))])
-       (line (line-from m) (line-to m) n)))))
-
-
 ; Grid Line -> Grid
 ; adds line to grid, if it is a valid move. Otherwise skips the move.
 (define (append-move g l)
@@ -203,10 +194,52 @@
                      (if box p (abs (- p 1)))
                      (if box (list-set scores p (+ boxes (list-ref scores p))) scores) (GameState-players s))))])))
 
+; player player Number Number -> GameState
+; convenience function for play-game.
+; numbers are grid dimensions
+(define (start-game p1 p2 grid1 grid2)
+  (play-game (GameState (grid '() grid1 grid2) 0 '(0 0) (list p1 p2))))
+
+; GameState path !
+; saves a game into the .dbn file format that I just made up.
+; don't worry, it's sexpy.
+(define (save-game! s filename)
+  (let ([g (GameState-grid s)]
+        [f (open-output-file filename)])
+    (pretty-write
+     `((player0 ,(player-name (first (GameState-players s))))
+       (player1 ,(player-name (second (GameState-players s))))
+       (grid ,(grid-width g) ,(grid-height g))
+       (score ,(first (GameState-scores s)) ,(second (GameState-scores s)))
+       (lines
+        ,(for/list ([l (grid-lines g)])
+                   (list (point-x (line-from l)) (point-y (line-from l)) (point-x (line-to l)) (point-y (line-to l)) (line-player l))))) f)
+    (close-output-port f)))
+
+; path -> GameState
+; loads a game from a .dbn file into a GameState structure
+(define (load-game! p)
+  (let* ([f (open-input-file p)]
+         [data (read f)])
+    (close-input-port f)
+    (GameState
+     (grid
+      (for/list ([i (last (assoc 'lines data))])
+        (line (point (first i) (second i)) (point (third i) (fourth i)) (fifth i)))
+      (second (assoc 'grid data)) (last (assoc 'grid data)))
+     0 ; assumed, the game is over
+     (list (second (assoc 'score data)) (last (assoc 'score data)))
+     `(
+       ,(player (last (assoc 'player0 data)) 0)
+       ,(player (last (assoc 'player1 data)) 0)
+       ))))
+
+
+
 ; Grid -> Image
 ; renders grid to an image for showing humans the game.
 (define (render-grid-bitmap g)
-  (let* ([bitmap (make-bitmap (+ 10 (* (grid-width g) GRID-SCALE) (+ 10 (* (grid-width g) GRID-SCALE))))] ; add border for printing
+  (let* ([bitmap (make-bitmap (+ 10 (* (grid-width g) GRID-SCALE)) (+ 10 (* (grid-width g) GRID-SCALE)))] ; add border for printing
          [dc (new bitmap-dc% [bitmap bitmap])])
     (render-grid g dc)
     bitmap))
@@ -235,36 +268,24 @@
             0))))
   (send dc draw-bitmap (grid-dots (grid-width g) (grid-height g)) 0 0)) ; overlay dot grid
 
-; GameState path !
-; saves a game into the .dbn file format that I just made up.
-; don't worry, it's sexpy.
-(define (save-game! s filename)
-  (let ([g (GameState-grid s)]
-        [f (open-output-file filename)])
-    (pretty-write
-     `((player0 ,(player-name (first (GameState-players s))))
-       (player1 ,(player-name (second (GameState-players s))))
-       (grid ,(grid-width g) ,(grid-height g))
-       (score ,(first (GameState-scores s)) ,(second (GameState-scores s)))
-       (lines
-        ,((for/list ([l (grid-lines g)])
-                   (list (point-x (line-from l)) (point-y (line-from l)) (point-x (line-to l)) (point-y (line-to l)) (line-player l)))))) f)
-    (close-output-port f)))
+; GameState filepath !
+; saves a game's history as images into /tmp/
+; TODO learn file/gif and make the gif properly
+(define (game->images game)
+  (let* ([g (GameState-grid game)]
+         [frames (grid-frames (grid '() (grid-width g) (grid-height g)) g '())])
+    
+         (for ([frame (in-range (length frames))])
+           (send (list-ref frames frame) save-file (format "/tmp/dotsandboxes~a.png" frame) 'png)
+         )))
+    
 
-; path -> GameState
-; loads a game from a .dbn file into a GameState structure
-(define (load-game! p)
-  (let* ([f (open-input-file p)]
-         [data (read f)])
-    (close-input-port f)
-    (GameState
-     (grid
-      (for/list ([i (last (assoc 'lines data))])
-        (line (point (first i) (second i)) (point (third i) (fourth i)) (fifth i)))
-      (second (assoc 'grid data)) (last (assoc 'grid data)))
-     0 ; assumed, the game is over
-     (list (second (assoc 'score data)) (last (assoc 'score data)))
-     `(
-       ,(player (last (assoc 'player0 data)) 0)
-       ,(player (last (assoc 'player1 data)) 0)
-       ))))
+; Used internally for rendering all the frames from a grid's history
+(define (grid-frames g grid-in frames)
+  (cond
+    [(empty? (grid-lines grid-in)) frames]
+    [(grid-frames
+      (grid (append (grid-lines g) (list (car (grid-lines grid-in)))) (grid-width g) (grid-height g))
+      (grid (cdr (grid-lines grid-in)) (grid-width grid-in) (grid-height grid-in))
+      (append frames (list (render-grid-bitmap g))))]
+  ))

players.rkt

@@ -0,0 +1,31 @@
+#lang racket
+
+; dots and boxes players!
+
+(require "main.rkt" racket/random)
+
+(provide player-random player-first player-last)
+
+; a Player that plays random moves
+(define player-random
+  (player
+   "Random"
+   (lambda (g n)
+     (let ([m (car (random-sample (valid-moves g) 1))])
+       (line (line-from m) (line-to m) n)))))
+
+; plays the first valid move found
+(define player-first
+  (player
+   "First Move"
+   (lambda (g n)
+     (let ([m (first (valid-moves g))])
+       (line (line-from m) (line-to m) n)))))
+
+; plays the last valid move found
+(define player-last
+  (player
+   "Last Move"
+   (lambda (g n)
+     (let ([m (last (valid-moves g))])
+       (line (line-from m) (line-to m) n)))))