(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)))
+(define room-actions
+ (build-actions
+ ;; desc == description
+ (wire-exits! (wrap-apply room-wire-exits!))
+ (cmd-go (wrap-apply room-cmd-go))
+ (cmd-go-where (wrap-apply room-cmd-go-where))
+ (cmd-look-room (wrap-apply room-cmd-look-room))))
+
+(define room-actions*
+ (append room-actions gameobj-actions))
+
+(define room-action-dispatch
+ (simple-dispatcher room-actions*))
+
;; TODO: Subclass from container?
(define-class <room> (<gameobj>)
;; A list of <exit>
#:getter room-exits)
(container-commands
- #:init-value %room-contain-commands)
+ #:init-value (wrap %room-contain-commands))
(message-handler
#:allocation #:each-subclass
#:init-value (wrap-apply room-action-dispatch)))
-(define room-actions
- (build-actions
- ;; desc == description
- (wire-exits! (wrap-apply room-wire-exits!))
- (cmd-go (wrap-apply room-cmd-go))
- (cmd-look-room (wrap-apply room-cmd-look-room))))
-
-(define room-actions*
- (append room-actions gameobj-actions))
-
-(define room-action-dispatch
- (simple-dispatcher room-actions*))
-
-
(define (room-wire-exits! room message)
"Actually hook up the rooms' exit addresses to the rooms they
claim to point to."
(<- room (message-from message) 'tell
#:text "I don't know where that is?\n"))))
+(define-mhandler (room-cmd-go-where room message)
+ (<- room (message-from message) 'tell
+ #:text "Go where?\n"))
+
(define-mhandler (room-cmd-look-room room message)
(<- room (message-from message) 'look-room))