grid structure stuff is almost working
This commit is contained in:
parent
df20fe9b22
commit
8ffad3c7b6
14
gui.rkt
14
gui.rkt
|
@ -17,7 +17,7 @@
|
|||
(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 t 0)
|
||||
(define frame (new frame%
|
||||
[label "Game Analysis"]
|
||||
|
@ -25,12 +25,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) 6 6) dc))]))
|
||||
|
||||
(define log (new list-box%
|
||||
[label ""]
|
||||
|
@ -38,7 +38,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 +52,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 +60,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)
|
|
@ -115,11 +115,11 @@
|
|||
|
||||
(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"
|
||||
|
|
6
main.rkt
6
main.rkt
|
@ -39,7 +39,7 @@
|
|||
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 (grid
|
||||
(define FULL-GRID (grid
|
||||
(flatten
|
||||
(for/list ([x (in-range GRID-WIDTH)])
|
||||
(for/list ([y (in-range GRID-HEIGHT)])
|
||||
|
@ -68,7 +68,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 (grid-lines 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.
|
||||
|
@ -165,7 +165,7 @@
|
|||
(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)]
|
||||
[new-grid (append-move g move)]
|
||||
|
|
Loading…
Reference in New Issue