;;; Some simple object types.
;;; =========================
-(define readable-commands
- (list
- (direct-command "read" 'cmd-read)))
-
-(define readable-commands*
- (append readable-commands
- thing-commands))
-
(define-class <readable> (<thing>)
(read-text #:init-value "All it says is: \"Blah blah blah.\""
#:init-keyword #:read-text)
(commands
- #:init-value readable-commands*)
+ #:allocation #:each-subclass
+ #:init-thunk (build-commands
+ ("read" ((direct-command cmd-read)))))
(actions #:allocation #:each-subclass
#:init-thunk (build-actions
(cmd-read readable-cmd-read))))
(<- (message-from message) 'tell
#:text text-to-send))
-(define chat-commands
- (list
- (direct-command "chat" 'cmd-chat)
- (direct-command "talk" 'cmd-chat)))
-
(define hotel-owner-grumps
'("Eight sinks! Eight sinks! And I couldn't unwind them..."
"Don't mind the mess. I built this place on a dare, you
(catchphrases #:init-value '("Blarga blarga blarga!")
#:init-keyword #:catchphrases)
(commands
- #:init-value chat-commands)
+ #:allocation #:each-subclass
+ #:init-thunk (build-commands
+ (("chat" "talk") ((direct-command cmd-chat)))))
(actions #:allocation #:each-subclass
#:init-thunk
(build-actions
(define-class <sign-in-form> (<gameobj>)
(commands
- #:init-value
- (list
- (prep-direct-command "sign" 'cmd-sign-form
- '("as"))))
+ #:allocation #:each-subclass
+ #:init-thunk (build-commands
+ ("sign" ((prep-direct-command cmd-sign-form '("as"))))))
(actions #:allocation #:each-subclass
#:init-thunk (build-actions
(cmd-sign-form sign-cmd-sign-in))))
character.\n")))
-(define summoning-bell-commands
- (list
- (direct-command "ring" 'cmd-ring)))
-(define summoning-bell-commands*
- (append summoning-bell-commands
- thing-commands*))
-
(define-class <summoning-bell> (<thing>)
(summons #:init-keyword #:summons)
(commands
- #:init-value summoning-bell-commands*)
+ #:allocation #:each-subclass
+ #:init-thunk (build-commands
+ ("ring" ((direct-command cmd-ring)))))
(actions #:allocation #:each-subclass
#:init-thunk (build-actions
(cmd-ring summoning-bell-cmd-ring))))
(sit-name #:init-keyword #:sit-name)
(commands
- #:init-value
- (list
- (direct-command "sit" 'cmd-sit-furniture)))
+ #:allocation #:each-subclass
+ #:init-thunk (build-commands
+ ("sit" ((direct-command cmd-sit-furniture)))))
(actions #:allocation #:each-subclass
#:init-thunk (build-actions
(cmd-sit-furniture furniture-cmd-sit))))
;;; Breakroom
;;; ---------
-(define clerk-commands
- (list
- (direct-command "talk" 'cmd-chat)
- (direct-command "chat" 'cmd-chat)
- (direct-command "ask" 'cmd-ask-incomplete)
- (prep-direct-command "ask" 'cmd-ask-about)
- (direct-command "dismiss" 'cmd-dismiss)))
-(define clerk-commands*
- (append clerk-commands thing-commands*))
-
(define-class <desk-clerk> (<thing>)
;; The desk clerk has three states:
;; - on-duty: Arrived, and waiting for instructions (and losing patience
;; - slacking: In the break room, probably smoking a cigarette
;; or checking text messages
(state #:init-value 'slacking)
- (commands #:init-value clerk-commands*)
+ (commands #:allocation #:each-subclass
+ #:init-thunk
+ (build-commands
+ (("talk" "chat") ((direct-command cmd-chat)))
+ ("ask" ((direct-command cmd-ask-incomplete)
+ (prep-direct-command cmd-ask-about)))
+ ("dismiss" ((direct-command cmd-dismiss)))))
(patience #:init-value 0)
(actions #:allocation #:each-subclass
#:init-thunk (build-actions