289 lines
11 KiB
Racket
289 lines
11 KiB
Racket
#lang racket
|
|
|
|
(provide (all-defined-out)) ; for testing module
|
|
|
|
(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")
|
|
; -- the width and height of the grid.
|
|
(struct grid (lines width height) #:transparent)
|
|
|
|
; represents a point in 2d space.
|
|
(struct point (x y) #:transparent)
|
|
|
|
; represents a line drawn from one point to another and which player drew it.
|
|
(struct line (from to player) #:transparent)
|
|
|
|
; represents the state of a game in play
|
|
; grid is the grid
|
|
; player is the current player (ignored when the game is over)
|
|
; scores is a list of numbers for the score of each player.
|
|
; 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.
|
|
; func can also be 0
|
|
(struct player (name func) #:transparent)
|
|
|
|
; size of one grid position in pixels
|
|
(define GRID-SCALE 16)
|
|
|
|
; Number Number -> Image
|
|
; image representing the empty grid
|
|
(define (grid-dots w h)
|
|
(let* ([bitmap (make-bitmap (* w GRID-SCALE) (* h GRID-SCALE))]
|
|
[dc (new bitmap-dc% [bitmap bitmap])])
|
|
(send dc set-brush "black" 'solid)
|
|
(for ([x (in-range w)])
|
|
(for ([y (in-range h)])
|
|
(send dc draw-ellipse (* x GRID-SCALE) (* y GRID-SCALE) (/ GRID-SCALE 2) (/ GRID-SCALE 2))))
|
|
bitmap))
|
|
|
|
; Width Height -> Grid
|
|
; Generates a 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 (full-grid w h) (grid
|
|
(flatten
|
|
(for/list ([x (in-range w)])
|
|
(for/list ([y (in-range h)])
|
|
(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))
|
|
|
|
; Line Line -> Bool
|
|
; tests if two lines are in the same position
|
|
(define (same-position? l1 l2)
|
|
(or
|
|
(and
|
|
(equal? (line-from l1) (line-from l2))
|
|
(equal? (line-to l1) (line-to l2)))
|
|
(and
|
|
(equal? (line-to l1) (line-from l2))
|
|
(equal? (line-from l1) (line-to l2)))))
|
|
|
|
; Point Point -> Point
|
|
; adds two points together.
|
|
(define (point+ p1 p2)
|
|
(point (+ (point-x p1) (point-x p2)) (+ (point-y p1) (point-y p2))))
|
|
|
|
; 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.
|
|
(define (valid-moves g)
|
|
(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.
|
|
(define (count-box p g)
|
|
; explanation:
|
|
; for every item in the grid (g), test it against every edge of the box for equality. if any are equal, it matches.
|
|
; then only those that match are kept and this list is checked for length to determine the matching lines.
|
|
(length
|
|
(filter (lambda (item)
|
|
(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))))) (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)
|
|
(define (forwards? line)
|
|
(and
|
|
(>= (point-x (line-to line)) (point-x (line-from line)))
|
|
(>= (point-y (line-to line)) (point-y (line-from line)))))
|
|
|
|
; Line -> Bool
|
|
; returns #t if a line is valid in terms of length (only moving one point in one direction)
|
|
(define (valid-length? line)
|
|
(= 1
|
|
(+ (abs (- (point-x (line-from line)) (point-x (line-to line))))
|
|
(abs (- (point-y (line-from line)) (point-y (line-to line)))))))
|
|
|
|
; Point Grid -> Bool
|
|
; returns #t if a point is out of bounds (off the edge of the grid)
|
|
(define (out-of-bounds? p g)
|
|
(or
|
|
(> 0 (point-x p))
|
|
(> 0 (point-y p))
|
|
(< (- (grid-width g) 1) (point-x p))
|
|
(< (- (grid-height g) 1) (point-y p))))
|
|
|
|
; Line Grid -> Bool
|
|
; 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-lines grid))) ; line doesn't already exist on board
|
|
(valid-length? line)
|
|
(forwards? line)
|
|
(and
|
|
(not (out-of-bounds? (line-from line) grid))
|
|
(not (out-of-bounds? (line-to line) grid)))))
|
|
|
|
; 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 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 (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
|
|
(define (completes-boxes gr l)
|
|
(let
|
|
([boxes (boxes-for l gr)]
|
|
[g (append-move gr l)])
|
|
(length (filter (lambda (b) (= (count-box b g) 4)) boxes))))
|
|
|
|
; Grid -> Number
|
|
; returns the total amount of moves possible for grid g.
|
|
; formula determined using a pen and paper to be:
|
|
; (width * (height-1) + (height * (width - 1))
|
|
(define (total-moves g)
|
|
(let ([w (grid-width g)]
|
|
[h (grid-height g)])
|
|
(+
|
|
(* w (- h 1))
|
|
(* h (- w 1)))))
|
|
|
|
; 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)
|
|
(let ([g (GameState-grid s)]
|
|
[p (GameState-player s)])
|
|
(cond
|
|
[(= (length (grid-lines g)) (total-moves g)) s] ; end of the game when every possible line is played
|
|
[else
|
|
(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))]
|
|
[scores (GameState-scores s)])
|
|
(play-game (GameState
|
|
new-grid
|
|
(if box p (abs (- p 1)))
|
|
(if box (list-set scores p (+ boxes (list-ref scores p))) scores) (GameState-players s))))])))
|
|
|
|
; player player Number Number -> GameState
|
|
; convenience function for play-game.
|
|
; numbers are grid dimensions
|
|
(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 (* (grid-width g) GRID-SCALE) (* (grid-width g) GRID-SCALE))] ; add border for printing
|
|
[dc (new bitmap-dc% [bitmap bitmap])])
|
|
(render-grid g dc)
|
|
bitmap))
|
|
|
|
; Grid dc !
|
|
; renders grid on the given drawing context.
|
|
(define (render-grid g dc)
|
|
(define passed '())
|
|
(for ([l (grid-lines g)])
|
|
(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
|
|
[(= (line-player l) 1) (send dc set-pen "blue" 4 'solid)]) ; player 2 draws in blue
|
|
(send dc draw-line
|
|
(+ 4 (* GRID-SCALE (point-x (line-from l))))
|
|
(+ 4 (* GRID-SCALE (point-y (line-from l))))
|
|
(+ 4 (* GRID-SCALE (point-x (line-to l))))
|
|
(+ 4 (* GRID-SCALE (point-y (line-to l))))) ; draw the line
|
|
(let ([boxes (boxes-for l g)])
|
|
(for ([b boxes])
|
|
(if (= (count-box b (grid passed (grid-width g) (grid-height g))) 4)
|
|
(send dc draw-text
|
|
(if (= (line-player l) 0) "R" "B")
|
|
(+ 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
|
|
|
|
; 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)
|
|
)))
|
|
|
|
|
|
; 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))))]
|
|
))
|