mmo-project/lisp/client/common-lisp/client.lisp

(load "~/quicklisp/setup.lisp")
(ql:quickload '(:cl-raylib :cl-bcrypt :websocket-driver-client
			   :alexandria :com.inuoe.jzon))

(defpackage :mmo-client
  (:use :common-lisp :cl-raylib :raylib :3d-vectors
	:websocket-driver-client :alexandria :com.inuoe.jzon))

(in-package :mmo-client)

(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))
		 (msg (gethash "msg" json))
		 (uid (gethash "uid" json)))
	  (cond
	   ((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 (gethash "cmd" msg) "move")
	      (setf (gethash "x" (gethash uid *logged-in-users*))
		    (gethash "x" msg))
	      (setf (gethash "y" (gethash uid *logged-in-users*))
		    (gethash "y" msg)))
	   (t 
	    (format t "Unknown message: ~A~%" message))))))

(let* ((screen-width 800)
       (screen-height 450)
       (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)))

  (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
    (loop
      until (window-should-close) ; detect window close button or ESC key
      do
	 (update-camera camera :camera-third-person)

         (when (is-key-down 87)
	     (send-move camera))
         (when (is-key-down 65)
	     (send-move camera))
         (when (is-key-down 83)
	     (send-move camera))
         (when (is-key-down 68)
	     (send-move 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-text (gethash "username" *current-user*)
			(- (floor (vx cube-screen-pos))
			   (floor (measure-text (gethash "username" *current-user*) 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*)