diff --git a/bugafriend/listener.scm b/bugafriend/listener.scm index 9769ba6..dc09543 100644 --- a/bugafriend/listener.scm +++ b/bugafriend/listener.scm @@ -2,15 +2,15 @@ #:use-module (bugafriend utils registry) #:use-module (goblins) #:use-module (goblins ocapn ids) - #:export (listen)) + #:export (listen-chat)) ;; Code for the listener (define (^listener bcom) (lambda (text) (format #t "~a\n" text))) -(define (listen setup-sref) +(define (listen-chat setup-sref) (on (prelay-sref->mycapn-registry setup-sref) (lambda (registry) - (define listener (spawn ^listener)) - (define listener-id ($ registry 'register listener)) - (format #t "Listener registered at ~s\n" (ocapn-id->string listener-id))))) + (define chat-listener (spawn ^listener)) + (define listener-id ($ registry 'register chat-listener)) + (format #t "Share this with a friend so they can send a message: ~a\n" (ocapn-id->string listener-id))))) diff --git a/bugafriend/ui.scm b/bugafriend/ui.scm index 075f9c4..c312008 100644 --- a/bugafriend/ui.scm +++ b/bugafriend/ui.scm @@ -6,62 +6,112 @@ #:use-module (fibers) #:use-module (fibers channels) #:use-module (fibers conditions) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-1) #:use-module (ice-9 rdelim) #:use-module (ice-9 match) #:use-module (ice-9 exceptions) + #:use-module (ice-9 readline) #:use-module (ice-9 suspendable-ports) #: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!) +;; ;; 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 (%prompt) (format #t " > ")) +(define can-quit? (make-condition)) -(define registry #f) -(define listener #f) +(define ocapn-registry #f) +(define listener-actor #f) -(define (is-command? str) (eq? (string-ref str 0) #\/)) +(define (is-command? str) + (and (> (string-length str) 0) (eq? (string-ref str 0) #\/))) -(define (%eval-command vat cmd) +(define-record-type + (make-console-command name help thunk) + console-command? + (name console-command-name) + (help console-command-help) + (thunk console-command-thunk)) + +(define commands + (list + (make-console-command + "/quit" + "- Exits the chat" + (λ (args) (signal-condition! can-quit?))) + (make-console-command + "/help" + "- Prints this help" + (λ (args) (print-help))) + (make-console-command + "/join" + " - Switch chats to another listener" + (λ (args) + (unless (eq? 2 (length args)) + (error "Need one argument, the listener sturdyref!")) + + (let* ((listener-id (list-ref args 1)) + (listener-sref (string->ocapn-id listener-id))) + (unless listener-sref + (error "Badly formatted sturdyref!")) + (unless ocapn-registry + (error "Relay not yet connected.")) + + (on (<- ocapn-registry 'enliven listener-sref) + (λ (l) + (set! listener-actor l) + (format #t "Connected to actor.\n")))))))) + +(define (print-help) + (format #t "Command reference:\n") + (map (λ (x) (format #t " ~a ~a\n" (console-command-name x) (console-command-help x))) commands)) + +(define command-names (map console-command-name commands)) + +(define (%eval-command 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 matching-command (find (λ (x) (equal? (console-command-name x) (car args))) commands)) + (if matching-command + ((console-command-thunk matching-command) args) + (begin + (format #t "Don't know how to handle ~a.\n\n" cmd) + (print-help)))) +(define (read-line-vow) + (spawn-fibrous-vow + (λ () + (read-line (readline-port))))) -(define (%loop echo-vat) - (%prompt) - (let* ((line (read-line (current-input-port)))) - (cond - ((is-command? line) (%eval-command echo-vat line)) - (else - (if (and registry listener) - (with-vat echo-vat - (<- listener line) - #t) - (format #t "Not connected to anyone yet. Use /join !")))))) +(define (%loop) + (with-exception-handler (λ (e) (format #t "Command failed: ~s\n" e)) + (on (read-line-vow) + (λ (line) + (cond + ((eq? 0 (string-length line)) #t) + ((is-command? line) + (%eval-command line)) + (else + (unless listener-actor + (format #t "Not connected to anyone yet. Use /join !\n")) + (<- listener-actor line))) + (%loop))) + #:unwind? #t)) -(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"))))) +(define (say setup-sref) + (define vat (spawn-vat #:name "Speaker Vat")) + + (activate-readline) + (set-readline-prompt! " 🐞 > ") + + (with-vat vat + (on (prelay-sref->mycapn-registry setup-sref) + (λ (r) + (set! ocapn-registry r) + (format #t "Connected to relay.\n"))) + + (%loop)) + + (wait can-quit?)) diff --git a/bugafriend/utils/registry.scm b/bugafriend/utils/registry.scm index a40edb6..47d2ff0 100644 --- a/bugafriend/utils/registry.scm +++ b/bugafriend/utils/registry.scm @@ -20,5 +20,7 @@ (define (prelay-sref->mycapn-registry setup-sref) (on (fetch-and-spawn-prelay-netlayer setup-sref) (lambda (netlayer) + (unless netlayer + (error "Couldn't spawn netlayer.")) (spawn ^mycapn-registry netlayer 'prelay)) #:promise? #t)) diff --git a/scripts/listen b/scripts/listen index ad9a868..ed30236 100755 --- a/scripts/listen +++ b/scripts/listen @@ -12,6 +12,6 @@ (define can-quit? (make-condition)) (with-vat (spawn-vat #:name "Listener UI") - (listen (string->ocapn-id (list-ref (command-line) 1)))) + (listen-chat (string->ocapn-id (list-ref (command-line) 1)))) (wait can-quit?) diff --git a/scripts/listen.in b/scripts/listen.in index c236730..439ee9e 100644 --- a/scripts/listen.in +++ b/scripts/listen.in @@ -12,6 +12,6 @@ (define can-quit? (make-condition)) (with-vat (spawn-vat #:name "Listener UI") - (listen (string->ocapn-id (list-ref (command-line) 1)))) + (listen-chat (string->ocapn-id (list-ref (command-line) 1)))) (wait can-quit?) \ No newline at end of file diff --git a/scripts/say b/scripts/say index ac14d2a..f8fb01b 100755 --- a/scripts/say +++ b/scripts/say @@ -8,8 +8,4 @@ (fibers conditions) (bugafriend ui)) -(define quit-cond (make-condition)) - -(say quit-cond (string->ocapn-id (list-ref (command-line) 1))) - -(wait quit-cond) +(say (string->ocapn-id (list-ref (command-line) 1))) diff --git a/scripts/say.in b/scripts/say.in index ba81c4d..f698485 100644 --- a/scripts/say.in +++ b/scripts/say.in @@ -8,8 +8,4 @@ (fibers conditions) (bugafriend ui)) -(define quit-cond (make-condition)) - -(say quit-cond (string->ocapn-id (list-ref (command-line) 1))) - -(wait quit-cond) +(say (string->ocapn-id (list-ref (command-line) 1)))