add a bunch of broken stuff, time to stop
This commit is contained in:
parent
4ca8770bd5
commit
e5540992b0
|
@ -11,19 +11,24 @@
|
|||
(defvar *client* (wsd:make-client "ws://localhost:12345"))
|
||||
(defvar *logged-in-users* (make-hash-table))
|
||||
(defvar *current-user* (make-hash-table))
|
||||
(defvar *login* (make-hash-table))
|
||||
|
||||
(wsd:start-connection *client*)
|
||||
(wsd:on :message *client*
|
||||
(lambda (message)
|
||||
(let* ((json (com.inuoe.jzon:parse message))
|
||||
(cmd (gethash "cmd" json))
|
||||
(uid (gethash "uid" json)))
|
||||
(uid (gethash "uid" json))
|
||||
(user (gethash "user" json))
|
||||
(users (gethash "users" json)))
|
||||
|
||||
(format t "message: ~A~%" message)
|
||||
|
||||
(cond
|
||||
((equalp cmd "login")
|
||||
(setf (gethash "uid" *current-user*) uid))
|
||||
((equalp cmd "user-login")
|
||||
(setf *logged-in-users* json))
|
||||
(setf *logged-in-users* users)
|
||||
(setf (gethash "uid" *current-user*) (gethash "uid" user))
|
||||
(setf (gethash "x" *current-user*) (gethash "x" user))
|
||||
(setf (gethash "y" *current-user*) (gethash "y" user)))
|
||||
((equalp cmd "logout")
|
||||
(remhash uid *logged-in-users*))
|
||||
((equalp cmd "move")
|
||||
|
@ -53,11 +58,6 @@
|
|||
:projection :camera-perspective))
|
||||
(cube-screen-pos (vec 0.0 0.0)))
|
||||
|
||||
(setf (gethash "cmd" *login*) "user-login")
|
||||
(setf (gethash "user" *login*) username)
|
||||
(setf (gethash "user" *current-user*) username)
|
||||
(wsd:send *client* (com.inuoe.jzon:stringify *login*))
|
||||
|
||||
(with-window (screen-width screen-height title)
|
||||
;; (disable-cursor)
|
||||
(set-target-fps 60) ; Set our game to run at 60 FPS
|
||||
|
@ -87,11 +87,12 @@
|
|||
(floor (measure-text username 20) 2))
|
||||
(floor (vy cube-screen-pos) ) 20 :black)
|
||||
|
||||
(loop :for user :being :the :hash-key :of *logged-in-users* :do
|
||||
(loop :for user :being :the :hash-keys :of *logged-in-users* :do
|
||||
(format t "loop! ~a~%" user)
|
||||
(let ((x (gethash "x" user))
|
||||
(y (gethash "y" user)))
|
||||
(draw-cube (vec x 0.5 y) 1.0 1.0 1.0 :red)
|
||||
(let ((name (gethash "username" user)))
|
||||
(let ((name (format nil "Guest ~a" (gethash "uid" user))))
|
||||
(draw-text name
|
||||
(- (floor (vx cube-screen-pos))
|
||||
(floor (measure-text name 20) 2))
|
||||
|
|
|
@ -24,18 +24,24 @@
|
|||
(cmd (gethash "cmd" json)))
|
||||
(cond
|
||||
((equalp cmd "user-login")
|
||||
(let ((copy (alexandria:copy-hash-table *connections*)))
|
||||
(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))))
|
||||
(websocket-driver:send con message)))))
|
||||
|
||||
(defun handle-close-connection (connection)
|
||||
(let ((message (format nil "{\"cmd\":\"logout\", \"uid\":\"~a\"}"
|
||||
|
|
|
@ -0,0 +1,47 @@
|
|||
(load "~/quicklisp/setup.lisp")
|
||||
(ql:quickload '(:clack :websocket-driver :cl-bcrypt :datafly
|
||||
:sxql :alexandria :com.inuoe.jzon))
|
||||
|
||||
(defvar *connections* (make-hash-table))
|
||||
|
||||
(defun handle-new-connection (con)
|
||||
(let* ((user (make-hash-table))
|
||||
(json (make-hash-table)))
|
||||
(setf (gethash "uid" user) (random 100000))
|
||||
(setf (gethash "x" user) 0.0)
|
||||
(setf (gethash "y" user) 0.0)
|
||||
(setf (gethash "cmd" json) "login")
|
||||
(setf (gethash "user" json) user)
|
||||
(setf (gethash "users" json) *connections*)
|
||||
(websocket-driver:send con (com.inuoe.jzon:stringify json))
|
||||
(setf (gethash con *connections*) user)))
|
||||
|
||||
(defun broadcast-to-room (connection message)
|
||||
(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 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)))
|
||||
(lambda (responder)
|
||||
(declare (ignore responder))
|
||||
(websocket-driver:start-connection ws))))
|
||||
|
||||
(defvar *server* (clack:clackup #'chat-server :port 12345))
|
Loading…
Reference in New Issue