gib-gab-gob/gib-gab-gob/actors.scm

(define-module (gib-gab-gob actors)
  #:use-module (gib-gab-gob rps)
  #:use-module (gib-gab-gob lib) ;; to go into goblins eventually!
  #:use-module (goblins)
  #:use-module (goblins vat)
  #:use-module (goblins actor-lib methods)
  #:use-module (goblins actor-lib sealers)
  #:use-module (oop goops)
  #:use-module (ice-9 match)
  #:use-module (ice-9 rdelim)
  #:export (^game-lobby ^client-picker))

(define (^game-lobby bcom)
  (define pick (pick-rps))

  (define gobbler #f)

  (methods
   [(register-opponent name peer sealed-pick)
    (format #t "Hey there, ~a! You sent me your pick of rock-paper-scissors; now I will send mine.\n" name)
    (on (<- (<- peer 'pick->unsealer pick) sealed-pick)
        (lambda (peer-pick)
          (define won? (rps-winner pick peer-pick))
          (format #t "Opponent ~a has picked ~a (do I win? ~a)\n" name peer-pick won?)
          ;; Transition to gobbler/receiver
          (let* ((g (spawn ^gib-gab-gobbler won? #f))
                 (receiver ($ g 'get-receiver)))
            (set! gobbler g)
            ($ gobbler 'register-receiver (<- peer 'register-receiver receiver)))))]))

(define (^client-picker bcom)
  (define-values (seal-pick unseal-pick my-pick?)
    (spawn-sealer-triplet))
  (define pick (pick-rps))
  (define won? #f)

  (define gobbler #f)

  (methods
   [(get-sealed-pick) ($ seal-pick pick)]
   [(pick->unsealer peer-pick)
    (set! won? (rps-winner pick peer-pick))
    (format #t "Peer picked ~a... a bold choice (do I win? ~a), I will send my unsealer\n" peer-pick won?)
    unseal-pick]
   [(register-receiver receiver)
    (set! gobbler (spawn ^gib-gab-gobbler won? receiver))
     ($ gobbler 'get-receiver)]))


;; Actual Tic Tac Toe game
(define ggg-size 3) ;; tic tac toe with more than 3x3 grid?

(define (^gib-gab-gobbler 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))

  (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))]))

;; 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)))

  (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
            (pk mark mark-char)
            ($ 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* (^mark bcom #:optional [mark #f])
  (methods
   [(get) mark]
   [(choose! mark-char)
    (if mark
        (error "this mark is already chosen")
        (bcom (^mark bcom mark-char)))]))