diff --git a/TODO b/TODO index fa6aeb4..6519e4c 100644 --- a/TODO +++ b/TODO @@ -46,10 +46,14 @@ * `terminate` hangs when a player is still logged in * cannot start two local games one after the other -> "ERROR: player exists" + +* crashed games leave sockets blocked to future use * world thread type error: "The value -1 is not of type unsigned-byte when binding sb-impl::n" -> if several players log on? / if one player quits? +* cannot launch from outside game directory (logo file missing) + -> NON-SEVERE * response to prolonged keypresses is sluggish diff --git a/TODO b/TODO index fa6aeb4..6519e4c 100644 --- a/TODO +++ b/TODO @@ -46,10 +46,14 @@ * `terminate` hangs when a player is still logged in * cannot start two local games one after the other -> "ERROR: player exists" + +* crashed games leave sockets blocked to future use * world thread type error: "The value -1 is not of type unsigned-byte when binding sb-impl::n" -> if several players log on? / if one player quits? +* cannot launch from outside game directory (logo file missing) + -> NON-SEVERE * response to prolonged keypresses is sluggish diff --git a/client/networking.lisp b/client/networking.lisp index 10a37d2..7235fff 100644 --- a/client/networking.lisp +++ b/client/networking.lisp @@ -19,14 +19,16 @@ (notify "Connection to server ~A:~A failed." ip port))) (defun current-server () naledi-server) ;XXX remove after development? + + (defun connectedp () (not (null naledi-server))) (defun query-server (&rest request) "Send a request string to the server and return the answer" ;; If one argument is :ignore-errors, error strings are passed up ;; to the caller. Otherwise, they cause a crash. - ;;TODO the client should handle errors gracefully - (unless naledi-server ;XXX do this with exceptions - (error "You are not connected to a server!")) + (unless naledi-server ;XXX do this with exceptions? + (disconnect "No connection to server.") + (return-from query-server)) (let* ((servstr (usocket:socket-stream naledi-server)) (ig-errors (find ':ignore-errors request)) (req (string-from-list @@ -34,17 +36,21 @@ request)))) (logf 4 "CLIENT: sending request ~S" request) (format servstr "~A~%" req) - (finish-output servstr) - (usocket:wait-for-input naledi-server) + (finish-output servstr) ;;FIXME hangs if the server crashes + (unless (usocket:wait-for-input naledi-server :timeout 5) ;XXX magic number + ;;terminate gracefully if the server crashed or is unresponsive + (disconnect "Server not responding, disconnected.")) (let ((reply (read servstr nil))) (logf 4 "CLIENT: received reply.") (when (search "ERROR" reply) (if ig-errors (logf 1 reply) (error reply))) reply))) - (defun disconnect () + (defun disconnect (&optional (msg "Disconnected from server.")) "Disconnect from the server" (when naledi-server (usocket:socket-close naledi-server) (setf naledi-server NIL) - (notify "Disconnected from server.")))) + (notify msg)) + ;;terminate if we're running a local game + (when (runningp) (terminate)))) diff --git a/TODO b/TODO index fa6aeb4..6519e4c 100644 --- a/TODO +++ b/TODO @@ -46,10 +46,14 @@ * `terminate` hangs when a player is still logged in * cannot start two local games one after the other -> "ERROR: player exists" + +* crashed games leave sockets blocked to future use * world thread type error: "The value -1 is not of type unsigned-byte when binding sb-impl::n" -> if several players log on? / if one player quits? +* cannot launch from outside game directory (logo file missing) + -> NON-SEVERE * response to prolonged keypresses is sluggish diff --git a/client/networking.lisp b/client/networking.lisp index 10a37d2..7235fff 100644 --- a/client/networking.lisp +++ b/client/networking.lisp @@ -19,14 +19,16 @@ (notify "Connection to server ~A:~A failed." ip port))) (defun current-server () naledi-server) ;XXX remove after development? + + (defun connectedp () (not (null naledi-server))) (defun query-server (&rest request) "Send a request string to the server and return the answer" ;; If one argument is :ignore-errors, error strings are passed up ;; to the caller. Otherwise, they cause a crash. - ;;TODO the client should handle errors gracefully - (unless naledi-server ;XXX do this with exceptions - (error "You are not connected to a server!")) + (unless naledi-server ;XXX do this with exceptions? + (disconnect "No connection to server.") + (return-from query-server)) (let* ((servstr (usocket:socket-stream naledi-server)) (ig-errors (find ':ignore-errors request)) (req (string-from-list @@ -34,17 +36,21 @@ request)))) (logf 4 "CLIENT: sending request ~S" request) (format servstr "~A~%" req) - (finish-output servstr) - (usocket:wait-for-input naledi-server) + (finish-output servstr) ;;FIXME hangs if the server crashes + (unless (usocket:wait-for-input naledi-server :timeout 5) ;XXX magic number + ;;terminate gracefully if the server crashed or is unresponsive + (disconnect "Server not responding, disconnected.")) (let ((reply (read servstr nil))) (logf 4 "CLIENT: received reply.") (when (search "ERROR" reply) (if ig-errors (logf 1 reply) (error reply))) reply))) - (defun disconnect () + (defun disconnect (&optional (msg "Disconnected from server.")) "Disconnect from the server" (when naledi-server (usocket:socket-close naledi-server) (setf naledi-server NIL) - (notify "Disconnected from server.")))) + (notify msg)) + ;;terminate if we're running a local game + (when (runningp) (terminate)))) diff --git a/client/user-interface.lisp b/client/user-interface.lisp index 49d908b..27d605d 100644 --- a/client/user-interface.lisp +++ b/client/user-interface.lisp @@ -158,30 +158,41 @@ :position (list height 0) :width width :height 1)) (update-ui mapwin playerwin placewin newswin) - ;;XXX This function is too long - shift the `event-case' elsewhere? (flet ((ui-update () (de.anvi.ncurses:%flushinp) ;discard excessive key events (update-ui mapwin playerwin placewin newswin))) (croatoan:event-case (scr event) - ;;TODO add other commands - ;;(#\h -> help window - ;;(#\a -> toggle attack mode - ;;(#\c -> command console - ;;(#\p -> pickup item - ;;(#\i -> manage inventory + ;; quit on Q wherever we are (#\q (if (user-confirm-p scr "Really quit?") (progn (disconnect) - ;;terminate if we're running a local game - (when (runningp) (terminate)) (return-from croatoan:event-case)) (ui-update))) - (#\n (set-popup 'NEWS) (ui-update)) - ;;XXX How about moving diagonally? - (:up (query-server "move n") (ui-update)) - (:down (query-server "move s") (ui-update)) - (:left (query-server "move w") (ui-update)) - (:right (query-server "move e") (ui-update)) - ((nil) (ui-update))))))) + ((nil) (ui-update)) ;just update the screen when idle + (otherwise + (interpret-command scr event) + (ui-update))))))) + +(defun interpret-command (scr event) + "Interpret a key command entered by the user" + (handler-case + (case event + ;; ;;XXX How about moving diagonally? + (:up (query-server "move n")) + (:down (query-server "move s")) + (:left (query-server "move w")) + (:right (query-server "move e")) + ;;TODO add other commands + (#\n (set-popup 'NEWS)) + ;;(#\h -> help window + ;;(#\a -> toggle attack mode + ;;(#\c -> command console + ;;(#\p -> pickup item + ;;(#\i -> manage inventory + ) + ;;XXX this silences the error? + ;;XXX actually, does it even do anything? + (error () (disconnect)))) + ;;TODO This is not yet a good solution. First, window objects are ;; constantly created. Secondly, these windows cannot be controlled, @@ -200,11 +211,11 @@ (defun update-ui (mapwin playerwin placewin newswin) "Update all active UI elements" - (unless popup + (draw-news-panel newswin) + (when (and (not popup) (connectedp)) (draw-map mapwin) (draw-descriptive-panel playerwin "describe-player") - (draw-descriptive-panel placewin "describe-patch") - (draw-news-panel newswin))) + (draw-descriptive-panel placewin "describe-patch"))) (defun draw-popup-window () "Draw the current popup window, if appropriate" @@ -250,7 +261,7 @@ (let ((news '("Press h for help.")) (display-time 6) (timer 0)) (defun draw-news-panel (win) "Draw a thin panel at the bottom of the screen to display news items." - (collect-news) + (when (connectedp) (collect-news)) (croatoan:clear win) (croatoan:move win 0 0) (when (< timer display-time) @@ -267,6 +278,7 @@ (setf timer 0)))) (defun notify (msg &rest format-args) + ;;TODO add a display-time argument "Pass a message from the client to the user" (let ((m (apply #'format (append (list NIL msg) format-args)))) (setf news (append (list m) news)) diff --git a/TODO b/TODO index fa6aeb4..6519e4c 100644 --- a/TODO +++ b/TODO @@ -46,10 +46,14 @@ * `terminate` hangs when a player is still logged in * cannot start two local games one after the other -> "ERROR: player exists" + +* crashed games leave sockets blocked to future use * world thread type error: "The value -1 is not of type unsigned-byte when binding sb-impl::n" -> if several players log on? / if one player quits? +* cannot launch from outside game directory (logo file missing) + -> NON-SEVERE * response to prolonged keypresses is sluggish diff --git a/client/networking.lisp b/client/networking.lisp index 10a37d2..7235fff 100644 --- a/client/networking.lisp +++ b/client/networking.lisp @@ -19,14 +19,16 @@ (notify "Connection to server ~A:~A failed." ip port))) (defun current-server () naledi-server) ;XXX remove after development? + + (defun connectedp () (not (null naledi-server))) (defun query-server (&rest request) "Send a request string to the server and return the answer" ;; If one argument is :ignore-errors, error strings are passed up ;; to the caller. Otherwise, they cause a crash. - ;;TODO the client should handle errors gracefully - (unless naledi-server ;XXX do this with exceptions - (error "You are not connected to a server!")) + (unless naledi-server ;XXX do this with exceptions? + (disconnect "No connection to server.") + (return-from query-server)) (let* ((servstr (usocket:socket-stream naledi-server)) (ig-errors (find ':ignore-errors request)) (req (string-from-list @@ -34,17 +36,21 @@ request)))) (logf 4 "CLIENT: sending request ~S" request) (format servstr "~A~%" req) - (finish-output servstr) - (usocket:wait-for-input naledi-server) + (finish-output servstr) ;;FIXME hangs if the server crashes + (unless (usocket:wait-for-input naledi-server :timeout 5) ;XXX magic number + ;;terminate gracefully if the server crashed or is unresponsive + (disconnect "Server not responding, disconnected.")) (let ((reply (read servstr nil))) (logf 4 "CLIENT: received reply.") (when (search "ERROR" reply) (if ig-errors (logf 1 reply) (error reply))) reply))) - (defun disconnect () + (defun disconnect (&optional (msg "Disconnected from server.")) "Disconnect from the server" (when naledi-server (usocket:socket-close naledi-server) (setf naledi-server NIL) - (notify "Disconnected from server.")))) + (notify msg)) + ;;terminate if we're running a local game + (when (runningp) (terminate)))) diff --git a/client/user-interface.lisp b/client/user-interface.lisp index 49d908b..27d605d 100644 --- a/client/user-interface.lisp +++ b/client/user-interface.lisp @@ -158,30 +158,41 @@ :position (list height 0) :width width :height 1)) (update-ui mapwin playerwin placewin newswin) - ;;XXX This function is too long - shift the `event-case' elsewhere? (flet ((ui-update () (de.anvi.ncurses:%flushinp) ;discard excessive key events (update-ui mapwin playerwin placewin newswin))) (croatoan:event-case (scr event) - ;;TODO add other commands - ;;(#\h -> help window - ;;(#\a -> toggle attack mode - ;;(#\c -> command console - ;;(#\p -> pickup item - ;;(#\i -> manage inventory + ;; quit on Q wherever we are (#\q (if (user-confirm-p scr "Really quit?") (progn (disconnect) - ;;terminate if we're running a local game - (when (runningp) (terminate)) (return-from croatoan:event-case)) (ui-update))) - (#\n (set-popup 'NEWS) (ui-update)) - ;;XXX How about moving diagonally? - (:up (query-server "move n") (ui-update)) - (:down (query-server "move s") (ui-update)) - (:left (query-server "move w") (ui-update)) - (:right (query-server "move e") (ui-update)) - ((nil) (ui-update))))))) + ((nil) (ui-update)) ;just update the screen when idle + (otherwise + (interpret-command scr event) + (ui-update))))))) + +(defun interpret-command (scr event) + "Interpret a key command entered by the user" + (handler-case + (case event + ;; ;;XXX How about moving diagonally? + (:up (query-server "move n")) + (:down (query-server "move s")) + (:left (query-server "move w")) + (:right (query-server "move e")) + ;;TODO add other commands + (#\n (set-popup 'NEWS)) + ;;(#\h -> help window + ;;(#\a -> toggle attack mode + ;;(#\c -> command console + ;;(#\p -> pickup item + ;;(#\i -> manage inventory + ) + ;;XXX this silences the error? + ;;XXX actually, does it even do anything? + (error () (disconnect)))) + ;;TODO This is not yet a good solution. First, window objects are ;; constantly created. Secondly, these windows cannot be controlled, @@ -200,11 +211,11 @@ (defun update-ui (mapwin playerwin placewin newswin) "Update all active UI elements" - (unless popup + (draw-news-panel newswin) + (when (and (not popup) (connectedp)) (draw-map mapwin) (draw-descriptive-panel playerwin "describe-player") - (draw-descriptive-panel placewin "describe-patch") - (draw-news-panel newswin))) + (draw-descriptive-panel placewin "describe-patch"))) (defun draw-popup-window () "Draw the current popup window, if appropriate" @@ -250,7 +261,7 @@ (let ((news '("Press h for help.")) (display-time 6) (timer 0)) (defun draw-news-panel (win) "Draw a thin panel at the bottom of the screen to display news items." - (collect-news) + (when (connectedp) (collect-news)) (croatoan:clear win) (croatoan:move win 0 0) (when (< timer display-time) @@ -267,6 +278,7 @@ (setf timer 0)))) (defun notify (msg &rest format-args) + ;;TODO add a display-time argument "Pass a message from the client to the user" (let ((m (apply #'format (append (list NIL msg) format-args)))) (setf news (append (list m) news)) diff --git a/naledi.lisp b/naledi.lisp index 2fe982b..07624f7 100644 --- a/naledi.lisp +++ b/naledi.lisp @@ -11,7 +11,6 @@ (declaim (optimize (debug 3) (speed 1) (space 1) (safety 1))) ;;XXX convenience functions during development, remove later - (defun start () (nya:start-game)) (defun dt (&optional (n 0)) diff --git a/TODO b/TODO index fa6aeb4..6519e4c 100644 --- a/TODO +++ b/TODO @@ -46,10 +46,14 @@ * `terminate` hangs when a player is still logged in * cannot start two local games one after the other -> "ERROR: player exists" + +* crashed games leave sockets blocked to future use * world thread type error: "The value -1 is not of type unsigned-byte when binding sb-impl::n" -> if several players log on? / if one player quits? +* cannot launch from outside game directory (logo file missing) + -> NON-SEVERE * response to prolonged keypresses is sluggish diff --git a/client/networking.lisp b/client/networking.lisp index 10a37d2..7235fff 100644 --- a/client/networking.lisp +++ b/client/networking.lisp @@ -19,14 +19,16 @@ (notify "Connection to server ~A:~A failed." ip port))) (defun current-server () naledi-server) ;XXX remove after development? + + (defun connectedp () (not (null naledi-server))) (defun query-server (&rest request) "Send a request string to the server and return the answer" ;; If one argument is :ignore-errors, error strings are passed up ;; to the caller. Otherwise, they cause a crash. - ;;TODO the client should handle errors gracefully - (unless naledi-server ;XXX do this with exceptions - (error "You are not connected to a server!")) + (unless naledi-server ;XXX do this with exceptions? + (disconnect "No connection to server.") + (return-from query-server)) (let* ((servstr (usocket:socket-stream naledi-server)) (ig-errors (find ':ignore-errors request)) (req (string-from-list @@ -34,17 +36,21 @@ request)))) (logf 4 "CLIENT: sending request ~S" request) (format servstr "~A~%" req) - (finish-output servstr) - (usocket:wait-for-input naledi-server) + (finish-output servstr) ;;FIXME hangs if the server crashes + (unless (usocket:wait-for-input naledi-server :timeout 5) ;XXX magic number + ;;terminate gracefully if the server crashed or is unresponsive + (disconnect "Server not responding, disconnected.")) (let ((reply (read servstr nil))) (logf 4 "CLIENT: received reply.") (when (search "ERROR" reply) (if ig-errors (logf 1 reply) (error reply))) reply))) - (defun disconnect () + (defun disconnect (&optional (msg "Disconnected from server.")) "Disconnect from the server" (when naledi-server (usocket:socket-close naledi-server) (setf naledi-server NIL) - (notify "Disconnected from server.")))) + (notify msg)) + ;;terminate if we're running a local game + (when (runningp) (terminate)))) diff --git a/client/user-interface.lisp b/client/user-interface.lisp index 49d908b..27d605d 100644 --- a/client/user-interface.lisp +++ b/client/user-interface.lisp @@ -158,30 +158,41 @@ :position (list height 0) :width width :height 1)) (update-ui mapwin playerwin placewin newswin) - ;;XXX This function is too long - shift the `event-case' elsewhere? (flet ((ui-update () (de.anvi.ncurses:%flushinp) ;discard excessive key events (update-ui mapwin playerwin placewin newswin))) (croatoan:event-case (scr event) - ;;TODO add other commands - ;;(#\h -> help window - ;;(#\a -> toggle attack mode - ;;(#\c -> command console - ;;(#\p -> pickup item - ;;(#\i -> manage inventory + ;; quit on Q wherever we are (#\q (if (user-confirm-p scr "Really quit?") (progn (disconnect) - ;;terminate if we're running a local game - (when (runningp) (terminate)) (return-from croatoan:event-case)) (ui-update))) - (#\n (set-popup 'NEWS) (ui-update)) - ;;XXX How about moving diagonally? - (:up (query-server "move n") (ui-update)) - (:down (query-server "move s") (ui-update)) - (:left (query-server "move w") (ui-update)) - (:right (query-server "move e") (ui-update)) - ((nil) (ui-update))))))) + ((nil) (ui-update)) ;just update the screen when idle + (otherwise + (interpret-command scr event) + (ui-update))))))) + +(defun interpret-command (scr event) + "Interpret a key command entered by the user" + (handler-case + (case event + ;; ;;XXX How about moving diagonally? + (:up (query-server "move n")) + (:down (query-server "move s")) + (:left (query-server "move w")) + (:right (query-server "move e")) + ;;TODO add other commands + (#\n (set-popup 'NEWS)) + ;;(#\h -> help window + ;;(#\a -> toggle attack mode + ;;(#\c -> command console + ;;(#\p -> pickup item + ;;(#\i -> manage inventory + ) + ;;XXX this silences the error? + ;;XXX actually, does it even do anything? + (error () (disconnect)))) + ;;TODO This is not yet a good solution. First, window objects are ;; constantly created. Secondly, these windows cannot be controlled, @@ -200,11 +211,11 @@ (defun update-ui (mapwin playerwin placewin newswin) "Update all active UI elements" - (unless popup + (draw-news-panel newswin) + (when (and (not popup) (connectedp)) (draw-map mapwin) (draw-descriptive-panel playerwin "describe-player") - (draw-descriptive-panel placewin "describe-patch") - (draw-news-panel newswin))) + (draw-descriptive-panel placewin "describe-patch"))) (defun draw-popup-window () "Draw the current popup window, if appropriate" @@ -250,7 +261,7 @@ (let ((news '("Press h for help.")) (display-time 6) (timer 0)) (defun draw-news-panel (win) "Draw a thin panel at the bottom of the screen to display news items." - (collect-news) + (when (connectedp) (collect-news)) (croatoan:clear win) (croatoan:move win 0 0) (when (< timer display-time) @@ -267,6 +278,7 @@ (setf timer 0)))) (defun notify (msg &rest format-args) + ;;TODO add a display-time argument "Pass a message from the client to the user" (let ((m (apply #'format (append (list NIL msg) format-args)))) (setf news (append (list m) news)) diff --git a/naledi.lisp b/naledi.lisp index 2fe982b..07624f7 100644 --- a/naledi.lisp +++ b/naledi.lisp @@ -11,7 +11,6 @@ (declaim (optimize (debug 3) (speed 1) (space 1) (safety 1))) ;;XXX convenience functions during development, remove later - (defun start () (nya:start-game)) (defun dt (&optional (n 0)) diff --git a/server/server.lisp b/server/server.lisp index 7fbfd81..5f957bc 100644 --- a/server/server.lisp +++ b/server/server.lisp @@ -103,9 +103,12 @@ (dotimes (i (length player-threads)) (let ((pt (nth i player-threads))) (when (equalp (second pt) "terminated") + ;;FIXME throws an error when i==0 (bt:join-thread (first pt)) - (setf (cdr (nth (1- i) player-threads)) - (nth (1+ i) player-threads)))))) + (if (zerop i) + (setf player-threads (cdr player-threads)) + (setf (cdr (nth (1- i) player-threads)) + (nth (1+ i) player-threads))))))) (defun update-loop () "The main loop, updating the world in the background" @@ -125,12 +128,13 @@ ;;Update the world map ;;FIXME ;;Do cleanup work - (when (zerop (rem uptime 20)) (cleanup-player-threads)) + (when (zerop (rem uptime 100)) (cleanup-player-threads)) ;;Save the world and start over (save-world) ;XXX not yet implemented (incf uptime) (sleep (/ *framerate* 1000)) - (when running (update-loop))) ;;CAVE requires Tail-Call Optimization + ;;CAVE requires Tail-Call Optimization (not provided by ABCL, otherwise no problem) + (when running (update-loop))) (defun run-server () "Start a server, listening for connections" @@ -228,7 +232,7 @@ "Return a 3D array (x-coord, y-coord, character/colour) of the visible map" ;;TODO It's too inefficient to compile a new map for every player at every ;; request. Keep a central map? -> XXX Is this indeed the case? - ;;XXX implement of "field of view" for each player? + ;;XXX implement a "field of view" for each player? (let* ((plr (player-human (get-player (thread-player)))) (width (read-from-string swidth)) (height (read-from-string sheight)) @@ -297,7 +301,7 @@ ((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 "s") (move plr 's));; (error "random error")) ;(test error) ((equalp dir "sw") (move plr 'sw)) ((equalp dir "w") (move plr 'w)) ((equalp dir "nw") (move plr 'nw))