cl-chat-web/live-chat-ws.lisp
Bubblegumdrop 0dbf9c90a6 Progress commit
- Slynk server
- Formatting output
- wait-for-clack-handler
- The WebSocket snippet from
  https://lispcookbook.github.io/cl-cookbook/websockets.html
  adatpted instead of hx-sse extension
- Persistent bottom navbar
- white-space: nowrap
2024-10-13 00:31:11 -04:00

54 lines
1.9 KiB
Common Lisp

(in-package #:live-chat-ws)
(defvar *connections* (make-hash-table))
(defun handle-post-message (message)
"Handle a new message being posted to the chat."
(let ((message (cl-who:escape-string message)))
(format *standard-output* "Message received: ~a~%" message)
(live-chat-db:insert-message message)))
(defun handle-new-connection (con)
(setf (gethash con *connections*)
(princ-to-string (gensym "USER-"))))
(defun broadcast-to-room (connection message)
(handle-post-message message)
(let ((message
(cl-who:with-html-output-to-string (*standard-output*)
(:div :class "box"
:style "overflow: auto; white-space: nowrap;"
(format t "~a: ~a" (gethash connection *connections*) message)))))
(loop :for con :being :the :hash-key :of *connections* :do
(send con message))))
(defun handle-close-connection (connection)
(let ((message
(cl-who:with-html-output-to-string (*standard-output*)
(:div :class "box"
:style "overflow: auto; white-space: nowrap;"
(format t "... ~a disconnected."
(gethash connection *connections*))))))
(loop :for con :being :the :hash-key :of *connections* :do
(send con message))))
(defun make-websocket-server (env)
(handler-case
(let ((ws (make-server env)))
(on :open ws
(lambda ()
(handle-new-connection ws)))
(on :message ws
(lambda (msg)
(broadcast-to-room ws msg)))
(on :close ws
(lambda (&key code reason)
(declare (ignore code reason))
(handle-close-connection ws)))
(lambda (responder)
(declare (ignore responder))
(start-connection ws)))
(error (e)
(declare (ignore e))
(format nil "Something went wrong. Try again?"))))