diff --git a/naledi.lisp b/naledi.lisp index b84f286..f7eecba 100644 --- a/naledi.lisp +++ b/naledi.lisp @@ -128,6 +128,7 @@ (terminate)) (return-from croatoan:event-case)) (#\n (croatoan:draw-menu (message-window))) + ;;FIXME change directions to single letters (:up (query-server "move north") (update-ui mapwin playerwin placewin newswin me)) (:down (query-server "move south") @@ -209,10 +210,7 @@ ;;XXX use `user-inform' instead of dialog-window? (make-instance 'croatoan:dialog-window :input-blocking t - :items (break-lines - (mapcar #'(lambda (n) (string-from-list (list "*" n))) - news) - 50) + :items (break-lines (mapcar #'(lambda (n) (sconc "* " n)) news) 50) :center t :border t :stacked t diff --git a/naledi.lisp b/naledi.lisp index b84f286..f7eecba 100644 --- a/naledi.lisp +++ b/naledi.lisp @@ -128,6 +128,7 @@ (terminate)) (return-from croatoan:event-case)) (#\n (croatoan:draw-menu (message-window))) + ;;FIXME change directions to single letters (:up (query-server "move north") (update-ui mapwin playerwin placewin newswin me)) (:down (query-server "move south") @@ -209,10 +210,7 @@ ;;XXX use `user-inform' instead of dialog-window? (make-instance 'croatoan:dialog-window :input-blocking t - :items (break-lines - (mapcar #'(lambda (n) (string-from-list (list "*" n))) - news) - 50) + :items (break-lines (mapcar #'(lambda (n) (sconc "* " n)) news) 50) :center t :border t :stacked t diff --git a/src/server.lisp b/src/server.lisp index ef24bb6..d104be5 100644 --- a/src/server.lisp +++ b/src/server.lisp @@ -19,7 +19,7 @@ ;;; PLAYER LIST (let ((players NIL)) - (defun reset-players () (setf players NIL)) + (defun reset-players () (setf players NIL)) ;;TODO logout first (defun get-player (name) (first (member name players @@ -98,7 +98,7 @@ (bt:destroy-thread server-thread) (bt:join-thread world-thread) (dolist (pt player-threads) - (bt:join-thread pt)) + (bt:join-thread (first pt))) (reset-server-threads) (save-world)) ;XXX not yet implemented @@ -111,6 +111,15 @@ (defun reset-server-threads () (set-list NIL server-thread world-thread player-threads)) + (defun thread-player (&optional (th (bt:current-thread))) + "Return the player name associated with this thread" + (cassoc th player-threads)) + + (defun set-thread-player (name &optional (th (bt:current-thread))) + "Set the player name associated with this thread" + ;;XXX somewhat ugly... + (setf (cassoc th player-threads) name)) + ;;TODO remove threads named `terminated' (defun update-loop () @@ -143,9 +152,9 @@ (let ((thread (bt:make-thread #'(lambda () (handle-connection socket)) - :name "anonymous"))) + :name "player-thread"))) (setf player-threads - (cons thread player-threads)) + (cons (list thread "anon") player-threads)) (sleep 1)))))) ;;give the socket a chance to connect (defun handle-connection (socket) @@ -158,35 +167,29 @@ (format sockstr "~S~%" (to-string (answer request))) (finish-output sockstr))))) -(defparameter *API* - ;; An alist of API commands and their corresponding functions - '((login #'login) - (map #'get-map) - (signup #'create-player) - (describe-patch #'describe-patch) - (move #'move-player))) - (defun answer (request) - "Dispatch on the functions registerd in `api'" - (let* ((reqelts (extract-elements request)) + "Dispatch on the functions registerd in `*API*'" + ;;XXX potential problem with reading all user-received symbols into memory + (let* ((reqelts (split-string request #\space)) (cmd (car reqelts)) (args (cdr reqelts))) - (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))) + (logging "SERVER: received request ~S~S" cmd args) + (if (member cmd (keys *API*) :test #'equalp) + (if (and (equalp (thread-player) "anon") + (not (or (equalp cmd "login") (equalp cmd "signup")))) "ERROR: not logged in" (progn (logging "SERVER: calling function ~S with args ~S" - (cassoc cmd *API* :test #'eq) args) - (apply (cassoc cmd *API* :test #'eq) args)))))) + (cassoc cmd *API* :test #'equalp) args) + (apply (cassoc cmd *API* :test #'equalp) args))) + (logging "ERROR: unknown command")))) ;;; 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") + (logging "SERVER: ~A is trying to log in" name) (let ((p (get-player name))) (cond ((not p) "ERROR: nonexistent player") ((not (equalp passwd (player-password p))) "ERROR: bad password") @@ -194,20 +197,22 @@ (setf (patch-occupant ;;TODO check for previous occupants (coord (.x (player-human p)) (.y (player-human p)))) (player-human p)) - (setf (bt:thread-name (bt:current-thread)) name) - (logging "SERVER: player ~A logged in" player) + ;;FIXME thread-name may only be set when creating thread? + ;; -> login player, THEN start thread + (set-thread-player name) + (logging "SERVER: player ~A logged in" name) name)))) (defun logout () "Log the player out again" - (let ((p (get-player (bt:thread-name (bt:current-thread))))) + (let ((p (get-player (thread-player)))) (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 " (logging "SERVER: player ~A logged out" player) - (setf (bt:thread-name (bt:current-thread)) "terminated")))) + (set-thread-player "terminated")))) (defun create-player (name passwd) "Create and log in a new player" @@ -218,6 +223,7 @@ (defun get-map (width height) "Return a 3d array (x-coord, y-coord, character/colour) of the visible map" + ;;FIXME (let* ((plr (player-human (get-player (bt:thread-name (bt:current-thread))))) (x0 (- (.x plr) (halve width))) @@ -254,3 +260,12 @@ "Move a player in the given direction" ;;TODO ) + +(defparameter *API* + ;; An alist of API commands and their corresponding functions + ;;XXX move all listed functions to another file? + (list (list "login" #'login) + (list "signup" #'create-player) + (list "map" #'get-map) + (list "describe-patch" #'describe-patch) + (list "move" #'move-player))) diff --git a/naledi.lisp b/naledi.lisp index b84f286..f7eecba 100644 --- a/naledi.lisp +++ b/naledi.lisp @@ -128,6 +128,7 @@ (terminate)) (return-from croatoan:event-case)) (#\n (croatoan:draw-menu (message-window))) + ;;FIXME change directions to single letters (:up (query-server "move north") (update-ui mapwin playerwin placewin newswin me)) (:down (query-server "move south") @@ -209,10 +210,7 @@ ;;XXX use `user-inform' instead of dialog-window? (make-instance 'croatoan:dialog-window :input-blocking t - :items (break-lines - (mapcar #'(lambda (n) (string-from-list (list "*" n))) - news) - 50) + :items (break-lines (mapcar #'(lambda (n) (sconc "* " n)) news) 50) :center t :border t :stacked t diff --git a/src/server.lisp b/src/server.lisp index ef24bb6..d104be5 100644 --- a/src/server.lisp +++ b/src/server.lisp @@ -19,7 +19,7 @@ ;;; PLAYER LIST (let ((players NIL)) - (defun reset-players () (setf players NIL)) + (defun reset-players () (setf players NIL)) ;;TODO logout first (defun get-player (name) (first (member name players @@ -98,7 +98,7 @@ (bt:destroy-thread server-thread) (bt:join-thread world-thread) (dolist (pt player-threads) - (bt:join-thread pt)) + (bt:join-thread (first pt))) (reset-server-threads) (save-world)) ;XXX not yet implemented @@ -111,6 +111,15 @@ (defun reset-server-threads () (set-list NIL server-thread world-thread player-threads)) + (defun thread-player (&optional (th (bt:current-thread))) + "Return the player name associated with this thread" + (cassoc th player-threads)) + + (defun set-thread-player (name &optional (th (bt:current-thread))) + "Set the player name associated with this thread" + ;;XXX somewhat ugly... + (setf (cassoc th player-threads) name)) + ;;TODO remove threads named `terminated' (defun update-loop () @@ -143,9 +152,9 @@ (let ((thread (bt:make-thread #'(lambda () (handle-connection socket)) - :name "anonymous"))) + :name "player-thread"))) (setf player-threads - (cons thread player-threads)) + (cons (list thread "anon") player-threads)) (sleep 1)))))) ;;give the socket a chance to connect (defun handle-connection (socket) @@ -158,35 +167,29 @@ (format sockstr "~S~%" (to-string (answer request))) (finish-output sockstr))))) -(defparameter *API* - ;; An alist of API commands and their corresponding functions - '((login #'login) - (map #'get-map) - (signup #'create-player) - (describe-patch #'describe-patch) - (move #'move-player))) - (defun answer (request) - "Dispatch on the functions registerd in `api'" - (let* ((reqelts (extract-elements request)) + "Dispatch on the functions registerd in `*API*'" + ;;XXX potential problem with reading all user-received symbols into memory + (let* ((reqelts (split-string request #\space)) (cmd (car reqelts)) (args (cdr reqelts))) - (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))) + (logging "SERVER: received request ~S~S" cmd args) + (if (member cmd (keys *API*) :test #'equalp) + (if (and (equalp (thread-player) "anon") + (not (or (equalp cmd "login") (equalp cmd "signup")))) "ERROR: not logged in" (progn (logging "SERVER: calling function ~S with args ~S" - (cassoc cmd *API* :test #'eq) args) - (apply (cassoc cmd *API* :test #'eq) args)))))) + (cassoc cmd *API* :test #'equalp) args) + (apply (cassoc cmd *API* :test #'equalp) args))) + (logging "ERROR: unknown command")))) ;;; 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") + (logging "SERVER: ~A is trying to log in" name) (let ((p (get-player name))) (cond ((not p) "ERROR: nonexistent player") ((not (equalp passwd (player-password p))) "ERROR: bad password") @@ -194,20 +197,22 @@ (setf (patch-occupant ;;TODO check for previous occupants (coord (.x (player-human p)) (.y (player-human p)))) (player-human p)) - (setf (bt:thread-name (bt:current-thread)) name) - (logging "SERVER: player ~A logged in" player) + ;;FIXME thread-name may only be set when creating thread? + ;; -> login player, THEN start thread + (set-thread-player name) + (logging "SERVER: player ~A logged in" name) name)))) (defun logout () "Log the player out again" - (let ((p (get-player (bt:thread-name (bt:current-thread))))) + (let ((p (get-player (thread-player)))) (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 " (logging "SERVER: player ~A logged out" player) - (setf (bt:thread-name (bt:current-thread)) "terminated")))) + (set-thread-player "terminated")))) (defun create-player (name passwd) "Create and log in a new player" @@ -218,6 +223,7 @@ (defun get-map (width height) "Return a 3d array (x-coord, y-coord, character/colour) of the visible map" + ;;FIXME (let* ((plr (player-human (get-player (bt:thread-name (bt:current-thread))))) (x0 (- (.x plr) (halve width))) @@ -254,3 +260,12 @@ "Move a player in the given direction" ;;TODO ) + +(defparameter *API* + ;; An alist of API commands and their corresponding functions + ;;XXX move all listed functions to another file? + (list (list "login" #'login) + (list "signup" #'create-player) + (list "map" #'get-map) + (list "describe-patch" #'describe-patch) + (list "move" #'move-player))) diff --git a/src/util.lisp b/src/util.lisp index fa9cbe0..28b1b6f 100644 --- a/src/util.lisp +++ b/src/util.lisp @@ -128,6 +128,10 @@ (T (concatenate 'string (to-string (first lst)) (to-string separator) (string-from-list (cdr lst) separator))))) +(defun sconc (&rest substrings) + "Concatenate all passed strings (wrapper function)" + (string-from-list substrings "")) + (defun split-string (str separator) "Split the string up into a list of strings along the separator character" (cond ((equalp str (to-string separator)) NIL)