145 lines
3.8 KiB
Racket
145 lines
3.8 KiB
Racket
(module board mzscheme
|
|
(require mred
|
|
mzlib/class
|
|
mzlib/etc
|
|
"boards.ss")
|
|
|
|
(provide
|
|
new-board ;; : (-> board) querys user
|
|
random-board) ;; : (num -> board)
|
|
|
|
(define (new-board)
|
|
(letrec ([dialog (make-object dialog% "New Board")]
|
|
[mode 'prebuilt]
|
|
[update-mode
|
|
(lambda ()
|
|
(send below-panel change-children
|
|
(case mode
|
|
[(random)
|
|
(lambda x (list random-panel))]
|
|
[(prebuilt)
|
|
(lambda x (list prebuilt-panel))]
|
|
[(empty)
|
|
(lambda x (list random-panel))])))]
|
|
[radio-box
|
|
(make-object radio-box% #f (list "Prebuilt" "Random" "Empty") dialog
|
|
(lambda (rb evt)
|
|
(cond
|
|
[(= 0 (send rb get-selection))
|
|
(set! mode 'prebuilt)]
|
|
[(= 1 (send rb get-selection))
|
|
(set! mode 'random)]
|
|
[(= 2 (send rb get-selection))
|
|
(set! mode 'empty)])
|
|
(update-mode))
|
|
'(horizontal))]
|
|
[below-panel (make-object vertical-panel% dialog)]
|
|
[prebuilt-panel (make-object vertical-panel% below-panel '(border))]
|
|
[prebuilt
|
|
(make-object choice%
|
|
#f
|
|
(map board-name boards)
|
|
prebuilt-panel
|
|
(lambda (choice evt)
|
|
(void)))]
|
|
[random-panel (make-object vertical-panel% below-panel '(border))]
|
|
[random-slider
|
|
(make-object slider%
|
|
"Board Size" 3 8 random-panel
|
|
(lambda (slider evt)
|
|
(void))
|
|
6)]
|
|
[button-panel (make-object horizontal-panel% dialog)]
|
|
[cancel? #t]
|
|
[ok (make-object button% "OK"
|
|
button-panel
|
|
(lambda x
|
|
(set! cancel? #f)
|
|
(send dialog show #f)))]
|
|
[cancel (make-object button% "Cancel"
|
|
button-panel
|
|
(lambda x
|
|
(send dialog show #f)))])
|
|
(update-mode)
|
|
(send button-panel set-alignment 'right 'center)
|
|
(set! new-board
|
|
(lambda ()
|
|
(set! cancel? #t)
|
|
(send dialog show #t)
|
|
(if cancel?
|
|
#f
|
|
(case mode
|
|
[(random)
|
|
(random-board (send random-slider get-value))]
|
|
[(empty)
|
|
(build-vector
|
|
(send random-slider get-value)
|
|
(lambda (x) (make-vector (send random-slider get-value) 'o)))]
|
|
[(prebuilt)
|
|
(board-board (list-ref boards (send prebuilt get-selection)))]))))
|
|
(new-board)))
|
|
|
|
'(define (build-vector n f)
|
|
(list->vector
|
|
(let loop ([n n])
|
|
(cond
|
|
[(zero? n) null]
|
|
[else (cons (f (- n 1)) (loop (- n 1)))]))))
|
|
|
|
(define (random-board n)
|
|
(let* ([choices
|
|
(let loop ([i n]
|
|
[res null])
|
|
(cond
|
|
[(zero? i) res]
|
|
[else
|
|
(loop (- i 1)
|
|
(let loop ([j n]
|
|
[res res])
|
|
(cond
|
|
[(zero? j) res]
|
|
[else (loop (- j 1)
|
|
(cons (cons (- i 1) (- j 1)) res))])))]))]
|
|
[board (build-vector n (lambda (x) (make-vector n 'o)))]
|
|
[flip
|
|
(lambda (i j)
|
|
(when (and (<= 0 i (- n 1))
|
|
(<= 0 j (- n 1)))
|
|
(vector-set! (vector-ref board j) i
|
|
(case (vector-ref (vector-ref board j) i)
|
|
[(x) 'o]
|
|
[(o) 'x]))))]
|
|
[sim-click
|
|
(lambda (i j)
|
|
(flip i j)
|
|
(flip (- i 1) j)
|
|
(flip (+ i 1) j)
|
|
(flip i (+ j 1))
|
|
(flip i (- j 1)))]
|
|
|
|
[number-of-clicks
|
|
(let loop ([n (* (+ n 1) 2)])
|
|
(cond
|
|
[(zero? n) 0]
|
|
[else (+ (random 2)
|
|
(loop (- n 1)))]))])
|
|
|
|
(let loop ([clicks number-of-clicks])
|
|
(unless (zero? clicks)
|
|
(let ([choice (random (length choices))]
|
|
[continue? (not (zero? (random 3)))]
|
|
[choice-coordinates #f])
|
|
(set! choices
|
|
(let loop ([choices choices]
|
|
[n choice])
|
|
(cond
|
|
[(zero? n)
|
|
;(printf "choose: ~a~n" (car choices))
|
|
(set! choice-coordinates (car choices))
|
|
(cdr choices)]
|
|
[else (cons (car choices) (loop (cdr choices) (- n 1)))])))
|
|
(sim-click (car choice-coordinates)
|
|
(cdr choice-coordinates))
|
|
(loop (- clicks 1)))))
|
|
board)))
|