Im angry at how good this works and clean it is compared to how terrible my old implementation was.
This commit is contained in:
parent
36618a500c
commit
6e1a2e9fd4
|
@ -1,35 +1,17 @@
|
|||
(load "~/quicklisp/setup.lisp") ; need to load quicklisp
|
||||
(ql:quickload '(:cl-raylib :cl-bcrypt :usocket :bordeaux-threads :alexandria :com.inuoe.jzon))
|
||||
(ql:quickload '(:cl-raylib :cl-bcrypt :websocket-driver-client :bordeaux-threads :alexandria :com.inuoe.jzon))
|
||||
|
||||
(defpackage :mmo-client
|
||||
(:use :common-lisp :cl-raylib :3d-vectors :usocket :bordeaux-threads :alexandria :com.inuoe.jzon))
|
||||
(:use :common-lisp :cl-raylib :3d-vectors :websocket-driver-client :bordeaux-threads :alexandria :com.inuoe.jzon))
|
||||
|
||||
(in-package :mmo-client)
|
||||
|
||||
(defvar *lock* (bt:make-lock))
|
||||
(defvar *logged-in-users-hash* (make-hash-table))
|
||||
(defvar *client* (wsd:make-client "ws://localhost:12345"))
|
||||
|
||||
(defun add-entry (key value)
|
||||
(bt:with-lock-held (*lock*)
|
||||
(setf (gethash key *logged-in-users-hash*) value)))
|
||||
|
||||
(defun get-value (key)
|
||||
(bt:with-lock-held (*lock*)
|
||||
(gethash key *logged-in-users-hash*)))
|
||||
|
||||
(add-entry 'pos (vec 0.0 0.0 0.0))
|
||||
|
||||
(defun create-client ()
|
||||
(usocket:with-client-socket (socket stream "127.0.0.1" 5001
|
||||
:element-type 'character)
|
||||
(unwind-protect
|
||||
(progn
|
||||
(loop
|
||||
(format stream "~a~%" (com.inuoe.jzon:stringify (get-value 'pos)))
|
||||
(force-output stream)
|
||||
(usocket:wait-for-input socket)
|
||||
(format t "from server: ~a~%" (read-line stream)))))
|
||||
(usocket:socket-close socket)))
|
||||
(wsd:start-connection *client*)
|
||||
(wsd:on :message *client*
|
||||
(lambda (message)
|
||||
(format t "~&Got: ~A~%" message)))
|
||||
|
||||
(defun game-loop ()
|
||||
(let* ((screen-width 800)
|
||||
|
@ -50,7 +32,7 @@
|
|||
until (window-should-close) ; detect window close button or ESC key
|
||||
do
|
||||
(update-camera camera :camera-third-person)
|
||||
(add-entry 'pos (list (camera3d-target camera) username :red :move))
|
||||
(wsd:send *client* (com.inuoe.jzon:stringify (list (camera3d-target camera) username :red :move)))
|
||||
(setf cube-screen-pos (get-world-to-screen (v+ (camera3d-target camera) (vec 0 1.0 0)) camera))
|
||||
(with-drawing
|
||||
(clear-background :raywhite)
|
||||
|
@ -59,10 +41,9 @@
|
|||
(draw-cube-wires (camera3d-target camera) 1.0 1.0 1.0 :maroon)
|
||||
(draw-grid 20 1.0))
|
||||
(draw-text username (- (floor (vx cube-screen-pos)) (floor (measure-text username 20) 2))
|
||||
(floor (vy cube-screen-pos) ) 20 :black))))))
|
||||
(floor (vy cube-screen-pos) ) 20 :black)))))
|
||||
(wsd:close-connection *client*))
|
||||
|
||||
(bt:make-thread 'create-client)
|
||||
(bt:make-thread 'game-loop)
|
||||
|
||||
(bt:run-in-new-thread (bt:get-thread 'create-client))
|
||||
(bt:run-in-new-thread (bt:get-thread 'game-loop))
|
||||
|
|
|
@ -1,27 +1,47 @@
|
|||
(load "~/quicklisp/setup.lisp")
|
||||
(ql:quickload '(:usocket :bordeaux-threads :cl-bcrypt :datafly :sxql :alexandria :com.inuoe.jzon))
|
||||
(ql:quickload '(:clack :websocket-driver :cl-bcrypt :datafly :sxql :alexandria :com.inuoe.jzon))
|
||||
|
||||
(defpackage :mmo-server
|
||||
(:use :common-lisp :usocket :bordeaux-threads :cl-bcrypt :datafly :sxql :alexandria :com.inuoe.jzon))
|
||||
(:use :common-lisp :clack :websocket-driver :cl-bcrypt :datafly :sxql :alexandria :com.inuoe.jzon))
|
||||
|
||||
(in-package :mmo-server)
|
||||
|
||||
(defvar *logged-in-users-hash* (make-hash-table))
|
||||
|
||||
(defun create-server (port)
|
||||
(let* ((socket (usocket:socket-listen "127.0.0.1" port))
|
||||
(connection (usocket:socket-accept socket :element-type
|
||||
'character)))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(loop do
|
||||
(setq message (read-line (usocket:socket-stream connection)))
|
||||
(format (usocket:socket-stream connection)
|
||||
"Hello ~a~%" message)
|
||||
(force-output (usocket:socket-stream connection))))
|
||||
(progn
|
||||
(format t "Closing sockets~%")
|
||||
(usocket:socket-close connection)
|
||||
(usocket:socket-close socket)))))
|
||||
(defvar *connections* (make-hash-table))
|
||||
|
||||
(create-server 5001)
|
||||
(defun handle-new-connection (con)
|
||||
(setf (gethash con *connections*)
|
||||
(format nil "user-~a" (random 100000))))
|
||||
|
||||
(defun broadcast-to-room (connection message)
|
||||
(let ((message (format nil "~a: ~a"
|
||||
(gethash connection *connections*)
|
||||
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 " .... ~a has left."
|
||||
(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 *chat-handler* (clack:clackup #'chat-server :port 12345))
|
||||
|
|
Loading…
Reference in New Issue