diff --git a/TODO b/TODO index 7ce1c0f..24330d9 100644 --- a/TODO +++ b/TODO @@ -27,10 +27,10 @@ -> SEVERE +* Heap exhaustion on map reload! + * `terminate` hangs when a player is still logged in -* Game map is not rendered - * world thread type error: "The value -1 is not of type unsigned-byte when binding sb-impl::n" diff --git a/TODO b/TODO index 7ce1c0f..24330d9 100644 --- a/TODO +++ b/TODO @@ -27,10 +27,10 @@ -> SEVERE +* Heap exhaustion on map reload! + * `terminate` hangs when a player is still logged in -* Game map is not rendered - * world thread type error: "The value -1 is not of type unsigned-byte when binding sb-impl::n" diff --git a/client/networking.lisp b/client/networking.lisp index 7833f6a..a920e99 100644 --- a/client/networking.lisp +++ b/client/networking.lisp @@ -31,19 +31,11 @@ (format servstr "~A~%" req) (finish-output servstr) (usocket:wait-for-input naledi-server) - (let ((reply (read-line servstr nil))) - ;;XXX do I need to be able to read multiple lines? - ;; (do* ((raw-reply (multiple-value-list (read-line servstr nil)) - ;; (multiple-value-list (read-line servstr nil))) - ;; (reply-line (first raw-reply) (first raw-reply)) - ;; (eof (second raw-reply) (second raw-reply)) - ;; (reply reply-line (sconc reply reply-line))) - ;; ((or eof (null reply-line)) ;;FIXME + (let ((reply (read servstr nil))) (logf 4 "CLIENT: received reply.") (if (search "ERROR" reply) - (error reply) - (read-from-string reply))))) - + (error reply) reply)))) + (defun disconnect () "Disconnect from the server" (when naledi-server diff --git a/TODO b/TODO index 7ce1c0f..24330d9 100644 --- a/TODO +++ b/TODO @@ -27,10 +27,10 @@ -> SEVERE +* Heap exhaustion on map reload! + * `terminate` hangs when a player is still logged in -* Game map is not rendered - * world thread type error: "The value -1 is not of type unsigned-byte when binding sb-impl::n" diff --git a/client/networking.lisp b/client/networking.lisp index 7833f6a..a920e99 100644 --- a/client/networking.lisp +++ b/client/networking.lisp @@ -31,19 +31,11 @@ (format servstr "~A~%" req) (finish-output servstr) (usocket:wait-for-input naledi-server) - (let ((reply (read-line servstr nil))) - ;;XXX do I need to be able to read multiple lines? - ;; (do* ((raw-reply (multiple-value-list (read-line servstr nil)) - ;; (multiple-value-list (read-line servstr nil))) - ;; (reply-line (first raw-reply) (first raw-reply)) - ;; (eof (second raw-reply) (second raw-reply)) - ;; (reply reply-line (sconc reply reply-line))) - ;; ((or eof (null reply-line)) ;;FIXME + (let ((reply (read servstr nil))) (logf 4 "CLIENT: received reply.") (if (search "ERROR" reply) - (error reply) - (read-from-string reply))))) - + (error reply) reply)))) + (defun disconnect () "Disconnect from the server" (when naledi-server diff --git a/client/user-interface.lisp b/client/user-interface.lisp index 2ea5445..5ed9149 100644 --- a/client/user-interface.lisp +++ b/client/user-interface.lisp @@ -194,7 +194,7 @@ ;; It's a bit ugly that I have to do a `read-from-string` here, ;; but see the server-side function `get-map' for details (submap (read-from-string - (query-server "map" map-width map-height)))) + (query-server "map" map-width map-height)))) (dotimes (h map-height) (dotimes (w map-width) (let ((pch (aref submap w h 0)) (pcol (aref submap w h 1))) diff --git a/TODO b/TODO index 7ce1c0f..24330d9 100644 --- a/TODO +++ b/TODO @@ -27,10 +27,10 @@ -> SEVERE +* Heap exhaustion on map reload! + * `terminate` hangs when a player is still logged in -* Game map is not rendered - * world thread type error: "The value -1 is not of type unsigned-byte when binding sb-impl::n" diff --git a/client/networking.lisp b/client/networking.lisp index 7833f6a..a920e99 100644 --- a/client/networking.lisp +++ b/client/networking.lisp @@ -31,19 +31,11 @@ (format servstr "~A~%" req) (finish-output servstr) (usocket:wait-for-input naledi-server) - (let ((reply (read-line servstr nil))) - ;;XXX do I need to be able to read multiple lines? - ;; (do* ((raw-reply (multiple-value-list (read-line servstr nil)) - ;; (multiple-value-list (read-line servstr nil))) - ;; (reply-line (first raw-reply) (first raw-reply)) - ;; (eof (second raw-reply) (second raw-reply)) - ;; (reply reply-line (sconc reply reply-line))) - ;; ((or eof (null reply-line)) ;;FIXME + (let ((reply (read servstr nil))) (logf 4 "CLIENT: received reply.") (if (search "ERROR" reply) - (error reply) - (read-from-string reply))))) - + (error reply) reply)))) + (defun disconnect () "Disconnect from the server" (when naledi-server diff --git a/client/user-interface.lisp b/client/user-interface.lisp index 2ea5445..5ed9149 100644 --- a/client/user-interface.lisp +++ b/client/user-interface.lisp @@ -194,7 +194,7 @@ ;; It's a bit ugly that I have to do a `read-from-string` here, ;; but see the server-side function `get-map' for details (submap (read-from-string - (query-server "map" map-width map-height)))) + (query-server "map" map-width map-height)))) (dotimes (h map-height) (dotimes (w map-width) (let ((pch (aref submap w h 0)) (pcol (aref submap w h 1))) diff --git a/server/server.lisp b/server/server.lisp index 505a3fe..3fe01ae 100644 --- a/server/server.lisp +++ b/server/server.lisp @@ -182,6 +182,8 @@ (do* ((sockstr (usocket:socket-stream conn)) (request (read-line sockstr NIL) (read-line sockstr NIL))) ((or (not running) (null request)) (logout)) + ;;FIXME Errors must be wrapped in double quotation marks + ;; (client uses `read') (format sockstr "~S~%" (to-string (answer request))) (finish-output sockstr))))) @@ -270,32 +272,33 @@ (string-from-list (split-string (to-string submap) #\newline) ""))) (defun describe-patch (&optional (x 0) (y 0)) - "Return a list of lines describing the patch at these coordinates." - ;;FIXME throws an out of bounds error somewhere on a string + "Return a set of lines describing the patch at these coordinates." (let* ((plr (player-human (get-player (thread-player)))) (p (coord (+ x (.x plr)) (+ y (.y plr))))) - (list (string-upcase (biome-name (patch-biome p))) "" - (format NIL "~A / ~A" (first (patch-pos p)) (second (patch-pos p))) "" - (format NIL "The ground here is ~A." (biome-ground (patch-biome p))) - (when (patch-occupant p) ;TODO players -> "$name is here." - (format NIL "There is ~A here." + (format NIL "~A~%~%~A / ~A~%~%The ground here is ~A.~A~A" + (string-upcase (biome-name (patch-biome p))) + (first (patch-pos p)) (second (patch-pos p)) + (biome-ground (patch-biome p)) + (when (and (patch-occupant p) (not (typep (patch-occupant p) 'human))) + ;;TODO players -> "$name is here." + (format NIL "~%~%There is ~A here." (leading-vowel (.name (patch-occupant p))))) - (when (patch-items p) - (format NIL "The following items are here:~A *~A" #\newline + (if (null (patch-items p)) "" + (format NIL "~%~%The following items are here:~A *~A" #\newline (string-from-list (mapcar #'.name (patch-items p))) (format NIL "~% *")))))) (defun move-player (dir) "Move a player in the given direction" (let ((plr (player-human (get-player (thread-player))))) - (cond ((equalp d "n") (move plr 'n)) - ((equalp d "ne") (move plr 'ne)) - ((equalp d "e") (move plr 'e)) - ((equalp d "se") (move plr 'se)) - ((equalp d "s") (move plr 's)) - ((equalp d "sw") (move plr 'sw)) - ((equalp d "w") (move plr 'w)) - ((equalp d "nw") (move plr 'nw)) + (cond ((equalp dir "n") (move plr 'n)) + ((equalp dir "ne") (move plr 'ne)) + ((equalp dir "e") (move plr 'e)) + ((equalp dir "se") (move plr 'se)) + ((equalp dir "s") (move plr 's)) + ((equalp dir "sw") (move plr 'sw)) + ((equalp dir "w") (move plr 'w)) + ((equalp dir "nw") (move plr 'nw)) (T "ERROR: Invalid move direction ~S" dir)))) (defparameter *API* diff --git a/TODO b/TODO index 7ce1c0f..24330d9 100644 --- a/TODO +++ b/TODO @@ -27,10 +27,10 @@ -> SEVERE +* Heap exhaustion on map reload! + * `terminate` hangs when a player is still logged in -* Game map is not rendered - * world thread type error: "The value -1 is not of type unsigned-byte when binding sb-impl::n" diff --git a/client/networking.lisp b/client/networking.lisp index 7833f6a..a920e99 100644 --- a/client/networking.lisp +++ b/client/networking.lisp @@ -31,19 +31,11 @@ (format servstr "~A~%" req) (finish-output servstr) (usocket:wait-for-input naledi-server) - (let ((reply (read-line servstr nil))) - ;;XXX do I need to be able to read multiple lines? - ;; (do* ((raw-reply (multiple-value-list (read-line servstr nil)) - ;; (multiple-value-list (read-line servstr nil))) - ;; (reply-line (first raw-reply) (first raw-reply)) - ;; (eof (second raw-reply) (second raw-reply)) - ;; (reply reply-line (sconc reply reply-line))) - ;; ((or eof (null reply-line)) ;;FIXME + (let ((reply (read servstr nil))) (logf 4 "CLIENT: received reply.") (if (search "ERROR" reply) - (error reply) - (read-from-string reply))))) - + (error reply) reply)))) + (defun disconnect () "Disconnect from the server" (when naledi-server diff --git a/client/user-interface.lisp b/client/user-interface.lisp index 2ea5445..5ed9149 100644 --- a/client/user-interface.lisp +++ b/client/user-interface.lisp @@ -194,7 +194,7 @@ ;; It's a bit ugly that I have to do a `read-from-string` here, ;; but see the server-side function `get-map' for details (submap (read-from-string - (query-server "map" map-width map-height)))) + (query-server "map" map-width map-height)))) (dotimes (h map-height) (dotimes (w map-width) (let ((pch (aref submap w h 0)) (pcol (aref submap w h 1))) diff --git a/server/server.lisp b/server/server.lisp index 505a3fe..3fe01ae 100644 --- a/server/server.lisp +++ b/server/server.lisp @@ -182,6 +182,8 @@ (do* ((sockstr (usocket:socket-stream conn)) (request (read-line sockstr NIL) (read-line sockstr NIL))) ((or (not running) (null request)) (logout)) + ;;FIXME Errors must be wrapped in double quotation marks + ;; (client uses `read') (format sockstr "~S~%" (to-string (answer request))) (finish-output sockstr))))) @@ -270,32 +272,33 @@ (string-from-list (split-string (to-string submap) #\newline) ""))) (defun describe-patch (&optional (x 0) (y 0)) - "Return a list of lines describing the patch at these coordinates." - ;;FIXME throws an out of bounds error somewhere on a string + "Return a set of lines describing the patch at these coordinates." (let* ((plr (player-human (get-player (thread-player)))) (p (coord (+ x (.x plr)) (+ y (.y plr))))) - (list (string-upcase (biome-name (patch-biome p))) "" - (format NIL "~A / ~A" (first (patch-pos p)) (second (patch-pos p))) "" - (format NIL "The ground here is ~A." (biome-ground (patch-biome p))) - (when (patch-occupant p) ;TODO players -> "$name is here." - (format NIL "There is ~A here." + (format NIL "~A~%~%~A / ~A~%~%The ground here is ~A.~A~A" + (string-upcase (biome-name (patch-biome p))) + (first (patch-pos p)) (second (patch-pos p)) + (biome-ground (patch-biome p)) + (when (and (patch-occupant p) (not (typep (patch-occupant p) 'human))) + ;;TODO players -> "$name is here." + (format NIL "~%~%There is ~A here." (leading-vowel (.name (patch-occupant p))))) - (when (patch-items p) - (format NIL "The following items are here:~A *~A" #\newline + (if (null (patch-items p)) "" + (format NIL "~%~%The following items are here:~A *~A" #\newline (string-from-list (mapcar #'.name (patch-items p))) (format NIL "~% *")))))) (defun move-player (dir) "Move a player in the given direction" (let ((plr (player-human (get-player (thread-player))))) - (cond ((equalp d "n") (move plr 'n)) - ((equalp d "ne") (move plr 'ne)) - ((equalp d "e") (move plr 'e)) - ((equalp d "se") (move plr 'se)) - ((equalp d "s") (move plr 's)) - ((equalp d "sw") (move plr 'sw)) - ((equalp d "w") (move plr 'w)) - ((equalp d "nw") (move plr 'nw)) + (cond ((equalp dir "n") (move plr 'n)) + ((equalp dir "ne") (move plr 'ne)) + ((equalp dir "e") (move plr 'e)) + ((equalp dir "se") (move plr 'se)) + ((equalp dir "s") (move plr 's)) + ((equalp dir "sw") (move plr 'sw)) + ((equalp dir "w") (move plr 'w)) + ((equalp dir "nw") (move plr 'nw)) (T "ERROR: Invalid move direction ~S" dir)))) (defparameter *API* diff --git a/util.lisp b/util.lisp index db5ca7b..751fc53 100644 --- a/util.lisp +++ b/util.lisp @@ -165,6 +165,8 @@ (defun break-lines (lines width &optional (indent "")) "Take a list of lines and break any that are too long." + (when (stringp lines) + (setf lines (split-string lines #\newline))) (do* ((ls lines (cdr ls)) (l (car ls) (car ls)) (result NIL)) ((null ls) result) (if (<= (length l) width)