add valid-moves function, cleanup

This commit is contained in:
Nico 2022-04-02 22:55:30 +01:00
parent e4cd2808c2
commit bd25ecc1c4
2 changed files with 92 additions and 22 deletions

View File

@ -2,6 +2,19 @@
(require rackunit "main.rkt")
(define grid (list
(line (point 0 0) (point 0 1) 1)
(line (point 0 1) (point 1 1) 0)
(line (point 1 0) (point 1 1) 1)
(line (point 0 0) (point 1 0) 0)
(line (point 1 1) (point 2 1) 0)
(line (point 2 0) (point 2 1) 1)
(line (point 2 0) (point 3 0) 0)
(line (point 3 3) (point 3 4) 0)
(line (point 3 3) (point 4 3) 0)
(line (point 4 3) (point 4 4) 0)
(line (point 3 4) (point 4 4) 0)))
(test-case
"same-position?"
(check-true (same-position? (line (point 0 0) (point 0 1) 1)
@ -64,21 +77,62 @@
(test-case
"count-square"
(define grid (list
(line (point 0 0) (point 0 1) 1)
(line (point 0 1) (point 1 1) 0)
(line (point 1 0) (point 1 1) 1)
(line (point 0 0) (point 1 0) 0)
(line (point 1 1) (point 2 1) 0)
(line (point 2 0) (point 2 1) 1)
(line (point 2 0) (point 3 0) 0)
(line (point 3 3) (point 3 4) 0)
(line (point 3 3) (point 4 3) 0)
(line (point 4 3) (point 4 4) 0)
(line (point 3 4) (point 4 4) 0)))
(check-equal? (count-square (point 0 0) grid) 4)
(check-equal? (count-square (point 1 0) grid) 3)
(check-equal? (count-square (point 2 0) grid) 2)
(check-equal? (count-square (point 3 2) grid) 1)
(check-equal? (count-square (point 0 4) grid) 0)
)
)
(test-case
"valid-moves"
(check-equal? (valid-moves grid) (list
(line (point 0 1) (point 0 2) 1)
(line (point 0 2) (point 1 2) 1)
(line (point 0 2) (point 0 3) 1)
(line (point 0 3) (point 1 3) 1)
(line (point 0 3) (point 0 4) 1)
(line (point 0 4) (point 1 4) 1)
(line (point 0 4) (point 0 5) 1)
(line (point 0 5) (point 1 5) 1)
(line (point 1 0) (point 2 0) 1)
(line (point 1 1) (point 1 2) 1)
(line (point 1 2) (point 2 2) 1)
(line (point 1 2) (point 1 3) 1)
(line (point 1 3) (point 2 3) 1)
(line (point 1 3) (point 1 4) 1)
(line (point 1 4) (point 2 4) 1)
(line (point 1 4) (point 1 5) 1)
(line (point 1 5) (point 2 5) 1)
(line (point 2 1) (point 3 1) 1)
(line (point 2 1) (point 2 2) 1)
(line (point 2 2) (point 3 2) 1)
(line (point 2 2) (point 2 3) 1)
(line (point 2 3) (point 3 3) 1)
(line (point 2 3) (point 2 4) 1)
(line (point 2 4) (point 3 4) 1)
(line (point 2 4) (point 2 5) 1)
(line (point 2 5) (point 3 5) 1)
(line (point 3 0) (point 4 0) 1)
(line (point 3 0) (point 3 1) 1)
(line (point 3 1) (point 4 1) 1)
(line (point 3 1) (point 3 2) 1)
(line (point 3 2) (point 4 2) 1)
(line (point 3 2) (point 3 3) 1)
(line (point 3 4) (point 3 5) 1)
(line (point 3 5) (point 4 5) 1)
(line (point 4 0) (point 5 0) 1)
(line (point 4 0) (point 4 1) 1)
(line (point 4 1) (point 5 1) 1)
(line (point 4 1) (point 4 2) 1)
(line (point 4 2) (point 5 2) 1)
(line (point 4 2) (point 4 3) 1)
(line (point 4 3) (point 5 3) 1)
(line (point 4 4) (point 5 4) 1)
(line (point 4 4) (point 4 5) 1)
(line (point 4 5) (point 5 5) 1)
(line (point 5 0) (point 5 1) 1)
(line (point 5 1) (point 5 2) 1)
(line (point 5 2) (point 5 3) 1)
(line (point 5 3) (point 5 4) 1)
(line (point 5 4) (point 5 5) 1))))

View File

@ -21,14 +21,22 @@
; 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])]]
(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)
@ -45,17 +53,25 @@
(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. these form a list, which is then folded into #t or #f if any match.
; 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) (foldl (lambda (x y) (or x y)) #f
(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
(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)
@ -94,8 +110,8 @@
; 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])]]
(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