;;; 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-value (build-actions
+ #:init-thunk (build-actions
(cmd-read readable-cmd-read))))
(define (readable-cmd-read actor message)
(<- (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-value
+ #:init-thunk
(build-actions
(cmd-chat npc-chat-randomly))))
-(define random-bricabrac
- '("a creepy porcelain doll"
- "assorted 1950s robots"
- "an exquisite tea set"
- "an antique mustard pot"
- "the pickled head of Elvis"
- "the pickled circuitboard of EVLIS"
- "a scroll of teletype paper holding the software Four Freedoms"
- "a telephone shaped like an orange cartoon cat"))
-
(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-value (build-actions
+ #: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-value (build-actions
+ #:init-thunk (build-actions
(cmd-ring summoning-bell-cmd-ring))))
(define* (summoning-bell-cmd-ring bell message . _)
('thing:lobby:cabinet
<gameobj> 'room:lobby
#:name "a curio cabinet"
- #:goes-by '("curio cabinet" "cabinet" "bricabrac cabinet")
+ #:goes-by '("curio cabinet" "cabinet" "bricabrac cabinet"
+ "cabinet of curiosities")
#:desc (lambda _
(format #f " The curio cabinet is full of all sorts of oddities!
Something catches your eye!
-Ooh, ~a!" (random-choice random-bricabrac))))
+Ooh, ~a!" (random-choice
+ '("a creepy porcelain doll"
+ "assorted 1950s robots"
+ "an exquisite tea set"
+ "an antique mustard pot"
+ "the pickled head of Elvis"
+ "the pickled circuitboard of EVLIS"
+ "a scroll of teletype paper holding the software Four Freedoms"
+ "a telephone shaped like an orange cartoon cat")))))
('thing:lobby:sign-in-form
<sign-in-form> 'room:lobby
#:name "sign-in form"
#:goes-by '("sign-in form" "form" "signin form")
#:desc "It looks like you could sign this form and set your name.")
- )
- )
+
+ ('thing:lobby:porcelain-doll
+ <thing> '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
+ #:generally-visible #f
+ #:name "a set of 1950s robots"
+ #:desc "There's a whole set of these 1950s style robots.
+They seem to be stamped out of tin, and have various decorations of levers
+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
+ #:generally-visible #f
+ #:name "a tea set"
+ #:desc "A complete tea set. Some of the cups are chipped.
+You can imagine yourself joining a tea party using this set, around a
+nice table with some doilies, drinking some Earl Grey tea, hot. Mmmm."
+ #:goes-by '("tea set" "tea"))
+ ('thing:lobby:mustard-pot
+ <thing> '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
+nice design, and it's an antique, but you can't imagine putting something
+like this in a museum.")
+ (p "Ha... imagine that... a mustard museum."))
+ #:goes-by '("mustard pot" "antique mustard pot" "mustard"))
+ ('thing:lobby:head-of-elvis
+ <thing> 'room:lobby
+ #:generally-visible #f
+ #:name "the pickled head of Elvis"
+ #:desc '((p "It's a jar full of some briny-looking liquid and...
+a free floating head. The head looks an awful lot like Elvis, and
+definitely not the younger Elvis. The hair even somehow maintains
+that signature swoop while suspended in liquid. But of course it's
+not Elvis.")
+ (p "Oh, wait, it has a label at the bottom which says:
+\"This is really the head of Elvis\". Well... maybe don't believe
+everything you read."))
+ #:goes-by '("pickled head of elvis" "pickled head of Elvis"
+ "elvis" "Elvis" "head" "pickled head"))
+ ('thing:lobby:circuitboard-of-evlis
+ <thing> 'room:lobby
+ #:generally-visible #f
+ #:name "the pickled circuitboard of 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
+no idea what it means to preserve computers, so here it is floating
+in some kind of briny liquid. It appears to be heavily corroded.
+Too bad..."))
+ #:goes-by '("pickled circuitboard of evlis" "pickled circuitboard of Evlis"
+ "pickled circuitboard of EVLIS"
+ "evlis" "Evlis" "EVLIS" "circuitboard" "pickled circuitboard"))
+ ('thing:lobby:teletype-scroll
+ <thing> 'room:lobby
+ #:generally-visible #f
+ #:name "a scroll of teletype"
+ #:desc '((p "This is a scroll of teletype paper. It's a bit old
+and yellowed but the type is very legible. It says:")
+ (br)
+ (i
+ (p (strong "== The four essential freedoms =="))
+ (p "A program is free software if the program's users have
+the four essential freedoms: ")
+ (ul (li "The freedom to run the program as you wish, for any purpose (freedom 0).")
+ (li "The freedom to study how the program works, and change it so it does your computing as you wish (freedom 1). Access to the source code is a precondition for this.")
+ (li "The freedom to redistribute copies so you can help your neighbor (freedom 2).")
+ (li "The freedom to distribute copies of your modified versions to others (freedom 3). By doing this you can give the whole community a chance to benefit from your changes. Access to the source code is a precondition for this.")))
+ (p "You get this feeling that ambiguities in the
+English language surrounding the word 'free' have lead to a lot of terminology debates."))
+ #:goes-by '("scroll of teletype" "scroll of teletype paper" "teletype scroll"
+ "teletype paper" "scroll" "four freedoms"
+ "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
+ #: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.
+It resembles a striped tabby, and it's eyes hold the emotion of
+a being both sleepy and smarmy.
+You suspect that someone, somewhere made a ton of cash on items holding
+this general shape in the 1990s."
+ #:goes-by '("orange cartoon cat phone" "orange cartoon cat telephone"
+ "orange cat phone" "orange cat telephone"
+ "cartoon cat phone" "cartoon cat"
+ "cat phone" "cat telephone" "phone" "telephone"))))
\f
(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-value (build-actions
+ #:init-thunk (build-actions
(cmd-sit-furniture furniture-cmd-sit))))
(define* (furniture-cmd-sit actor message #:key direct-obj)
;;; 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-value (build-actions
+ #:init-thunk (build-actions
(init clerk-act-init)
(cmd-chat clerk-cmd-chat)
(cmd-ask-incomplete clerk-cmd-ask-incomplete)
<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
projects / mudsync.git / blobdiff