Refactor to make it slightly better but it still is broken

This commit is contained in:
zongor 2024-01-14 22:11:42 -05:00
parent e5540992b0
commit 1c6c991171
2 changed files with 83 additions and 88 deletions

View File

@ -1,4 +1,4 @@
(load "~/quicklisp/setup.lisp") ; need to load quicklisp
(load "~/quicklisp/setup.lisp")
(ql:quickload '(:cl-raylib :cl-bcrypt :websocket-driver-client
:alexandria :com.inuoe.jzon))
@ -8,48 +8,68 @@
(in-package :mmo-client)
(defvar *client* (wsd:make-client "ws://localhost:12345"))
(defvar *client* (wsd:make-client "ws://localhost:5000/"))
(defvar *logged-in-users* (make-hash-table))
(defvar *current-user* (make-hash-table))
(setf (gethash "username" *current-user*) "testificate")
(setf (gethash "x" *current-user*) 0.0)
(setf (gethash "y" *current-user*) 0.0)
(defun send-get-logged-in-request ()
(wsd:send *client* "{\"cmd\":\"send-logged-in\"}"))
(defun send-move (camera)
(let* ((json (make-hash-table))
(user (make-hash-table))
(x (vx (camera3d-target camera)))
(y (vz (camera3d-target camera))))
(setf (gethash "x" *current-user*) x)
(setf (gethash "y" *current-user*) y)
(setf (gethash "cmd" json) "move")
(setf (gethash "username" user) (gethash "username" *current-user*))
(setf (gethash "x" user) x)
(setf (gethash "y" user) y)
(setf (gethash "user" json) user)
(wsd:send *client* (com.inuoe.jzon:stringify json))))
(defun send-logged-in-response ()
(let* ((json (make-hash-table))
(user (make-hash-table)))
(setf (gethash "cmd" json) "get-logged-in")
(setf (gethash "username" user) (gethash "username" *current-user*))
(setf (gethash "x" user) (gethash "x" *current-user*))
(setf (gethash "y" user) (gethash "y" *current-user*))
(setf (gethash "user" json) user)
(wsd:send *client* (com.inuoe.jzon:stringify json))))
(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))
(user (gethash "user" json))
(users (gethash "users" json)))
(format t "message: ~A~%" message)
(msg (gethash "msg" json))
(uid (gethash "uid" json)))
(cond
((equalp cmd "login")
(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")
((equalp (gethash "cmd" msg) "login")
(setf (gethash "uid" *current-user*) uid))
((equalp (gethash "cmd" msg) "send-logged-in")
(send-logged-in-response))
((equalp (gethash "cmd" msg) "get-logged-in")
(format t "~a~%" msg)
(setf (gethash uid *logged-in-users*)
(gethash "user" msg)))
((equalp (gethash "cmd" msg) "logout")
(remhash uid *logged-in-users*))
((equalp cmd "move")
((equalp (gethash "cmd" msg) "move")
(setf (gethash "x" (gethash uid *logged-in-users*))
(gethash "x" json))
(gethash "x" msg))
(setf (gethash "y" (gethash uid *logged-in-users*))
(gethash "y" json)))
(gethash "y" msg)))
(t
(format t "Unknown message: ~A~%" message))))))
(defun send-move (camera username)
(let ((move (make-hash-table)))
(setf (gethash "cmd" move) "move")
(setf (gethash "user" move) username)
(setf (gethash "x" move) (vx (camera3d-target camera)))
(setf (gethash "y" move) (vz (camera3d-target camera)))
(wsd:send *client* (com.inuoe.jzon:stringify move))))
(let* ((screen-width 800)
(screen-height 450)
(username "username")
(title "mmo client - common lisp")
(camera (make-camera3d :position (vec 4.0 2.0 4.0)
:target (vec 0.0 0.5 0.0)
@ -58,6 +78,8 @@
:projection :camera-perspective))
(cube-screen-pos (vec 0.0 0.0)))
(send-get-logged-in-request)
(with-window (screen-width screen-height title)
;; (disable-cursor)
(set-target-fps 60) ; Set our game to run at 60 FPS
@ -67,13 +89,13 @@
(update-camera camera :camera-third-person)
(when (is-key-down 87)
(send-move camera username))
(send-move camera))
(when (is-key-down 65)
(send-move camera username))
(send-move camera))
(when (is-key-down 83)
(send-move camera username))
(send-move camera))
(when (is-key-down 68)
(send-move camera username))
(send-move camera))
(setf cube-screen-pos
(get-world-to-screen
@ -82,21 +104,22 @@
(clear-background :raywhite)
(with-mode-3d (camera)
(draw-cube (camera3d-target camera) 1.0 1.0 1.0 :red)
(draw-text username
(draw-text (gethash "username" *current-user*)
(- (floor (vx cube-screen-pos))
(floor (measure-text username 20) 2))
(floor (measure-text (gethash "username" *current-user*) 20) 2))
(floor (vy cube-screen-pos) ) 20 :black)
(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 (format nil "Guest ~a" (gethash "uid" user))))
(draw-text name
(- (floor (vx cube-screen-pos))
(floor (measure-text name 20) 2))
(floor (vy cube-screen-pos)) 20 :black))))
(loop :for user :being :the :hash-values :of *logged-in-users* :do
(format t "~a~%" user)
;; (if (gethash "x" user)
;; (format t "x:~a~%" (gethash "x" user)))
;; (draw-cube (vec x 0.5 y) 1.0 1.0 1.0 :red)
;; (let ((name (gethash "username" user)))
;; (draw-text name
;; (- (floor (vx cube-screen-pos))
;; (floor (measure-text name 20) 2))
;; (floor (vy cube-screen-pos)) 20 :black))))
)
(draw-grid 20 1.0))))))
(wsd:close-connection *client*)

View File

@ -1,51 +1,23 @@
(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)
(ql:quickload '(clack websocket-driver alexandria))
(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)))
(let ((message (format nil "{\"uid\":\"~a\", \"msg\":~a}"
(gethash connection *connections*)
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-new-connection (con)
(let ((user (format nil "~a" (random 100000))))
(setf (gethash con *connections*) user)
(websocket-driver:send con (format nil "{\"uid\":\"~a\",\"msg\":{\"cmd\":\"login\"}}" user))))
(defun handle-close-connection (connection)
(let ((message (format nil "{\"cmd\":\"logout\", \"uid\":\"~a\"}"
(gethash "uid" (gethash connection *connections*)))))
(let ((message (format nil "{ \"uid\":\"~a\",\"msg\":{\"cmd\":\"login\"}}"
(gethash connection *connections*))))
(remhash connection *connections*)
(loop :for con :being :the :hash-key :of *connections* :do
(websocket-driver:send con message))))
@ -59,16 +31,16 @@
(lambda (msg)
(broadcast-to-room ws msg)))
(websocket-driver:on :error ws
(lambda (msg)
(format t "~a" 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))
(defvar *chat-handler* (clack:clackup #'chat-server :port 5000))