Compare commits
5 Commits
37d0a75ea7
...
e84ee87d72
Author | SHA1 | Date |
---|---|---|
Nico | e84ee87d72 | |
Nico | 8a98223d67 | |
Nico | 0584652a18 | |
Nico | 8ffad3c7b6 | |
Nico | df20fe9b22 |
16
gui.rkt
16
gui.rkt
|
@ -17,7 +17,9 @@
|
|||
(define (analysis-gui game)
|
||||
|
||||
; Make a frame by instantiating the frame% class
|
||||
(define g (GameState-grid game))
|
||||
(define g (grid-lines (GameState-grid game)))
|
||||
(define w (grid-width (GameState-grid game)))
|
||||
(define h (grid-height (GameState-grid game)))
|
||||
(define t 0)
|
||||
(define frame (new frame%
|
||||
[label "Game Analysis"]
|
||||
|
@ -25,12 +27,12 @@
|
|||
[height 300]))
|
||||
|
||||
(define displaypanel (new horizontal-panel% [parent frame]))
|
||||
(define grid (new canvas%
|
||||
(define grid-canvas (new canvas%
|
||||
[parent displaypanel]
|
||||
[paint-callback
|
||||
(lambda (canvas dc)
|
||||
(send dc clear)
|
||||
(render-grid (take g t) dc))]))
|
||||
(render-grid (grid (take g t) w h) dc))]))
|
||||
|
||||
(define log (new list-box%
|
||||
[label ""]
|
||||
|
@ -38,7 +40,7 @@
|
|||
[choices (map line->string g)]
|
||||
[callback (lambda (box event)
|
||||
(set! t (car (send box get-selections)))
|
||||
(send grid refresh))]))
|
||||
(send grid-canvas refresh))]))
|
||||
|
||||
(define buttonpanel (new horizontal-panel%
|
||||
[parent frame]
|
||||
|
@ -52,7 +54,7 @@
|
|||
(if (not (= t 0))
|
||||
(set! t (sub1 t)) 0)
|
||||
(send log select (- t 1))
|
||||
(send grid refresh))]))
|
||||
(send grid-canvas refresh))]))
|
||||
(define forwardbutton (new button%
|
||||
[parent buttonpanel]
|
||||
[label "forward"]
|
||||
|
@ -60,12 +62,12 @@
|
|||
(if (not (= t (length g)))
|
||||
(set! t (add1 t)) 0)
|
||||
(send log select (- t 1))
|
||||
(send grid refresh))]))
|
||||
(send grid-canvas refresh))]))
|
||||
(define score (new message%
|
||||
[parent buttonpanel]
|
||||
[label (format "Final Score: R: ~a, B: ~a" (first (GameState-scores game)) (last (GameState-scores game)))]))
|
||||
(send frame show #t))
|
||||
|
||||
(define g (play-game (GameState '() 0 '(0 0)) (list random-player random-player)))
|
||||
(define g (play-game (GameState (grid '() 6 6) 0 '(0 0) (list random-player random-player))))
|
||||
(print (GameState-grid g))
|
||||
(analysis-gui g)
|
|
@ -2,7 +2,7 @@
|
|||
|
||||
(require rackunit "main.rkt")
|
||||
|
||||
(define grid (list
|
||||
(define test-grid (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)
|
||||
|
@ -13,7 +13,7 @@
|
|||
(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)))
|
||||
(line (point 3 4) (point 4 4) 0)) 6 6))
|
||||
|
||||
(test-case
|
||||
"same-position?"
|
||||
|
@ -47,14 +47,14 @@
|
|||
(check-equal? (boxes-for (line (point 0 0) (point 0 1) 1)) (list (point 0 0)))
|
||||
(check-equal? (boxes-for (line (point 2 1) (point 2 2) 1)) (list (point 2 1) (point 1 1)))
|
||||
(check-equal? (boxes-for (line (point 0 0) (point 1 0) 1)) (list (point 0 0)))
|
||||
(check-equal? (boxes-for (line (point 1 1) (point 2 1) 1)) (list (point 1 1) (point 1 0)))
|
||||
(check-equal? (boxes-for (line (point 1 1) (point 2 1) 1)) (list (point 1 1) (point 1 0)))
|
||||
(check-equal? (boxes-for (line (point 0 5) (point 1 5) 1)) (list (point 0 4)))
|
||||
(check-equal? (boxes-for (line (point 5 0) (point 5 1) 0)) (list (point 4 0))))
|
||||
|
||||
(test-case
|
||||
"completes-boxes"
|
||||
(define grid
|
||||
(list
|
||||
(define test-grid
|
||||
(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)
|
||||
|
@ -72,26 +72,26 @@
|
|||
(line (point 3 4) (point 4 4) 1)
|
||||
(line (point 4 5) (point 5 5) 1)
|
||||
(line (point 4 4) (point 5 4) 0)
|
||||
(line (point 5 4) (point 5 5) 1))) ; all possible unfinished boxes (plus an unfinished double)
|
||||
(check-equal? (completes-boxes grid (line (point 0 0) (point 1 0) 0)) 1)
|
||||
(check-equal? (completes-boxes grid (line (point 1 2) (point 1 3) 0)) 1)
|
||||
(check-equal? (completes-boxes grid (line (point 3 1) (point 4 1) 0)) 1)
|
||||
(check-equal? (completes-boxes grid (line (point 0 5) (point 1 5) 0)) 1)
|
||||
(check-equal? (completes-boxes grid (line (point 4 4) (point 4 5) 0)) 2)
|
||||
(check-equal? (completes-boxes grid (line (point 1 0) (point 2 0) 1)) 0))
|
||||
(line (point 5 4) (point 5 5) 1)) 6 6)) ; all possible unfinished boxes (plus an unfinished double)
|
||||
(check-equal? (completes-boxes test-grid (line (point 0 0) (point 1 0) 0)) 1)
|
||||
(check-equal? (completes-boxes test-grid (line (point 1 2) (point 1 3) 0)) 1)
|
||||
(check-equal? (completes-boxes test-grid (line (point 3 1) (point 4 1) 0)) 1)
|
||||
(check-equal? (completes-boxes test-grid (line (point 0 5) (point 1 5) 0)) 1)
|
||||
(check-equal? (completes-boxes test-grid (line (point 4 4) (point 4 5) 0)) 2)
|
||||
(check-equal? (completes-boxes test-grid (line (point 1 0) (point 2 0) 1)) 0))
|
||||
|
||||
(test-case
|
||||
"valid-move?"
|
||||
(define grid (list
|
||||
(define test-grid (grid (list
|
||||
(line (point 0 0) (point 0 1) 1)
|
||||
(line (point 0 1) (point 0 2) 0)
|
||||
(line (point 3 2) (point 3 3) 0)))
|
||||
(check-false (valid-move? (line (point 0 0) (point 0 1) 1) grid))
|
||||
(check-true (valid-move? (line (point 0 2) (point 0 3) 0) grid)) ; not overwriting existing moves
|
||||
(check-false (valid-move? (line (point 0 2) (point 0 1) 1) grid)) ; moving forward
|
||||
(check-false (valid-move? (line (point 0 0) (point 0 2) 1) grid)) ; valid length check
|
||||
(check-false (valid-move? (line (point (+ GRID-WIDTH 1) 0) (point 0 2) 1) grid))
|
||||
(check-false (valid-move? (line (point (+ GRID-WIDTH 1) 0) (point 0 2) 1) grid))) ; out of bounds
|
||||
(line (point 3 2) (point 3 3) 0)) 6 6))
|
||||
(check-false (valid-move? (line (point 0 0) (point 0 1) 1) test-grid))
|
||||
(check-true (valid-move? (line (point 0 2) (point 0 3) 0) test-grid)) ; not overwriting existing moves
|
||||
(check-false (valid-move? (line (point 0 2) (point 0 1) 1) test-grid)) ; moving forward
|
||||
(check-false (valid-move? (line (point 0 0) (point 0 2) 1) test-grid)) ; valid length check
|
||||
(check-false (valid-move? (line (point (+ GRID-WIDTH 1) 0) (point 0 2) 1) test-grid))
|
||||
(check-false (valid-move? (line (point (+ GRID-WIDTH 1) 0) (point 0 2) 1) test-grid))) ; out of bounds
|
||||
|
||||
(test-case
|
||||
"out-of-bounds?"
|
||||
|
@ -115,21 +115,24 @@
|
|||
|
||||
(test-case
|
||||
"count-square"
|
||||
(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))
|
||||
(check-equal? (count-square (point 0 0) test-grid) 4)
|
||||
(check-equal? (count-square (point 1 0) test-grid) 3)
|
||||
(check-equal? (count-square (point 2 0) test-grid) 2)
|
||||
(check-equal? (count-square (point 3 2) test-grid) 1)
|
||||
(check-equal? (count-square (point 0 4) test-grid) 0))
|
||||
|
||||
(test-case
|
||||
"append-move"
|
||||
(check-equal? (append-move grid (line (point 2 2) (point 2 3) 0)) (append grid (list (line (point 2 2) (point 2 3) 0))))
|
||||
(check-equal? (append-move grid (line (point 0 0) (point 0 1) 0)) grid))
|
||||
(check-equal? (append-move test-grid (line (point 2 2) (point 2 3) 0)) (grid (append
|
||||
(grid-lines test-grid)
|
||||
(list (line (point 2 2) (point 2 3) 0)))
|
||||
(grid-width test-grid) (grid-height test-grid)))
|
||||
(check-equal? (append-move test-grid (line (point 0 0) (point 0 1) 0)) test-grid))
|
||||
|
||||
|
||||
(test-case
|
||||
"valid-moves"
|
||||
(check-equal? (valid-moves grid) (list
|
||||
(check-equal? (valid-moves test-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)
|
||||
|
|
60
main.rkt
60
main.rkt
|
@ -4,7 +4,10 @@
|
|||
|
||||
(require racket/draw racket/random)
|
||||
|
||||
; 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")
|
||||
; 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)
|
||||
|
||||
; represents a point in 2d space.
|
||||
(struct point (x y) #:transparent)
|
||||
|
@ -16,7 +19,14 @@
|
|||
; grid is the grid
|
||||
; player is the current player
|
||||
; scores is a list of numbers for the score of each player.
|
||||
(struct GameState (grid player scores) #:transparent)
|
||||
; players is a list of two players who are playing in the game
|
||||
(struct GameState (grid player scores players) #:transparent)
|
||||
|
||||
; 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.
|
||||
(struct player (name func) #:transparent)
|
||||
|
||||
; width and height of the playing grid.
|
||||
(define GRID-WIDTH 6)
|
||||
|
@ -36,12 +46,13 @@
|
|||
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
|
||||
(define FULL-GRID (grid
|
||||
(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) '()))))))
|
||||
(if (< y (- GRID-HEIGHT 1)) (line (point x y) (point x (+ y 1)) 1) '()))))) GRID-WIDTH GRID-HEIGHT))
|
||||
|
||||
; Line Line -> Bool
|
||||
; tests if two lines are in the same position
|
||||
|
@ -64,7 +75,7 @@
|
|||
; 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))
|
||||
(filter (lambda (move) (valid-move? move g)) (grid-lines FULL-GRID)))
|
||||
|
||||
; 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.
|
||||
|
@ -77,7 +88,7 @@
|
|||
(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
|
||||
(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
|
||||
|
||||
; Line -> Bool
|
||||
; returns #t if the line is forwards (with forwards being moving right and down, higher end coord than start)
|
||||
|
@ -106,26 +117,25 @@
|
|||
; 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
|
||||
(empty? (filter (lambda (l) (same-position? l line)) (grid-lines 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))))))
|
||||
|
||||
; a Player 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.
|
||||
|
||||
; a Player that plays random moves
|
||||
(define (random-player g n)
|
||||
(let ([m (car (random-sample (valid-moves g) 1))])
|
||||
(line (line-from m) (line-to m) n)))
|
||||
(define random-player
|
||||
(player
|
||||
"Random"
|
||||
(lambda (g n)
|
||||
(let ([m (car (random-sample (valid-moves g) 1))])
|
||||
(line (line-from m) (line-to m) n)))))
|
||||
|
||||
; Grid Line -> Grid
|
||||
; adds line to grid, if it is a valid move. Otherwise skips the move.
|
||||
(define (append-move g l)
|
||||
(if (valid-move? l g) (append g (list l)) g))
|
||||
(if (valid-move? l g) (grid (append (grid-lines g) (list l)) (grid-width g) (grid-height g)) g))
|
||||
|
||||
; Line -> List of Points
|
||||
; returns the positions of boxes the given line affects, assuming a valid line.
|
||||
|
@ -152,18 +162,18 @@
|
|||
([boxes (boxes-for l)]
|
||||
[g (append-move grid l)])
|
||||
(length (filter (lambda (b) (= (count-square b g) 4)) boxes))))
|
||||
|
||||
; GameState, List of 2 Players -> GameState
|
||||
|
||||
; GameState -> GameState
|
||||
; 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.
|
||||
(define (play-game s players)
|
||||
(define (play-game s)
|
||||
(let ([g (GameState-grid s)]
|
||||
[p (GameState-player s)])
|
||||
(cond
|
||||
[(= (length g) (length ALL-LINES)) s] ; end of the game
|
||||
[(= (length (grid-lines g)) (length (grid-lines FULL-GRID))) s] ; end of the game
|
||||
[else
|
||||
(let* ([move ((list-ref players p) g p)]
|
||||
(let* ([move ((player-func (list-ref (GameState-players s) p)) g p)]
|
||||
[new-grid (append-move g move)]
|
||||
[boxes (completes-boxes g move)]
|
||||
[box (not (= 0 boxes))]
|
||||
|
@ -171,7 +181,7 @@
|
|||
(play-game (GameState
|
||||
new-grid
|
||||
(if box p (abs (- p 1)))
|
||||
(if box (list-set scores p (+ boxes (list-ref scores p))) scores)) players))])))
|
||||
(if box (list-set scores p (+ boxes (list-ref scores p))) scores) (GameState-players s))))])))
|
||||
|
||||
; Grid -> Image
|
||||
; renders grid to an image for showing humans the game.
|
||||
|
@ -185,9 +195,9 @@
|
|||
; renders grid on the given drawing context.
|
||||
; TODO setting line color doesn't seem to be always working?
|
||||
; TODO color in squares
|
||||
(define (render-grid grid dc)
|
||||
(define (render-grid g dc)
|
||||
(define passed '())
|
||||
(for ([l grid]) ; reversed for fill-drawing malarkey.
|
||||
(for ([l (grid-lines g)]) ; reversed for fill-drawing malarkey.
|
||||
(if (empty? passed) (set! passed (list l)) (set! passed (append passed (list l))))
|
||||
(cond
|
||||
[(= (line-player l) 0) (send dc set-pen "red" 4 'solid)] ; player 1 draws in red
|
||||
|
@ -199,8 +209,8 @@
|
|||
(+ 4 (* GRID-SCALE (point-y (line-to l))))) ; draw the line
|
||||
(let ([boxes (boxes-for l)])
|
||||
(for ([b boxes])
|
||||
(if (= (count-square b passed) 4)
|
||||
(send dc draw-text
|
||||
(if (= (count-square b (grid passed (grid-width g) (grid-height g))) 4)
|
||||
(send dc draw-text
|
||||
(if (= (line-player l) 0) "R" "B")
|
||||
(+ 6 (* GRID-SCALE (point-x b)))
|
||||
(+ 3 (* GRID-SCALE (point-y b))))
|
||||
|
|
Loading…
Reference in New Issue