diff --git a/main-test.rkt b/main-test.rkt index 68910af..fe2c9df 100644 --- a/main-test.rkt +++ b/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?" diff --git a/main.rkt b/main.rkt index 86606fa..911e330 100644 --- a/main.rkt +++ b/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 \ No newline at end of file + (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))) \ No newline at end of file