mmo-project/lisp/server/server.lisp

(load "~/quicklisp/setup.lisp")
(ql:quickload '(:clack :websocket-driver :cl-bcrypt :datafly
		       :sxql :alexandria :com.inuoe.jzon))

(defpackage :mmo-server
  (:use :common-lisp :clack :websocket-driver :cl-bcrypt :datafly
	:sxql :alexandria :com.inuoe.jzon))

(in-package :mmo-server)

(defvar *connections* (make-hash-table))

(defun handle-new-connection (con)
  (let ((user (make-hash-table)))
    (setf (gethash "uid" user) (random 100000))
    (setf (gethash "cmd" user) "login")
    (websocket-driver:send con (com.inuoe.jzon:stringify user))
    (remhash "cmd" user)
    (setf (gethash con *connections*) user)))

(defun broadcast-to-room (connection message)
  (let* ((json (com.inuoe.jzon:parse message))
        (user (gethash connection *connections*))
        (cmd (gethash "cmd" json)))
    (cond
     ((equalp cmd "user-login")
      (format t "user-login: ~A~%" message)
      (let* ((copy (alexandria:copy-hash-table *connections*))
       (qwer (make-hash-table)))
	(remhash connection copy)
	(setf (gethash "cmd" qwer) "user-login")
	(setf (gethash "connections" qwer) copy)
        (websocket-driver:send connection (com.inuoe.jzon:stringify copy))))
     ((equalp cmd "move")
      (format t "move: ~A~%" message)
      (setf (gethash "x" user) (gethash "x" json))
      (setf (gethash "y" user) (gethash "y" json))
      (setf (gethash connection *connections*) user)) 
     (t 
      (format t "Unknown message: ~A~%" message)))

    (when (not (equalp cmd "user-login"))
      (loop :for con :being :the :hash-key :of *connections* :do
	(websocket-driver:send con message)))))

(defun handle-close-connection (connection)
  (let ((message (format nil "{\"cmd\":\"logout\", \"uid\":\"~a\"}"
                         (gethash "uid" (gethash connection *connections*)))))
    (remhash connection *connections*)
    (loop :for con :being :the :hash-key :of *connections* :do
          (websocket-driver:send con message))))

(defun chat-server (env)
  (let ((ws (websocket-driver:make-server env)))
    (websocket-driver:on :open ws
                         (lambda () (handle-new-connection ws)))

    (websocket-driver:on :message ws
                         (lambda (msg)
                           (broadcast-to-room ws msg)))

    (websocket-driver:on :close ws
                         (lambda (&key code reason)
                           (declare (ignore code reason))
                           (handle-close-connection ws)))
    (websocket-driver:on :error ws
	(lambda (error)
	  (format t "Got an error: ~S~%" error)))

    (lambda (responder)
      (declare (ignore responder))
      (websocket-driver:start-connection ws))))

(defvar *chat-handler* (clack:clackup #'chat-server :port 12345))