#:init-thunk (build-actions
(cmd-read readable-cmd-read))))
-(define (readable-cmd-read actor message)
+(define (readable-cmd-read actor message . _)
(<- (message-from message) 'tell
- #:text (string-append (slot-ref actor 'read-text) "\n")))
+ #:text (slot-ref actor 'read-text)))
;; This one allows you to take from items that are proxied by it
<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.")
+ #:desc '("It looks like you could sign this form and set your name like so: "
+ (i "sign form as <my-name-here>")))
;; Object: curio cabinets
;; TODO: respond to attempts to open the curio cabinet
#:exclude player)
(gameobj-self-destruct gameobj))
+\f
+;;; Grand hallway
+
+(define lobby-map-text
+ "\
+ | : : |
+ .----------.----------. : & : .----------.----------.
+ | computer | |& :YOU ARE: &| smoking | *UNDER* |
+ | room + playroom + : HERE : + parlor | *CONS- |
+ | > | |& : : &| | TRUCTION*|
+ '----------'----------'-++-------++-'-------+--'----------'
+ | '-----' | | |
+ : LOBBY : '---'
+ '. .'
+ '---------'")
+
(define grand-hallway
(lol
('grand-hallway
(make <exit>
#:name "east"
#:to 'smoking-parlor)))
+ ('grand-hallway:map
+ <readable> 'grand-hallway
+ #:name "the hotel map"
+ #:desc '("This appears to be a map of the hotel. "
+ "Like the hotel itself, it seems to be "
+ "incomplete."
+ "You could read it if you want to.")
+ #:read-text `(pre ,lobby-map-text)
+ #:goes-by '("map" "hotel map"))
('grand-hallway:carpet
<gameobj> 'grand-hallway
#:name "the Grand Hallway carpet"
;; 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
#:key direct-obj indir-obj preposition
(player (message-from message)))
(define (tell-room text)
- (<- (gameobj-loc gameobj) 'tell-room
- #:text text))
+ (<-wait (gameobj-loc gameobj) 'tell-room
+ #:text text))
(define (tell-room-excluding-player text)
- (<- (gameobj-loc gameobj) 'tell-room
- #:text text
- #:exclude player))
+ (<-wait (gameobj-loc gameobj) 'tell-room
+ #:text text
+ #:exclude player))
(cond
((ci-member direct-obj '("button" "load button" "load"))
(tell-room-excluding-player
(set! (.state gameobj) 'ready)
(tell-room "The READY light turns on!"))
((loading ready)
- (<- 'tell player
+ (<- player 'tell
#:text '("Pressing the button does nothing right now, "
"but it does feel satisfying.")))))
(else
#:text '((p "You insert the glowing disc into the drive.")
(p "The LOAD button begins to glow."))))))
+;; The computar
+(define-actor <computer> (<gameobj>)
+ ((cmd-run-program computer-run-program)
+ (cmd-run-what (lambda (gameobj message . _)
+ (<- (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\"")))))
+ (commands #:allocation #:each-subclass
+ #:init-thunk (build-commands
+ ("run" ((prep-indir-command cmd-run-program
+ '("on"))
+ (direct-command cmd-run-what))))))
+
+(define* (computer-run-program gameobj message
+ #:key direct-obj indir-obj preposition
+ (player (message-from message)))
+ (define (hd-state)
+ (mbody-val (<-wait (dyn-ref gameobj 'computer-room:hard-drive) 'get-state)))
+ (define (tell-room text)
+ (<-wait (gameobj-loc gameobj) 'tell-room
+ #:text text))
+ (define (tell-room-excluding-player text)
+ (<-wait (gameobj-loc gameobj) 'tell-room
+ #:text text
+ #:exclude player))
+ (define (tell-player text)
+ (<-wait player 'tell
+ #:text text))
+ (cond
+ ((ci-member direct-obj '("program"))
+ (tell-room-excluding-player
+ `(,(mbody-val (<-wait player 'get-name))
+ " runs the program loaded on the computer..."))
+ (tell-player "You run the program on the computer...")
+
+ (cond
+ ((not (eq? (hd-state) 'ready))
+ (tell-room '("... but it errors out. "
+ "It seems to be complaining about a " (b "DISK ERROR!")
+ ". It looks like it is missing some essential software.")))
+ (else
+ (<- (dyn-ref gameobj 'computer-room:floor-panel) 'open-up))))))
+
+
+;; floor panel
+(define-actor <floor-panel> (<gameobj>)
+ ;; TODO: Add "open" verb, since obviously people will try that
+ ((open? (lambda (panel message)
+ (<-reply message (slot-ref panel 'open))))
+ (open-up floor-panel-open-up))
+ (open #:init-value #f))
+
+(define (floor-panel-open-up panel message)
+ (if (slot-ref panel 'open)
+ (<- (gameobj-loc panel) 'tell-room
+ #:text '("You hear some gears grind around the hinges of the "
+ "floor panel, but it appears to already be open."))
+ (begin
+ (slot-set! panel 'open #t)
+ (<- (gameobj-loc panel) 'tell-room
+ #:text '("You hear some gears grind, as the metal panel on "
+ "the ground opens and reveals a stairwell going down!")))))
+
+(define* (floor-panel-desc panel #:optional whos-looking)
+ `("It's a large metal panel on the floor in the middle of the room. "
+ ,(if (slot-ref panel 'open)
+ '("It's currently wide open, revealing a spiraling staircase "
+ "which descends into darkness.")
+ '("It's currently closed shut, but there are clearly hinges, and "
+ "it seems like there is a mechanism which probably opens it via "
+ "some automation. What could be down there?"))))
+
(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."))
+ #:desc (lambda (gameobj whos-looking)
+ (define panel-open
+ (mbody-val (<-wait (dyn-ref gameobj 'computer-room:floor-panel)
+ 'open?)))
+ `((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. "
+ ,(if panel-open
+ '("It is wide open, exposing a spiral staircase "
+ "which descends into darkness.")
+ '("It is closed, but it has hinges which "
+ "suggest it could be opened.")))))
#:exits
(list (make <exit>
#:name "east"
- #:to 'playroom)))
+ #:to 'playroom)
+ (make <exit>
+ #:name "down"
+ #:to 'underground-lab
+ #:traverse-check
+ (lambda (exit room whos-exiting)
+ (define panel-open
+ (mbody-val (<-wait (dyn-ref room 'computer-room:floor-panel)
+ 'open?)))
+ (if panel-open
+ (values #t "You descend the spiral staircase.")
+ (values #f '("You'd love to go down, but the only way "
+ "through is through that metal panel, "
+ "which seems closed.")))))))
('computer-room:hard-drive
<hard-drive> 'computer-room
- #:name "a hard drive"
+ #:name "the hard drive"
#:desc (wrap-apply hard-drive-desc)
- #:goes-by '("hard drive" "drive" "hard disk"))))
+ #:goes-by '("hard drive" "drive" "hard disk"))
+ ('computer-room:computer
+ <computer> 'computer-room
+ #:name "the computer"
+ #:desc '((p "It's a coat closet sized computer labeled \"PDP-11.5\". ")
+ (p "The computer is itself turned on, and it looks like it is "
+ "all set up for you to run a program on it."))
+ #:goes-by '("computer"))
+ ('computer-room:floor-panel
+ <floor-panel> 'computer-room
+ #:name "a floor panel"
+ #:desc (wrap-apply floor-panel-desc)
+ #:invisible? #t
+ #:goes-by '("floor panel" "panel"))))
+
+\f
+;;; * UNDERGROUND SECTION OF THE GAME! *
+
+\f
+;;; The lab
+
+(define underground-map-text
+ "\
+ _______ |
+ .-' @ '-. \\ ?????
+ .' '. .\\
+ | [8sync Hive] |======' '-_____
+ ', M ,'
+ '. @ .'
+ \\ @ /
+ '-__+__-'
+ '. @ .'
+ .--------------. \\ /
+ | [Guile Async | .-------+------.
+ | Museum] | | [Lab] #!#| .-------------.
+ | @| | MM | |[Federation |
+ | & ^ +##+@ || < +##| Station]|
+ | | | @ | | |
+ | & # | |*You-Are-Here*| '-------------'
+ | # ^ | #+-------+------'
+ '-------+------' # #
+ # # #
+ # # .-----------.
+ .-+----. # |# F |
+ |@?+%? +#### | ^ f## |
+ '------' | f f %|
+ |F [Mudsync |
+ | $ 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 '((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.")))))
+
+ ;; map
+ ('underground-lab:map
+ <readable> 'underground-lab
+ #:name "the underground map"
+ #: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"))
+
+ ('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
(define (game-spec)
(append lobby grand-hallway smoking-parlor
- playroom break-room computer-room))
+ playroom break-room computer-room underground-lab))
;; TODO: Provide command line args
(define (run-game . args)
projects / mudsync.git / blobdiff