Code for joiner too! It works!
This commit is contained in:
parent
ad2d33e994
commit
3e9d075cda
4 changed files with 29 additions and 15 deletions
|
@ -19,7 +19,8 @@
|
||||||
(else 'play)))
|
(else 'play)))
|
||||||
(define (signal-turn)
|
(define (signal-turn)
|
||||||
;; any better way to do this?
|
;; any better way to do this?
|
||||||
(spawn-fiber (λ () (put-message my-turn+ #t))))
|
(spawn-fiber (λ () (put-message my-turn+ #t)))
|
||||||
|
#f)
|
||||||
(define (switch-turn!)
|
(define (switch-turn!)
|
||||||
(set! %my-turn? (not %my-turn?))
|
(set! %my-turn? (not %my-turn?))
|
||||||
(when %my-turn? (signal-turn))
|
(when %my-turn? (signal-turn))
|
||||||
|
@ -39,7 +40,10 @@
|
||||||
[(my-mark) mark]
|
[(my-mark) mark]
|
||||||
[(state) (%state)]
|
[(state) (%state)]
|
||||||
[(initialize!)
|
[(initialize!)
|
||||||
(on (<- peer 'try-transition) (λ (status) (format #t "Peer's status: ~a\n" status)) #:promise? #t)]
|
(on (<- peer 'try-transition)
|
||||||
|
(λ (status)
|
||||||
|
(format #t "Peer's status: ~a\n" status)
|
||||||
|
status) #:promise? #t)]
|
||||||
[(my-turn! x y)
|
[(my-turn! x y)
|
||||||
(if %my-turn?
|
(if %my-turn?
|
||||||
(begin
|
(begin
|
||||||
|
|
|
@ -8,7 +8,7 @@
|
||||||
#:use-module (goblins ocapn netlayer onion)
|
#:use-module (goblins ocapn netlayer onion)
|
||||||
#:use-module (gib-gab-gob board)
|
#:use-module (gib-gab-gob board)
|
||||||
#:use-module (fibers conditions)
|
#:use-module (fibers conditions)
|
||||||
#:export (make-joiner initiator/connect resolve-initiator ^game-initiator ^game-joiner))
|
#:export (initiator/connect ^game-initiator ^game-joiner))
|
||||||
|
|
||||||
;;
|
;;
|
||||||
;; Initiator logic
|
;; Initiator logic
|
||||||
|
@ -39,16 +39,8 @@
|
||||||
;;
|
;;
|
||||||
;; Joiner logic
|
;; Joiner logic
|
||||||
;;
|
;;
|
||||||
(define (make-joiner ^game-controller addr)
|
|
||||||
(define mycapn (spawn-mycapn (new-onion-netlayer)))
|
|
||||||
(define init-sref (string->ocapn-id addr))
|
|
||||||
(define initiator ($ mycapn 'enliven init-sref))
|
|
||||||
(define joiner (spawn ^game-joiner initiator ^game-controller))
|
|
||||||
(on (<- initiator 'register-opponent joiner ($ joiner 'get-sealed-pick))
|
|
||||||
(lambda (_) (<- initiator 'try-transition)))
|
|
||||||
joiner)
|
|
||||||
|
|
||||||
(define (^game-joiner bcom initiator ^game-controller)
|
(define (^game-joiner bcom initiator ^game-controller board my-turn+)
|
||||||
(define-values (seal-pick unseal-pick my-pick?)
|
(define-values (seal-pick unseal-pick my-pick?)
|
||||||
(spawn-sealer-triplet))
|
(spawn-sealer-triplet))
|
||||||
(define pick (pick-rps))
|
(define pick (pick-rps))
|
||||||
|
@ -60,7 +52,7 @@
|
||||||
;; We make the assumption that initiator is to become a controller.
|
;; We make the assumption that initiator is to become a controller.
|
||||||
;; Note second arg to bcom which will return the value (this is confusing to me)
|
;; Note second arg to bcom which will return the value (this is confusing to me)
|
||||||
;; see https://spritely.institute/files/docs/guile-goblins/0.11.0/Object-construction.html
|
;; see https://spritely.institute/files/docs/guile-goblins/0.11.0/Object-construction.html
|
||||||
(bcom (^game-controller bcom (make-board) (make-condition) won? initiator) unseal-pick)]))
|
(bcom (^game-controller bcom board my-turn+ won? initiator) unseal-pick)]))
|
||||||
|
|
||||||
;;
|
;;
|
||||||
;; Standard rock paper scissors logic follows!
|
;; Standard rock paper scissors logic follows!
|
||||||
|
|
|
@ -9,7 +9,10 @@
|
||||||
#:use-module (fibers)
|
#:use-module (fibers)
|
||||||
#:use-module (fibers channels)
|
#:use-module (fibers channels)
|
||||||
#:use-module (goblins)
|
#:use-module (goblins)
|
||||||
#:export (make-initiator))
|
#:use-module (goblins ocapn captp)
|
||||||
|
#:use-module (goblins ocapn ids)
|
||||||
|
#:use-module (goblins ocapn netlayer onion)
|
||||||
|
#:export (make-initiator make-joiner))
|
||||||
|
|
||||||
;; Module for simple console-based UI (no curses)
|
;; Module for simple console-based UI (no curses)
|
||||||
|
|
||||||
|
@ -70,3 +73,18 @@
|
||||||
(define initiator (spawn ^game-initiator ^ggg-controller board my-turn+))
|
(define initiator (spawn ^game-initiator ^ggg-controller board my-turn+))
|
||||||
(initiator/connect initiator)
|
(initiator/connect initiator)
|
||||||
(begin-game-loop board initiator my-turn+)))
|
(begin-game-loop board initiator my-turn+)))
|
||||||
|
|
||||||
|
(define (make-joiner ^game-controller addr)
|
||||||
|
(with-vat
|
||||||
|
(spawn-vat #:name "Joiner Game")
|
||||||
|
(define mycapn (spawn-mycapn (new-onion-netlayer)))
|
||||||
|
(define my-turn+ (make-channel))
|
||||||
|
(define board (make-board))
|
||||||
|
(let* ((init-sref (string->ocapn-id addr))
|
||||||
|
(initiator ($ mycapn 'enliven init-sref))
|
||||||
|
(joiner (spawn ^game-joiner initiator ^game-controller board my-turn+))
|
||||||
|
(sealed ($ joiner 'get-sealed-pick)))
|
||||||
|
(on (<- initiator 'register-opponent joiner sealed)
|
||||||
|
(λ (_)
|
||||||
|
(on ($ joiner 'initialize!)
|
||||||
|
(λ (status) (begin-game-loop board joiner my-turn+) #f)))))))
|
||||||
|
|
|
@ -3,7 +3,7 @@
|
||||||
!#
|
!#
|
||||||
|
|
||||||
(use-modules
|
(use-modules
|
||||||
(gib-gab-gob rps)
|
(gib-gab-gob ui console)
|
||||||
(gib-gab-gob game))
|
(gib-gab-gob game))
|
||||||
(apply make-joiner (cons ^ggg-controller (cdr (command-line))))
|
(apply make-joiner (cons ^ggg-controller (cdr (command-line))))
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue