X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;f=mudsync%2Fnetworking.scm;h=2a193ae5d0d144b34a9d07e006b1c0abc84da576;hb=refs%2Fheads%2F8sync-fibers;hp=1a8ece5002b4e47fad5c433e3e9cace5cdc8863c;hpb=829df0120213f2bf7420b8ae153e761feb675106;p=mudsync.git diff --git a/mudsync/networking.scm b/mudsync/networking.scm index 1a8ece5..2a193ae 100644 --- a/mudsync/networking.scm +++ b/mudsync/networking.scm @@ -26,6 +26,9 @@ #:use-module (ice-9 receive) #:use-module (oop goops) + ;; Formatting + #:use-module (mudsync scrubl) + ;; used by web server only #:use-module (sxml simple) #:use-module (web request) @@ -57,7 +60,8 @@ (web-server-port %default-web-server-port)) (if web-server-port (nm-install-web-server actor server web-server-port)) - (nm-install-socket actor server port))) + ;; (nm-install-socket actor server port) + )) (send-to-client nm-send-to-client-id) (new-socket-client nm-new-socket-client) (new-web-client nm-new-web-client) @@ -161,7 +165,7 @@ (hash-set! (nm-clients nm) client-id (cons 'websocket ws-client-id)) (<- (nm-send-input-to nm) 'new-client #:client client-id) - (<-reply message client-id)) + client-id) (define (nm-client-receive-loop nm client-socket client-id) "Make a method to receive client data" @@ -180,26 +184,28 @@ "Handle a closed port" (format #t "DEBUG: handled closed port ~a\n" client-id) (hash-remove! (nm-clients nm) client-id) - (<-* `(#:actor ,nm) (nm-send-input-to nm) 'client-closed #:client client-id)) + (<- (nm-send-input-to nm) 'client-closed #:client client-id)) (define (nm-handle-line nm client-id line) "Handle an incoming line of input from a client" - (<-* `(#:actor ,nm) (nm-send-input-to nm) 'client-input + (<- (nm-send-input-to nm) 'client-input #:data line #:client client-id)) (define* (nm-send-to-client-id nm message #:key client data) "Send DATA to TO-CLIENT id" + (define formatted-data + (scrubl-write scrubl-sxml data)) (define client-obj (hash-ref (nm-clients nm) client)) (match client-obj (#f (throw 'no-such-client "Asked to send data to client but that client doesn't exist" #:client-id client - #:data data)) + #:data formatted-data)) (('socket . client-socket) - (display data client-socket)) + (display formatted-data client-socket)) (('websocket . ws-client-id) - (<- (.web-server nm) 'ws-send ws-client-id data)))) + (<- (.web-server nm) 'ws-send ws-client-id formatted-data)))) (define (nm-incoming-line-action nm message client-id line) "Handle LINE coming in, probably from an external message handler, @@ -221,7 +227,7 @@ like the web one" (define (nm-install-web-server nm server web-server-port) "This installs the web server, which we see in use below...." (set! (.web-server nm) - (create-actor nm + (create-actor #:network-manager (actor-id nm) #:port web-server-port #:http-handler (wrap-apply http-handler) @@ -244,7 +250,11 @@ like the web one" ;; (p (b "") " Last one!")) )) (div (@ (id "input-metabox")) - (input (@ (id "main-input")))))) + (input (@ (id "main-input"))) + " " + (span (@ (id "connection-status") + (class "disconnected")) + "[disconnected]")))) (define (main-tmpl) `(html (@ (xmlns "http://www.w3.org/1999/xhtml")) @@ -306,8 +316,8 @@ like the web one" (define (websocket-client-connect websocket-server client-id) (let ((nm-client-id - (mbody-val (<-wait (.network-manager websocket-server) - 'new-web-client client-id)))) + (<-wait (.network-manager websocket-server) + 'new-web-client client-id))) (hash-set! (.nm-client-ids websocket-server) client-id nm-client-id)))