Compare commits
2 commits
3830cdbed4
...
3040c402b8
Author | SHA1 | Date | |
---|---|---|---|
3040c402b8 | |||
fbdf8129f5 |
1 changed files with 45 additions and 92 deletions
|
@ -11,102 +11,55 @@
|
|||
;; Actual Tic Tac Toe game
|
||||
(define ggg-size 3) ;; tic tac toe with more than 3x3 grid?
|
||||
|
||||
(define (^ggg-controller bcom initiator? arg-peer)
|
||||
(format #t "Creating gobbler\n")
|
||||
|
||||
(define mark (if initiator? "x" "o"))
|
||||
(define peer-mark (if initiator? "o" "x"))
|
||||
|
||||
(define board (selfish-spawn ^peer-board))
|
||||
|
||||
;; Move Receiver actor which receives moves from the peer.
|
||||
(define (^move-receiver bcom)
|
||||
(methods
|
||||
;; Receive the move from the peer.
|
||||
[(exchange-move peer coords)
|
||||
(format #t "exchange-move ~s\n" coords)
|
||||
($ board 'choose! coords peer-mark)
|
||||
(move!)]))
|
||||
|
||||
(define receiver (spawn ^move-receiver))
|
||||
|
||||
;; Convert from a prompt to a valid move.
|
||||
;; TODO: validation
|
||||
;; Careful! This does not play nice with the REPL!
|
||||
(define (prompt->move)
|
||||
(format #t "enter move? > ")
|
||||
(map string->number (string-tokenize (read-line (current-input-port)) char-set:digit)))
|
||||
|
||||
;; Do our move.
|
||||
(define (move!)
|
||||
(on (spawn-fibrous-vow (lambda () (prompt->move)))
|
||||
(lambda (move)
|
||||
(format #t "move is ~s\n" move)
|
||||
($ board 'choose! move mark)
|
||||
move)
|
||||
#:promise? #t))
|
||||
|
||||
(define (loop-move peer)
|
||||
(format #t "begin move w ~s\n" peer)
|
||||
(on (move!)
|
||||
(lambda (move)
|
||||
(on (<- peer 'exchange-move receiver move)
|
||||
;; get exchange
|
||||
(lambda (peer-move)
|
||||
;; Actually respond to the move
|
||||
(format #t "Peer move ~s\n" peer-move)
|
||||
($ board 'choose! peer-move peer-mark)
|
||||
;; And now we repeat!
|
||||
(loop-move peer))))))
|
||||
|
||||
;; Initial logic. If the peer is not set we wait until we receive it.
|
||||
;; If we don't go first we also wait.
|
||||
(when (and arg-peer initiator?)
|
||||
(loop-move arg-peer))
|
||||
(define (^ggg-controller bcom initiator? peer)
|
||||
(define mark (if initiator? 'x 'o))
|
||||
(define peer-mark (if initiator? 'o 'x))
|
||||
(define board (make-board))
|
||||
(define my-turn? (not initiator?))
|
||||
|
||||
(methods
|
||||
[(get-receiver) receiver]
|
||||
;; Learn about the receiver from the peer. Then do our move if we are first.
|
||||
[(register-receiver peer)
|
||||
(when initiator?
|
||||
(loop-move peer))]))
|
||||
;; The peer is telling us about the turn it took.
|
||||
[(peer-turn! coords)
|
||||
(if (not my-turn?)
|
||||
(begin
|
||||
(board-choose! board peer-mark coords)
|
||||
(set! my-turn? (not my-turn?))
|
||||
(board-display board))
|
||||
(error "It's my turn!"))]
|
||||
;; TODO: This needs to go somewhere else so the peer can't move for us!
|
||||
[(my-turn! coords)
|
||||
(if my-turn?
|
||||
(begin
|
||||
(board-choose! board mark coords)
|
||||
(set! my-turn? (not my-turn?))
|
||||
(board-display board))
|
||||
(error "It's not my turn."))]))
|
||||
|
||||
;; Board logic
|
||||
|
||||
(define (^peer-board bcom self)
|
||||
;; Define the array with unspecified values, then fill
|
||||
(define arr (make-array *unspecified* ggg-size ggg-size))
|
||||
(array-map! arr (lambda () (spawn ^mark)))
|
||||
(define (make-board)
|
||||
(make-array #f ggg-size ggg-size))
|
||||
|
||||
(methods
|
||||
;; Switch coords for clarity
|
||||
[(ref coords)
|
||||
(match coords ((x y) (array-ref arr y x)))]
|
||||
[(chosen? coords) (not (not ($ ($ self 'ref coords) 'get)))]
|
||||
[(choose! coords mark-char)
|
||||
(let* ((mark ($ self 'ref coords))
|
||||
(char ($ mark 'get)))
|
||||
(if (not (not char))
|
||||
(error "coords already chosen:" coords)
|
||||
(begin
|
||||
($ mark 'choose! mark-char)
|
||||
($ self 'display))))]
|
||||
[(display)
|
||||
(define (print-mark mark)
|
||||
(let ((mark ($ mark 'get)))
|
||||
(or mark " ")))
|
||||
;; this is .. probably messy?
|
||||
(array-slice-for-each-in-order
|
||||
1
|
||||
(lambda (x)
|
||||
(map (lambda (i) (format #t "[~a]" (print-mark i)))
|
||||
(array->list x))
|
||||
(format #t "\n")) arr)]))
|
||||
(define (board-ref board coords)
|
||||
(match coords ((x y) (array-ref board y x))))
|
||||
|
||||
(define* (^mark bcom #:optional [mark #f])
|
||||
(methods
|
||||
[(get) mark]
|
||||
[(choose! mark-char)
|
||||
(if mark
|
||||
(error "this mark is already chosen")
|
||||
(bcom (^mark bcom mark-char)))]))
|
||||
(define (board-choose! board val coords)
|
||||
(match coords
|
||||
((x y)
|
||||
(define ref (board-ref board coords))
|
||||
(if ref
|
||||
(error "That space is already occupied with:" ref)
|
||||
(array-set! board val y x)))))
|
||||
|
||||
(define (board-display board)
|
||||
(define (print-mark mark)
|
||||
(if mark mark " "))
|
||||
|
||||
;; this is .. probably messy?
|
||||
(array-slice-for-each-in-order
|
||||
1
|
||||
(lambda (x)
|
||||
(map (lambda (i) (format #t "[~a]" (print-mark i)))
|
||||
(array->list x))
|
||||
(format #t "\n"))
|
||||
board))
|
||||
|
|
Loading…
Reference in a new issue