Compare commits
2 commits
610e09b2a6
...
32fb2edb71
Author | SHA1 | Date | |
---|---|---|---|
32fb2edb71 | |||
493ad2349c |
8 changed files with 46 additions and 41 deletions
|
@ -1,5 +1,5 @@
|
|||
bin_SCRIPTS = scripts/make-client \
|
||||
scripts/make-host
|
||||
bin_SCRIPTS = scripts/make-joiner \
|
||||
scripts/make-initiator
|
||||
|
||||
# Handle substitution of fully-expanded Autoconf variables.
|
||||
do_subst = $(SED) \
|
||||
|
|
|
@ -12,8 +12,8 @@ AM_SILENT_RULES([yes])
|
|||
|
||||
AC_CONFIG_FILES([Makefile])
|
||||
AC_CONFIG_FILES([pre-inst-env], [chmod +x pre-inst-env])
|
||||
AC_CONFIG_FILES([scripts/make-client],[chmod +x scripts/make-client])
|
||||
AC_CONFIG_FILES([scripts/make-host],[chmod +x scripts/make-host])
|
||||
AC_CONFIG_FILES([scripts/make-joiner],[chmod +x scripts/make-joiner])
|
||||
AC_CONFIG_FILES([scripts/make-initiator],[chmod +x scripts/make-initiator])
|
||||
dnl Search for 'guile' and 'guild'. This macro defines
|
||||
dnl 'GUILE_EFFECTIVE_VERSION'.
|
||||
GUILE_PKG([3.0 2.2 2.0])
|
||||
|
|
|
@ -6,16 +6,16 @@
|
|||
#:export (^ggg-controller))
|
||||
|
||||
;; Actual Tic Tac Toe game
|
||||
(define (^ggg-controller bcom initiator? peer)
|
||||
(define mark (if initiator? 'x 'o))
|
||||
(define peer-mark (if initiator? 'o 'x))
|
||||
(define (^ggg-controller bcom won? peer)
|
||||
(define mark (if won? 'x 'o))
|
||||
(define peer-mark (if won? 'o 'x))
|
||||
(define board (make-board))
|
||||
(define my-turn? (not initiator?))
|
||||
(define my-turn? won?)
|
||||
(define (i-won?) (board-winner? board mark))
|
||||
(define (peer-won?) (board-winner? board peer-mark))
|
||||
(define (display)
|
||||
(board-display board)
|
||||
(format #t "-> It is ~a turn\n" (if my-turn? "my" "peer's"))
|
||||
(format #t "-> It is ~a turn!\n" (if my-turn? "my" "peer's"))
|
||||
(when (i-won?) (format #t "*** I won! ***\n"))
|
||||
(when (peer-won?) (format #t "*** I lost! ***\n")))
|
||||
(display)
|
||||
|
@ -28,7 +28,10 @@
|
|||
(set! my-turn? (not my-turn?))
|
||||
(display))
|
||||
(error "It's my turn!"))]
|
||||
;; TODO: This needs to go somewhere else so the peer can't move for us!
|
||||
;; TODO: These need to go somewhere else so the peer can't move or init for us!
|
||||
[(try-transition) 'playing]
|
||||
[(initialize!)
|
||||
(on (<- peer 'try-transition) (lambda (status) (format #t "Peer's status: ~a\n" status)) #:promise? #t)]
|
||||
[(my-turn! x y)
|
||||
(if my-turn?
|
||||
(begin
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
#:use-module (goblins ocapn captp)
|
||||
#:use-module (goblins ocapn ids)
|
||||
#:use-module (goblins ocapn netlayer testuds)
|
||||
#:export (make-host make-client))
|
||||
#:export (make-initiator make-joiner ^game-initiator ^game-joiner))
|
||||
|
||||
;;
|
||||
;; Helper to use testuds netlayer
|
||||
|
@ -17,43 +17,45 @@
|
|||
(spawn ^testuds-netlayer tmp))
|
||||
|
||||
;;
|
||||
;; Host logic
|
||||
;; Initiator logic
|
||||
;;
|
||||
(define (make-host ^game-controller)
|
||||
(define (make-initiator ^game-controller)
|
||||
(with-vat (spawn-vat)
|
||||
(define lobby (spawn ^game-lobby ^game-controller))
|
||||
(define initiator (spawn ^game-initiator ^game-controller))
|
||||
(define mycapn (spawn-mycapn (new-testuds-netlayer)))
|
||||
(define lobby-sref ($ mycapn 'register lobby 'testuds))
|
||||
(format #t "Connect to: ~a\n" (ocapn-id->string lobby-sref))))
|
||||
(define init-sref ($ mycapn 'register initiator 'testuds))
|
||||
(format #t "Connect to: ~a\n" (ocapn-id->string init-sref))))
|
||||
|
||||
(define (^game-lobby bcom ^game-controller)
|
||||
(define (^game-initiator bcom ^game-controller)
|
||||
(define pick (pick-rps))
|
||||
|
||||
(define won? #nil)
|
||||
(define peer #nil)
|
||||
(methods
|
||||
[(register-opponent name peer sealed-pick)
|
||||
[(register-opponent name p sealed-pick)
|
||||
(set! peer p)
|
||||
(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)
|
||||
(λ (peer-pick)
|
||||
(define won? (rps-winner pick peer-pick))
|
||||
(format #t "Opponent ~a has picked ~a (do I win? ~a). Time to be a controller.\n" name peer-pick won?)
|
||||
(bcom (^game-controller bcom won? peer))))]))
|
||||
(set! won? (rps-winner pick peer-pick))
|
||||
(format #t "Opponent ~a has picked ~a (do I win? ~a). Ready to be a controller.\n" name peer-pick won?)))]
|
||||
[(try-transition)
|
||||
(if (eq? won? #nil)
|
||||
'connecting
|
||||
(bcom (^game-controller bcom won? peer) 'ready-to-play))]))
|
||||
|
||||
;;
|
||||
;; Client logic
|
||||
;; Joiner logic
|
||||
;;
|
||||
(define (make-client ^game-controller user-name addr)
|
||||
(pk user-name)
|
||||
(pk addr)
|
||||
(pk ^game-controller)
|
||||
(define (make-joiner ^game-controller user-name addr)
|
||||
(with-vat (spawn-vat)
|
||||
(define mycapn (spawn-mycapn (new-testuds-netlayer)))
|
||||
(define lobby-sref (string->ocapn-id addr))
|
||||
(define lobby ($ mycapn 'enliven lobby-sref))
|
||||
(define client-picker (spawn ^client-picker lobby ^game-controller))
|
||||
(on (<- lobby 'register-opponent user-name client-picker ($ client-picker 'get-sealed-pick))
|
||||
(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 user-name joiner ($ joiner 'get-sealed-pick))
|
||||
(λ (_) (format #t "~a finished the game.\n" user-name)))))
|
||||
|
||||
(define (^client-picker bcom lobby ^game-controller)
|
||||
(define (^game-joiner bcom initiator ^game-controller)
|
||||
(define-values (seal-pick unseal-pick my-pick?)
|
||||
(spawn-sealer-triplet))
|
||||
(define pick (pick-rps))
|
||||
|
@ -62,10 +64,10 @@
|
|||
[(pick->unsealer peer-pick)
|
||||
(define won? (rps-winner pick peer-pick))
|
||||
(format #t "Peer picked ~a... a bold choice (do I win? ~a), I will become a controller and send my unsealer.\n" peer-pick won?)
|
||||
;; We make the assumption that lobby 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)
|
||||
;; see https://spritely.institute/files/docs/guile-goblins/0.11.0/Object-construction.html
|
||||
(bcom (^game-controller bcom won? lobby) unseal-pick)]))
|
||||
(bcom (^game-controller bcom won? initiator) unseal-pick)]))
|
||||
|
||||
;;
|
||||
;; Standard rock paper scissors logic follows!
|
||||
|
|
2
guix.scm
2
guix.scm
|
@ -69,7 +69,7 @@
|
|||
"GUILE_LOAD_COMPILED_PATH"
|
||||
(compiled-dir out version)
|
||||
(compiled-dir "" version))))
|
||||
,''("make-client" "make-host"))
|
||||
,''("make-joiner" "make-initiator"))
|
||||
#t))))))))
|
||||
(native-inputs
|
||||
`(("autoconf" ,autoconf)
|
||||
|
|
8
hall.scm
8
hall.scm
|
@ -26,10 +26,10 @@
|
|||
(programs
|
||||
((directory
|
||||
"scripts"
|
||||
((in-file "make-client")
|
||||
(in-file "make-host")
|
||||
(text-file "make-host")
|
||||
(text-file "make-client")))))
|
||||
((in-file "make-joiner")
|
||||
(in-file "make-initiator")
|
||||
(text-file "make-initiator")
|
||||
(text-file "make-joiner")))))
|
||||
(documentation ((org-file "README")))
|
||||
(infrastructure
|
||||
((in-file "pre-inst-env")
|
||||
|
|
|
@ -5,6 +5,6 @@
|
|||
(use-modules
|
||||
(gib-gab-gob rps)
|
||||
(gib-gab-gob game))
|
||||
(make-host ^ggg-controller)
|
||||
(make-initiator ^ggg-controller)
|
||||
|
||||
(while #t #f) ;; indefinitely
|
|
@ -5,6 +5,6 @@
|
|||
(use-modules
|
||||
(gib-gab-gob rps)
|
||||
(gib-gab-gob game))
|
||||
(apply make-client (cons ^ggg-controller (cdr (command-line))))
|
||||
(apply make-joiner (cons ^ggg-controller (cdr (command-line))))
|
||||
|
||||
(while #t #f) ;; indefinitely
|
Loading…
Reference in a new issue