;;; 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>)
+(define-class <readable> (<gameobj>)
(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>)
+(define-class <summoning-bell> (<gameobj>)
(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))))
#:desc "It looks like you could sign this form and set your name.")
('thing:lobby:porcelain-doll
- <thing> 'room:lobby
+ <gameobj> 'room:lobby
#:generally-visible #f
#:name "a creepy porcelain doll"
#:desc "It strikes you that while the doll is technically well crafted,
it's also the stuff of nightmares."
#:goes-by '("porcelain doll" "doll"))
('thing:lobby:1950s-robots
- <thing> 'room:lobby
+ <gameobj> 'room:lobby
#:generally-visible #f
#:name "a set of 1950s robots"
#:desc "There's a whole set of these 1950s style robots.
and buttons and springs. Some of them have wind-up knobs on them."
#:goes-by '("robot" "robots" "1950s robot" "1950s robots"))
('thing:lobby:tea-set
- <thing> 'room:lobby
+ <gameobj> 'room:lobby
#:generally-visible #f
#:name "a tea set"
#:desc "A complete tea set. Some of the cups are chipped.
nice table with some doilies, drinking some Earl Grey tea, hot. Mmmm."
#:goes-by '("tea set" "tea"))
('thing:lobby:mustard-pot
- <thing> 'room:lobby
+ <gameobj> 'room:lobby
#:generally-visible #f
#:name "a mustard pot"
#:desc '((p "It's a mustard pot. I mean, it's kind of cool, it has a
(p "Ha... imagine that... a mustard museum."))
#:goes-by '("mustard pot" "antique mustard pot" "mustard"))
('thing:lobby:head-of-elvis
- <thing> 'room:lobby
+ <gameobj> 'room:lobby
#:generally-visible #f
#:name "the pickled head of Elvis"
#:desc '((p "It's a jar full of some briny-looking liquid and...
#:goes-by '("pickled head of elvis" "pickled head of Elvis"
"elvis" "Elvis" "head" "pickled head"))
('thing:lobby:circuitboard-of-evlis
- <thing> 'room:lobby
+ <gameobj> 'room:lobby
#:generally-visible #f
#:name "the pickled circuitboard of Evlis"
- #:desc '((p "It's a circuitboard from a Lisp Machine called Evlis.
+ #:desc '((p "It's a circuitboard from a Lisp Machine called EVLIS.
This is quite the find, and you bet just about anyone interested in
preserving computer history would love to get their hands on this.")
(p "Unfortunately, whatever moron did acquire this has
"pickled circuitboard of EVLIS"
"evlis" "Evlis" "EVLIS" "circuitboard" "pickled circuitboard"))
('thing:lobby:teletype-scroll
- <thing> 'room:lobby
+ <gameobj> 'room:lobby
#:generally-visible #f
#:name "a scroll of teletype"
#:desc '((p "This is a scroll of teletype paper. It's a bit old
"scroll of teletype paper holding the software Four Freedoms"
"scroll of teletype paper holding the software four freedoms"))
('thing:lobby:orange-cat-phone
- <thing> 'room:lobby
+ <gameobj> 'room:lobby
#:generally-visible #f
#:name "a telephone shaped like an orange cartoon cat"
#:desc "It's made out of a cheap plastic, and it's very orange.
#:name "east"
#:to 'room:grand-hallway)))
('thing:playroom:cubey
- <thing> 'room:playroom
+ <gameobj> 'room:playroom
#:name "cubey"
#:takeable #t
#:desc " It's a little foam cube with googly eyes on it. So cute!")
('thing:cuddles-plushie
- <thing> 'room:playroom
+ <gameobj> 'room:playroom
#:name "a cuddles plushie"
#:goes-by '("plushie" "cuddles plushie" "cuddles")
#:takeable #t
(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))))
#:catchphrases prefect-quotes)
('thing:smoking-parlor:no-smoking-sign
- <thing> 'room:smoking-parlor
+ <gameobj> 'room:smoking-parlor
#:generally-visible #f
#:name "No Smoking Sign"
#:desc "This sign says \"No Smoking\" in big, red letters.
;;; 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>)
+(define-class <desk-clerk> (<gameobj>)
;; The desk clerk has three states:
;; - on-duty: Arrived, and waiting for instructions (and losing patience
;; gradually)
;; - 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
<desk-clerk> 'room:break-room
#:name "the hotel desk clerk"
#:desc " The hotel clerk is wearing a neatly pressed uniform bearing the
-hotel insignia. She looks like she'd much rather be somewhere else."
+hotel insignia. She appears to be rather exhausted."
#:goes-by '("hotel desk clerk" "clerk" "desk clerk"))
('thing:break-room:void
- <thing> 'room:break-room
+ <gameobj> 'room:break-room
#:generally-visible #f
#:name "The Void"
#:desc "As you stare into the void, the void stares back into you."
- #:goes-by '("void" "abyss" "nothingness"))))
+ #:goes-by '("void" "abyss" "nothingness" "scenery"))
+ ('thing:break-room:fence
+ <gameobj> 'room:break-room
+ #:generally-visible #f
+ #:name "break room cage"
+ #:desc "It's a mostly-cubical wire mesh surrounding the break area.
+You can see through the gaps, but they're too small to put more than a
+couple of fingers through. There appears to be some wear and tear to
+the paint, but the wires themselves seem to be unusually sturdy."
+ #:goes-by '("fence" "cage" "wire cage"))))
\f
projects / mudsync.git / blobdiff