much cleanup, first version of writing games out to files.
This commit is contained in:
parent
c0c9dda25e
commit
087fec0cdd
|
@ -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?"
|
||||
|
|
72
main.rkt
72
main.rkt
|
@ -53,9 +53,6 @@
|
|||
(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
|
||||
(define (same-position? l1 l2)
|
||||
|
@ -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)])
|
||||
|
@ -230,3 +234,25 @@
|
|||
(+ 3 (* GRID-SCALE (point-y b))))
|
||||
0))))
|
||||
(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)))
|
Loading…
Reference in New Issue