diff --git a/naledi.lisp b/naledi.lisp index 7528d60..b84f286 100644 --- a/naledi.lisp +++ b/naledi.lisp @@ -81,7 +81,8 @@ ;;give the server time to start (while (not (runningp)) ;;TODO replace with `loop' (sleep 0.5)) - (connect-server)) + (connect-server) + (query-server "signup localuser default")) ;;just use a default user ;;TODO (choose-world-size) @@ -120,17 +121,21 @@ ;;TODO (croatoan:event-case (scr event) (#\q (disconnect) - (terminate) - (return-from croatoan:event-case)) ;XXX + ;;terminate if we're running a local game + (when (member "server-thread" (bt:all-threads) :test + #'(lambda (nm th) + (equalp nm (bt:thread-name th)))) + (terminate)) + (return-from croatoan:event-case)) (#\n (croatoan:draw-menu (message-window))) - (:up (decf (second me)) (update-ui mapwin playerwin - placewin newswin me)) - (:down (incf (second me)) (update-ui mapwin playerwin - placewin newswin me)) - (:left (decf (first me)) (update-ui mapwin playerwin - placewin newswin me)) - (:right (incf (first me)) (update-ui mapwin playerwin - placewin newswin me)) + (:up (query-server "move north") + (update-ui mapwin playerwin placewin newswin me)) + (:down (query-server "move south") + (update-ui mapwin playerwin placewin newswin me)) + (:left (query-server "move west") + (update-ui mapwin playerwin placewin newswin me)) + (:right (query-server "move east") + (update-ui mapwin playerwin placewin newswin me)) ((nil) (update-ui mapwin playerwin placewin newswin me)) (otherwise (notify (string event))))))) @@ -179,6 +184,7 @@ (1+ (first (croatoan:.cursor-position win))) 1)) (croatoan:refresh win))) +;;FIXME needs to be overhauled for client/server (let ((news '("Press h for help."))) (defun draw-news-panel (win) "Draw a thin panel at the bottom of the screen to display news items." diff --git a/naledi.lisp b/naledi.lisp index 7528d60..b84f286 100644 --- a/naledi.lisp +++ b/naledi.lisp @@ -81,7 +81,8 @@ ;;give the server time to start (while (not (runningp)) ;;TODO replace with `loop' (sleep 0.5)) - (connect-server)) + (connect-server) + (query-server "signup localuser default")) ;;just use a default user ;;TODO (choose-world-size) @@ -120,17 +121,21 @@ ;;TODO (croatoan:event-case (scr event) (#\q (disconnect) - (terminate) - (return-from croatoan:event-case)) ;XXX + ;;terminate if we're running a local game + (when (member "server-thread" (bt:all-threads) :test + #'(lambda (nm th) + (equalp nm (bt:thread-name th)))) + (terminate)) + (return-from croatoan:event-case)) (#\n (croatoan:draw-menu (message-window))) - (:up (decf (second me)) (update-ui mapwin playerwin - placewin newswin me)) - (:down (incf (second me)) (update-ui mapwin playerwin - placewin newswin me)) - (:left (decf (first me)) (update-ui mapwin playerwin - placewin newswin me)) - (:right (incf (first me)) (update-ui mapwin playerwin - placewin newswin me)) + (:up (query-server "move north") + (update-ui mapwin playerwin placewin newswin me)) + (:down (query-server "move south") + (update-ui mapwin playerwin placewin newswin me)) + (:left (query-server "move west") + (update-ui mapwin playerwin placewin newswin me)) + (:right (query-server "move east") + (update-ui mapwin playerwin placewin newswin me)) ((nil) (update-ui mapwin playerwin placewin newswin me)) (otherwise (notify (string event))))))) @@ -179,6 +184,7 @@ (1+ (first (croatoan:.cursor-position win))) 1)) (croatoan:refresh win))) +;;FIXME needs to be overhauled for client/server (let ((news '("Press h for help."))) (defun draw-news-panel (win) "Draw a thin panel at the bottom of the screen to display news items." diff --git a/src/client.lisp b/src/client.lisp index 05e428c..0cbbeaa 100644 --- a/src/client.lisp +++ b/src/client.lisp @@ -2,8 +2,7 @@ ;;;; Naledi ya Africa ("Star of Africa") is an ncurses-based survival game ;;;; set in Africa. ;;;; -;;;; This file is responsible for connecting to the server and provides the -;;;; API functions for doing so. +;;;; This file is responsible for connecting to the server. ;;;; ;;;; (c) 2018 Daniel Vedder, MIT license ;;;; @@ -30,10 +29,13 @@ (logging "CLIENT: sending request ~S" request) (format servstr "~A~%" req) (finish-output servstr) - ;;FIXME server still doesn't receive string until disconnect... (logging "CLIENT: waiting for server response") (usocket:wait-for-input naledi-server) - (read-from-string (read-line servstr)))) + (let ((reply (read-line servstr))) + (logging "CLIENT: received reply ~A" reply) + (read-from-string reply)))) + ;; (logging "CLIENT: ready to receive response") + ;; (read-from-string (read-line servstr)))) (defun disconnect () "Disconnect from the server" diff --git a/naledi.lisp b/naledi.lisp index 7528d60..b84f286 100644 --- a/naledi.lisp +++ b/naledi.lisp @@ -81,7 +81,8 @@ ;;give the server time to start (while (not (runningp)) ;;TODO replace with `loop' (sleep 0.5)) - (connect-server)) + (connect-server) + (query-server "signup localuser default")) ;;just use a default user ;;TODO (choose-world-size) @@ -120,17 +121,21 @@ ;;TODO (croatoan:event-case (scr event) (#\q (disconnect) - (terminate) - (return-from croatoan:event-case)) ;XXX + ;;terminate if we're running a local game + (when (member "server-thread" (bt:all-threads) :test + #'(lambda (nm th) + (equalp nm (bt:thread-name th)))) + (terminate)) + (return-from croatoan:event-case)) (#\n (croatoan:draw-menu (message-window))) - (:up (decf (second me)) (update-ui mapwin playerwin - placewin newswin me)) - (:down (incf (second me)) (update-ui mapwin playerwin - placewin newswin me)) - (:left (decf (first me)) (update-ui mapwin playerwin - placewin newswin me)) - (:right (incf (first me)) (update-ui mapwin playerwin - placewin newswin me)) + (:up (query-server "move north") + (update-ui mapwin playerwin placewin newswin me)) + (:down (query-server "move south") + (update-ui mapwin playerwin placewin newswin me)) + (:left (query-server "move west") + (update-ui mapwin playerwin placewin newswin me)) + (:right (query-server "move east") + (update-ui mapwin playerwin placewin newswin me)) ((nil) (update-ui mapwin playerwin placewin newswin me)) (otherwise (notify (string event))))))) @@ -179,6 +184,7 @@ (1+ (first (croatoan:.cursor-position win))) 1)) (croatoan:refresh win))) +;;FIXME needs to be overhauled for client/server (let ((news '("Press h for help."))) (defun draw-news-panel (win) "Draw a thin panel at the bottom of the screen to display news items." diff --git a/src/client.lisp b/src/client.lisp index 05e428c..0cbbeaa 100644 --- a/src/client.lisp +++ b/src/client.lisp @@ -2,8 +2,7 @@ ;;;; Naledi ya Africa ("Star of Africa") is an ncurses-based survival game ;;;; set in Africa. ;;;; -;;;; This file is responsible for connecting to the server and provides the -;;;; API functions for doing so. +;;;; This file is responsible for connecting to the server. ;;;; ;;;; (c) 2018 Daniel Vedder, MIT license ;;;; @@ -30,10 +29,13 @@ (logging "CLIENT: sending request ~S" request) (format servstr "~A~%" req) (finish-output servstr) - ;;FIXME server still doesn't receive string until disconnect... (logging "CLIENT: waiting for server response") (usocket:wait-for-input naledi-server) - (read-from-string (read-line servstr)))) + (let ((reply (read-line servstr))) + (logging "CLIENT: received reply ~A" reply) + (read-from-string reply)))) + ;; (logging "CLIENT: ready to receive response") + ;; (read-from-string (read-line servstr)))) (defun disconnect () "Disconnect from the server" diff --git a/src/server.lisp b/src/server.lisp index f7472ae..ef24bb6 100644 --- a/src/server.lisp +++ b/src/server.lisp @@ -158,29 +158,35 @@ (format sockstr "~S~%" (to-string (answer request))) (finish-output sockstr))))) -(defparameter api +(defparameter *API* ;; An alist of API commands and their corresponding functions '((login #'login) (map #'get-map) (signup #'create-player) - (describe-patch #'describe-patch))) + (describe-patch #'describe-patch) + (move #'move-player))) (defun answer (request) "Dispatch on the functions registerd in `api'" - (logging "SERVER: received request ~S" request) (let* ((reqelts (extract-elements request)) (cmd (car reqelts)) (args (cdr reqelts))) - (when (member cmd (keys api) :test #'eq) - (if (and (equalp (thread-name (current-thread)) "anonymous") + (logging "SERVER: received request ~S" reqelts) + (when (member cmd (keys *API*) :test #'eq) + (if (and (equalp (bt:thread-name (bt:current-thread)) "anonymous") (not (member cmd '(login signup) :test #'eq))) "ERROR: not logged in" - (apply (cassoc cmd api :test #'eq) args))))) + (progn + (logging "SERVER: calling function ~S with args ~S" + (cassoc cmd *API* :test #'eq) args) + (apply (cassoc cmd *API* :test #'eq) args)))))) ;;; COMMUNICATION FUNCTIONS (defun login (name passwd) "Log this player in" + ;;XXX name and passwd are converted to symbols by `answer'! + (logging "SERVER: ~A is trying to log in") (let ((p (get-player name))) (cond ((not p) "ERROR: nonexistent player") ((not (equalp passwd (player-password p))) "ERROR: bad password") @@ -188,18 +194,20 @@ (setf (patch-occupant ;;TODO check for previous occupants (coord (.x (player-human p)) (.y (player-human p)))) (player-human p)) - (setf (thread-name (current-thread)) name) + (setf (bt:thread-name (bt:current-thread)) name) + (logging "SERVER: player ~A logged in" player) name)))) (defun logout () "Log the player out again" - (let ((p (get-player (thread-name (current-thread))))) + (let ((p (get-player (bt:thread-name (bt:current-thread))))) (when p (setf (player-online p) NIL) (setf (patch-occupant (coord (.x (player-human p)) (.y (player-human p)))) NIL) ;;TODO set to "statue of " - (setf (thread-name (current-thread)) "terminated")))) + (logging "SERVER: player ~A logged out" player) + (setf (bt:thread-name (bt:current-thread)) "terminated")))) (defun create-player (name passwd) "Create and log in a new player" @@ -210,7 +218,8 @@ (defun get-map (width height) "Return a 3d array (x-coord, y-coord, character/colour) of the visible map" - (let* ((plr (player-human (get-player (thread-name (current-thread))))) + (let* ((plr (player-human + (get-player (bt:thread-name (bt:current-thread))))) (x0 (- (.x plr) (halve width))) (y0 (- (.y plr) (halve height))) (submap (make-array (list width height 2)))) @@ -239,4 +248,9 @@ (when (patch-items p) (format NIL "The following items are here:~A *~A" #\newline (string-from-list (mapcar #'.name (patch-items p))) - (format NIL "~% *")))))) + (format NIL "~% *")))))) + +(defun move-player (dir) + "Move a player in the given direction" + ;;TODO + )