#lang racket (provide (all-defined-out)) ; for testing module (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") ; 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) ; size of one grid position in pixels (define GRID-SCALE 16) ; image representing the empty grid (define EMPTY-GRID (let* ([bitmap (make-bitmap (* GRID-WIDTH GRID-SCALE) (* GRID-HEIGHT GRID-SCALE))] [dc (new bitmap-dc% [bitmap bitmap])]) (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)) ; 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) '())))))) ; 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. ; TODO write more tests (define (valid-moves g) (filter (lambda (move) (valid-move? move g)) ALL-LINES)) ; 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-square 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))))) 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 -> 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)))) ; 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)) ; line doesn't already exist on board (valid-length? line) (forwards? line) (and (not (out-of-bounds? (line-from line))) (not (out-of-bounds? (line-to line)))))) ; Grid -> Image ; renders grid to an image for showing humans the game. (define (render-grid grid) (let* ([bitmap (make-bitmap (* GRID-WIDTH GRID-SCALE) (* GRID-HEIGHT GRID-SCALE))] [dc (new bitmap-dc% [bitmap bitmap])]) (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)))) (+ 4 (* GRID-SCALE (point-y (line-to l)))))) ; draw the line (send dc draw-bitmap EMPTY-GRID 0 0) ; overlay dot grid bitmap))