1
0
Fork 0

Lots of tweaks, there's one more error I cannot figure out

This commit is contained in:
Vivianne 2024-01-31 18:00:13 -05:00
parent 8faa622f32
commit 314a29eb88
7 changed files with 106 additions and 62 deletions

View File

@ -2,15 +2,15 @@
#:use-module (bugafriend utils registry) #:use-module (bugafriend utils registry)
#:use-module (goblins) #:use-module (goblins)
#:use-module (goblins ocapn ids) #:use-module (goblins ocapn ids)
#:export (listen)) #:export (listen-chat))
;; Code for the listener ;; Code for the listener
(define (^listener bcom) (define (^listener bcom)
(lambda (text) (format #t "~a\n" text))) (lambda (text) (format #t "~a\n" text)))
(define (listen setup-sref) (define (listen-chat setup-sref)
(on (prelay-sref->mycapn-registry setup-sref) (on (prelay-sref->mycapn-registry setup-sref)
(lambda (registry) (lambda (registry)
(define listener (spawn ^listener)) (define chat-listener (spawn ^listener))
(define listener-id ($ registry 'register listener)) (define listener-id ($ registry 'register chat-listener))
(format #t "Listener registered at ~s\n" (ocapn-id->string listener-id))))) (format #t "Share this with a friend so they can send a message: ~a\n" (ocapn-id->string listener-id)))))

View File

@ -6,62 +6,112 @@
#:use-module (fibers) #:use-module (fibers)
#:use-module (fibers channels) #:use-module (fibers channels)
#:use-module (fibers conditions) #:use-module (fibers conditions)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-1)
#:use-module (ice-9 rdelim) #:use-module (ice-9 rdelim)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 exceptions) #:use-module (ice-9 exceptions)
#:use-module (ice-9 readline)
#:use-module (ice-9 suspendable-ports) #:use-module (ice-9 suspendable-ports)
#:export (say)) #:export (say))
;; https://www.gnu.org/software/guile/manual/guile.html#Non_002dBlocking-I_002fO ;; ;; https://www.gnu.org/software/guile/manual/guile.html#Non_002dBlocking-I_002fO
(let* ((input (current-input-port)) ;; (let* ((input (current-input-port))
(flags (fcntl input F_GETFL))) ;; (flags (fcntl input F_GETFL)))
(fcntl input F_SETFL (logior O_NONBLOCK flags))) ;; (fcntl input F_SETFL (logior O_NONBLOCK flags)))
(install-suspendable-ports!) ;; (install-suspendable-ports!)
(define (%prompt) (format #t " > ")) (define can-quit? (make-condition))
(define registry #f) (define ocapn-registry #f)
(define listener #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 <console-command>
(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"
"<listener-id> - 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)) (define args (string-split cmd char-set:whitespace))
(match args (define matching-command (find (λ (x) (equal? (console-command-name x) (car args))) commands))
(("/quit" ...) #f) ;; Returns false so we quit the loop (if matching-command
(("/join" listener-id) ((console-command-thunk matching-command) args)
(define listener-sref (string->ocapn-id listener-id)) (begin
(with-vat vat (format #t "Don't know how to handle ~a.\n\n" cmd)
(on (<- registry 'enliven listener-sref) (print-help))))
(lambda (l)
(set! listener l)))))
(else
(format #t "Don't know how to handle ~a.\n" cmd)
#t)))
(define (read-line-vow)
(spawn-fibrous-vow
(λ ()
(read-line (readline-port)))))
(define (%loop echo-vat) (define (%loop)
(%prompt) (with-exception-handler (λ (e) (format #t "Command failed: ~s\n" e))
(let* ((line (read-line (current-input-port)))) (on (read-line-vow)
(cond (λ (line)
((is-command? line) (%eval-command echo-vat line)) (cond
(else ((eq? 0 (string-length line)) #t)
(if (and registry listener) ((is-command? line)
(with-vat echo-vat (%eval-command line))
(<- listener line) (else
#t) (unless listener-actor
(format #t "Not connected to anyone yet. Use /join <sturdyref>!")))))) (format #t "Not connected to anyone yet. Use /join <sturdyref>!\n"))
(<- listener-actor line)))
(%loop)))
#:unwind? #t))
(define (say quit-cond setup-sref) (define (say setup-sref)
(with-vat (define vat (spawn-vat #:name "Speaker Vat"))
(spawn-vat #:name "Speaker UI")
(define echo-vat (spawn-vat)) (activate-readline)
(syscaller-free-fiber (set-readline-prompt! " 🐞 > ")
(lambda ()
(with-vat echo-vat (with-vat vat
(on (prelay-sref->mycapn-registry setup-sref) (on (prelay-sref->mycapn-registry setup-sref)
(lambda (r) (λ (r)
(set! registry r)))) (set! ocapn-registry r)
(while (%loop echo-vat)) (format #t "Connected to relay.\n")))
(signal-condition! quit-cond)
(format #t "Bye!\n"))))) (%loop))
(wait can-quit?))

View File

@ -20,5 +20,7 @@
(define (prelay-sref->mycapn-registry setup-sref) (define (prelay-sref->mycapn-registry setup-sref)
(on (fetch-and-spawn-prelay-netlayer setup-sref) (on (fetch-and-spawn-prelay-netlayer setup-sref)
(lambda (netlayer) (lambda (netlayer)
(unless netlayer
(error "Couldn't spawn netlayer."))
(spawn ^mycapn-registry netlayer 'prelay)) (spawn ^mycapn-registry netlayer 'prelay))
#:promise? #t)) #:promise? #t))

View File

@ -12,6 +12,6 @@
(define can-quit? (make-condition)) (define can-quit? (make-condition))
(with-vat (spawn-vat #:name "Listener UI") (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?) (wait can-quit?)

View File

@ -12,6 +12,6 @@
(define can-quit? (make-condition)) (define can-quit? (make-condition))
(with-vat (spawn-vat #:name "Listener UI") (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?) (wait can-quit?)

View File

@ -8,8 +8,4 @@
(fibers conditions) (fibers conditions)
(bugafriend ui)) (bugafriend ui))
(define quit-cond (make-condition)) (say (string->ocapn-id (list-ref (command-line) 1)))
(say quit-cond (string->ocapn-id (list-ref (command-line) 1)))
(wait quit-cond)

View File

@ -8,8 +8,4 @@
(fibers conditions) (fibers conditions)
(bugafriend ui)) (bugafriend ui))
(define quit-cond (make-condition)) (say (string->ocapn-id (list-ref (command-line) 1)))
(say quit-cond (string->ocapn-id (list-ref (command-line) 1)))
(wait quit-cond)