;;; 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
- #:generally-visible #f
+ <gameobj> 'room:lobby
+ #:invisible? #t
#: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
+ <gameobj> 'room:lobby
+ #:invisible? #t
#: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
+ <gameobj> 'room:lobby
+ #:invisible? #t
#: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
+ <gameobj> 'room:lobby
+ #:invisible? #t
#: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
(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
+ <gameobj> 'room:lobby
+ #:invisible? #t
#: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
#: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
+ <gameobj> 'room:lobby
+ #:invisible? #t
#: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
"pickled circuitboard of EVLIS"
"evlis" "Evlis" "EVLIS" "circuitboard" "pickled circuitboard"))
('thing:lobby:teletype-scroll
- <thing> 'room:lobby
- #:generally-visible #f
+ <gameobj> 'room:lobby
+ #:invisible? #t
#: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:")
"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
+ <gameobj> 'room:lobby
+ #:invisible? #t
#: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
('room:grand-hallway
<room> #f
#:name "Grand Hallway"
- #:desc " A majestic red carpet runs down the center of the room.
+ #:desc '((p " A majestic red carpet runs down the center of the room.
Busts of serious looking people line the walls, but there's no
-clear indication that they have any logical relation to this place.
- In the center is a large statue of a bearded man. You wonder what
-that's all about?
- To the south is the lobby. A door to the east is labeled \"smoking
-room\", while a door to the west is labeled \"playroom\"."
+clear indication that they have any logical relation to this place.")
+ (p "In the center is a large statue of a woman in a warrior's
+pose, but something is strange about her weapon and shield. You wonder what
+that's all about?")
+ (p "To the south is the lobby. A door to the east is labeled \"smoking
+room\", while a door to the west is labeled \"playroom\"."))
#:exits
(list (make <exit>
#:name "south"
(make <exit>
#:name "east"
#:to 'room:smoking-parlor)))
- ('thing:ignucius-statue
+ ('thing:hackthena-statue
<gameobj> 'room:grand-hallway
#:name "a statue"
- #:desc " The statue is of a serious-looking bearded man with long, flowing hair.
- It has a large physical halo. Removing it is tempting, but it looks pretty
-well fastened."
- #:goes-by '("statue" "st ignucius" "st. ignucius"))))
+ #:desc '((p "The base of the statue says \"Hackthena, guardian of the hacker
+spirit\". You've heard of Hackthena... not a goddess, but spiritual protector of
+all good hacks, and legendary hacker herself.")
+ (p "Hackthena holds the form of a human woman. She wears flowing
+robes, has a pear of curly bovine-esque horns protruding from the sides of her
+head, wears a pair of horn-rimmed glasses, and appears posed as if for battle.
+But instead of a weapon, she seems to hold some sort of keyboard. And her
+shield... well it's round like a shield, but something seems off about it.
+You'd better take a closer look to be sure."))
+ #:goes-by '("hackthena statue" "hackthena" "statue"))))
\f
;;; Playroom
#:name "east"
#:to 'room:grand-hallway)))
('thing:playroom:cubey
- <thing> 'room:playroom
+ <gameobj> 'room:playroom
#:name "cubey"
- #:takeable #t
+ #:take-me? #t
#:desc " It's a little foam cube with googly eyes on it. So cute!")
- ('thing:cuddles-plushie
- <thing> 'room:playroom
+ ('thing:playroom:cuddles-plushie
+ <gameobj> 'room:playroom
#:name "a cuddles plushie"
#:goes-by '("plushie" "cuddles plushie" "cuddles")
- #:takeable #t
- #:desc " A warm and fuzzy cuddles plushie! It's a cuddlefish!")))
+ #:take-me? #t
+ #:desc " A warm and fuzzy cuddles plushie! It's a cuddlefish!")
+
+ ('thing:playroom:toy-chest
+ <gameobj> 'room:playroom
+ #:name "a toy chest"
+ #:goes-by '("toy chest" "chest")
+ #:desc (lambda (toy-chest whos-looking)
+ (let ((contents (gameobj-occupants toy-chest)))
+ `((p "A brightly painted wooden chest. The word \"TOYS\" is "
+ "engraved on it.")
+ (p "Inside you see:"
+ ,(if (eq? (pk 'contents contents) '())
+ " nothing! It's empty!"
+ `(ul ,(map (lambda (occupant)
+ `(li ,(mbody-val
+ (<-wait occupant 'get-name))))
+ (gameobj-occupants toy-chest))))))))
+ #:take-from-me? #t
+ #:put-in-me? #t)
+
+ ;; Things inside the toy chest
+ ('thing:playroom:toy-chest:rubber-duck
+ <gameobj> 'thing:playroom:toy-chest
+ #:name "a rubber duck"
+ #:goes-by '("rubber duck" "duck")
+ #:take-me? #t
+ #:desc "It's a yellow rubber duck with a bright orange beak.")))
\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-thunk (build-actions
(cmd-sit-furniture furniture-cmd-sit))))
#:catchphrases prefect-quotes)
('thing:smoking-parlor:no-smoking-sign
- <thing> 'room:smoking-parlor
- #:generally-visible #f
+ <gameobj> 'room:smoking-parlor
+ #:invisible? #t
#:name "No Smoking Sign"
#:desc "This sign says \"No Smoking\" in big, red letters.
It has some bits of bubble gum stuck to it... yuck."
;;; 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
- #:generally-visible #f
+ <gameobj> 'room:break-room
+ #:invisible? #t
#: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
+ #:invisible? #t
+ #: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