much cleanup, first version of writing games out to files.

main-test.rkt

@@ -49,6 +49,24 @@
  (check-equal? (boxes-for (line (point 0 5) (point 1 5) 1) test-grid) (list (point 0 4)))
  (check-equal? (boxes-for (line (point 5 0) (point 5 1) 0) test-grid) (list (point 4 0))))
 
+(test-case
+ "vertical?"
+ (check-false (vertical? (line (point 2 0) (point 3 0) 0)))
+ (check-true (vertical? (line (point 0 5) (point 0 6) 0))))
+
+(test-case
+ "horizontal?"
+ (check-true (horizontal? (line (point 2 0) (point 3 0) 0)))
+ (check-false (horizontal? (line (point 0 5) (point 0 6) 0))))
+
+(test-case
+ "box-in-grid?"
+ (check-true (box-in-grid? test-grid (point 0 0)))
+ (check-true (box-in-grid? test-grid (point 2 4)))
+ (check-false (box-in-grid? test-grid (point 0 5)))
+ (check-false (box-in-grid? test-grid (point 5 0)))
+ (check-false (box-in-grid? test-grid (point -1 3))))
+
 (test-case
  "completes-boxes"
  (define test-grid
@@ -88,8 +106,8 @@
  (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) test-grid)) ; moving forward
  (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) test-grid))
- (check-false (valid-move? (line (point (+ GRID-WIDTH 1) 0) (point 0 2) 1) test-grid))) ; out of bounds
+ (check-false (valid-move? (line (point (+ (grid-width test-grid) 1) 0) (point 0 2) 1) test-grid))
+ (check-false (valid-move? (line (point (+ (grid-width test-grid) 1) 0) (point 0 2) 1) test-grid))) ; out of bounds
 
 (test-case
  "out-of-bounds?"

main.rkt

@@ -52,9 +52,6 @@
                         (list
                          (if (< x (- w 1)) (line (point x y) (point (+ x 1) y) 1) '())
                          (if (< y (- h 1)) (line (point x y) (point x (+ y 1)) 1) '()))))) w h))
-
-; stores the full grid
-(define FULL-GRID (grid '() 0 0))
   
 ; Line Line -> Bool
 ; tests if two lines are in the same position
@@ -75,9 +72,8 @@
 ; Grid -> List of Lines
 ; returns all valid moves on a grid.
 ; 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)) (grid-lines FULL-GRID)))
+    (filter (lambda (move) (valid-move? move g)) (grid-lines (full-grid (grid-width g) (grid-height g)))))
 
 ; 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.
@@ -134,28 +130,39 @@
      (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) (grid (append (grid-lines g) (list l)) (grid-width g) (grid-height g)) g))
 
+; Line -> Bool
+(define (vertical? l) (= (point-x (line-from l)) (point-x (line-to l))))
+; Line -> Bool
+(define (horizontal? l) (= (point-y (line-from l)) (point-y (line-to l))))
+
+; Point -> Bool
+; returns if a box is within the boundaries of grid
+(define (box-in-grid? g b)
+  (not (or
+   (< (point-x b) 0)
+   (< (point-y b) 0)
+   (>= (point-x b) (- (grid-width g) 1))
+   (>= (point-y b) (- (grid-height g) 1)))))
+
 ; Line Grid -> List of Points
-; returns the positions of boxes the given line affects, assuming a valid line.
-; TODO this is messy as fuck, especially with that (filter). Racket must have some way to do this more nicely.
+; returns the boxes either side of the given line.
+; Given a horizontal line from (x1 y) to (x2 y), the two boxes on either side of
+; it lie at (x1 (- y 1)) and (x1 y); analogous for a vertical line from (x y1)
+; to (x y2).
 (define (boxes-for line g)
-  (filter (lambda (x) (not (eq? x 0)))
-          (list
-           (if (and
-                (not (= (- (grid-width g) 1) (point-x (line-from line))))
-                (not (= (- (grid-height g) 1) (point-y (line-from line))))) (line-from line) 0)
-           (if (and
-                (< (point-x (line-from line)) (point-x (line-to line))) ; horizontal line
-                (> (point-y (line-from line)) 0))
-                (point (point-x (line-from line)) (- (point-y (line-from line)) 1)) 0)
-           (if (and
-                (< (point-y (line-from line)) (point-y (line-to line))) ; vertical line
-                (> (point-x (line-from line)) 0))
-               (point (- (point-x (line-from line)) 1) (point-y (line-from line))) 0))))
+  (filter (curry box-in-grid? g)
+          (let ([dx (if (horizontal? line) 0 1)]
+                [dy (if (vertical? line) 0 1)]
+                [px (point-x (line-from line))]
+                [py (point-y (line-from line))])
+            (list (point px py)
+                  (point (- px dx) (- py dy))))))
 
 ; Grid Line -> bool or Number
 ; returns the number of boxes this completes
@@ -183,7 +190,6 @@
 (define (play-game s)
   (let ([g (GameState-grid s)]
         [p (GameState-player s)])
-    (set! FULL-GRID (full-grid (grid-width g) (grid-height g)))
     (cond
       [(= (length (grid-lines g)) (total-moves g)) s] ; end of the game when every possible line is played
       [else
@@ -207,8 +213,6 @@
 
 ; 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 g dc)
   (define passed '())
   (for ([l (grid-lines g)])
@@ -229,4 +233,26 @@
             (+ 6 (* GRID-SCALE (point-x b)))
             (+ 3 (* GRID-SCALE (point-y b))))
             0))))
-  (send dc draw-bitmap (grid-dots (grid-width g) (grid-height g)) 0 0)) ; overlay dot grid
+  (send dc draw-bitmap (grid-dots (grid-width g) (grid-height g)) 0 0)) ; overlay dot grid
+
+; GameState !
+; saves a game into the .dbn file format that I just made up.
+; don't worry, it's sexpy.
+; TODO write loader
+(define (save-game s filename)
+  (let ([g (GameState-grid s)]
+        [f (open-output-file filename)])
+    (pretty-write
+     (quasiquote
+      ((player0
+        (unquote (player-name (first (GameState-players s)))))
+       (player1
+        (unquote (player-name (second (GameState-players s)))))
+       (grid
+        (unquote (grid-width g)) (unquote (grid-height g)))
+       (score
+        (unquote (first (GameState-scores s))) (unquote (second (GameState-scores s))))
+       (lines
+        (unquote (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)))