moved players into GameState so GameStates can be easily saved as records

gui.rkt

@@ -17,7 +17,9 @@
 (define (analysis-gui game)
   
   ; Make a frame by instantiating the frame% class
-  (define g (GameState-grid game))
+  (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"]
@@ -25,12 +27,12 @@
                      [height 300]))
   
   (define displaypanel (new horizontal-panel% [parent frame]))
-  (define grid (new canvas%
+  (define grid-canvas (new canvas%
                     [parent displaypanel]
                     [paint-callback
                      (lambda (canvas dc)
                        (send dc clear)
-                       (render-grid (take g t) dc))]))
+                       (render-grid (grid (take g t) w h) dc))]))
 
   (define log (new list-box%
                    [label ""]
@@ -38,7 +40,7 @@
                    [choices (map line->string g)]
                    [callback (lambda (box event)
                                (set! t (car (send box get-selections)))
-                               (send grid refresh))]))
+                               (send grid-canvas refresh))]))
   
   (define buttonpanel (new horizontal-panel%
                            [parent frame]
@@ -52,7 +54,7 @@
                                       (if (not (= t 0))
                                           (set! t (sub1 t)) 0)
                                       (send log select (- t 1))
-                                      (send grid refresh))]))
+                                      (send grid-canvas refresh))]))
    (define forwardbutton (new button%
                           [parent buttonpanel]
                           [label "forward"]
@@ -60,12 +62,12 @@
                                      (if (not (= t (length g)))
                                          (set! t (add1 t)) 0)
                                      (send log select (- t 1))
-                                     (send grid refresh))]))
+                                     (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 g (play-game (GameState '() 0 '(0 0)) (list random-player random-player)))
+(define g (play-game (GameState (grid '() 6 6) 0 '(0 0) (list random-player random-player))))
 (print (GameState-grid g))
 (analysis-gui g)

main-test.rkt

@@ -2,7 +2,7 @@
 
 (require rackunit "main.rkt")
 
-(define grid (list
+(define test-grid (grid (list
               (line (point 0 0) (point 0 1) 1)
               (line (point 0 1) (point 1 1) 0)
               (line (point 1 0) (point 1 1) 1)
@@ -13,7 +13,7 @@
               (line (point 3 3) (point 3 4) 0)
               (line (point 3 3) (point 4 3) 0)
               (line (point 4 3) (point 4 4) 0)
-              (line (point 3 4) (point 4 4) 0)))
+              (line (point 3 4) (point 4 4) 0)) 6 6))
 
 (test-case
  "same-position?"
@@ -47,14 +47,14 @@
  (check-equal? (boxes-for (line (point 0 0) (point 0 1) 1)) (list (point 0 0)))
  (check-equal? (boxes-for (line (point 2 1) (point 2 2) 1)) (list (point 2 1) (point 1 1)))
  (check-equal? (boxes-for (line (point 0 0) (point 1 0) 1)) (list (point 0 0)))
- (check-equal? (boxes-for (line (point 1 1) (point 2 1) 1)) (list (point 1 1) (point 1 0)))
+ (check-equal? (boxes-for (line (point 1 1) (point 2 1) 1))  (list (point 1 1) (point 1 0)))
  (check-equal? (boxes-for (line (point 0 5) (point 1 5) 1)) (list (point 0 4)))
  (check-equal? (boxes-for (line (point 5 0) (point 5 1) 0)) (list (point 4 0))))
 
 (test-case
  "completes-boxes"
- (define grid
+ (define test-grid
-   (list
+   (grid (list
     (line (point 0 0) (point 0 1) 1)
     (line (point 0 1) (point 1 1) 0)
     (line (point 1 0) (point 1 1) 1)
@@ -72,26 +72,26 @@
     (line (point 3 4) (point 4 4) 1)
     (line (point 4 5) (point 5 5) 1)
     (line (point 4 4) (point 5 4) 0)
-    (line (point 5 4) (point 5 5) 1))) ; all possible unfinished boxes (plus an unfinished double)
+    (line (point 5 4) (point 5 5) 1)) 6 6)) ; all possible unfinished boxes (plus an unfinished double)
- (check-equal? (completes-boxes grid (line (point 0 0) (point 1 0) 0)) 1)
+ (check-equal? (completes-boxes test-grid (line (point 0 0) (point 1 0) 0)) 1)
- (check-equal? (completes-boxes grid (line (point 1 2) (point 1 3) 0)) 1)
+ (check-equal? (completes-boxes test-grid (line (point 1 2) (point 1 3) 0)) 1)
- (check-equal? (completes-boxes grid (line (point 3 1) (point 4 1) 0)) 1)
+ (check-equal? (completes-boxes test-grid (line (point 3 1) (point 4 1) 0)) 1)
- (check-equal? (completes-boxes grid (line (point 0 5) (point 1 5) 0)) 1)
+ (check-equal? (completes-boxes test-grid (line (point 0 5) (point 1 5) 0)) 1)
- (check-equal? (completes-boxes grid (line (point 4 4) (point 4 5) 0)) 2)
+ (check-equal? (completes-boxes test-grid (line (point 4 4) (point 4 5) 0)) 2)
- (check-equal? (completes-boxes grid (line (point 1 0) (point 2 0) 1)) 0))
+ (check-equal? (completes-boxes test-grid (line (point 1 0) (point 2 0) 1)) 0))
 
 (test-case
  "valid-move?"
- (define grid (list
+ (define test-grid (grid (list
                (line (point 0 0) (point 0 1) 1)
                (line (point 0 1) (point 0 2) 0)
-               (line (point 3 2) (point 3 3) 0)))
+               (line (point 3 2) (point 3 3) 0)) 6 6))
- (check-false (valid-move? (line (point 0 0) (point 0 1) 1) grid))
+ (check-false (valid-move? (line (point 0 0) (point 0 1) 1) test-grid))
- (check-true (valid-move? (line (point 0 2) (point 0 3) 0) grid))  ; not overwriting existing moves
+ (check-true (valid-move? (line (point 0 2) (point 0 3) 0) test-grid))  ; not overwriting existing moves
- (check-false (valid-move? (line (point 0 2) (point 0 1) 1) grid)) ; moving forward
+ (check-false (valid-move? (line (point 0 2) (point 0 1) 1) test-grid)) ; moving forward
- (check-false (valid-move? (line (point 0 0) (point 0 2) 1) grid)) ; valid length check
+ (check-false (valid-move? (line (point 0 0) (point 0 2) 1) test-grid)) ; valid length check
- (check-false (valid-move? (line (point (+ GRID-WIDTH 1) 0) (point 0 2) 1) grid))
+ (check-false (valid-move? (line (point (+ GRID-WIDTH 1) 0) (point 0 2) 1) test-grid))
- (check-false (valid-move? (line (point (+ GRID-WIDTH 1) 0) (point 0 2) 1) grid))) ; out of bounds
+ (check-false (valid-move? (line (point (+ GRID-WIDTH 1) 0) (point 0 2) 1) test-grid))) ; out of bounds
 
 (test-case
  "out-of-bounds?"
@@ -115,21 +115,24 @@
 
 (test-case
  "count-square"
-  (check-equal? (count-square (point 0 0) grid) 4)
+  (check-equal? (count-square (point 0 0) test-grid) 4)
-  (check-equal? (count-square (point 1 0) grid) 3)
+  (check-equal? (count-square (point 1 0) test-grid) 3)
-  (check-equal? (count-square (point 2 0) grid) 2)
+  (check-equal? (count-square (point 2 0) test-grid) 2)
-  (check-equal? (count-square (point 3 2) grid) 1)
+  (check-equal? (count-square (point 3 2) test-grid) 1)
-  (check-equal? (count-square (point 0 4) grid) 0))
+  (check-equal? (count-square (point 0 4) test-grid) 0))
 
 (test-case
  "append-move"
- (check-equal? (append-move grid (line (point 2 2) (point 2 3) 0)) (append grid  (list (line (point 2 2) (point 2 3) 0))))
+ (check-equal? (append-move test-grid (line (point 2 2) (point 2 3) 0)) (grid (append
- (check-equal? (append-move grid (line (point 0 0) (point 0 1) 0)) grid))
+                                                                               (grid-lines test-grid)
+                                                                               (list (line (point 2 2) (point 2 3) 0)))
+                                                                              (grid-width test-grid) (grid-height test-grid)))
+ (check-equal? (append-move test-grid (line (point 0 0) (point 0 1) 0)) test-grid))
 
 
 (test-case
  "valid-moves"
- (check-equal? (valid-moves grid) (list
+ (check-equal? (valid-moves test-grid) (list
  (line (point 0 1) (point 0 2) 1)
  (line (point 0 2) (point 1 2) 1)
  (line (point 0 2) (point 0 3) 1)

main.rkt

@@ -4,7 +4,10 @@
 
 (require racket/draw racket/random)
 
-; a Grid is 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")
+; 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")
+; -- the width and height of the grid.
+(struct grid (lines width height) #:transparent)
 
 ; represents a point in 2d space.
 (struct point (x y) #:transparent)
@@ -16,7 +19,14 @@
 ; grid is the grid
 ; player is the current player
 ; scores is a list of numbers for the score of each player.
-(struct GameState (grid player scores) #:transparent)
+; players is a list of two players who are playing in the game
+(struct GameState (grid player scores players) #:transparent)
+
+; represents a player. func is a function with the signature:
+; Grid Number -> Line
+; where the grid is the current board state, the Number is if the player is player 1 or 2, and it returns the move it will play that turn.
+; name is the player's name.
+(struct player (name func) #:transparent)
 
 ; width and height of the playing grid.
 (define GRID-WIDTH 6)
@@ -36,12 +46,13 @@
     bitmap))
 
 ; Grid that contains all possible lines filled. Used for filtering valid moves. This is an ugly way, but i can't think of a better one right now.
-(define ALL-LINES (flatten
+(define FULL-GRID (grid
+                   (flatten
                     (for/list ([x (in-range GRID-WIDTH)])
                       (for/list ([y (in-range GRID-HEIGHT)])
                         (list
                          (if (< x (- GRID-WIDTH 1)) (line (point x y) (point (+ x 1) y) 1) '())
-                         (if (< y (- GRID-HEIGHT 1)) (line (point x y) (point x (+ y 1)) 1) '()))))))
+                         (if (< y (- GRID-HEIGHT 1)) (line (point x y) (point x (+ y 1)) 1) '()))))) GRID-WIDTH GRID-HEIGHT))
 
 ; Line Line -> Bool
 ; tests if two lines are in the same position
@@ -64,7 +75,7 @@
 ; TODO optimise. This "filtering what is invalid out of all possible lines" method sucks.
 ; TODO write more tests
 (define (valid-moves g)
-    (filter (lambda (move) (valid-move? move g)) ALL-LINES))
+    (filter (lambda (move) (valid-move? move g)) (grid-lines FULL-GRID)))
 
 ; Point Grid -> Number
 ; given a point that is the top-left corner of a square on the grid, returns the amount of edges surrounding that square.
@@ -77,7 +88,7 @@
              (member #t
                      (for/list ([x (list (point 0 0) (point 0 1) (point 1 0) (point 0 0))]
                                 [y (list (point 0 1) (point 1 1) (point 1 1) (point 1 0))]) 
-                       (same-position? item (line (point+ x p) (point+ y p) 0))))) g))) ; for every position in the square, check if there's a line there
+                       (same-position? item (line (point+ x p) (point+ y p) 0))))) (grid-lines g)))) ; for every position in the square, check if there's a line there
 
 ; Line -> Bool
 ; returns #t if the line is forwards (with forwards being moving right and down, higher end coord than start)
@@ -106,26 +117,25 @@
 ; returns #t if adding the given move to the grid is valid.
 (define (valid-move? line grid)
   (and
-   (empty? (filter (lambda (l) (same-position? l line)) grid)) ; line doesn't already exist on board
+   (empty? (filter (lambda (l) (same-position? l line)) (grid-lines grid))) ; line doesn't already exist on board
    (valid-length? line)
    (forwards? line)
    (and
     (not (out-of-bounds? (line-from line)))
     (not (out-of-bounds? (line-to line))))))
 
-; a Player is a function with the signature:
-; Grid Number -> Line
-; where the grid is the current board state, the Number is if the player is player 1 or 2, and it returns the move it will play that turn.
-
 ; a Player that plays random moves
-(define (random-player g n)
+(define random-player
-  (let ([m (car (random-sample (valid-moves g) 1))])
+  (player
-    (line (line-from m) (line-to m) n)))
+   "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)
-  (if (valid-move? l g) (append g (list l)) g))
+  (if (valid-move? l g) (grid (append (grid-lines g) (list l)) (grid-width g) (grid-height g)) g))
 
 ; Line -> List of Points
 ; returns the positions of boxes the given line affects, assuming a valid line.
@@ -152,18 +162,18 @@
       ([boxes (boxes-for l)]
        [g (append-move grid l)])
     (length (filter (lambda (b) (= (count-square b g) 4)) boxes))))
-
+    
-; GameState, List of 2 Players -> GameState
+; GameState -> GameState
 ; 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.
-(define (play-game s players)
+(define (play-game s)
   (let ([g (GameState-grid s)]
         [p (GameState-player s)])
     (cond
-      [(= (length g) (length ALL-LINES)) s] ; end of the game
+      [(= (length (grid-lines g)) (length (grid-lines FULL-GRID))) s] ; end of the game
       [else
-       (let* ([move ((list-ref players p) g p)]
+       (let* ([move ((player-func (list-ref (GameState-players s) p)) g p)]
               [new-grid (append-move g move)]
               [boxes (completes-boxes g move)]
               [box (not (= 0 boxes))]
@@ -171,7 +181,7 @@
          (play-game (GameState
                      new-grid
                      (if box p (abs (- p 1)))
-                     (if box (list-set scores p (+ boxes (list-ref scores p))) scores)) players))])))
+                     (if box (list-set scores p (+ boxes (list-ref scores p))) scores) (GameState-players s))))])))
 
 ; Grid -> Image
 ; renders grid to an image for showing humans the game.
@@ -185,9 +195,9 @@
 ; 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)
+(define (render-grid g dc)
   (define passed '())
-  (for ([l grid]) ; reversed for fill-drawing malarkey.
+  (for ([l (grid-lines g)]) ; 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)] ; player 1 draws in red
@@ -199,8 +209,8 @@
           (+ 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)
+        (if (= (count-square b (grid passed (grid-width g) (grid-height g))) 4)
-            (send dc draw-text
+           (send dc draw-text
             (if (= (line-player l) 0) "R" "B")
             (+ 6 (* GRID-SCALE (point-x b)))
             (+ 3 (* GRID-SCALE (point-y b))))