;;; 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)