X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=mudsync%2Froom.scm;h=aee0636ab4c817c6e9c985d18c6bee1ef2b888e9;hp=56c5a5922751a71bb209e92bef8a8f8e9ff3ee1f;hb=d539213774955a5593ec760f06022aeecf4e1abc;hpb=7525c62ccdf9e3480214831fb14d9a2d30ab139d diff --git a/mudsync/room.scm b/mudsync/room.scm index 56c5a59..aee0636 100644 --- a/mudsync/room.scm +++ b/mudsync/room.scm @@ -79,7 +79,10 @@ (wire-exits! (wrap-apply room-wire-exits!)) (cmd-go (wrap-apply room-cmd-go)) (cmd-go-where (wrap-apply room-cmd-go-where)) - (cmd-look-room (wrap-apply room-cmd-look-room)))) + (look-room (wrap-apply room-look-room)) + ;; in this case the command is the same version as the normal + ;; look-room version + (cmd-look-room (wrap-apply room-look-room)))) (define room-actions* (append room-actions gameobj-actions)) @@ -128,9 +131,12 @@ claim to point to." (room-exits room))) (cond (exit + ;; Set the player's new location (<-wait room (message-from message) 'set-loc! #:loc (slot-ref exit 'to-address)) - (<- room (message-from message) 'look-room)) + ;; Have the new room update the player to the new location + (<- room (slot-ref exit 'to-address) 'look-room + #:to-id (message-from message))) (else (<- room (message-from message) 'tell #:text "You don't see any way to go there.\n")))) @@ -139,5 +145,22 @@ claim to point to." (<- room (message-from message) 'tell #:text "Go where?\n")) -(define-mhandler (room-cmd-look-room room message) - (<- room (message-from message) 'look-room)) +;;; look commands + +(define (room-player-looks-around room player-id) + "Handle looking around the room" + (define room-text + (format #f "**~a**\n~a\n" + (slot-ref room 'name) + (slot-ref room 'desc))) + (<- room player-id 'tell + #:text room-text)) + +(define-mhandler (room-look-room room message) + "Command: Player asks to look around the room" + (room-player-looks-around + room + ;; Either send it to the #:to-id of the message, or to the + ;; sender of the message + (message-ref message 'to-id + (message-from message))))