TakeV
/
bugafriend
forked from vv/bugafriend
1
0
Fork 0
Code Pull Requests Activity

Lots of fixes. Have a proper message pump going on

This commit is contained in:
Vivianne 2024-02-02 00:01:48 -05:00
parent 314a29eb88
commit 3db784c18c
1 changed files with 44 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

71
bugafriend/ui.scm
View File

@ -21,7 +21,6 @@
;; (fcntl input F_SETFL (logior O_NONBLOCK flags))) ;; (fcntl input F_SETFL (logior O_NONBLOCK flags)))
;; (install-suspendable-ports!) ;; (install-suspendable-ports!)
(define can-quit? (make-condition))
(define ocapn-registry #f) (define ocapn-registry #f)
(define listener-actor #f) (define listener-actor #f)
@ -41,11 +40,13 @@
(make-console-command (make-console-command
"/quit" "/quit"
"- Exits the chat" "- Exits the chat"
(λ (args) (signal-condition! can-quit?))) (λ (args) (loop! #f)))
(make-console-command (make-console-command
"/help" "/help"
"- Prints this help" "- Prints this help"
(λ (args) (print-help))) (λ (args)
(print-help)
(loop! #t)))
(make-console-command (make-console-command
"/join" "/join"
"<listener-id> - Switch chats to another listener" "<listener-id> - Switch chats to another listener"
@ -60,10 +61,16 @@
(unless ocapn-registry (unless ocapn-registry
(error "Relay not yet connected.")) (error "Relay not yet connected."))
(format #t "Connecting...\n")
(on (<- ocapn-registry 'enliven listener-sref) (on (<- ocapn-registry 'enliven listener-sref)
(λ (l) (λ (l)
(set! listener-actor l) (set! listener-actor l)
(format #t "Connected to actor.\n")))))))) (format #t "Joined chat.\n")
(loop! #t))
#:catch
(λ (e)
(format #t "Failed: ~a\n" e)
(loop! #t))))))))
(define (print-help) (define (print-help)
(format #t "Command reference:\n") (format #t "Command reference:\n")
@ -78,40 +85,50 @@
((console-command-thunk matching-command) args) ((console-command-thunk matching-command) args)
(begin (begin
(format #t "Don't know how to handle ~a.\n\n" cmd) (format #t "Don't know how to handle ~a.\n\n" cmd)
(print-help)))) (print-help)
(loop! #t))))
(define (read-line-vow) (define loop-channel (make-channel))
(spawn-fibrous-vow (define (loop! val) (put-message loop-channel val) val)
(λ ()
(read-line (readline-port)))))
(define (%loop) (define (%loop vat)
(with-exception-handler (λ (e) (format #t "Command failed: ~s\n" e)) (with-exception-handler
(on (read-line-vow) (λ (e)
(λ (line) (format #t "Command failed: ~s\n" e)
(cond (loop! #t))
((eq? 0 (string-length line)) #t) (λ ()
((is-command? line) (let ((line (readline)))
(%eval-command line)) (with-vat vat
(else (cond
(unless listener-actor ((eq? 0 (string-length line)) (loop! #t))
(format #t "Not connected to anyone yet. Use /join <sturdyref>!\n")) ((is-command? line)
(<- listener-actor line))) (%eval-command line))
(%loop))) (else (if listener-actor
(on (<- listener-actor line) (λ (val) (loop! val)))
(begin
(format #t "Not connected to anyone yet. Use /join <sturdyref>!\n")
(loop! #t))))))))
#:unwind? #t)) #:unwind? #t))
(define (say setup-sref) (define (say setup-sref)
(define vat (spawn-vat #:name "Speaker Vat")) (define vat (spawn-vat #:name "Speaker Vat"))
(activate-readline)
(set-readline-prompt! " 🐞 > ") (set-readline-prompt! " 🐞 > ")
(with-vat vat (with-vat vat
(format #t "Connecting to relay...\n")
(on (prelay-sref->mycapn-registry setup-sref) (on (prelay-sref->mycapn-registry setup-sref)
(λ (r) (λ (r)
(set! ocapn-registry r) (set! ocapn-registry r)
(format #t "Connected to relay.\n"))) (format #t "Connected.\n")
(loop! #t))
#:catch
(λ (e)
(format #t "Failed: ~a\n" e)
(loop! #t))))
(%loop)) (while (get-message loop-channel)
(with-vat vat
(wait can-quit?)) (syscaller-free-fiber
(λ ()
(%loop vat))))))