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

14
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"]
[parent button-panel]
[style '(border)]
[callback
(lambda x (lambda x
(set! cancel? #f) (set! cancel? #f)
(send dialog show #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])

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

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