X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=mudsync%2Fnetworking.scm;h=4417cfd27e898f4061992aad69bc65f820c58216;hp=b938c8a9427bdf53936c44c1e9b7a045abdd4048;hb=0ea9e56921f887613da5472f12c1e2ae229cb829;hpb=f19d236c49f1145138e2274d2f5ab3fb1be3e890 diff --git a/mudsync/networking.scm b/mudsync/networking.scm index b938c8a..4417cfd 100644 --- a/mudsync/networking.scm +++ b/mudsync/networking.scm @@ -32,6 +32,7 @@ #:use-module (web response) #:use-module (web uri) #:use-module (mudsync package-config) + #:use-module (mudsync contrib mime-types) #:use-module (rnrs io ports) #:export (;; Should we be exporting these? @@ -205,21 +206,20 @@ (pk 'web-server (create-actor nm #:port web-server-port #:http-handler (wrap-apply http-handler) - #:websocket-handler (wrap-apply websocket-handler))))) + #:on-ws-message (wrap-apply websocket-new-message))))) (define (view:main-display request body) (define one-entry - '(div (@ (class "stream-entry")) - (p "This is an entry!") - (p "Let's try a few paragraphs") - (p "okay?"))) + '(div (@ (class "stream-entry")) + (p (b "") " Wow, it's so shiny!"))) (define body-tmpl `((div (@ (id "stream-metabox")) (div (@ (id "stream")) - ,@(map (const one-entry) (iota 10)))) + ,@(map (const one-entry) (iota 25)) + (div (@ (class "stream-entry")) + (p (b "") " Last one!")))) (div (@ (id "input-metabox")) - (p "test test") (input (@ (id "input")))))) (define (main-tmpl) @@ -227,7 +227,9 @@ (head (title "Mudsync!") (meta (@ (charset "UTF-8"))) (link (@ (rel "stylesheet") - (href "/static/css/main.css")))) + (href "/static/css/main.css"))) + (script (@ (type "text/javascript") + (src "/static/js/mudsync.js")))) (body ,@body-tmpl))) (define (write-template-to-string) (with-fluids ((%default-port-encoding "UTF-8")) @@ -240,8 +242,7 @@ (define (view:render-static request body static-path) (values (build-response #:code 200 - ;; #:content-type (mime-type static-path) - ) + #:headers `((content-type . (,(mime-type static-path))))) (call-with-input-file (web-static-filepath static-path) get-bytevector-all))) (define (view:standard-four-oh-four . args) @@ -269,7 +270,9 @@ ;; Respond to text messages by reversing the message. Respond to ;; binary messages with "hello". -(define (websocket-handler data) - (if (string? data) - (string-reverse data) - "hello")) +(define (websocket-new-message websocket-server client-id data) + (<- (actor-id websocket-server) 'ws-send + client-id + (if (string? data) + (string-reverse data) + "hello")))