123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736 |
- ;;; Mudsync --- Live hackable MUD
- ;;; Copyright © 2016 Christopher Allan Webber <cwebber@dustycloud.org>
- ;;;
- ;;; This file is part of Mudsync.
- ;;;
- ;;; Mudsync is free software; you can redistribute it and/or modify it
- ;;; under the terms of the GNU General Public License as published by
- ;;; the Free Software Foundation; either version 3 of the License, or
- ;;; (at your option) any later version.
- ;;;
- ;;; Mudsync is distributed in the hope that it will be useful, but
- ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
- ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- ;;; General Public License for more details.
- ;;;
- ;;; You should have received a copy of the GNU General Public License
- ;;; along with Mudsync. If not, see <http://www.gnu.org/licenses/>.
- ;;; Hotel Bricabrac
- (use-modules (mudsync)
- (mudsync parser)
- (8sync actors)
- (8sync agenda)
- (oop goops)
- (ice-9 control)
- (ice-9 format)
- (ice-9 match)
- (rx irregex))
- ;;; Utilities, useful or otherwise
- ;;; ==============================
- (set! *random-state* (random-state-from-platform))
- (define (random-choice lst)
- (list-ref lst (random (length lst))))
- ;; list of lists, lol.
- (define-syntax-rule (lol (list-contents ...) ...)
- (list (list list-contents ...) ...))
- ;;; 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*)
- (actions #:allocation #:each-subclass
- #:init-value (build-actions
- (cmd-read readable-cmd-read))))
- (define (readable-cmd-read actor message)
- (<- (message-from message) 'tell
- #:text (string-append (slot-ref actor 'read-text) "\n")))
- ;;; Lobby
- ;;; -----
- (define (npc-chat-randomly actor message . _)
- (define text-to-send
- (format #f "~a says: \"~a\"\n"
- (slot-ref actor 'name)
- (random-choice (slot-ref actor 'catchphrases))))
- (<- (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
- know?"
- "(*tearfully*) Here, take this parenthesis. May it serve
- you well."
- "I gotta get back to the goblin farm soon..."
- "Oh, but I was going to make a mansion... a great,
- beautiful mansion! Full of ghosts! Now all I have is this cruddy
- mo... hotel. Oh... If only I had more time!"
- "I told them to paint more of the walls purple.
- Why didn't they listen?"
- "Listen to that overhead muzak. Whoever made that doesn't
- know how to compose very well! Have you heard of the bands 'fmt'
- or 'skribe'? Now *that's* composition!"))
- (define-class <chatty-npc> (<gameobj>)
- (catchphrases #:init-value '("Blarga blarga blarga!")
- #:init-keyword #:catchphrases)
- (commands
- #:init-value chat-commands)
- (actions #:allocation #:each-subclass
- #:init-value
- (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"))))
- (actions #:allocation #:each-subclass
- #:init-value (build-actions
- (cmd-sign-form sign-cmd-sign-in))))
- (define name-sre
- (sre->irregex '(: alpha (** 1 14 (or alphanum "-" "_")))))
- (define forbidden-words
- (append article preposition
- '("and" "or" "but" "admin")))
- (define (valid-name? name)
- (and (irregex-match name-sre name)
- (not (member name forbidden-words))))
- (define* (sign-cmd-sign-in actor message
- #:key direct-obj indir-obj preposition)
- (define old-name
- (mbody-val (<-wait (message-from message) 'get-name)))
- (define name indir-obj)
- (if (valid-name? indir-obj)
- (begin
- (<-wait (message-from message) 'set-name! name)
- (<- (slot-ref actor 'loc) 'tell-room
- #:text (format #f "~a signs the form!\n~a is now known as ~a\n"
- old-name old-name name)))
- (<- (message-from message) 'tell
- #:text "Sorry, that's not a valid name.
- Alphanumerics, _ and - only, 2-15 characters, starts with an alphabetic
- 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*)
- (actions #:allocation #:each-subclass
- #:init-value (build-actions
- (cmd-ring summoning-bell-cmd-ring))))
- (define* (summoning-bell-cmd-ring bell message . _)
- ;; Call back to actor who invoked this message handler
- ;; and find out their name. We'll call *their* get-name message
- ;; handler... meanwhile, this procedure suspends until we get
- ;; their response.
- (define who-rang
- (mbody-val (<-wait (message-from message) 'get-name)))
- ;; Now we'll invoke the "tell" message handler on the player
- ;; who rang us, displaying this text on their screen.
- ;; This one just uses <- instead of <-wait, since we don't
- ;; care when it's delivered; we're not following up on it.
- (<- (message-from message) 'tell
- #:text "*ring ring!* You ring the bell!\n")
- ;; We also want everyone else in the room to "hear" the bell,
- ;; but they get a different message since they aren't the ones
- ;; ringing it. Notice here's where we make use of the invoker's
- ;; name as extracted and assigned to the who-rang variable.
- ;; Notice how we send this message to our "location", which
- ;; forwards it to the rest of the occupants in the room.
- (<- (gameobj-loc bell) 'tell-room
- #:text
- (format #f "*ring ring!* ~a rings the bell!\n"
- who-rang)
- #:exclude (message-from message))
- ;; Now we perform the primary task of the bell, which is to summon
- ;; the "clerk" character to the room. (This is configurable,
- ;; so we dynamically look up their address.)
- (<- (dyn-ref bell (slot-ref bell 'summons)) 'be-summoned
- #:who-summoned (message-from message)))
- (define prefect-quotes
- '("I'm a frood who really knows where my towel is!"
- "On no account allow a Vogon to read poetry at you."
- "Time is an illusion, lunchtime doubly so!"
- "How can you have money if none of you produces anything?"
- "On no account allow Arthur to request tea on this ship."))
- (define lobby
- (lol
- ('room:lobby
- <room> #f
- #:name "Hotel Lobby"
- #:desc
- " You're in some sort of hotel lobby. You see a large sign hanging
- over the desk that says \"Hotel Bricabrac\". On the desk is a bell
- that says \"'ring bell' for service\". Terrible music plays from a speaker
- somewhere overhead.
- The room is lined with various curio cabinets, filled with all sorts
- of kitschy junk. It looks like whoever decorated this place had great
- ambitions, but actually assembled it all in a hurry and used whatever
- kind of objects they found lying around.
- There's a door to the north leading to some kind of hallway."
- #:exits
- (list (make <exit>
- #:name "north"
- #:to 'room:grand-hallway)))
- ;; NPC: hotel owner
- ('npc:lobby:hotel-owner
- <chatty-npc> 'room:lobby
- #:name "a frumpy fellow"
- #:desc " Whoever this is, they looks totally exhausted. They're
- collapsed into the only comfortable looking chair in the room and you
- don't get the sense that they're likely to move any time soon.
- You notice they're wearing a sticker badly adhesed to their clothing
- which says \"Hotel Proprietor\", but they look so disorganized that you
- think that can't possibly be true... can it?
- Despite their exhaustion, you sense they'd be happy to chat with you,
- though the conversation may be a bit one sided."
- #:goes-by '("frumpy fellow" "fellow"
- "Chris Webber" ; heh, did you rtfc? or was it so obvious?
- "hotel proprietor" "proprietor")
- #:catchphrases hotel-owner-grumps)
- ;; Object: Sign
- ('thing:lobby:sign
- <readable> 'room: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
- hastily painted over an existing sign and changed the \"M\" to an \"H\".
- Classy!"
- #:read-text " All it says is \"Hotel Bricabrac\" in smudged, hasty text."
- #:goes-by '("sign"
- "bricabrac sign"
- "hotel sign"
- "hotel bricabrac sign"
- "lobby sign"))
- ('thing:lobby:bell
- <summoning-bell> 'room: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)
- ;; Object: curio cabinets
- ('thing:lobby:cabinet
- <gameobj> 'room:lobby
- #:name "a curio cabinet"
- #:goes-by '("curio cabinet" "cabinet" "bricabrac cabinet")
- #: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
- )
- )
- ;;; Grand hallway
- ;;; -------------
- (define grand-hallway
- (lol
- ('room:grand-hallway
- <room> #f
- #:name "Grand Hallway"
- #:desc " 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\"."
- #:exits
- (list (make <exit>
- #:name "south"
- #:to 'room:lobby)
- (make <exit>
- #:name "west"
- #:to 'room: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"))))
- ;;; Playroom
- ;;; --------
- (define playroom
- (lol
- ('room: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."
- #:exits
- (list (make <exit>
- #:name "east"
- #:to 'room:grand-hallway)))
- ('thing:playroom:cubey
- <thing> '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
- #:name "a cuddles plushie"
- #:goes-by '("plushie" "cuddles plushie" "cuddles")
- #:takeable #t
- #:desc " A warm and fuzzy cuddles plushie! It's a cuddlefish!")))
- ;;; Writing room
- ;;; ------------
- ;;; Armory???
- ;;; ---------
- ;; ... full of NURPH weapons?
- ;;; Smoking parlor
- ;;; --------------
- (define-class <furniture> (<gameobj>)
- (sit-phrase #:init-keyword #:sit-phrase)
- (sit-phrase-third-person #:init-keyword #:sit-phrase-third-person)
- (sit-name #:init-keyword #:sit-name)
- (commands
- #:init-value
- (list
- (direct-command "sit" 'cmd-sit-furniture)))
- (actions #:allocation #:each-subclass
- #:init-value (build-actions
- (cmd-sit-furniture furniture-cmd-sit))))
- (define* (furniture-cmd-sit actor message #:key direct-obj)
- (define player-name
- (mbody-val (<-wait (message-from message) 'get-name)))
- (<- (message-from message) 'tell
- #:text (format #f "You ~a ~a.\n"
- (slot-ref actor 'sit-phrase)
- (slot-ref actor 'sit-name)))
- (<- (slot-ref actor 'loc) 'tell-room
- #:text (format #f "~a ~a on ~a.\n"
- player-name
- (slot-ref actor 'sit-phrase-third-person)
- (slot-ref actor 'sit-name))
- #:exclude (message-from message)))
- (define smoking-parlor
- (lol
- ('room:smoking-parlor
- <room> #f
- #:name "Smoking Parlor"
- #:desc " This room looks quite posh. There are huge comfy seats you can sit in
- if you like.
- Strangely, you see a large sign saying \"No Smoking\". The owners must
- have installed this place and then changed their mind later.
- There's a door to the west leading back to the grand hallway, and
- a nondescript steel door to the south, leading apparently outside."
- #:exits
- (list (make <exit>
- #:name "west"
- #:to 'room:grand-hallway)
- (make <exit>
- #:name "south"
- #:to 'room:break-room)))
- ('thing:smoking-room:chair
- <furniture> 'room: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-room:sofa
- <furniture> 'room:smoking-parlor
- #:name "a plush leather sofa"
- #:desc " That leather chair looks really comfy!"
- #:goes-by '("leather sofa" "plush leather sofa" "sofa"
- "leather couch" "plush leather couch" "couch")
- #:sit-phrase "sprawl out on"
- #:sit-phrase-third-person "sprawls out on into"
- #:sit-name "the plush leather couch")
- ('thing:smoking-room:bar-stool
- <furniture> 'room:smoking-parlor
- #:name "a bar stool"
- #:desc " Conveniently located near the bar! Not the most comfortable
- seat in the room, though."
- #:goes-by '("stool" "bar stool" "seat")
- #:sit-phrase "hop on"
- #:sit-phrase-third-person "hops onto"
- #:sit-name "the bar stool")
- ('npc:ford-prefect
- <chatty-npc> 'room:smoking-parlor
- #:name "Ford Prefect"
- #:desc "Just some guy, you know?"
- #:goes-by '("Ford Prefect" "ford prefect"
- "frood" "prefect" "ford")
- #:catchphrases prefect-quotes)
- ;; TODO: Cigar dispenser
- ))
- ;;; 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
- ;; gradually)
- ;; - slacking: In the break room, probably smoking a cigarette
- ;; or checking text messages
- (state #:init-value 'slacking)
- (commands #:init-value clerk-commands*)
- (patience #:init-value 0)
- (actions #:allocation #:each-subclass
- #:init-value (build-actions
- (init clerk-act-init)
- (cmd-chat clerk-cmd-chat)
- (cmd-ask-incomplete clerk-cmd-ask-incomplete)
- (cmd-ask-about clerk-cmd-ask)
- (cmd-dismiss clerk-cmd-dismiss)
- (update-loop clerk-act-update-loop)
- (be-summoned clerk-act-be-summoned))))
- (define (clerk-act-init clerk message)
- ;; call the gameobj main init method
- (gameobj-act-init clerk message)
- ;; start our main loop
- (<- (actor-id clerk) 'update-loop))
- (define clerk-help-topics
- '(("changing name" .
- "Changing your name is easy! We have a clipboard here at the desk
- where you can make yourself known to other participants in the hotel
- if you sign it. Try 'sign form as <your-name>', replacing
- <your-name>, obviously!")
- ("common commands" .
- "Here are some useful commands you might like to try: chat,
- go, take, drop, say...")
- ("hotel" .
- "We hope you enjoy your stay at Hotel Bricabrac. As you may see,
- our hotel emphasizes interesting experiences over rest and lodging.
- The origins of the hotel are... unclear... and it has recently come
- under new... 'management'. But at Hotel Bricabrac we believe these
- aspects make the hotel into a fun and unique experience! Please,
- feel free to walk around and explore.")))
- (define clerk-knows-about
- "'changing name', 'common commands', and 'about the hotel'")
- (define clerk-general-helpful-line
- (string-append
- "The clerk says, \"If you need help with anything, feel free to ask me about it.
- For example, 'ask clerk about changing name'. You can ask me about the following:
- " clerk-knows-about ".\"\n"))
- (define clerk-slacking-complaints
- '("The pay here is absolutely lousy."
- "The owner here has no idea what they're doing."
- "Some times you just gotta step away, you know?"
- "You as exhausted as I am?"
- "Yeah well, this is just temporary. I'm studying to be a high
- energy particle physicist. But ya gotta pay the bills, especially
- with tuition at where it is..."))
- (define* (clerk-cmd-chat clerk message #:key direct-obj)
- (match (slot-ref clerk 'state)
- ('on-duty
- (<- (message-from message) 'tell
- #:text clerk-general-helpful-line))
- ('slacking
- (<- (message-from message) 'tell
- #:text
- (string-append
- "The clerk says, \""
- (random-choice clerk-slacking-complaints)
- "\"\n")))))
- (define (clerk-cmd-ask-incomplete clerk message)
- (<- (message-from message) 'tell
- #:text "The clerk says, \"Ask about what?\"\n"))
- (define clerk-doesnt-know-text
- "The clerk apologizes and says she doesn't know about that topic.\n")
- (define* (clerk-cmd-ask clerk message #:key indir-obj
- #:allow-other-keys)
- (match (slot-ref clerk 'state)
- ('on-duty
- (match (assoc (pk 'indir indir-obj) clerk-help-topics)
- ((_ . info)
- (<- (message-from message) 'tell
- #:text
- (string-append "The clerk clears her throat and says:\n \""
- info
- "\"\n")))
- (#f
- (<- (message-from message) 'tell
- #:text clerk-doesnt-know-text))))
- ('slacking
- (<- (message-from message) 'tell
- #:text "The clerk says, \"Sorry, I'm on my break.\"\n"))))
- (define* (clerk-act-be-summoned clerk message #:key who-summoned)
- (match (slot-ref clerk 'state)
- ('on-duty
- (<- who-summoned 'tell
- #:text
- "The clerk tells you as politely as she can that she's already here,
- so there's no need to ring the bell.\n"))
- ('slacking
- (<- (gameobj-loc clerk) 'tell-room
- #: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))
- (slot-set! clerk 'patience 8)
- (slot-set! clerk 'state 'on-duty)
- (<- (gameobj-loc clerk) 'tell-room
- #:text
- (string-append
- " Suddenly, a uniformed woman rushes into the room! She's wearing a
- badge that says \"Desk Clerk\".
- \"Hello, yes,\" she says between breaths, \"welcome to Hotel Bricabrac!
- We look forward to your stay. If you'd like help getting acclimated,
- feel free to ask me. For example, 'ask clerk about changing name'.
- You can ask me about the following:
- " clerk-knows-about ".\"\n")))))
- (define* (clerk-cmd-dismiss clerk message . _)
- (define player-name
- (mbody-val (<-wait (message-from message) 'get-name)))
- (match (slot-ref clerk 'state)
- ('on-duty
- (<- (gameobj-loc clerk) 'tell-room
- #:text
- (format #f "\"Thanks ~a!\" says the clerk. \"I have somewhere I need to be.\"
- 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))
- (slot-set! clerk 'state 'slacking)
- (<- (gameobj-loc clerk) 'tell-room
- #:text clerk-return-to-slacking-text
- #:exclude (actor-id clerk)))
- ('slacking
- (<- (message-from message) 'tell
- #:text "The clerk sternly asks you to not be so dismissive.\n"))))
- (define clerk-slacking-texts
- '("The clerk takes a long drag on her cigarette.\n"
- "The clerk scrolls through text messages on her phone.\n"
- "The clerk coughs a few times.\n"
- "The clerk checks her watch and justifies a few more minutes outside.\n"
- "The clerk fumbles around for a lighter.\n"
- "The clerk sighs deeply and exhaustedly.\n"
- "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"))
- (define clerk-slack-excuse-text
- "The desk clerk excuses herself, claiming she has important things to
- attend to.\n")
- (define clerk-return-to-slacking-text
- "The desk clerk enters and slams the door behind her.\n")
- (define (clerk-act-update-loop clerk message)
- (define (tell-room text)
- (<- (gameobj-loc clerk) 'tell-room
- #:text text
- #:exclude (actor-id clerk)))
- (define (loop-if-not-destructed)
- (if (not (slot-ref clerk 'destructed))
- ;; This iterates by "recursing" on itself by calling itself
- ;; (as the message handler) again. It used to be that we had to do
- ;; this, because there was a bug where a loop which yielded like this
- ;; would keep growing the stack due to some parameter goofiness.
- ;; That's no longer true, but there's an added advantage to this
- ;; route: it's much more live hackable. If we change the definition
- ;; of this method, the character will act differently on the next
- ;; "tick" of the loop.
- (<- (actor-id clerk) 'update-loop)))
- (match (slot-ref clerk 'state)
- ('slacking
- (tell-room (random-choice clerk-slacking-texts))
- (8sleep (+ (random 10) 10))
- (loop-if-not-destructed))
- ('on-duty
- (if (> (slot-ref clerk 'patience) 0)
- ;; Keep working but lose patience gradually
- (begin
- (tell-room (random-choice clerk-working-impatience-texts))
- (slot-set! clerk 'patience (- (slot-ref clerk 'patience)
- (+ (random 2) 1)))
- (8sleep (+ (random 25) 20))
- (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)))
- (tell-room clerk-return-to-slacking-text)
- ;; annnnnd back to slacking
- (slot-set! clerk 'state 'slacking)
- (8sleep (+ (random 30) 15))
- (loop-if-not-destructed))))))
- (define break-room
- (lol
- ('room:break-room
- <room> #f
- #:name "Employee Break Room"
- #:desc " This is less a room and more of an outdoor wire cage. You get
- a bit of a view of the brick exterior of the building, and a crisp wind blows,
- whistling, through the openings of the fenced area. Partly smoked cigarettes
- and various other debris cover the floor.
- Through the wires you can see... well... hm. It looks oddly like
- the scenery tapers off nothingness. But that can't be right, can it?"
- #:exits
- (list (make <exit>
- #:name "north"
- #:to 'room:smoking-parlor))
- )
- ('npc:break-room:desk-clerk
- <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."
- #:goes-by '("hotel desk clerk" "clerk" "desk clerk"))))
- ;;; Ennpie's Sea Lounge
- ;;; -------------------
- ;;; Computer room
- ;;; -------------
- ;;; Game
- ;;; ----
- (define game-spec
- (append lobby grand-hallway smoking-parlor
- playroom break-room))
- ;; TODO: Provide command line args
- (define (run-game . args)
- (run-demo game-spec 'room:lobby #:repl-server #t))
|