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-03-31 13:40:43 +00:00
( require racket/draw )
; a Grid is 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")
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 )
; width and height of the playing grid.
( define GRID-WIDTH 6 )
( define GRID-HEIGHT 6 )
2022-03-31 13:40:43 +00:00
; size of one grid position in pixels
( define GRID-SCALE 16 )
; image representing the empty grid
( define EMPTY-GRID
2022-04-02 21:55:30 +00:00
( let* ( [ bitmap ( make-bitmap ( * GRID-WIDTH GRID-SCALE ) ( * GRID-HEIGHT GRID-SCALE ) ) ]
[ dc ( new bitmap-dc% [ bitmap bitmap ] ) ] )
2022-03-31 13:40:43 +00:00
( send dc set-brush " black " ' solid )
( for ( [ x ( in-range GRID-WIDTH ) ] )
( for ( [ y ( in-range GRID-HEIGHT ) ] )
( 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-02 21:55:30 +00:00
; 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 ALL-LINES ( flatten
( for/list ( [ x ( in-range GRID-WIDTH ) ] )
( for/list ( [ y ( in-range GRID-HEIGHT ) ] )
( list
( if ( < x ( - GRID-WIDTH 1 ) ) ( line ( point x y ) ( point ( + x 1 ) y ) 1 ) ' ( ) )
( if ( < y ( - GRID-HEIGHT 1 ) ) ( line ( point x y ) ( point x ( + y 1 ) ) 1 ) ' ( ) ) ) ) ) ) )
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.
; TODO write more tests
( define ( valid-moves g )
( filter ( lambda ( move ) ( valid-move? move g ) ) ALL-LINES ) )
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-01 22:11:42 +00:00
( define ( count-square p g )
; 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 ) ) ] )
( same-position? item ( line ( point+ x p ) ( point+ y p ) 0 ) ) ) ) ) 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 ) ) ) ) ) ) )
; Point -> Bool
; returns #t if a point is out of bounds (off the edge of the grid)
( define ( out-of-bounds? p )
( or
( > 0 ( point-x p ) )
( > 0 ( point-y p ) )
( < ( - GRID-WIDTH 1 ) ( point-x p ) )
( < ( - GRID-WIDTH 1 ) ( point-y p ) ) ) )
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-03-31 13:40:43 +00:00
( empty? ( filter ( lambda ( l ) ( same-position? l line ) ) 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
( not ( out-of-bounds? ( line-from line ) ) )
2022-03-31 11:18:48 +00:00
( not ( out-of-bounds? ( line-to line ) ) ) ) ) )
2022-03-31 13:40:43 +00:00
; Grid -> Image
; renders grid to an image for showing humans the game.
( define ( render-grid grid )
2022-04-02 21:55:30 +00:00
( let* ( [ bitmap ( make-bitmap ( * GRID-WIDTH GRID-SCALE ) ( * GRID-HEIGHT GRID-SCALE ) ) ]
[ dc ( new bitmap-dc% [ bitmap bitmap ] ) ] )
2022-03-31 13:40:43 +00:00
( for ( [ l grid ] )
( 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 ) ) ) )
2022-03-31 15:47:03 +00:00
( + 4 ( * GRID-SCALE ( point-y ( line-to l ) ) ) ) ) ) ; draw the line
2022-03-31 13:40:43 +00:00
( send dc draw-bitmap EMPTY-GRID 0 0 ) ; overlay dot grid
bitmap ) )