;;; -----
(define (npc-chat-randomly actor message . _)
+ (define catchphrase
+ (random-choice (slot-ref actor 'catchphrases)))
(define text-to-send
- (format #f "~a says: \"~a\"\n"
- (slot-ref actor 'name)
- (random-choice (slot-ref actor 'catchphrases))))
+ ((slot-ref actor 'chat-format) actor catchphrase))
(<- (message-from message) 'tell
#:text text-to-send))
(define-class <chatty-npc> (<gameobj>)
(catchphrases #:init-value '("Blarga blarga blarga!")
#:init-keyword #:catchphrases)
+ (chat-format #:init-value (lambda (npc catchphrase)
+ `(,(slot-ref npc 'name) " says: \""
+ ,catchphrase "\""))
+ #:init-keyword #:chat-format)
(commands
#:allocation #:each-subclass
#:init-thunk (build-commands
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:cups
+ <cabinet-item> 'lobby
+ #:invisible? #t
+ #:name "cups from the tea set"
+ #:desc "They're chipped."
+ #:goes-by '("cups"))
('lobby:mustard-pot
<cabinet-item> 'lobby
#:invisible? #t
#:catchphrases prefect-quotes)
('smoking-parlor:no-smoking-sign
- <gameobj> 'smoking-parlor
+ <readable> '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."
- #:goes-by '("no smoking sign" "sign"))
-
+ #:goes-by '("no smoking sign" "sign")
+ #:read-text "It says \"No Smoking\", just like you'd expect from
+a No Smoking sign.")
;; TODO: Cigar dispenser
))
;; 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
+(define changing-name-text "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!")
+
+(define phd-text
+ "Ah... when I'm not here, I've got a PHD to finish.")
+
+(define clerk-help-topics
+ `(("changing name" . ,changing-name-text)
+ ("sign-in form" . ,changing-name-text)
+ ("form" . ,changing-name-text)
("common commands" .
"Here are some useful commands you might like to try: chat,
go, take, drop, say...")
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.")))
+feel free to walk around and explore.")
+ ("physics paper" . ,phd-text)
+ ("paper" . ,phd-text)
+ ("proprietor" . "Oh, he's that frumpy looking fellow sitting over there.")))
(define clerk-knows-about
(<- (message-from message) 'tell
#:text '("The computer is already running, and a program appears "
"ready to run."
- "you mean to \"run the program on the computer\"")))))
+ "you mean to \"run the program on the computer\""))))
+ (cmd-help-run-not-press
+ (lambda (gameobj message . _)
+ (<- (message-from message) 'tell
+ #:text '("You don't need to press / push / flip anything. "
+ "You could " (i "run program on computer")
+ " already if you wanted to.")))))
(commands #:allocation #:each-subclass
#:init-thunk (build-commands
("run" ((prep-indir-command cmd-run-program
'("on"))
- (direct-command cmd-run-what))))))
+ (direct-command cmd-run-what)))
+ (("press" "push" "flip")
+ ((prep-indir-command cmd-help-run-not-press))))))
(define* (computer-run-program gameobj message
#:key direct-obj indir-obj preposition
| $ Swamp] |
'-----------'")
+(define 8sync-design-goals
+ '(ul (li (b "Actor based, shared nothing environment: ")
+ "Shared resources are hard to control and result in fighting
+deadlocks, etc. Escape the drudgery: only one actor controls a resource,
+and they only receive one message at a time (though they can \"juggle\"
+messages).")
+ (li (b "Live hackable: ")
+ "It's hard to plan out a concurrent system; the right structure
+is often found by evolving the system while it runs. Make it easy to
+build, shape, and change a running system, as well as observe and correct
+errors.")
+ (li (b "No callback hell: ")
+ "Just because you're calling out to some other asynchronous
+code doesn't mean you should need to chop up your program into a bunch of bits.
+Clever use of delimited continuations makes it easy.")))
+
(define underground-lab
(lol
('underground-lab
<room> #f
#:name "Underground laboratory"
- #:desc '("This appears to be some sort of underground laboratory. "
- )
+ #:desc '((p "This appears to be some sort of underground laboratory."
+ "There is a spiral staircase here leading upwards, where "
+ "it seems much brighter.")
+ (p "There are a number of doors leading in different directions:
+north, south, east, and west, as well as a revolving door to the southwest.
+It looks like it could be easy to get lost, but luckily there
+is a map detailing the layout of the underground structure."))
#:exits
(list (make <exit>
#:name "up"
#:to 'computer-room
#:traverse-check
(lambda (exit room whos-exiting)
- (values #t "You climb the spiral staircase.")))))
+ (values #t "You climb the spiral staircase.")))
+ (make <exit>
+ #:name "west"
+ #:to 'async-museum
+ #:traverse-check
+ (lambda (exit room whos-exiting)
+ (values #t '("You head west through a fancy-looking entrance. "
+ "A security guard steps aside for you to pass through, "
+ "into the room, then stands in front of the door."))))
+ (make <exit>
+ #:name "north"
+ #:to 'hive-entrance)))
- ;; Test tubes
;; map
('underground-lab:map
<readable> 'underground-lab
#:desc '("This appears to be a map of the surrounding area. "
"You could read it if you want to.")
#:read-text `(pre ,underground-map-text)
- #:goes-by '("map" "underground map" "lab map"))))
+ #:goes-by '("map" "underground map" "lab map"))
+ ('underground-lab:8sync-sign
+ <readable> 'underground-lab
+ #:name "a sign labeled \"8sync design goals\""
+ #:goes-by '("sign" "8sync design goals sign" "8sync sign")
+ #:read-text 8sync-design-goals
+ #:desc `((p "The sign says:")
+ ,8sync-design-goals))))
+\f
+;;; guile async museum
+(define async-museum
+ (list
+ (list
+ 'async-museum
+ <room> #f
+ #:name "Guile Asynchronous Museum"
+ #:desc '((p "You're in the Guile Asynchronous Museum. There is a list of exhibits
+on the wall near the entrance. Scattered around the room are the exhibits
+themselves, but it's difficult to pick them out. Maybe you should read the list
+to orient yourself.")
+ (p "There is a door to the east, watched by a security guard,
+as well as an exit leading to the south."))
+ #:exits (list
+ (make <exit>
+ #:name "south"
+ #:to 'gift-shop)
+ (make <exit>
+ #:name "east"
+ #:to 'underground-lab
+ #:traverse-check
+ (lambda (exit room whos-exiting)
+ (values #f '("The security guard stops you and tells you "
+ "that the only exit is through the gift shop."))))))
+ (list
+ 'async-museum:security-guard
+ <chatty-npc> 'async-museum
+ #:name "a security guard"
+ #:desc
+ '(p "The security guard is blocking the eastern entrance, where "
+ "you came in from.")
+ #:goes-by '("security guard" "guard" "security")
+ #:catchphrases '("It's hard standing here all day."
+ "I just want to go home."
+ "The exhibits are nice, but I've seen them all before."))
+ (let ((placard
+ `((p "Welcome to our humble museum! The exhibits are listed below. "
+ (br)
+ "To look at one, simply type: " (i "look at <exhibit-name>"))
+ (p "Available exhibits:")
+ (ul ,@(map (lambda (exhibit)
+ `(li ,exhibit))
+ '("2016 Progress"
+ "8sync and Fibers"
+ "Suspendable Ports"
+ "The Actor Model"))))))
+ (list
+ 'async-museum:list-of-exhibits
+ <readable> 'async-museum
+ #:name "list of exhibits"
+ #:desc
+ `((p "It's a list of exibits in the room. The placard says:")
+ ,@placard)
+ #:goes-by '("list of exhibits" "exhibit list" "list" "exhibits")
+ #:read-text placard))
+ (let ((desc
+ '((p "It's a three-piece exhibit, with three little dioramas and some text "
+ "explaining what they represent. They are:")
+ (ul (li (b "Late 2015/Early 2016 talk: ")
+ "This one explains the run-up conversation from late 2015 "
+ "and early 2016 about the need for an "
+ "\"asynchronous event loop for Guile\". The diorama "
+ "is a model of the Veggie Galaxy restaurant where after "
+ "the FSF 30th anniversary party; Mark Weaver, Christopher "
+ "Allan Webber, David Thompson, and Andrew Engelbrecht chat "
+ "about the need for Guile to have an answer to asynchronous "
+ "programming. A mailing list post " ; TODO: link it?
+ "summarizing the discussion is released along with various "
+ "conversations around what is needed, as well as further "
+ "discussion at FOSDEM 2016.")
+ (li (b "Early implementations: ")
+ "This one shows Chris Webber's 8sync and Chris Vine's "
+ "guile-a-sync, both appearing in late 2015 and evolving "
+ "into their basic designs in early 2016. It's less a diorama "
+ "than a printout of some mailing list posts. Come on, the "
+ "curators could have done better with this one.")
+ (li (b "Suspendable ports and Fibers: ")
+ "The diorama shows Andy Wingo furiously hacking at his keyboard. "
+ "The description talks about Wingo's mailing list thread "
+ "about possibly breaking Guile compatibility for a \"ports refactor\". "
+ "Wingo releases Fibers, another asynchronous library, making use of "
+ "the new interface, and 8sync and guile-a-sync "
+ "quickly move to support suspendable ports as well. "
+ "The description also mentions that there is an exhibit entirely "
+ "devoted to suspendable ports."))
+ (p "Attached at the bottom is a post it note mentioning "
+ "https integration landing in Guile 2.2."))))
+ (list
+ 'async-museum:2016-progress-exhibit
+ <readable> 'async-museum
+ #:name "2016 Progress Exhibit"
+ #:goes-by '("2016 progress exhibit" "2016 progress" "2016 exhibit")
+ #:desc desc
+ #:read-text desc))
+ (let ((desc
+ '((p "This exhibit is a series of charts explaining the similarities "
+ "and differences between 8sync and Fibers, two asynchronous programming "
+ "libraries for GNU Guile. It's way too wordy, but you get the general gist.")
+ (p (b "Similarities:")
+ (ul (li "Both use Guile's suspendable-ports facility")
+ (li "Both use message passing")))
+ (p (b "Differences:")
+ (ul (li "Fibers \"processes\" can read from multiple \"channels\", "
+ "but 8sync actors only read from one \"inbox\" each.")
+ (li "Different theoretical basis:"
+ (ul (li "Fibers: based on CSP (Communicating Sequential Processes), "
+ "a form of Process Calculi")
+ (li "8sync: based on the Actor Model")
+ (li "Luckily CSP and the Actor Model are \"dual\"!")))))
+ (p "Fibers is also designed by Andy Wingo, an excellent compiler hacker, "
+ "whereas 8sync is designed by Chris Webber, who built this crappy "
+ "hotel simulator."))))
+ (list
+ 'async-museum:8sync-and-fibers-exhibit
+ <readable> 'async-museum
+ #:name "8sync and Fibers Exhibit"
+ #:goes-by '("8sync and fibers exhibit" "8sync exhibit" "fibers exhibit")
+ #:desc desc
+ #:read-text desc))
+ (let ((desc
+ '((p "This exhibit is a series of charts explaining the similarities "
+ "and differences between 8sync and Fibers, two asynchronous programming "
+ "libraries for GNU Guile. It's way too wordy, but you get the general gist.")
+ (p (b "Similarities:")
+ (ul (li "Both use Guile's suspendable-ports facility")
+ (li "Both use message passing")))
+ (p (b "Differences:")
+ (ul (li "Fibers \"processes\" can read from multiple \"channels\", "
+ "but 8sync actors only read from one \"inbox\" each.")
+ (li "Different theoretical basis:"
+ (ul (li "Fibers: based on CSP (Communicating Sequential Processes), "
+ "a form of Process Calculi")
+ (li "8sync: based on the Actor Model")
+ (li "Luckily CSP and the Actor Model are \"dual\"!")))))
+ (p "Fibers is also designed by Andy Wingo, an excellent compiler hacker, "
+ "whereas 8sync is designed by Chris Webber, who built this crappy "
+ "hotel simulator."))))
+ (list
+ 'async-museum:8sync-and-fibers-exhibit
+ <readable> 'async-museum
+ #:name "8sync and Fibers Exhibit"
+ #:goes-by '("8sync and fibers exhibit" "8sync exhibit" "fibers exhibit")
+ #:desc desc
+ #:read-text desc))
+ (list
+ 'async-museum:suspendable-ports-exhibit
+ <gameobj> 'async-museum
+ #:name "Suspendable Ports Exhibit"
+ #:goes-by '("suspendable ports exhibit" "ports exhibit"
+ "suspendable exhibit" "suspendable ports" "ports")
+ #:desc
+ '((p "Suspendable ports are a new feature in Guile 2.2, and allows code "
+ "that would normally block on IO to " (i "automatically") " suspend "
+ "to the scheduler until information is ready to be read/written!")
+ (p "Yow! You might barely need to change your existing blocking code!")
+ (p "Fibers, 8sync, and guile-a-sync now support suspendable ports.")))
+ (list
+ 'async-museum:actor-model-exhibit
+ <gameobj> 'async-museum
+ #:name "Actor Model Exhibit"
+ #:goes-by '("actor model exhibit" "actor exhibit"
+ "actor model")
+ #:desc
+ '((p "Here are some fact(oids) about the actor model!")
+ (ul (li "Concieved initially by Carl Hewitt in early 1970s")
+ (li "\"A society of experts\"")
+ (li "shared nothing, message passing")
+ (li "Originally the research goal of Scheme! "
+ "(message passing / lambda anecdote here)")
+ (li "Key concepts consistent, but implementation details vary widely")
+ (li "Almost all distributed systems can be viewed in terms of actor model")
+ (li "Replaced by vanilla lambdas & generic methods? "
+ "Maybe not if address space not shared!"))))))
+
+(define gift-shop
+ (lol
+ ('gift-shop
+ <room> #f
+ #:name "Museum Gift Shop"
+ #:desc "foo"
+ #:exits (list
+ (make <exit>
+ #:name "northeast"
+ #:to 'underground-lab)
+ (make <exit>
+ #:name "north"
+ #:to 'async-museum)))))
+\f
+;;; Hive entrance
+
+(define actor-descriptions
+ '("This one is fused to the side of the hive. It isn't receiving any
+messages, and it seems to be in hibernation."
+ "A chat program glows in front of this actor's face. They seem to
+be responding to chat messages and forwarding them to some other actors,
+and forwarding messages from other actors back to the chat."
+ "This actor is bossing around other actors, delegating tasks to them
+as it receives requests, and providing reports on the worker actors'
+progress."
+ "This actor is trying to write to some device, but the device keeps
+alternating between saying \"BUSY\" or \"READY\". Whenever it says
+\"BUSY\" the actor falls asleep, and whenever it says \"READY\" it
+seems to wake up again and starts writing to the device."
+ "Whoa, this actor is totally wigging out! It seems to be throwing
+some errors. It probably has some important work it should be doing
+but you're relieved to see that it isn't grinding the rest of the Hive
+to a halt."))
+
+(define hive-entrance
+ (lol
+ ('hive-entrance
+ <room> #f
+ #:name "Entrance to the 8sync Hive"
+ #:desc
+ '((p "Towering before you is the great dome-like 8sync Hive, or at least
+one of them. You've heard about this... the Hive is itself the actor that all
+the other actors attach themselves to. It's shaped like a spherical half-dome.
+There are some actors milling about, and some seem fused to the side of the
+hive itself, but all of them have an umbellical cord attached to the hive from
+which you see flashes of light comunicating what must be some sort of messaging
+protocol.")
+ (p "To the south is a door leading back to the underground lab.
+North leads into the Hive itself."))
+ #:exits
+ (list (make <exit>
+ #:name "south"
+ #:to 'underground-lab)
+ (make <exit>
+ #:name "north"
+ #:to 'hive-inside)))
+ ('hive-entrance:hive
+ <gameobj> 'hive-entrance
+ #:name "the Hive"
+ #:goes-by '("hive")
+ #:desc
+ '((p "It's shaped like half a sphere embedded in the ground.
+Supposedly, while all actors are autonomous and control their own state,
+they communicate through the hive itself, which is a sort of meta-actor.
+There are rumors that actors can speak to each other even across totally
+different hives. Could that possibly be true?")))
+ ('hive-entrance:actor
+ <chatty-npc> 'hive-entrance
+ #:name "some actors"
+ #:goes-by '("actor" "actors" "some actors")
+ #:chat-format (lambda (npc catchphrase)
+ `((p "You pick one actor out of the mix and chat with it. ")
+ (p "It says: \"" ,catchphrase "\"")))
+ #:desc
+ (lambda _
+ `((p "There are many actors, but your eyes focus on one in particular.")
+ (p ,(random-choice actor-descriptions))))
+ #:catchphrases
+ '("Yeah we go through a lot of sleep/awake cycles around here.
+If you aren't busy processing a message, what's the point of burning
+valuable resources?"
+ "I know I look like I'm some part of dreary collective, but
+really we have a lot of independence. It's a shared nothing environment,
+after all. (Well, except for CPU cycles, and memory, and...)"
+ "Shh! I've got another message coming in and I've GOT to
+handle it!"
+ "I just want to go to 8sleep already."
+ "What a lousy scheduler we're using! I hope someone upgrades
+that thing soon."))))
+
+;;; Inside the hive
\f
;;; Game
(define (game-spec)
(append lobby grand-hallway smoking-parlor
- playroom break-room computer-room underground-lab))
+ playroom break-room computer-room underground-lab
+ async-museum gift-shop hive-entrance))
;; TODO: Provide command line args
(define (run-game . args)
projects / mudsync.git / blobdiff