add a bunch of broken stuff, time to stop

This commit is contained in:
zongor 2024-01-13 11:30:32 -05:00
parent 4ca8770bd5
commit e5540992b0
3 changed files with 70 additions and 16 deletions

View File

@ -11,19 +11,24 @@
(defvar *client* (wsd:make-client "ws://localhost:12345")) (defvar *client* (wsd:make-client "ws://localhost:12345"))
(defvar *logged-in-users* (make-hash-table)) (defvar *logged-in-users* (make-hash-table))
(defvar *current-user* (make-hash-table)) (defvar *current-user* (make-hash-table))
(defvar *login* (make-hash-table))
(wsd:start-connection *client*) (wsd:start-connection *client*)
(wsd:on :message *client* (wsd:on :message *client*
(lambda (message) (lambda (message)
(let* ((json (com.inuoe.jzon:parse message)) (let* ((json (com.inuoe.jzon:parse message))
(cmd (gethash "cmd" json)) (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 (cond
((equalp cmd "login") ((equalp cmd "login")
(setf (gethash "uid" *current-user*) uid)) (setf *logged-in-users* users)
((equalp cmd "user-login") (setf (gethash "uid" *current-user*) (gethash "uid" user))
(setf *logged-in-users* json)) (setf (gethash "x" *current-user*) (gethash "x" user))
(setf (gethash "y" *current-user*) (gethash "y" user)))
((equalp cmd "logout") ((equalp cmd "logout")
(remhash uid *logged-in-users*)) (remhash uid *logged-in-users*))
((equalp cmd "move") ((equalp cmd "move")
@ -53,11 +58,6 @@
:projection :camera-perspective)) :projection :camera-perspective))
(cube-screen-pos (vec 0.0 0.0))) (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) (with-window (screen-width screen-height title)
;; (disable-cursor) ;; (disable-cursor)
(set-target-fps 60) ; Set our game to run at 60 FPS (set-target-fps 60) ; Set our game to run at 60 FPS
@ -87,11 +87,12 @@
(floor (measure-text username 20) 2)) (floor (measure-text username 20) 2))
(floor (vy cube-screen-pos) ) 20 :black) (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)) (let ((x (gethash "x" user))
(y (gethash "y" user))) (y (gethash "y" user)))
(draw-cube (vec x 0.5 y) 1.0 1.0 1.0 :red) (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 (draw-text name
(- (floor (vx cube-screen-pos)) (- (floor (vx cube-screen-pos))
(floor (measure-text name 20) 2)) (floor (measure-text name 20) 2))

View File

@ -24,18 +24,24 @@
(cmd (gethash "cmd" json))) (cmd (gethash "cmd" json)))
(cond (cond
((equalp cmd "user-login") ((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) (remhash connection copy)
(setf (gethash "cmd" qwer) "user-login")
(setf (gethash "connections" qwer) copy)
(websocket-driver:send connection (com.inuoe.jzon:stringify copy)))) (websocket-driver:send connection (com.inuoe.jzon:stringify copy))))
((equalp cmd "move") ((equalp cmd "move")
(format t "move: ~A~%" message)
(setf (gethash "x" user) (gethash "x" json)) (setf (gethash "x" user) (gethash "x" json))
(setf (gethash "y" user) (gethash "y" json)) (setf (gethash "y" user) (gethash "y" json))
(setf (gethash connection *connections*) user)) (setf (gethash connection *connections*) user))
(t (t
(format t "Unknown message: ~A~%" message))) (format t "Unknown message: ~A~%" message)))
(when (not (equalp cmd "user-login"))
(loop :for con :being :the :hash-key :of *connections* :do (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) (defun handle-close-connection (connection)
(let ((message (format nil "{\"cmd\":\"logout\", \"uid\":\"~a\"}" (let ((message (format nil "{\"cmd\":\"logout\", \"uid\":\"~a\"}"

47
lisp/server/server2.lisp Normal file
View File

@ -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))