suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fixed an (apparently VERY old) problem with lights out and the built-in boards

Browse Source 
please merge to release branch
(cherry picked from commit 4f236386a9)
This commit is contained in:
Robby Findler 2010-10-22 14:43:58 -05:00 committed by Ryan Culpepper
parent b845c05e7d
commit b7ccf8d91e
2 changed files with 79 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
collects/games/lights-out/board.rkt
View File

@ -51,11 +51,14 @@
6)] 6)]
[button-panel (make-object horizontal-panel% dialog)] [button-panel (make-object horizontal-panel% dialog)]
[cancel? #t] [cancel? #t]
[ok (make-object button% "OK" [ok (new button%
button-panel [label "OK"]
(lambda x [parent button-panel]
(set! cancel? #f) [style '(border)]
(send dialog show #f)))] [callback
(lambda x
(set! cancel? #f)
(send dialog show #f))])]
[cancel (make-object button% "Cancel" [cancel (make-object button% "Cancel"
button-panel button-panel
(lambda x (lambda x
@ -76,9 +79,12 @@
(send random-slider get-value) (send random-slider get-value)
(lambda (x) (make-vector (send random-slider get-value) 'o)))] (lambda (x) (make-vector (send random-slider get-value) 'o)))]
[(prebuilt) [(prebuilt)
(board-board (list-ref boards (send prebuilt get-selection)))])))) (to-vectors (board-board (list-ref boards (send prebuilt get-selection))))]))))
(new-board))) (new-board)))
(define (to-vectors lsts)
(apply vector (map (λ (x) (apply vector x)) lsts)))
'(define (build-vector n f) '(define (build-vector n f)
(list->vector (list->vector
(let loop ([n n]) (let loop ([n n])

129
collects/games/lights-out/boards.rkt
View File

@ -1,64 +1,69 @@
(module boards mzscheme #lang racket/base
(provide boards (require racket/vector)
(struct board (name board)))
(define-struct board (name board)) (provide boards
(struct-out board))
(define boards (define-struct board (name board))
(list
(make-board (define (build-board name vec)
"1" (make-board name (vector-map vector-copy vec)))
#(#(o o o o o)
#(o o o o o) (define boards
#(x o x o x) (list
#(o o o o o) (make-board
#(o o o o o))) "1"
(make-board '((o o o o o)
"2" (o o o o o)
#(#(x o x o x) (x o x o x)
#(x o x o x) (o o o o o)
#(o o o o o) (o o o o o)))
#(x o x o x) (make-board
#(x o x o x))) "2"
(make-board '((x o x o x)
"3" (x o x o x)
#(#(o x o x o) (o o o o o)
#(x x o x x) (x o x o x)
#(x x o x x) (x o x o x)))
#(x x o x x) (make-board
#(o x o x o))) "3"
(make-board '((o x o x o)
"4" (x x o x x)
#(#(o o o o o) (x x o x x)
#(x x o x x) (x x o x x)
#(o o o o o) (o x o x o)))
#(x o o o x) (make-board
#(x x o x x))) "4"
(make-board '((o o o o o)
"5" (x x o x x)
#(#(x x x x o) (o o o o o)
#(x x x o x) (x o o o x)
#(x x x o x) (x x o x x)))
#(o o o x x) (make-board
#(x x o x x))) "5"
(make-board '((x x x x o)
"6" (x x x o x)
#(#(o o o o o) (x x x o x)
#(o o o o o) (o o o x x)
#(x o x o x) (x x o x x)))
#(x o x o x) (make-board
#(o x x x o))) "6"
(make-board '((o o o o o)
"7" (o o o o o)
#(#(x x x x o) (x o x o x)
#(x o o o x) (x o x o x)
#(x o o o x) (o x x x o)))
#(x o o o x) (make-board
#(x x x x o))) "7"
(make-board '((x x x x o)
"Diagonal" (x o o o x)
#(#(o o o o x) (x o o o x)
#(o o o x o) (x o o o x)
#(o o x o o) (x x x x o)))
#(o x o o o) (make-board
#(x o o o o)))))) "Diagonal"
'((o o o o x)
(o o o x o)
(o o x o o)
(o x o o o)
(x o o o o)))))