hunchenchat.lisp

(ql:quickload "hunchentoot")
(ql:quickload "hunchensocket")

(hunchentoot:define-easy-handler (say-yo :uri "/yo") (name)
  (setf (hunchentoot:content-type*) "text/plain")
  (format nil "Hey ~@[~A~]!" name))

(defclass chat-room (hunchensocket:websocket-resource)
  ((name :initarg :name :initform (error "Name this room") :reader name))
  (:default-initargs :client-class 'user))

(defclass user (hunchensocket:websocket-client)
  ((name :initarg :user-agent :reader name :writer set-name :initform (error "Name this user!"))))

(defvar *chat-rooms* (list (make-instance 'chat-room :name "/bongo")
                           (make-instance 'chat-room :name "/fury")))

(defun find-room (request)
  (find (hunchentoot:script-name request) *chat-rooms* :test #'string= :key #'name))

(pushnew 'find-room hunchensocket:*websocket-dispatch-table*)

(defun broadcast (room message &rest args)
  (loop for peer in (hunchensocket:clients room)
     do (hunchensocket:send-text-message peer (apply #'format nil message args))))

(defun single (user message &rest args)
  (hunchensocket:send-text-message user (apply #'format nil message args)))

(defmethod hunchensocket:client-connected ((room chat-room) user)
  (broadcast room "~a has joined ~a" (name user) (name room)))

(defmethod hunchensocket:client-disconnected ((room chat-room) user)
  (broadcast room "~a has left ~a" (name user) (name room)))

(defmethod hunchensocket:text-message-received ((room chat-room) user message)
  (cond
    ((eq (position #\/ message) 0)
     (let* ((params (str:split #\Space message))
            (command (first params)))
       (cond
         ((string= "/quit" command) (single user "please don't quit"))
         ((string= "/party" command) (broadcast room "someone wants to party!"))
         ((string= "/nick" command)
          (let ((new-name (second params)))
            (set-name new-name user)
            (single user "name changed to: ~a" new-name)))
         (t (single user "unknown command: ~a" message)))))
    (t (broadcast room "~a: ~a" (name user) message))))

(defvar *ws-server* (make-instance 'hunchensocket:websocket-acceptor :port 12345))
(hunchentoot:start *ws-server*)

(hunchentoot:start (make-instance 'hunchentoot:easy-acceptor :port 4242))