Almost working on the initiator side
This commit is contained in:
parent
748bbfdb3f
commit
78226e84e6
4 changed files with 38 additions and 28 deletions
|
@ -7,11 +7,10 @@
|
||||||
#:export (^ggg-controller))
|
#:export (^ggg-controller))
|
||||||
|
|
||||||
;; Actual Tic Tac Toe game
|
;; Actual Tic Tac Toe game
|
||||||
(define (^ggg-controller bcom board first? peer)
|
(define (^ggg-controller bcom board my-turn+ first? peer)
|
||||||
(define mark (if first? 'x 'o))
|
(define mark (if first? 'x 'o))
|
||||||
(define peer-mark (if first? 'o 'x))
|
(define peer-mark (if first? 'o 'x))
|
||||||
(define %my-turn? first?)
|
(define %my-turn? first?)
|
||||||
(define my-turn+ (make-condition))
|
|
||||||
(define (%state)
|
(define (%state)
|
||||||
(cond
|
(cond
|
||||||
((board-winner? board mark) => 'won)
|
((board-winner? board mark) => 'won)
|
||||||
|
|
|
@ -6,26 +6,20 @@
|
||||||
#:use-module (goblins ocapn captp)
|
#:use-module (goblins ocapn captp)
|
||||||
#:use-module (goblins ocapn ids)
|
#:use-module (goblins ocapn ids)
|
||||||
#:use-module (goblins ocapn netlayer onion)
|
#:use-module (goblins ocapn netlayer onion)
|
||||||
#:export (make-initiator make-joiner initiator/connect resolve-initiator ^game-initiator ^game-joiner))
|
#:use-module (gib-gab-gob board)
|
||||||
|
#:use-module (fibers conditions)
|
||||||
|
#:export (make-joiner initiator/connect resolve-initiator ^game-initiator ^game-joiner))
|
||||||
|
|
||||||
;;
|
;;
|
||||||
;; Initiator logic
|
;; Initiator logic
|
||||||
;;
|
;;
|
||||||
;; todo: refactor?
|
|
||||||
(define (make-initiator ^game-controller)
|
|
||||||
(with-vat (spawn-vat)
|
|
||||||
(define initiator (spawn ^game-initiator ^game-controller))
|
|
||||||
(define mycapn (spawn-mycapn (new-onion-netlayer)))
|
|
||||||
(define init-sref ($ mycapn 'register initiator 'testuds))
|
|
||||||
(format #t "Connect to: ~a\n" (ocapn-id->string init-sref))))
|
|
||||||
|
|
||||||
;; use this one
|
;; use this one
|
||||||
(define (initiator/connect initiator)
|
(define (initiator/connect initiator)
|
||||||
(define mycapn (spawn-mycapn (new-onion-netlayer)))
|
(define mycapn (spawn-mycapn (new-onion-netlayer)))
|
||||||
(define init-sref ($ mycapn 'register initiator 'onion))
|
(define init-sref ($ mycapn 'register initiator 'onion))
|
||||||
(format #t "Connect to: ~a\n" (ocapn-id->string init-sref)))
|
(format #t "Connect to: ~a\n" (ocapn-id->string init-sref)))
|
||||||
|
|
||||||
(define (^game-initiator bcom ^game-controller)
|
(define (^game-initiator bcom ^game-controller board my-turn+)
|
||||||
(define pick (pick-rps))
|
(define pick (pick-rps))
|
||||||
(define won? #nil)
|
(define won? #nil)
|
||||||
(define peer #nil)
|
(define peer #nil)
|
||||||
|
@ -40,7 +34,7 @@
|
||||||
[(try-transition)
|
[(try-transition)
|
||||||
(if (eq? won? #nil)
|
(if (eq? won? #nil)
|
||||||
'connecting
|
'connecting
|
||||||
(bcom (^game-controller bcom won? peer) 'ready-to-play))]))
|
(bcom (^game-controller bcom board my-turn+ won? peer) 'ready-to-play))]))
|
||||||
|
|
||||||
;;
|
;;
|
||||||
;; Joiner logic
|
;; Joiner logic
|
||||||
|
@ -66,7 +60,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 won? initiator) unseal-pick)]))
|
(bcom (^game-controller bcom (make-board) (make-condition) won? initiator) unseal-pick)]))
|
||||||
|
|
||||||
;;
|
;;
|
||||||
;; Standard rock paper scissors logic follows!
|
;; Standard rock paper scissors logic follows!
|
||||||
|
|
|
@ -1,25 +1,30 @@
|
||||||
(define-module (gib-gab-gob ui console)
|
(define-module (gib-gab-gob ui console)
|
||||||
|
#:use-module (gib-gab-gob rps)
|
||||||
|
#:use-module (gib-gab-gob game)
|
||||||
#:use-module (gib-gab-gob board)
|
#:use-module (gib-gab-gob board)
|
||||||
#:use-module (ice-9 rdelim)
|
#:use-module (ice-9 rdelim)
|
||||||
#:use-module (ice-9 exceptions)
|
#:use-module (ice-9 exceptions)
|
||||||
#:use-module (srfi srfi-9)
|
#:use-module (srfi srfi-9)
|
||||||
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (fibers)
|
#:use-module (fibers)
|
||||||
#:use-module (fibers channels)
|
#:use-module (fibers channels)
|
||||||
#:use-module (fibers conditions)
|
#:use-module (fibers conditions)
|
||||||
#:use-module (goblins)
|
#:use-module (goblins)
|
||||||
#:export (begin-game-loop))
|
#:export (make-initiator))
|
||||||
|
|
||||||
;; Module for simple console-based UI (no curses)
|
;; Module for simple console-based UI (no curses)
|
||||||
|
|
||||||
;; A single run of the loop for a bespoke REPL for playing the game
|
;; A single run of the loop for a bespoke REPL for playing the game
|
||||||
(define (%loop vat b controller my-turn+)
|
(define (%loop vat b controller my-turn+)
|
||||||
(wait my-turn+)
|
(wait my-turn+)
|
||||||
(let ((state ($ controller 'state)))
|
(with-vat vat
|
||||||
(%print b state)
|
(on (<- controller 'state)
|
||||||
(if (eq? state 'play)
|
(λ (state)
|
||||||
(let ((coords (%read)))
|
(%print b state)
|
||||||
(if coords (%eval vat controller coords) #f))
|
(if (eq? state 'play)
|
||||||
#f)))
|
(let ((coords (%read)))
|
||||||
|
(if coords (%eval vat b controller coords) #f))
|
||||||
|
#f)))))
|
||||||
|
|
||||||
(define (%read)
|
(define (%read)
|
||||||
(define line (read-line (current-input-port)))
|
(define line (read-line (current-input-port)))
|
||||||
|
@ -30,12 +35,13 @@
|
||||||
(%prompt) (%read))
|
(%prompt) (%read))
|
||||||
coords))))
|
coords))))
|
||||||
|
|
||||||
(define (%eval vat controller coordinates)
|
(define (%eval vat b controller coordinates)
|
||||||
(format #t "Moving ~a\n" coordinates)
|
(format #t "Moving ~a\n" coordinates)
|
||||||
(with-vat
|
;; weird?
|
||||||
vat
|
(let ((x (first coordinates))
|
||||||
(on (<- controller 'my-turn! coordinates)
|
(y (second coordinates)))
|
||||||
(λ (state) (%display b state)))))
|
(on (<- controller 'my-turn! x y)
|
||||||
|
(λ (state) (%display b state)))))
|
||||||
|
|
||||||
(define (%print b state)
|
(define (%print b state)
|
||||||
(%display b state)
|
(%display b state)
|
||||||
|
@ -56,3 +62,12 @@
|
||||||
(while (%loop vat board controller my-turn+))
|
(while (%loop vat board controller my-turn+))
|
||||||
(format #t "bye-bye!\n")
|
(format #t "bye-bye!\n")
|
||||||
#f)))
|
#f)))
|
||||||
|
|
||||||
|
(define (make-initiator)
|
||||||
|
(with-vat
|
||||||
|
(spawn-vat #:name "Initiator Game")
|
||||||
|
(define my-turn+ (make-condition))
|
||||||
|
(define board (make-board))
|
||||||
|
(define initiator (spawn ^game-initiator ^ggg-controller board my-turn+))
|
||||||
|
(initiator/connect initiator)
|
||||||
|
(begin-game-loop board initiator my-turn+)))
|
||||||
|
|
|
@ -4,7 +4,9 @@
|
||||||
|
|
||||||
(use-modules
|
(use-modules
|
||||||
(gib-gab-gob rps)
|
(gib-gab-gob rps)
|
||||||
(gib-gab-gob game))
|
(gib-gab-gob game)
|
||||||
(make-initiator ^ggg-controller)
|
(gib-gab-gob ui console))
|
||||||
|
|
||||||
|
(make-initiator)
|
||||||
|
|
||||||
(while #t #f) ;; indefinitely
|
(while #t #f) ;; indefinitely
|
||||||
|
|
Loading…
Reference in a new issue