From e5540992b0044d8dbef41238a8b3341f878d4d86 Mon Sep 17 00:00:00 2001 From: zongor Date: Sat, 13 Jan 2024 11:30:32 -0500 Subject: [PATCH] add a bunch of broken stuff, time to stop --- lisp/client/common-lisp/client.lisp | 25 +++++++-------- lisp/server/server.lisp | 14 ++++++--- lisp/server/server2.lisp | 47 +++++++++++++++++++++++++++++ 3 files changed, 70 insertions(+), 16 deletions(-) create mode 100644 lisp/server/server2.lisp diff --git a/lisp/client/common-lisp/client.lisp b/lisp/client/common-lisp/client.lisp index 9d7f4ba..528a635 100644 --- a/lisp/client/common-lisp/client.lisp +++ b/lisp/client/common-lisp/client.lisp @@ -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)) diff --git a/lisp/server/server.lisp b/lisp/server/server.lisp index 8155be2..fc3a004 100644 --- a/lisp/server/server.lisp +++ b/lisp/server/server.lisp @@ -24,18 +24,24 @@ (cmd (gethash "cmd" json))) (cond ((equalp cmd "user-login") - (let ((copy (alexandria:copy-hash-table *connections*))) - (remhash connection copy) + (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))) - (loop :for con :being :the :hash-key :of *connections* :do - (websocket-driver:send con 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\"}" diff --git a/lisp/server/server2.lisp b/lisp/server/server2.lisp new file mode 100644 index 0000000..e843b98 --- /dev/null +++ b/lisp/server/server2.lisp @@ -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))