gib-gab-gob/game.scm

@@ -11,55 +11,102 @@
 ;; Actual Tic Tac Toe game
 (define ggg-size 3) ;; tic tac toe with more than 3x3 grid?
 
-(define (^ggg-controller bcom initiator? peer)
+(define (^ggg-controller bcom initiator? arg-peer)
-  (define mark (if initiator? 'x 'o))
+  (format #t "Creating gobbler\n")
-  (define peer-mark (if initiator? 'o 'x))
+
-  (define board (make-board))
+  (define mark (if initiator? "x" "o"))
-  (define my-turn? (not initiator?))
+  (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))
 
   (methods
-   ;; The peer is telling us about the turn it took.
+   [(get-receiver) receiver]
-   [(peer-turn! coords)
+   ;; Learn about the receiver from the peer. Then do our move if we are first.
-    (if (not my-turn?)
+   [(register-receiver peer)
-        (begin
+    (when initiator?
-          (board-choose! board peer-mark coords)
+      (loop-move peer))]))
-          (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 (make-board)
+(define (^peer-board bcom self)
-  (make-array #f ggg-size ggg-size))
+  ;; Define the array with unspecified values, then fill
+  (define arr (make-array *unspecified* ggg-size ggg-size))
+  (array-map! arr (lambda () (spawn ^mark)))
 
-(define (board-ref board coords)
+  (methods
-  (match coords ((x y) (array-ref board y x))))
+   ;; Switch coords for clarity
-
+   [(ref coords)
-(define (board-choose! board val coords)
+    (match coords ((x y) (array-ref arr y x)))]
-  (match coords
+   [(chosen? coords) (not (not ($ ($ self 'ref coords) 'get)))]
-    ((x y)
+   [(choose! coords mark-char)
-     (define ref (board-ref board coords))
+    (let* ((mark ($ self 'ref coords))
-     (if ref
+          (char ($ mark 'get)))
-         (error "That space is already occupied with:" ref)
+      (if (not (not char))
-         (array-set! board val y x)))))
+          (error "coords already chosen:" coords)
-
+          (begin
-(define (board-display board)
+            ($ mark 'choose! mark-char)
+            ($ self 'display))))]
+   [(display)
     (define (print-mark mark)
-    (if 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"))
+       (format #t "\n")) arr)]))
-   board))
+
+(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)))]))