2022-03-30 19:08:45 +00:00
#lang racket
2022-03-30 19:12:43 +00:00
( provide ( all-defined-out ) ) ; for testing module
2022-04-07 21:20:59 +00:00
( require racket/draw racket/random file/gif )
2022-03-31 13:40:43 +00:00
2022-04-04 11:07:36 +00:00
; 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 )
2022-03-30 19:08:45 +00:00
; 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 )
2022-04-03 17:50:25 +00:00
; represents the state of a game in play
; grid is the grid
2022-04-07 16:47:46 +00:00
; player is the current player (ignored when the game is over)
2022-04-03 17:50:25 +00:00
; scores is a list of numbers for the score of each player.
2022-04-04 13:35:43 +00:00
; players is a list of two players who are playing in the game
( struct GameState ( grid player scores players ) #:transparent )
2022-04-03 17:50:25 +00:00
2022-04-04 13:12:17 +00:00
; 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.
2022-04-05 13:58:30 +00:00
; func can also be 0
2022-04-04 13:35:43 +00:00
( struct player ( name func ) #:transparent )
2022-04-04 13:12:17 +00:00
2022-03-31 13:40:43 +00:00
; size of one grid position in pixels
( define GRID-SCALE 16 )
2022-04-05 10:14:06 +00:00
; Number Number -> Image
2022-03-31 13:40:43 +00:00
; image representing the empty grid
2022-04-05 10:14:06 +00:00
( define ( grid-dots w h )
( let* ( [ bitmap ( make-bitmap ( * w GRID-SCALE ) ( * h GRID-SCALE ) ) ]
2022-04-02 21:55:30 +00:00
[ dc ( new bitmap-dc% [ bitmap bitmap ] ) ] )
2022-03-31 13:40:43 +00:00
( send dc set-brush " black " ' solid )
2022-04-05 10:14:06 +00:00
( for ( [ x ( in-range w ) ] )
( for ( [ y ( in-range h ) ] )
2022-03-31 13:40:43 +00:00
( send dc draw-ellipse ( * x GRID-SCALE ) ( * y GRID-SCALE ) ( / GRID-SCALE 2 ) ( / GRID-SCALE 2 ) ) ) )
bitmap ) )
2022-03-30 19:08:45 +00:00
2022-04-05 10:14:06 +00:00
; 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
2022-04-04 11:07:36 +00:00
( flatten
2022-04-05 10:14:06 +00:00
( for/list ( [ x ( in-range w ) ] )
( for/list ( [ y ( in-range h ) ] )
2022-04-02 21:55:30 +00:00
( list
2022-04-05 10:14:06 +00:00
( 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 ) )
2022-04-05 13:58:30 +00:00
2022-03-30 19:08:45 +00:00
; 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 ) ) ) ) )
2022-04-01 22:11:42 +00:00
; Point Point -> Point
; adds two points together.
( define ( point+ p1 p2 )
( point ( + ( point-x p1 ) ( point-x p2 ) ) ( + ( point-y p1 ) ( point-y p2 ) ) ) )
2022-04-02 21:55:30 +00:00
; 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 )
2022-04-05 21:05:21 +00:00
( filter ( lambda ( move ) ( valid-move? move g ) ) ( grid-lines ( full-grid ( grid-width g ) ( grid-height g ) ) ) ) )
2022-04-02 21:55:30 +00:00
2022-04-01 16:01:32 +00:00
; 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.
2022-04-05 21:23:56 +00:00
( define ( count-box p g )
2022-04-01 22:11:42 +00:00
; explanation:
2022-04-02 21:55:30 +00:00
; for every item in the grid (g), test it against every edge of the box for equality. if any are equal, it matches.
2022-04-01 22:14:22 +00:00
; then only those that match are kept and this list is checked for length to determine the matching lines.
2022-04-01 22:11:42 +00:00
( length
2022-04-02 21:55:30 +00:00
( 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 ) ) ] )
2022-04-04 11:07:36 +00:00
( 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
2022-04-01 16:01:32 +00:00
2022-03-31 11:18:48 +00:00
; 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 ) ) ) ) )
2022-03-30 19:08:45 +00:00
; 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 ) ) ) ) ) ) )
2022-04-05 10:14:06 +00:00
; Point Grid -> Bool
2022-03-30 19:08:45 +00:00
; returns #t if a point is out of bounds (off the edge of the grid)
2022-04-05 10:14:06 +00:00
( define ( out-of-bounds? p g )
2022-03-30 19:08:45 +00:00
( or
( > 0 ( point-x p ) )
( > 0 ( point-y p ) )
2022-04-05 10:14:06 +00:00
( < ( - ( grid-width g ) 1 ) ( point-x p ) )
( < ( - ( grid-height g ) 1 ) ( point-y p ) ) ) )
2022-03-30 19:08:45 +00:00
2022-03-31 15:47:03 +00:00
; Line Grid -> Bool
2022-03-31 13:40:43 +00:00
; returns #t if adding the given move to the grid is valid.
( define ( valid-move? line grid )
2022-03-30 19:08:45 +00:00
( and
2022-04-04 11:07:36 +00:00
( empty? ( filter ( lambda ( l ) ( same-position? l line ) ) ( grid-lines grid ) ) ) ; line doesn't already exist on board
2022-03-30 19:08:45 +00:00
( valid-length? line )
2022-03-31 11:18:48 +00:00
( forwards? line )
2022-03-30 19:08:45 +00:00
( and
2022-04-05 10:14:06 +00:00
( not ( out-of-bounds? ( line-from line ) grid ) )
( not ( out-of-bounds? ( line-to line ) grid ) ) ) ) )
2022-03-31 13:40:43 +00:00
2022-04-03 14:18:59 +00:00
; Grid Line -> Grid
; adds line to grid, if it is a valid move. Otherwise skips the move.
( define ( append-move g l )
2022-04-04 11:07:36 +00:00
( if ( valid-move? l g ) ( grid ( append ( grid-lines g ) ( list l ) ) ( grid-width g ) ( grid-height g ) ) g ) )
2022-04-03 14:18:59 +00:00
2022-04-05 21:05:21 +00:00
; 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 ) ) ) ) )
2022-04-05 10:14:06 +00:00
; Line Grid -> List of Points
2022-04-05 21:05:21 +00:00
; 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).
2022-04-05 10:14:06 +00:00
( define ( boxes-for line g )
2022-04-05 21:05:21 +00:00
( 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 ) ) ) ) ) )
2022-04-03 14:18:59 +00:00
2022-04-03 17:50:25 +00:00
; Grid Line -> bool or Number
; returns the number of boxes this completes
2022-04-05 10:14:06 +00:00
( define ( completes-boxes gr l )
2022-04-03 14:18:59 +00:00
( let
2022-04-05 10:14:06 +00:00
( [ boxes ( boxes-for l gr ) ]
[ g ( append-move gr l ) ] )
2022-04-05 21:23:56 +00:00
( length ( filter ( lambda ( b ) ( = ( count-box b g ) 4 ) ) boxes ) ) ) )
2022-04-05 10:14:06 +00:00
; 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 ) ) ) ) )
2022-04-04 13:35:43 +00:00
; GameState -> GameState
2022-04-03 17:50:25 +00:00
; 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.
2022-04-04 13:35:43 +00:00
( define ( play-game s )
2022-04-03 17:50:25 +00:00
( let ( [ g ( GameState-grid s ) ]
[ p ( GameState-player s ) ] )
( cond
2022-04-05 10:14:06 +00:00
[ ( = ( length ( grid-lines g ) ) ( total-moves g ) ) s ] ; end of the game when every possible line is played
2022-04-03 17:50:25 +00:00
[ else
2022-04-04 13:35:43 +00:00
( let* ( [ move ( ( player-func ( list-ref ( GameState-players s ) p ) ) g p ) ]
2022-04-03 17:50:25 +00:00
[ 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 ) ) )
2022-04-04 13:35:43 +00:00
( if box ( list-set scores p ( + boxes ( list-ref scores p ) ) ) scores ) ( GameState-players s ) ) ) ) ] ) ) )
2022-04-03 14:18:59 +00:00
2022-04-07 20:03:18 +00:00
; 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 ) ) ) )
2022-04-07 21:20:59 +00:00
; 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 )
2022-04-09 18:44:51 +00:00
, ( player ( last ( assoc ' player1 data ) ) 0 ) ) ) ) )
2022-04-07 21:20:59 +00:00
2022-03-31 13:40:43 +00:00
; Grid -> Image
; renders grid to an image for showing humans the game.
2022-04-05 10:14:06 +00:00
( define ( render-grid-bitmap g )
2022-04-09 18:44:51 +00:00
( let* ( [ bitmap ( make-bitmap ( * ( grid-width g ) GRID-SCALE ) ( * ( grid-width g ) GRID-SCALE ) ) ] ; add border for printing
2022-04-02 21:55:30 +00:00
[ dc ( new bitmap-dc% [ bitmap bitmap ] ) ] )
2022-04-05 10:14:06 +00:00
( render-grid g dc )
2022-04-03 17:50:25 +00:00
bitmap ) )
; Grid dc !
; renders grid on the given drawing context.
2022-04-04 12:58:49 +00:00
( define ( render-grid g dc )
2022-04-03 19:26:38 +00:00
( define passed ' ( ) )
2022-04-05 13:58:30 +00:00
( for ( [ l ( grid-lines g ) ] )
2022-04-03 19:26:38 +00:00
( if ( empty? passed ) ( set! passed ( list l ) ) ( set! passed ( append passed ( list l ) ) ) )
2022-04-03 17:50:25 +00:00
( cond
2022-04-03 19:26:38 +00:00
[ ( = ( 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
2022-04-03 17:50:25 +00:00
( 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 ) ) ) )
2022-04-03 19:26:38 +00:00
( + 4 ( * GRID-SCALE ( point-y ( line-to l ) ) ) ) ) ; draw the line
2022-04-05 10:14:06 +00:00
( let ( [ boxes ( boxes-for l g ) ] )
2022-04-03 19:26:38 +00:00
( for ( [ b boxes ] )
2022-04-05 21:23:56 +00:00
( if ( = ( count-box b ( grid passed ( grid-width g ) ( grid-height g ) ) ) 4 )
2022-04-04 12:58:49 +00:00
( send dc draw-text
2022-04-03 19:26:38 +00:00
( if ( = ( line-player l ) 0 ) " R " " B " )
( + 6 ( * GRID-SCALE ( point-x b ) ) )
( + 3 ( * GRID-SCALE ( point-y b ) ) ) )
0 ) ) ) )
2022-04-05 21:05:21 +00:00
( send dc draw-bitmap ( grid-dots ( grid-width g ) ( grid-height g ) ) 0 0 ) ) ; overlay dot grid
2022-04-07 21:20:59 +00:00
; 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 )
) ) )
2022-04-07 16:47:46 +00:00
2022-04-07 21:20:59 +00:00
; 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 ) ) ) ) ]
) )