zongor
/
mmo-project
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Add bordeaux-threads, make simple example echoing client position to server

This commit is contained in:
zongor 2023-12-31 15:21:34 -05:00
parent 6f65a71f4b
commit 1efecbd0c6
2 changed files with 70 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
lisp/client/common-lisp/client.lisp
View File

@ -1,12 +1,37 @@
(load "~/quicklisp/setup.lisp") ; need to load quicklisp
(ql:quickload '(:cl-raylib :cl-bcrypt :usocket :simple-actors :bordeaux-threads))
(ql:quickload '(:cl-raylib :cl-bcrypt :usocket :bordeaux-threads :alexandria))
(defpackage :mmo-client
(:use :common-lisp :cl-raylib :3d-vectors))
(:use :common-lisp :cl-raylib :3d-vectors :usocket :bordeaux-threads :alexandria))
(in-package :mmo-client)
(defun main ()
(defvar *lock* (bt:make-lock))
(defvar *logged-in-users-hash* (make-hash-table))
(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~%" (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 ()
(let* ((screen-width 800)
(screen-height 450)
(username "username")
@ -17,20 +42,29 @@
:fovy 60.0
:projection :camera-perspective))
(cube-screen-pos (vec 0.0 0.0)))
(add-entry 'pos (camera3d-target camera))
(with-window (screen-width screen-height title)
(disable-cursor)
(set-target-fps 60) ; Set our game to run at 60 FPS
(loop
until (window-should-close) ; detect window close button or ESC key
do (update-camera camera :camera-third-person)
(setf cube-screen-pos (get-world-to-screen (v+ (camera3d-target camera) (vec 0 1.0 0)) camera))
(with-drawing
(clear-background :raywhite)
(with-mode-3d (camera)
(draw-cube (camera3d-target camera) 1.0 1.0 1.0 :red)
(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))))))
do
(update-camera camera :camera-third-person)
(add-entry 'pos (camera3d-target camera))
(setf cube-screen-pos (get-world-to-screen (v+ (camera3d-target camera) (vec 0 1.0 0)) camera))
(with-drawing
(clear-background :raywhite)
(with-mode-3d (camera)
(draw-cube (camera3d-target camera) 1.0 1.0 1.0 :red)
(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))))))
(main)
(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))

25
lisp/server/server.lisp
View File

@ -1,8 +1,27 @@
(load "~/quicklisp/setup.lisp")
(ql:quickload '(:usocket :simple-actors :bordeaux-threads :cl-bcrypt :datafly :sxql))
(ql:quickload '(:usocket :bordeaux-threads :cl-bcrypt :datafly :sxql :alexandria))
(defpackage :mmo-server
(:use :common-lisp :usocket :simple-actors :bordeaux-threads)
(:export :accept-connections))
(:use :common-lisp :usocket :bordeaux-threads :cl-bcrypt :datafly :sxql :alexandria))
(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)))))
(create-server 5001)