;;; Hotel Bricabrac
(use-modules (mudsync)
- (mudsync parser)
- (8sync actors)
- (8sync agenda)
+ (mudsync container)
+ (8sync)
(oop goops)
(ice-9 control)
(ice-9 format)
;;; 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-value (build-actions
+ #:init-thunk (build-actions
(cmd-read readable-cmd-read))))
(define (readable-cmd-read actor message)
#:text (string-append (slot-ref actor 'read-text) "\n")))
+;; This one allows you to take from items that are proxied by it
+(define-actor <proxy-items> (<gameobj>)
+ ((cmd-take-from take-from-proxy))
+ (proxy-items #:init-keyword #:proxy-items))
+
+(define* (take-from-proxy gameobj message
+ #:key direct-obj indir-obj preposition
+ (player (message-from message)))
+ (call/ec
+ (lambda (escape)
+ (for-each
+ (lambda (obj-sym)
+ (define obj-id (dyn-ref gameobj obj-sym))
+ (define goes-by
+ (mbody-val (<-wait obj-id 'goes-by)))
+ (when (ci-member direct-obj goes-by)
+ (<- obj-id 'cmd-take #:direct-obj direct-obj #:player player)
+ (escape #f)))
+ (slot-ref gameobj 'proxy-items))
+
+ (<- player 'tell
+ #:text `("You don't see any such " ,direct-obj " to take "
+ ,preposition " " ,(slot-ref gameobj 'name) ".")))))
+
+
\f
;;; Lobby
;;; -----
(<- (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>)
+(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-value (build-actions
+ #:init-thunk (build-actions
(cmd-ring summoning-bell-cmd-ring))))
(define* (summoning-bell-cmd-ring bell message . _)
"How can you have money if none of you produces anything?"
"On no account allow Arthur to request tea on this ship."))
+(define-class <cabinet-item> (<gameobj>)
+ (take-me? #:init-value
+ (lambda _
+ (values #f #:why-not
+ `("Hm, well... the cabinet is locked and the properitor "
+ "is right over there.")))))
+
(define lobby
(lol
- ('room:lobby
+ ('lobby
<room> #f
#:name "Hotel Lobby"
#:desc
#:exits
(list (make <exit>
#:name "north"
- #:to 'room:grand-hallway)))
+ #:to 'grand-hallway)))
;; NPC: hotel owner
- ('npc:lobby:hotel-owner
- <chatty-npc> 'room:lobby
+ ('lobby:hotel-owner
+ <chatty-npc> 'lobby
#:name "a frumpy fellow"
#:desc
'((p " Whoever this is, they looks totally exhausted. They're
"hotel proprietor" "proprietor")
#:catchphrases hotel-owner-grumps)
;; Object: Sign
- ('thing:lobby:sign
- <readable> 'room:lobby
+ ('lobby:sign
+ <readable> 'lobby
#:name "the Hotel Bricabrac sign"
#:desc " It strikes you that there's something funny going on with this sign.
Sure enough, if you look at it hard enough, you can tell that someone
"hotel bricabrac sign"
"lobby sign"))
- ('thing:lobby:bell
- <summoning-bell> 'room:lobby
+ ('lobby:bell
+ <summoning-bell> 'lobby
#:name "a shiny brass bell"
#:goes-by '("shiny brass bell" "shiny bell" "brass bell" "bell")
#:desc " A shiny brass bell. Inscribed on its wooden base is the text
\"ring me for service\". You probably could \"ring the bell\" if you
wanted to."
- #:summons 'npc:break-room:desk-clerk)
+ #:summons 'break-room:desk-clerk)
+
+ ('lobby:sign-in-form
+ <sign-in-form> '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.")
;; Object: curio cabinets
- ('thing:lobby:cabinet
- <gameobj> 'room:lobby
+ ;; TODO: respond to attempts to open the curio cabinet
+ ('lobby:cabinet
+ <proxy-items> 'lobby
+ #:proxy-items '(lobby:porcelain-doll
+ lobby:1950s-robots
+ lobby:tea-set lobby:mustard-pot
+ lobby:head-of-elvis lobby:circuitboard-of-evlis
+ lobby:teletype-scroll lobby:orange-cat-phone)
#: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))))
- ('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.")
- ;; Object: desk
- ;; - Object: bell
- ;; - Object: sign in form
- ;; - Object: pamphlet
- ;; Object: <invisible bell>: reprimands that you want to ring the
- ;; bell on the desk
- )
- )
+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")))))
+
+ ('lobby:porcelain-doll
+ <cabinet-item> '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"))
+ ('lobby:1950s-robots
+ <cabinet-item> '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"))
+ ('lobby:tea-set
+ <cabinet-item> '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"))
+ ('lobby:mustard-pot
+ <cabinet-item> '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
+like this in a museum.")
+ (p "Ha... imagine that... a mustard museum."))
+ #:goes-by '("mustard pot" "antique mustard pot" "mustard"))
+ ('lobby:head-of-elvis
+ <cabinet-item> '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
+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"))
+ ('lobby:circuitboard-of-evlis
+ <cabinet-item> '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
+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"))
+ ('lobby:teletype-scroll
+ <cabinet-item> '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:")
+ (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"))
+ ('lobby:orange-cat-phone
+ <cabinet-item> '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
+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
;;; Grand hallway
;;; -------------
+(define-actor <disc-shield> (<gameobj>)
+ ((cmd-take disc-shield-take)))
+
+(define* (disc-shield-take gameobj message
+ #:key direct-obj
+ (player (message-from message)))
+ (create-gameobj <glowing-disc> (gameobj-gm gameobj)
+ player) ;; set loc to player to put in player's inventory
+ (<- player 'tell
+ #:text '((p "As you attempt to pull the shield / disk platter
+from the statue, there is a bright glow... and a completely separate,
+glowing copy of the disc materializes into your hands!")
+ (p "You hear a voice whispering in your ear: "
+ (i "\"Share the software... and you'll be free...\"")))))
+
+;;; This is the disc that gets put in the player's inventory
+(define-actor <glowing-disc> (<gameobj>)
+ ((cmd-drop glowing-disc-drop-cmd))
+ (initial-props
+ #:allocation #:each-subclass
+ #:init-thunk (build-props
+ '((hd-platter? . #t))))
+ (name #:allocation #:each-subclass
+ #:init-value "a glowing disc")
+ (desc #:allocation #:each-subclass
+ #:init-value "A brightly glowing disc. It's shaped like a hard
+drive platter, not unlike the one from the statue it came from. It's
+labeled \"RL02.5\".")
+ (goes-by #:init-value '("glowing disc" "glowing platter"
+ "glowing disc platter" "glowing disk platter"
+ "platter" "disc" "disk" "glowing shield")))
+
+(define* (glowing-disc-drop-cmd gameobj message
+ #:key direct-obj
+ (player (message-from message)))
+ (<- player 'tell
+ #:text "You drop the glowing disc, and it shatters into a million
+pieces!")
+ (gameobj-self-destruct gameobj))
+
(define grand-hallway
(lol
- ('room:grand-hallway
+ ('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"
- #:to 'room:lobby)
+ #:to 'lobby)
(make <exit>
#:name "west"
- #:to 'room:playroom)
+ #:to 'playroom)
(make <exit>
#:name "east"
- #:to 'room:smoking-parlor)))
- ('thing:ignucius-statue
- <gameobj> 'room:grand-hallway
- #:name "a statue"
- #:desc " The statue is of a serious-looking bearded man with long, flowing hair.
-The inscription says \"St. Ignucius\".
- It has a large physical halo. Removing it is tempting, but it looks pretty
-well fastened."
- #:goes-by '("statue" "st ignucius" "st. ignucius"))))
+ #:to 'smoking-parlor)))
+ ('grand-hallway:carpet
+ <gameobj> 'grand-hallway
+ #:name "the Grand Hallway carpet"
+ #:desc "It's very red, except in the places where it's very worn."
+ #:invisible? #t
+ #:goes-by '("red carpet" "carpet"))
+ ('grand-hallway:busts
+ <gameobj> 'grand-hallway
+ #:name "the busts of serious people"
+ #:desc "There are about 6 of them in total. They look distinguished
+but there's no indication of who they are."
+ #:invisible? #t
+ #:goes-by '("busts" "bust" "busts of serious people" "bust of serious person"))
+ ('grand-hallway:hackthena-statue
+ <proxy-items> 'grand-hallway
+ #:name "the statue of Hackthena"
+ #: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" "statue of hackthena")
+ #:proxy-items '(grand-hallway:keyboard
+ grand-hallway:disc-platter
+ grand-hallway:hackthena-horns))
+ ('grand-hallway:keyboard
+ <gameobj> 'grand-hallway
+ #:name "a Knight Keyboard"
+ #:desc "Whoa, this isn't just any old keyboard, this is a Knight Keyboard!
+Any space cadet can see that with that kind of layout a hack-and-slayer could
+thrash out some serious key-chords like there's no tomorrow. You guess
+Hackthena must be an emacs user."
+ #:invisible? #t
+ #:take-me? (lambda _
+ (values #f
+ #:why-not
+ `("Are you kidding? Do you know how hard it is to find "
+ "a Knight Keyboard? There's no way she's going "
+ "to give that up.")))
+ #:goes-by '("knight keyboard" "keyboard"))
+ ('grand-hallway:hackthena-horns
+ <gameobj> 'grand-hallway
+ #:name "Hackthena's horns"
+ #:desc "They're not unlike a Gnu's horns."
+ #:invisible? #t
+ #:take-me? (lambda _
+ (values #f
+ #:why-not
+ `("Are you seriously considering desecrating a statue?")))
+ #:goes-by '("hackthena's horns" "horns" "horns of hacktena"))
+ ('grand-hallway:disc-platter
+ <disc-shield> 'grand-hallway
+ #:name "Hackthena's shield"
+ #:desc "This isn't a shield after all, it seems to be a hard disk
+platter! It has \"RL02.5\" written on it. It looks kind of loose..."
+ #:invisible? #t
+ #:goes-by '("hackthena's shield" "shield" "platter"))))
\f
;;; Playroom
(define playroom
(lol
- ('room:playroom
+ ('playroom
<room> #f
#:name "The Playroom"
- #:desc " There are toys scattered everywhere here. It's really unclear
-if this room is intended for children or child-like adults."
+ #:desc '(p (" There are toys scattered everywhere here. It's really unclear
+if this room is intended for children or child-like adults.")
+ (" There are doors to both the east and the west."))
#:exits
(list (make <exit>
#:name "east"
- #:to 'room:grand-hallway)))
- ('thing:playroom:cubey
- <thing> 'room:playroom
- #:name "cubey"
- #:takeable #t
+ #:to 'grand-hallway)
+ (make <exit>
+ #:name "west"
+ #:to 'computer-room)))
+ ('playroom:cubey
+ <gameobj> 'playroom
+ #:name "Cubey"
+ #:take-me? #t
#:desc " It's a little foam cube with googly eyes on it. So cute!")
- ('thing:cuddles-plushie
- <thing> 'room:playroom
- #:name "a cuddles plushie"
+ ('playroom:cuddles-plushie
+ <gameobj> '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!")
+
+ ('playroom:toy-chest
+ <container> '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? 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
+ ('playroom:toy-chest:rubber-duck
+ <gameobj> '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-value (build-actions
+ #:init-thunk (build-actions
(cmd-sit-furniture furniture-cmd-sit))))
(define* (furniture-cmd-sit actor message #:key direct-obj)
(define smoking-parlor
(lol
- ('room:smoking-parlor
+ ('smoking-parlor
<room> #f
#:name "Smoking Parlor"
#:desc
#:exits
(list (make <exit>
#:name "west"
- #:to 'room:grand-hallway)
+ #:to 'grand-hallway)
(make <exit>
#:name "south"
- #:to 'room:break-room)))
- ('thing:smoking-parlor:chair
- <furniture> 'room:smoking-parlor
+ #:to 'break-room)))
+ ('smoking-parlor:chair
+ <furniture> 'smoking-parlor
#:name "a comfy leather chair"
#:desc " That leather chair looks really comfy!"
#:goes-by '("leather chair" "comfy leather chair" "chair")
#:sit-phrase "sink into"
#:sit-phrase-third-person "sinks into"
#:sit-name "the comfy leather chair")
- ('thing:smoking-parlor:sofa
- <furniture> 'room:smoking-parlor
+ ('smoking-parlor:sofa
+ <furniture> 'smoking-parlor
#:name "a plush leather sofa"
#:desc " That leather chair looks really comfy!"
#:goes-by '("leather sofa" "plush leather sofa" "sofa"
#:sit-phrase "sprawl out on"
#:sit-phrase-third-person "sprawls out on into"
#:sit-name "the plush leather couch")
- ('thing:smoking-parlor:bar-stool
- <furniture> 'room:smoking-parlor
+ ('smoking-parlor:bar-stool
+ <furniture> 'smoking-parlor
#:name "a bar stool"
#:desc " Conveniently located near the bar! Not the most comfortable
seat in the room, though."
#:sit-phrase "hop on"
#:sit-phrase-third-person "hops onto"
#:sit-name "the bar stool")
- ('npc:ford-prefect
- <chatty-npc> 'room:smoking-parlor
+ ('ford-prefect
+ <chatty-npc> 'smoking-parlor
#:name "Ford Prefect"
#:desc "Just some guy, you know?"
#:goes-by '("Ford Prefect" "ford prefect"
"frood" "prefect" "ford")
#:catchphrases prefect-quotes)
- ('thing:smoking-parlor:no-smoking-sign
- <thing> 'room:smoking-parlor
- #:generally-visible #f
+ ('smoking-parlor:no-smoking-sign
+ <gameobj> '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-value (build-actions
+ #:init-thunk (build-actions
(init clerk-act-init)
(cmd-chat clerk-cmd-chat)
(cmd-ask-incomplete clerk-cmd-ask-incomplete)
(update-loop clerk-act-update-loop)
(be-summoned clerk-act-be-summoned))))
-(define (clerk-act-init clerk message)
+(define (clerk-act-init clerk message . _)
;; call the gameobj main init method
(gameobj-act-init clerk message)
;; start our main loop
#:text
"The clerk's ears perk up, she stamps out a cigarette, and she
runs out of the room!\n")
- (gameobj-set-loc! clerk (dyn-ref clerk 'room:lobby))
+ (gameobj-set-loc! clerk (dyn-ref clerk 'lobby))
(slot-set! clerk 'patience 8)
(slot-set! clerk 'state 'on-duty)
(<- (gameobj-loc clerk) 'tell-room
The clerk leaves the room in a hurry.\n"
player-name)
#:exclude (actor-id clerk))
- (gameobj-set-loc! clerk (dyn-ref clerk 'room:break-room))
+ (gameobj-set-loc! clerk (dyn-ref clerk 'break-room))
(slot-set! clerk 'state 'slacking)
(<- (gameobj-loc clerk) 'tell-room
#:text clerk-return-to-slacking-text
"The clerk fumbles around for a cigarette.\n"))
(define clerk-working-impatience-texts
- '("The clerk struggles to retain an interested and polite smile.\n"
- "The clerk checks the time on her phone.\n"
- "The clerk taps her foot.\n"
- "The clerk takes a deep breath.\n"
- "The clerk yawns.\n"
- "The clerk drums her nails on the counter.\n"
- "The clerk clicks around on the desk computer.\n"
- "The clerk thumbs through a printout of some physics paper.\n"
- "The clerk mutters that her dissertation isn't going to write itself.\n"))
+ '("The clerk hums something, but you're not sure what it is."
+ "The clerk attempts to change the overhead music, but the dial seems broken."
+ "The clerk clicks around on the desk computer."
+ "The clerk scribbles an equation on a memo pad, then crosses it out."
+ "The clerk mutters something about the proprietor having no idea how to run a hotel."
+ "The clerk thumbs through a printout of some physics paper."))
(define clerk-slack-excuse-text
- "The desk clerk excuses herself, claiming she has important things to
-attend to.\n")
+ "The desk clerk excuses herself, but says you are welcome to ring the bell
+if you need further help.")
(define clerk-return-to-slacking-text
"The desk clerk enters and slams the door behind her.\n")
(match (slot-ref clerk 'state)
('slacking
(tell-room (random-choice clerk-slacking-texts))
- (8sleep (+ (random 10) 10))
+ (8sleep (+ (random 20) 15))
(loop-if-not-destructed))
('on-duty
(if (> (slot-ref clerk 'patience) 0)
(tell-room (random-choice clerk-working-impatience-texts))
(slot-set! clerk 'patience (- (slot-ref clerk 'patience)
(+ (random 2) 1)))
- (8sleep (+ (random 25) 20))
+ (8sleep (+ (random 60) 40))
(loop-if-not-destructed))
;; Back to slacking
(begin
(tell-room clerk-slack-excuse-text)
;; back bto the break room
- (gameobj-set-loc! clerk (pk 'break-room (dyn-ref clerk 'room:break-room)))
+ (gameobj-set-loc! clerk (pk 'break-room (dyn-ref clerk 'break-room)))
(tell-room clerk-return-to-slacking-text)
;; annnnnd back to slacking
(slot-set! clerk 'state 'slacking)
(define break-room
(lol
- ('room:break-room
+ ('break-room
<room> #f
#:name "Employee Break Room"
#:desc " This is less a room and more of an outdoor wire cage. You get
#:exits
(list (make <exit>
#:name "north"
- #:to 'room:smoking-parlor))
- )
- ('npc:break-room:desk-clerk
- <desk-clerk> 'room:break-room
+ #:to 'smoking-parlor)))
+ ('break-room:desk-clerk
+ <desk-clerk> '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."
- #:goes-by '("hotel desk clerk" "clerk" "desk clerk"))))
+hotel insignia. She appears to be rather exhausted."
+ #:goes-by '("hotel desk clerk" "clerk" "desk clerk"))
+ ('break-room:void
+ <gameobj> '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" "scenery"))
+ ('break-room:fence
+ <gameobj> '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
;;; Computer room
;;; -------------
+;; Our computer and hard drive are based off the PDP-11 and the RL01 /
+;; RL02 disk drives. However we increment both by .5 (a true heresy)
+;; to distinguish both from the real thing.
+
+(define-actor <hard-drive> (<gameobj>)
+ ()
+ ;; the state moves from: empty -> with-disc -> loading -> ready
+ (state #:init-value 'empty
+ #:accessor .state))
+
+(define* (hard-drive-desc hard-drive #:optional whos-looking)
+ `((p "The hard drive is labeled \"RL02.5\". It's a little under a meter tall.")
+ (p "There is a slot where a disk platter could be inserted, "
+ ,(if (eq? (.state hard-drive) 'empty)
+ "which is currently empty"
+ "which contains a glowing platter")
+ ". There is a LOAD button "
+ ,(if (member (.state hard-drive) '(empty with-disc))
+ "which is glowing"
+ "which is pressed in and unlit")
+ ". There is a READY indicator "
+ ,(if (eq? (.state hard-drive) 'ready)
+ "which is glowing. The machine emits a gentle whirring noise."
+ "which is unlit."))))
+
+(define computer-room
+ (lol
+ ('computer-room
+ <room> #f
+ #:name "Computer Room"
+ #:desc '((p "A sizable computer cabinet covers a good portion of the left
+wall. It emits a pleasant hum which covers the room like a warm blanket.
+Connected to a computer is a large hard drive.")
+ (p "On the floor is a large steel panel. It is closed, but it has
+hinges which suggest it could be opened."))
+ #:exits
+ (list (make <exit>
+ #:name "east"
+ #:to 'playroom)))
+ ('computer-room:hard-drive
+ <hard-drive> 'computer-room
+ #:name "a hard drive"
+ #:desc (wrap-apply hard-drive-desc)
+ #:goes-by '("hard drive" "drive" "hard disk"))))
+
+
\f
;;; Game
;;; ----
(define (game-spec)
(append lobby grand-hallway smoking-parlor
- playroom break-room))
+ playroom break-room computer-room))
;; TODO: Provide command line args
(define (run-game . args)
- (run-demo (game-spec) 'room:lobby #:repl-server #t))
+ (run-demo (game-spec) 'lobby #:repl-server #t))
projects / mudsync.git / blobdiff