X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=mudsync%2Froom.scm;h=594d913b0e0a50991641d93ea854f9371cb42e44;hp=6baea54ce99daef1d83e8b0440de2fb0ef8a4f5e;hb=85963b83c04295db994a5cbd531de9d234f61131;hpb=29f902827724fd50b512c60916a16850367f6046 diff --git a/mudsync/room.scm b/mudsync/room.scm index 6baea54..594d913 100644 --- a/mudsync/room.scm +++ b/mudsync/room.scm @@ -81,6 +81,7 @@ (wire-exits! (wrap-apply room-wire-exits!)) (cmd-go (wrap-apply room-cmd-go)) (cmd-go-where (wrap-apply room-cmd-go-where)) + (announce-entrance (wrap-apply room-announce-entrance)) (look-room (wrap-apply room-look-room)) (tell-room (wrap-apply room-act-tell-room)) ;; in this case the command is the same version as the normal @@ -134,11 +135,22 @@ claim to point to." (lambda (exit) (equal? (exit-name exit) direct-obj)) (room-exits room))) + (define to-address (slot-ref exit 'to-address)) + (define player-name + (message-ref (<-wait room (message-from message) + 'get-name) 'val)) (cond (exit ;; Set the player's new location (<-wait room (message-from message) 'set-loc! - #:loc (slot-ref exit 'to-address)) + #:loc to-address) + ;; Tell everyone else the person walked away + (room-tell-room + room + (format #f "~a wanders ~a.\n" + player-name direct-obj)) + (<- room to-address 'announce-entrance + #:who-entered (message-from message)) ;; Have the new room update the player to the new location (<- room (slot-ref exit 'to-address) 'look-room #:to-id (message-from message))) @@ -288,3 +300,12 @@ claim to point to." (define message-to-send (format #f "~a says: ~a\n" player-name phrase)) (room-tell-room room message-to-send)) + +(define-mhandler (room-announce-entrance room message who-entered) + (define player-name + (message-ref (<-wait room who-entered 'get-name) + 'val)) + (define message-to-send + (format #f "~a enters the room.\n" player-name)) + (room-tell-room room message-to-send + #:exclude who-entered))