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
|
(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
|
(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)
|
(in-package :mmo-client)
|
||||||
|
|
||||||
(defvar *lock* (bt:make-lock))
|
(defvar *client* (wsd:make-client "ws://localhost:12345"))
|
||||||
(defvar *logged-in-users-hash* (make-hash-table))
|
|
||||||
|
|
||||||
(defun add-entry (key value)
|
(wsd:start-connection *client*)
|
||||||
(bt:with-lock-held (*lock*)
|
(wsd:on :message *client*
|
||||||
(setf (gethash key *logged-in-users-hash*) value)))
|
(lambda (message)
|
||||||
|
(format t "~&Got: ~A~%" message)))
|
||||||
(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)))
|
|
||||||
|
|
||||||
(defun game-loop ()
|
(defun game-loop ()
|
||||||
(let* ((screen-width 800)
|
(let* ((screen-width 800)
|
||||||
|
@ -50,7 +32,7 @@
|
||||||
until (window-should-close) ; detect window close button or ESC key
|
until (window-should-close) ; detect window close button or ESC key
|
||||||
do
|
do
|
||||||
(update-camera camera :camera-third-person)
|
(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))
|
(setf cube-screen-pos (get-world-to-screen (v+ (camera3d-target camera) (vec 0 1.0 0)) camera))
|
||||||
(with-drawing
|
(with-drawing
|
||||||
(clear-background :raywhite)
|
(clear-background :raywhite)
|
||||||
|
@ -59,10 +41,9 @@
|
||||||
(draw-cube-wires (camera3d-target camera) 1.0 1.0 1.0 :maroon)
|
(draw-cube-wires (camera3d-target camera) 1.0 1.0 1.0 :maroon)
|
||||||
(draw-grid 20 1.0))
|
(draw-grid 20 1.0))
|
||||||
(draw-text username (- (floor (vx cube-screen-pos)) (floor (measure-text username 20) 2))
|
(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:make-thread 'game-loop)
|
||||||
|
|
||||||
(bt:run-in-new-thread (bt:get-thread 'create-client))
|
|
||||||
(bt:run-in-new-thread (bt:get-thread 'game-loop))
|
(bt:run-in-new-thread (bt:get-thread 'game-loop))
|
||||||
|
|
|
@ -1,27 +1,47 @@
|
||||||
(load "~/quicklisp/setup.lisp")
|
(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
|
(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)
|
(in-package :mmo-server)
|
||||||
|
|
||||||
(defvar *logged-in-users-hash* (make-hash-table))
|
|
||||||
|
|
||||||
(defun create-server (port)
|
(defvar *connections* (make-hash-table))
|
||||||
(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)))))
|
|
||||||
|
|
||||||
(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