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

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

@@ -50,7 +50,7 @@
      [label "&Load"]
      [parent file-menu]
      [callback (lambda (m event)
-                 (let ([f (get-file "Load Game")]) ;#f #f #f ".dbn" '() '(("*.dbn" "Dots and Boxes Notation")))])
+                 (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))

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)
@@ -209,10 +200,46 @@
 (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))
@@ -241,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)))))