2023-12-16 15:06:29 -05:00
|
|
|
(load "~/quicklisp/setup.lisp") ; need to load quicklisp
|
2024-01-04 08:46:46 -05:00
|
|
|
(ql:quickload '(:cl-raylib :cl-bcrypt :websocket-driver-client
|
|
|
|
:alexandria :com.inuoe.jzon))
|
2023-12-16 15:06:29 -05:00
|
|
|
|
|
|
|
(defpackage :mmo-client
|
2024-01-04 08:46:46 -05:00
|
|
|
(:use :common-lisp :cl-raylib :raylib :3d-vectors
|
|
|
|
:websocket-driver-client :alexandria :com.inuoe.jzon))
|
2023-12-16 15:06:29 -05:00
|
|
|
|
|
|
|
(in-package :mmo-client)
|
|
|
|
|
2024-01-01 15:26:28 -05:00
|
|
|
(defvar *client* (wsd:make-client "ws://localhost:12345"))
|
2024-01-01 19:04:32 -05:00
|
|
|
(defvar *logged-in-users* (make-hash-table))
|
2024-01-04 08:46:46 -05:00
|
|
|
(defvar *current-user* (make-hash-table))
|
2023-12-31 15:21:34 -05:00
|
|
|
|
2024-01-01 15:26:28 -05:00
|
|
|
(wsd:start-connection *client*)
|
|
|
|
(wsd:on :message *client*
|
|
|
|
(lambda (message)
|
2024-01-04 08:46:46 -05:00
|
|
|
(let* ((json (com.inuoe.jzon:parse message))
|
|
|
|
(cmd (gethash "cmd" json))
|
2024-01-13 11:30:32 -05:00
|
|
|
(uid (gethash "uid" json))
|
|
|
|
(user (gethash "user" json))
|
|
|
|
(users (gethash "users" json)))
|
|
|
|
|
|
|
|
(format t "message: ~A~%" message)
|
|
|
|
|
2024-01-04 08:46:46 -05:00
|
|
|
(cond
|
|
|
|
((equalp cmd "login")
|
2024-01-13 11:30:32 -05:00
|
|
|
(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)))
|
2024-01-04 08:46:46 -05:00
|
|
|
((equalp cmd "logout")
|
|
|
|
(remhash uid *logged-in-users*))
|
|
|
|
((equalp cmd "move")
|
|
|
|
(setf (gethash "x" (gethash uid *logged-in-users*))
|
|
|
|
(gethash "x" json))
|
|
|
|
(setf (gethash "y" (gethash uid *logged-in-users*))
|
|
|
|
(gethash "y" json)))
|
|
|
|
(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))))
|
2024-01-01 16:33:39 -05:00
|
|
|
|
|
|
|
(let* ((screen-width 800)
|
|
|
|
(screen-height 450)
|
2024-01-04 08:46:46 -05:00
|
|
|
(username "username")
|
2024-01-01 16:33:39 -05:00
|
|
|
(title "mmo client - common lisp")
|
|
|
|
(camera (make-camera3d :position (vec 4.0 2.0 4.0)
|
|
|
|
:target (vec 0.0 0.5 0.0)
|
|
|
|
:up (vec 0.0 1.0 0.0)
|
|
|
|
:fovy 60.0
|
|
|
|
:projection :camera-perspective))
|
|
|
|
(cube-screen-pos (vec 0.0 0.0)))
|
|
|
|
|
|
|
|
(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)
|
|
|
|
|
|
|
|
(when (is-key-down 87)
|
2024-01-04 08:46:46 -05:00
|
|
|
(send-move camera username))
|
2024-01-01 16:33:39 -05:00
|
|
|
(when (is-key-down 65)
|
2024-01-04 08:46:46 -05:00
|
|
|
(send-move camera username))
|
2024-01-01 16:33:39 -05:00
|
|
|
(when (is-key-down 83)
|
2024-01-04 08:46:46 -05:00
|
|
|
(send-move camera username))
|
2024-01-01 16:33:39 -05:00
|
|
|
(when (is-key-down 68)
|
2024-01-04 08:46:46 -05:00
|
|
|
(send-move camera username))
|
2024-01-01 16:33:39 -05:00
|
|
|
|
2024-01-04 08:46:46 -05:00
|
|
|
(setf cube-screen-pos
|
|
|
|
(get-world-to-screen
|
|
|
|
(v+ (camera3d-target camera) (vec 0 1.0 0)) camera))
|
2024-01-01 16:33:39 -05:00
|
|
|
(with-drawing
|
|
|
|
(clear-background :raywhite)
|
|
|
|
(with-mode-3d (camera)
|
|
|
|
(draw-cube (camera3d-target camera) 1.0 1.0 1.0 :red)
|
2024-01-04 08:46:46 -05:00
|
|
|
(draw-text username
|
|
|
|
(- (floor (vx cube-screen-pos))
|
|
|
|
(floor (measure-text username 20) 2))
|
|
|
|
(floor (vy cube-screen-pos) ) 20 :black)
|
|
|
|
|
2024-01-13 11:30:32 -05:00
|
|
|
(loop :for user :being :the :hash-keys :of *logged-in-users* :do
|
|
|
|
(format t "loop! ~a~%" user)
|
2024-01-04 08:46:46 -05:00
|
|
|
(let ((x (gethash "x" user))
|
|
|
|
(y (gethash "y" user)))
|
|
|
|
(draw-cube (vec x 0.5 y) 1.0 1.0 1.0 :red)
|
2024-01-13 11:30:32 -05:00
|
|
|
(let ((name (format nil "Guest ~a" (gethash "uid" user))))
|
2024-01-04 08:46:46 -05:00
|
|
|
(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))))))
|
2024-01-01 16:33:39 -05:00
|
|
|
|
|
|
|
(wsd:close-connection *client*)
|