Working!
This commit is contained in:
parent
fcb4c49a3c
commit
8faa622f32
|
@ -1,14 +1,15 @@
|
|||
(define-module (bugafriend ui)
|
||||
#:use-module (bugafriend utils registry)
|
||||
#:use-module (goblins)
|
||||
#:use-module (goblins vat)
|
||||
#:use-module (bugafriend utils registry)
|
||||
#:use-module (goblins ocapn ids)
|
||||
#:use-module (ice-9 rdelim)
|
||||
#:use-module (ice-9 suspendable-ports)
|
||||
#:use-module (fibers)
|
||||
#:use-module (fibers channels)
|
||||
#:use-module (fibers conditions)
|
||||
#:use-module (ice-9 rdelim)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 exceptions)
|
||||
#:use-module (ice-9 suspendable-ports)
|
||||
#:export (say))
|
||||
|
||||
;; https://www.gnu.org/software/guile/manual/guile.html#Non_002dBlocking-I_002fO
|
||||
|
@ -17,59 +18,50 @@
|
|||
(fcntl input F_SETFL (logior O_NONBLOCK flags)))
|
||||
(install-suspendable-ports!)
|
||||
|
||||
(define echo-vat
|
||||
(spawn-vat #:name "echo-vat"))
|
||||
;; Code for the speaker
|
||||
(define (%prompt) (format #t "say > "))
|
||||
(define (%prompt) (format #t " > "))
|
||||
|
||||
(define registry #f)
|
||||
|
||||
(define listener #f)
|
||||
(define listener-set? (make-condition))
|
||||
|
||||
(define (%eval-command cmd)
|
||||
(match cmd
|
||||
(("quit") #f) ;; Returns false so we quit the loop
|
||||
(("join" listener-id)
|
||||
(define listener-sref (string->ocapn-id listener-id))
|
||||
(on (<- registry 'enliven listener-sref)
|
||||
(lambda (l)
|
||||
(set! listener l)
|
||||
(signal-condition! listener-set?))))
|
||||
(else
|
||||
(format #t "Don't know how to handle ~a.\n" cmd)
|
||||
#t)))
|
||||
(define (is-command? str) (eq? (string-ref str 0) #\/))
|
||||
|
||||
(define (%eval-loop)
|
||||
((%prompt)
|
||||
(let* ((line (read-line (current-input-port)))
|
||||
(first-char (string-ref line 0)))
|
||||
(when (eq? first-char #\/) (%eval-command (substring line 1))))))
|
||||
(define (%eval-command vat cmd)
|
||||
(define args (string-split cmd char-set:whitespace))
|
||||
(match args
|
||||
(("/quit" ...) #f) ;; Returns false so we quit the loop
|
||||
(("/join" listener-id)
|
||||
(define listener-sref (string->ocapn-id listener-id))
|
||||
(with-vat vat
|
||||
(on (<- registry 'enliven listener-sref)
|
||||
(lambda (l)
|
||||
(set! listener l)))))
|
||||
(else
|
||||
(format #t "Don't know how to handle ~a.\n" cmd)
|
||||
#t)))
|
||||
|
||||
(define (%loop)
|
||||
|
||||
(define (%loop echo-vat)
|
||||
(%prompt)
|
||||
(let* ((line (read-line (current-input-port)))
|
||||
(first-char (string-ref line 0)))
|
||||
(let* ((line (read-line (current-input-port))))
|
||||
(cond
|
||||
((eq? first-char #\/) (%eval-command (substring line 1)))
|
||||
((is-command? line) (%eval-command echo-vat line))
|
||||
(else
|
||||
(with-vat echo-vat
|
||||
(<- listener line)
|
||||
#t)))))
|
||||
(if (and registry listener)
|
||||
(with-vat echo-vat
|
||||
(<- listener line)
|
||||
#t)
|
||||
(format #t "Not connected to anyone yet. Use /join <sturdyref>!"))))))
|
||||
|
||||
(define (say setup-sref)
|
||||
(define registry-set? (make-condition))
|
||||
(format #t "Hello?")
|
||||
(syscaller-free-fiber
|
||||
(lambda ()
|
||||
(format #t "Is it me you're looking for")
|
||||
(with-vat echo-vat
|
||||
(on (prelay-sref->mycapn-registry setup-sref)
|
||||
(lambda (r)
|
||||
(set! registry r)
|
||||
(signal-condition! registry-set?))))
|
||||
(while (%eval-loop))
|
||||
(wait registry-set?)
|
||||
(wait listener-set?)
|
||||
(while (%loop))
|
||||
(format #t "Bye!\n"))))
|
||||
(define (say quit-cond setup-sref)
|
||||
(with-vat
|
||||
(spawn-vat #:name "Speaker UI")
|
||||
(define echo-vat (spawn-vat))
|
||||
(syscaller-free-fiber
|
||||
(lambda ()
|
||||
(with-vat echo-vat
|
||||
(on (prelay-sref->mycapn-registry setup-sref)
|
||||
(lambda (r)
|
||||
(set! registry r))))
|
||||
(while (%loop echo-vat))
|
||||
(signal-condition! quit-cond)
|
||||
(format #t "Bye!\n")))))
|
||||
|
|
14
scripts/say
14
scripts/say
|
@ -3,9 +3,13 @@
|
|||
!#
|
||||
|
||||
(use-modules
|
||||
(goblins)
|
||||
(goblins ocapn ids)
|
||||
(bugafriend ui))
|
||||
(goblins)
|
||||
(goblins ocapn ids)
|
||||
(fibers conditions)
|
||||
(bugafriend ui))
|
||||
|
||||
(with-vat (spawn-vat #:name "Speaker UI")
|
||||
(say (string->ocapn-id (list-ref (command-line) 1))))
|
||||
(define quit-cond (make-condition))
|
||||
|
||||
(say quit-cond (string->ocapn-id (list-ref (command-line) 1)))
|
||||
|
||||
(wait quit-cond)
|
||||
|
|
|
@ -3,9 +3,13 @@
|
|||
!#
|
||||
|
||||
(use-modules
|
||||
(goblins)
|
||||
(goblins ocapn ids)
|
||||
(bugafriend ui))
|
||||
(goblins)
|
||||
(goblins ocapn ids)
|
||||
(fibers conditions)
|
||||
(bugafriend ui))
|
||||
|
||||
(with-vat (spawn-vat #:name "Speaker UI")
|
||||
(say (string->ocapn-id (list-ref (command-line) 1))))
|
||||
(define quit-cond (make-condition))
|
||||
|
||||
(say quit-cond (string->ocapn-id (list-ref (command-line) 1)))
|
||||
|
||||
(wait quit-cond)
|
||||
|
|
Loading…
Reference in New Issue