- ;; Set the player's new location
- (<-wait (message-from message) 'set-loc!
- #:loc to-address)
- ;; Tell everyone else the person walked away
- (room-tell-room
- room
- (format #f "~a wanders ~a.\n"
- player-name direct-obj))
- (<- to-address 'announce-entrance
- #:who-entered (message-from message))
- ;; Have the new room update the player to the new location
- (<- to-address 'look-room
- #:to-id (message-from message)))
+ (call-with-values (lambda ()
+ (exit-can-traverse? exit room player))
+ (lambda* (can-traverse? #:optional player-flavortext
+ room-flavortext)
+ (if can-traverse?
+ ;; looks like we can go, so let's go!
+ (begin
+ ;; Set the player's new location
+ (<-wait player 'set-loc!
+ #:loc to-address)
+ (when player-flavortext
+ (<-wait player 'tell
+ #:text player-flavortext))
+ ;; Tell everyone else the person walked away
+ (room-tell-room
+ room (or room-flavortext
+ (format #f "~a wanders ~a.\n"
+ player-name direct-obj)))
+ (<- to-address 'announce-entrance
+ #:who-entered player)
+ ;; Have the new room update the player to the new location
+ (<- to-address 'look-room
+ #:to-id player))
+ ;; Otherwise, if we can't go...
+ (begin
+ (<- player 'tell
+ #:text (or player-flavortext
+ `("You try to go " ,direct-obj " but something "
+ "seems to block you.")))
+ (when room-flavortext
+ (room-tell-room room room-flavortext
+ #:exclude player)))))))