diff --git a/item-classes.lisp b/item-classes.lisp index 378d13b..c781194 100644 --- a/item-classes.lisp +++ b/item-classes.lisp @@ -63,6 +63,7 @@ (last-move :accessor .last-move :initform 0)) (:default-initargs :destroy-with '(weapon) :movable T)) +;;TODO (defclass player (feature) ;; Create a new class for each item type (defmacro new-item (superclass name &body body) diff --git a/item-classes.lisp b/item-classes.lisp index 378d13b..c781194 100644 --- a/item-classes.lisp +++ b/item-classes.lisp @@ -63,6 +63,7 @@ (last-move :accessor .last-move :initform 0)) (:default-initargs :destroy-with '(weapon) :movable T)) +;;TODO (defclass player (feature) ;; Create a new class for each item type (defmacro new-item (superclass name &body body) diff --git a/item-methods.lisp b/item-methods.lisp index f21cddd..51e060c 100644 --- a/item-methods.lisp +++ b/item-methods.lisp @@ -37,14 +37,14 @@ (patchindir (.x a) (.y a) dir)) (ttl 10 (1- ttl))) ((zerop ttl) - (logging "The ~A at ~S/~S didn't move." (.name a) (.x a) (.y a)) + ;(logging "The ~A at ~S/~S didn't move." (.name a) (.x a) (.y a)) NIL) (when (and next-patch (null (patch-occupant next-patch)) (member (read-from-string (biome-name (patch-biome next-patch))) (.habitat a))) - (logging "The ~A at ~S/~S is moving ~S." - (.name a) (.x a) (.y a) dir) + ;; (logging "The ~A at ~S/~S is moving ~S." + ;; (.name a) (.x a) (.y a) dir) (setf (patch-occupant (coord (.x a) (.y a))) NIL) (setf (.x a) (first (patch-pos next-patch)) (.y a) (second (patch-pos next-patch))) diff --git a/item-classes.lisp b/item-classes.lisp index 378d13b..c781194 100644 --- a/item-classes.lisp +++ b/item-classes.lisp @@ -63,6 +63,7 @@ (last-move :accessor .last-move :initform 0)) (:default-initargs :destroy-with '(weapon) :movable T)) +;;TODO (defclass player (feature) ;; Create a new class for each item type (defmacro new-item (superclass name &body body) diff --git a/item-methods.lisp b/item-methods.lisp index f21cddd..51e060c 100644 --- a/item-methods.lisp +++ b/item-methods.lisp @@ -37,14 +37,14 @@ (patchindir (.x a) (.y a) dir)) (ttl 10 (1- ttl))) ((zerop ttl) - (logging "The ~A at ~S/~S didn't move." (.name a) (.x a) (.y a)) + ;(logging "The ~A at ~S/~S didn't move." (.name a) (.x a) (.y a)) NIL) (when (and next-patch (null (patch-occupant next-patch)) (member (read-from-string (biome-name (patch-biome next-patch))) (.habitat a))) - (logging "The ~A at ~S/~S is moving ~S." - (.name a) (.x a) (.y a) dir) + ;; (logging "The ~A at ~S/~S is moving ~S." + ;; (.name a) (.x a) (.y a) dir) (setf (patch-occupant (coord (.x a) (.y a))) NIL) (setf (.x a) (first (patch-pos next-patch)) (.y a) (second (patch-pos next-patch))) diff --git a/naledi.lisp b/naledi.lisp index ee950eb..bcb055c 100644 --- a/naledi.lisp +++ b/naledi.lisp @@ -77,7 +77,7 @@ (update-ui mapwin playerwin placewin newswin me) ;;TODO (event-case (scr event) - (#\q (terminate) (return-from event-case)) + (#\q (disconnect) (terminate) (return-from event-case)) ;XXX (#\n (draw-menu (message-window))) (:up (decf (second me)) (update-ui mapwin playerwin placewin newswin me)) @@ -140,9 +140,7 @@ (defun draw-place-panel (win me) "Draw a panel with information about the player's current location." - (let* ((p (coord (first me) (second me))) - (descr (when p (break-lines (describe-patch p) - (- (.width win) 2))))) + (let ((descr (break-lines (describe-patch me) (- (.width win) 2)))) (clear win) (box win) (move win 1 1) diff --git a/item-classes.lisp b/item-classes.lisp index 378d13b..c781194 100644 --- a/item-classes.lisp +++ b/item-classes.lisp @@ -63,6 +63,7 @@ (last-move :accessor .last-move :initform 0)) (:default-initargs :destroy-with '(weapon) :movable T)) +;;TODO (defclass player (feature) ;; Create a new class for each item type (defmacro new-item (superclass name &body body) diff --git a/item-methods.lisp b/item-methods.lisp index f21cddd..51e060c 100644 --- a/item-methods.lisp +++ b/item-methods.lisp @@ -37,14 +37,14 @@ (patchindir (.x a) (.y a) dir)) (ttl 10 (1- ttl))) ((zerop ttl) - (logging "The ~A at ~S/~S didn't move." (.name a) (.x a) (.y a)) + ;(logging "The ~A at ~S/~S didn't move." (.name a) (.x a) (.y a)) NIL) (when (and next-patch (null (patch-occupant next-patch)) (member (read-from-string (biome-name (patch-biome next-patch))) (.habitat a))) - (logging "The ~A at ~S/~S is moving ~S." - (.name a) (.x a) (.y a) dir) + ;; (logging "The ~A at ~S/~S is moving ~S." + ;; (.name a) (.x a) (.y a) dir) (setf (patch-occupant (coord (.x a) (.y a))) NIL) (setf (.x a) (first (patch-pos next-patch)) (.y a) (second (patch-pos next-patch))) diff --git a/naledi.lisp b/naledi.lisp index ee950eb..bcb055c 100644 --- a/naledi.lisp +++ b/naledi.lisp @@ -77,7 +77,7 @@ (update-ui mapwin playerwin placewin newswin me) ;;TODO (event-case (scr event) - (#\q (terminate) (return-from event-case)) + (#\q (disconnect) (terminate) (return-from event-case)) ;XXX (#\n (draw-menu (message-window))) (:up (decf (second me)) (update-ui mapwin playerwin placewin newswin me)) @@ -140,9 +140,7 @@ (defun draw-place-panel (win me) "Draw a panel with information about the player's current location." - (let* ((p (coord (first me) (second me))) - (descr (when p (break-lines (describe-patch p) - (- (.width win) 2))))) + (let ((descr (break-lines (describe-patch me) (- (.width win) 2)))) (clear win) (box win) (move win 1 1) diff --git a/server.lisp b/server.lisp index 11e2e3a..917cc2f 100644 --- a/server.lisp +++ b/server.lisp @@ -41,7 +41,7 @@ (unless (or (< x 0) (< y 0) (> x (length world)) (> y (length world))) (nth x (nth y world))))) -;;; WORLD THREAD +;;; WORLD THREADS (let ((uptime 0) (world-thread NIL) (server-thread NIL) (player-threads NIL) (running NIL)) @@ -64,11 +64,17 @@ (bt:destroy-thread server-thread) (bt:join-thread world-thread) (dolist (pt player-threads) - (bt:join-thread pt))) + (bt:join-thread pt)) + (save-world)) ;XXX not yet implemented (defun age-of-the-world () uptime) - (Defun reset-world-age () (setf uptime 0)) + (defun reset-world-age () (setf uptime 0)) + + (defun runningp () running) + + (defun reset-server-threads () + (set-list NIL server-thread world-thread player-threads)) (defun update-loop () "The main loop, updating the world in the background" @@ -100,12 +106,75 @@ (socket-accept socket)))) (setf player-threads (cons thread player-threads)))))) - (defun handle-connection (socket) + (defun handle-connection (socket) + "Answer requests until the player disconnects" (with-connected-socket (connection (socket-accept socket)) + (logging "~&SERVER: received a connection.") ; cf. `get-peer-name' (do* ((sockstr (socket-stream connection)) (request (read-line sockstr (eof-error-p NIL)) (read-line sockstr (eof-error-p NIL)))) ((or (not running) (null request)) (force-output sockstr)) (format (socket-stream connection) "~S" (answer request)))))) -;;TODO (defun answer (request) ) +(defun answer (request) + (debugging "Received request ~S" request) + (let* ((reqelts (extract-elements request)) + (player-name (first reqelts)) + (cmd (second reqelts)) + (args (cddr reqelts))) + (cond ((eq player-name 'ACK) "ACK ACK") ;debug + ((eq cmd 'get-map) (to-string (get-map player-name))) + ((eq cmd 'describe-patch) (to-string (describe-patch args))) + ;;TODO + ))) + +;;; COMMUNICATION FUNCTIONS + +(defun get-map (player-name) + "Return a 2d list of map places (each a list of a char and a colour)" + ;;TODO + ) + +(defun describe-patch (coords) + "Return a list of lines describing the patch at these coordinates." + (let ((p (coord (first coords) (second coords)))) + (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." + (leading-vowel (.name (patch-occupant p))))) + (when (patch-items p) + (format NIL "The following items are here:~A *~A" #\newline + (string-from-list (mapcar #'.name (patch-items p))) + (format NIL "~% *")))))) + + +;;; CLIENT FUNCTIONS + +(let ((naledi-server NIL)) + (defun connect-server (&optional (ip "127.0.0.1") (port *port*)) + "Connect to the specified server" + ;;FIXME I need to catch some exceptions here... + (setf naledi-server (socket-connect ip port)) + (if naledi-server + (notify "Connected to server ~A:~A" ip port) + (notify "Connection to server ~A:~A failed." ip port))) + + (defun current-server () naledi-server) ;TODO remove after development + + (defun query-server (request) + "Send a request string to the server and return the answer" + (unless naledi-server ;XXX do this with exceptions + (return-from query-server "You are not connected to a server!")) + (let ((servstr (socket-stream naledi-server))) + (format servstr request) + (wait-for-input naledi-server) + (read-from-string (read-line servstr)))) + + (defun disconnect () + "Disconnect from the server" + (when naledi-server + (socket-close naledi-server) + (setf naledi-server NIL) + (notify "Disconnected from server.")))) diff --git a/item-classes.lisp b/item-classes.lisp index 378d13b..c781194 100644 --- a/item-classes.lisp +++ b/item-classes.lisp @@ -63,6 +63,7 @@ (last-move :accessor .last-move :initform 0)) (:default-initargs :destroy-with '(weapon) :movable T)) +;;TODO (defclass player (feature) ;; Create a new class for each item type (defmacro new-item (superclass name &body body) diff --git a/item-methods.lisp b/item-methods.lisp index f21cddd..51e060c 100644 --- a/item-methods.lisp +++ b/item-methods.lisp @@ -37,14 +37,14 @@ (patchindir (.x a) (.y a) dir)) (ttl 10 (1- ttl))) ((zerop ttl) - (logging "The ~A at ~S/~S didn't move." (.name a) (.x a) (.y a)) + ;(logging "The ~A at ~S/~S didn't move." (.name a) (.x a) (.y a)) NIL) (when (and next-patch (null (patch-occupant next-patch)) (member (read-from-string (biome-name (patch-biome next-patch))) (.habitat a))) - (logging "The ~A at ~S/~S is moving ~S." - (.name a) (.x a) (.y a) dir) + ;; (logging "The ~A at ~S/~S is moving ~S." + ;; (.name a) (.x a) (.y a) dir) (setf (patch-occupant (coord (.x a) (.y a))) NIL) (setf (.x a) (first (patch-pos next-patch)) (.y a) (second (patch-pos next-patch))) diff --git a/naledi.lisp b/naledi.lisp index ee950eb..bcb055c 100644 --- a/naledi.lisp +++ b/naledi.lisp @@ -77,7 +77,7 @@ (update-ui mapwin playerwin placewin newswin me) ;;TODO (event-case (scr event) - (#\q (terminate) (return-from event-case)) + (#\q (disconnect) (terminate) (return-from event-case)) ;XXX (#\n (draw-menu (message-window))) (:up (decf (second me)) (update-ui mapwin playerwin placewin newswin me)) @@ -140,9 +140,7 @@ (defun draw-place-panel (win me) "Draw a panel with information about the player's current location." - (let* ((p (coord (first me) (second me))) - (descr (when p (break-lines (describe-patch p) - (- (.width win) 2))))) + (let ((descr (break-lines (describe-patch me) (- (.width win) 2)))) (clear win) (box win) (move win 1 1) diff --git a/server.lisp b/server.lisp index 11e2e3a..917cc2f 100644 --- a/server.lisp +++ b/server.lisp @@ -41,7 +41,7 @@ (unless (or (< x 0) (< y 0) (> x (length world)) (> y (length world))) (nth x (nth y world))))) -;;; WORLD THREAD +;;; WORLD THREADS (let ((uptime 0) (world-thread NIL) (server-thread NIL) (player-threads NIL) (running NIL)) @@ -64,11 +64,17 @@ (bt:destroy-thread server-thread) (bt:join-thread world-thread) (dolist (pt player-threads) - (bt:join-thread pt))) + (bt:join-thread pt)) + (save-world)) ;XXX not yet implemented (defun age-of-the-world () uptime) - (Defun reset-world-age () (setf uptime 0)) + (defun reset-world-age () (setf uptime 0)) + + (defun runningp () running) + + (defun reset-server-threads () + (set-list NIL server-thread world-thread player-threads)) (defun update-loop () "The main loop, updating the world in the background" @@ -100,12 +106,75 @@ (socket-accept socket)))) (setf player-threads (cons thread player-threads)))))) - (defun handle-connection (socket) + (defun handle-connection (socket) + "Answer requests until the player disconnects" (with-connected-socket (connection (socket-accept socket)) + (logging "~&SERVER: received a connection.") ; cf. `get-peer-name' (do* ((sockstr (socket-stream connection)) (request (read-line sockstr (eof-error-p NIL)) (read-line sockstr (eof-error-p NIL)))) ((or (not running) (null request)) (force-output sockstr)) (format (socket-stream connection) "~S" (answer request)))))) -;;TODO (defun answer (request) ) +(defun answer (request) + (debugging "Received request ~S" request) + (let* ((reqelts (extract-elements request)) + (player-name (first reqelts)) + (cmd (second reqelts)) + (args (cddr reqelts))) + (cond ((eq player-name 'ACK) "ACK ACK") ;debug + ((eq cmd 'get-map) (to-string (get-map player-name))) + ((eq cmd 'describe-patch) (to-string (describe-patch args))) + ;;TODO + ))) + +;;; COMMUNICATION FUNCTIONS + +(defun get-map (player-name) + "Return a 2d list of map places (each a list of a char and a colour)" + ;;TODO + ) + +(defun describe-patch (coords) + "Return a list of lines describing the patch at these coordinates." + (let ((p (coord (first coords) (second coords)))) + (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." + (leading-vowel (.name (patch-occupant p))))) + (when (patch-items p) + (format NIL "The following items are here:~A *~A" #\newline + (string-from-list (mapcar #'.name (patch-items p))) + (format NIL "~% *")))))) + + +;;; CLIENT FUNCTIONS + +(let ((naledi-server NIL)) + (defun connect-server (&optional (ip "127.0.0.1") (port *port*)) + "Connect to the specified server" + ;;FIXME I need to catch some exceptions here... + (setf naledi-server (socket-connect ip port)) + (if naledi-server + (notify "Connected to server ~A:~A" ip port) + (notify "Connection to server ~A:~A failed." ip port))) + + (defun current-server () naledi-server) ;TODO remove after development + + (defun query-server (request) + "Send a request string to the server and return the answer" + (unless naledi-server ;XXX do this with exceptions + (return-from query-server "You are not connected to a server!")) + (let ((servstr (socket-stream naledi-server))) + (format servstr request) + (wait-for-input naledi-server) + (read-from-string (read-line servstr)))) + + (defun disconnect () + "Disconnect from the server" + (when naledi-server + (socket-close naledi-server) + (setf naledi-server NIL) + (notify "Disconnected from server.")))) diff --git a/world.lisp b/world.lisp index 6f137b1..ddd1f32 100644 --- a/world.lisp +++ b/world.lisp @@ -185,17 +185,3 @@ (logging (time-stamp)) (setf *random-state* (make-random-state t)) (create-world *world-size*)) - -(defun describe-patch (p) - "Return a list of lines describing this patch." - (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) - (format NIL "There is ~A here." - (leading-vowel (.name (patch-occupant p))))) - (when (patch-items p) - ;;FIXME we will be dealing with instances here, not names... - (format NIL "The following items are here:~A *~A" #\newline - (string-from-list (mapcar #'.name (patch-items p)) - (format NIL "~% *"))))))