#:allocation #:each-subclass
#:init-thunk
(build-commands
- ("look" ((loose-direct-command cmd-look-at)
- (empty-command cmd-look-room)))
+ (("l" "look") ((empty-command cmd-look-room)))
("go" ((empty-command cmd-go-where)
(loose-direct-command cmd-go)))
(("say" "\"" "'") ((greedy-command cmd-say)))
(("emote" "/me") ((greedy-command cmd-emote)))))
+ (container-sub-commands
+ #:allocation #:each-subclass
+ #:init-thunk
+ (build-commands
+ (("l" "look") ((loose-direct-command cmd-look-at-from-room)))))
+
(actions #:allocation #:each-subclass
#:init-thunk
(build-actions
;; in this case the command is the same version as the normal
;; look-room version
(cmd-look-room room-look-room)
- (cmd-look-at room-look-at)
+ (cmd-look-at-from-room room-look-dont-see-it)
(cmd-say room-cmd-say)
(cmd-emote room-cmd-emote))))
(slot-ref room 'occupants)))
#f)))
-(define %formless-desc
- "You don't see anything special.")
-
-(define* (room-look-at room message #:key direct-obj)
- "Look at a specific object in the room."
- (define matching-object
- (room-find-thing-called room direct-obj))
-
- (cond
- (matching-object
- (let ((obj-desc
- (mbody-val (<-wait matching-object 'get-desc
- #:whos-looking (message-from message)))))
- (if obj-desc
- (<- (message-from message) 'tell #:text obj-desc)
- (<- (message-from message) 'tell #:text %formless-desc))))
- (else
- (<- (message-from message) 'tell
- #:text "You don't see that here, so you can't look at it.\n"))))
+(define* (room-look-dont-see-it room message #:key direct-obj)
+ "In general, if we get to this point, we didn't find something to look at."
+ (<- (message-from message) 'tell
+ #:text "You don't see that here, so you can't look at it.\n"))
(define* (room-tell-room room text #:key exclude wait)