forked from vv/bugafriend
76 lines
2.2 KiB
Scheme
76 lines
2.2 KiB
Scheme
(define-module (bugafriend ui)
|
|
#: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 match)
|
|
#:export (say))
|
|
|
|
;; https://www.gnu.org/software/guile/manual/guile.html#Non_002dBlocking-I_002fO
|
|
(let* ((input (current-input-port))
|
|
(flags (fcntl input F_GETFL)))
|
|
(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 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 (%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 (%loop)
|
|
(%prompt)
|
|
(let* ((line (read-line (current-input-port)))
|
|
(first-char (string-ref line 0)))
|
|
(cond
|
|
((eq? first-char #\/) (%eval-command (substring line 1)))
|
|
(else
|
|
(with-vat echo-vat
|
|
(<- listener line)
|
|
#t)))))
|
|
|
|
(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"))))
|