dotsandboxes/main.rkt

126 lines
4.9 KiB
Racket
Raw Normal View History

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))
; 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-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))