;;; Rooms
;;; =====
-(define %room-contain-commands
- (list
- (loose-direct-command "look" 'cmd-look-at)
- (empty-command "look" 'cmd-look-room)
- (empty-command "go" 'cmd-go-where)
- (loose-direct-command "go" 'cmd-go)
- (greedy-command "say" 'cmd-say)
- (greedy-command "\"" 'cmd-say)
- (greedy-command "'" 'cmd-say)
- (greedy-command "emote" 'cmd-emote)
- (greedy-command "/me" 'cmd-emote)))
-
;; TODO: Subclass from container?
(define-class <room> (<gameobj>)
;; A list of <exit>
#:getter room-exits)
(container-commands
- #:init-value (wrap %room-contain-commands))
+ #:allocation #:each-subclass
+ #:init-thunk
+ (build-commands
+ ("look" ((loose-direct-command cmd-look-at)
+ (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)))))
(actions #:allocation #:each-subclass
- #:init-value
+ #:init-thunk
(build-actions
(cmd-go room-cmd-go)
(cmd-go-where room-cmd-go-where)
(mbody-val (<-wait matching-object 'get-desc
#:whos-looking (message-from message)))))
(if obj-desc
- (<- (message-from message) 'tell
- #:text (string-append obj-desc "\n"))
- (<- (message-from message) 'tell
- #:text (string-append %formless-desc "\n")))))
+ (<- (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"))))