X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;f=worlds%2Fbricabrac.scm;h=6bdadca3e6c6af9a39b898f74e354f314767452b;hb=refs%2Fheads%2F8sync-fibers;hp=701da14fcc8919376b321d7dc415c188968f8a5b;hpb=82398f8a5151d3b33a8ad9c818c0dc9984ad7e53;p=mudsync.git diff --git a/worlds/bricabrac.scm b/worlds/bricabrac.scm index 701da14..6bdadca 100644 --- a/worlds/bricabrac.scm +++ b/worlds/bricabrac.scm @@ -21,6 +21,7 @@ (use-modules (mudsync) (mudsync container) (8sync) + (8sync daydream) (oop goops) (ice-9 control) (ice-9 format) @@ -82,8 +83,7 @@ (for-each (lambda (obj-sym) (define obj-id (dyn-ref gameobj obj-sym)) - (define goes-by - (mbody-val (<-wait obj-id 'goes-by))) + (define goes-by (<-wait obj-id 'goes-by)) (when (ci-member direct-obj goes-by) (<- obj-id 'cmd-take #:direct-obj direct-obj #:player player) (escape #f))) @@ -162,8 +162,7 @@ or 'skribe'? Now *that's* composition!")) (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 old-name (<-wait (message-from message) 'get-name)) (define name indir-obj) (if (valid-name? indir-obj) (begin @@ -193,8 +192,7 @@ character.\n"))) ;; 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))) + (define who-rang (<-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. @@ -446,10 +444,10 @@ from the statue a shining outline appears around it... and a completely separate, glowing copy of the disc materializes into your hands!"))) (<- (gameobj-loc gameobj) 'tell-room - #:text `(,(mbody-val (<-wait player 'get-name)) - " pulls on the shield of the statue, and a glowing " - "copy of it materializes into their hands!") - #:exclude player) + #:text `(,(<-wait player 'get-name) + " pulls on the shield of the statue, and a glowing " + "copy of it materializes into their hands!") + #:exclude player) (<- (gameobj-loc gameobj) 'tell-room #:text '(p "You hear a voice whisper: " @@ -477,8 +475,8 @@ labeled \"RL02.5\".") (player (message-from message))) (<- player 'tell #:text "You drop the glowing disc, and it shatters into a million pieces!") - (<- (mbody-val (<-wait player 'get-loc)) 'tell-room - #:text `(,(mbody-val (<-wait player 'get-name)) + (<- (<-wait player 'get-loc) 'tell-room + #:text `(,(<-wait player 'get-name) " drops a glowing disc, and it shatters into a million pieces!") #:exclude player) (gameobj-self-destruct gameobj)) @@ -616,10 +614,10 @@ platter! It has \"RL02.5\" written on it. It looks kind of loose." (<-wait player 'tell #:text '("You start the rube goldberg machine.")) (<-wait (gameobj-loc rgb-machine) 'tell-room - #:text `(,(mbody-val (<-wait player 'get-name)) + #:text `(,(<-wait player 'get-name) " runs the rube goldberg machine.") #:exclude player) - (8sleep 1) + (daydream 1) (match (.rgb-items rgb-machine) ((first-item rest ...) (<- (dyn-ref rgb-machine first-item) 'trigger)))) @@ -632,18 +630,18 @@ platter! It has \"RL02.5\" written on it. It looks kind of loose." (<-wait player 'tell #:text '("You reset the rube goldberg machine.")) (<-wait (gameobj-loc rgb-machine) 'tell-room - #:text `(,(mbody-val (<-wait player 'get-name)) + #:text `(,(<-wait player 'get-name) " resets the rube goldberg machine.") #:exclude player) (<-wait (gameobj-loc rgb-machine) 'tell-room #:text '("From a panel in the wall, a white gloved mechanical " "arm reaches out to reset all the " "rube goldberg components.")) - (8sleep (/ 1 2)) + (daydream (/ 1 2)) (for-each (lambda (rgb-item) (<- (dyn-ref rgb-machine rgb-item) 'reset) - (8sleep (/ 1 2))) + (daydream (/ 1 2))) (.rgb-items rgb-machine)) (<- (gameobj-loc rgb-machine) 'tell-room #:text "The machine's mechanical arm retreats into the wall!") @@ -684,7 +682,7 @@ platter! It has \"RL02.5\" written on it. It looks kind of loose." (<- room 'tell-room #:text str)) ;; A number? Sleep for that many secs ((? number? num) - (8sleep num)) + (daydream num)) ;; A symbol? That's another gameobj to look up dynamically ((? symbol? sym) (<- (dyn-ref rgb-item sym) 'trigger @@ -742,7 +740,7 @@ platter! It has \"RL02.5\" written on it. It looks kind of loose." (<- room 'tell-room #:text '((i "*kshhhhhh!*") " The water has boiled!")) - (8sleep .25) + (daydream .25) (set! (.state rgb-item) 'ran) ;; insert a cup of hot tea in the room (create-gameobj (gameobj-gm rgb-item) room) @@ -791,8 +789,8 @@ platter! It has \"RL02.5\" written on it. It looks kind of loose." (define (hot-tea-cmd-drink hot-tea message . _) (define player (message-from message)) - (define player-loc (mbody-val (<-wait player 'get-loc))) - (define player-name (mbody-val (<-wait player 'get-name))) + (define player-loc (<-wait player 'get-loc)) + (define player-name (<-wait player 'get-name)) (<- player 'tell #:text "You drink a steaming cup of hot tea all at once... hot hot hot!") (<- player-loc 'tell-room @@ -803,8 +801,8 @@ platter! It has \"RL02.5\" written on it. It looks kind of loose." (define (hot-tea-cmd-sip hot-tea message . _) (define player (message-from message)) - (define player-loc (mbody-val (<-wait player 'get-loc))) - (define player-name (mbody-val (<-wait player 'get-name))) + (define player-loc (<-wait player 'get-loc)) + (define player-name (<-wait player 'get-name)) (set! (.sips-left hot-tea) (- (.sips-left hot-tea) 1)) (<- player 'tell #:text "You take a sip of your steaming hot tea. How refined!") @@ -873,8 +871,7 @@ if this room is intended for children or child-like adults.") ,(if (eq? contents '()) " nothing! It's empty!" `(ul ,(map (lambda (occupant) - `(li ,(mbody-val - (<-wait occupant 'get-name)))) + `(li ,(<-wait occupant 'get-name))) (gameobj-occupants toy-chest)))))))) #:take-from-me? #t #:put-in-me? #t) @@ -907,8 +904,7 @@ if this room is intended for children or child-like adults.") ,(if (eq? contents '()) " nothing! It's empty!" `(ul ,(map (lambda (occupant) - `(li ,(mbody-val - (<-wait occupant 'get-name)))) + `(li ,(<-wait occupant 'get-name))) (gameobj-occupants toy-chest))))))))) ;; Things inside the toy chest @@ -1048,7 +1044,7 @@ What could happen if you started it?") (define* (furniture-cmd-sit actor message #:key direct-obj) (define player-name - (mbody-val (<-wait (message-from message) 'get-name))) + (<-wait (message-from message) 'get-name)) (<- (message-from message) 'tell #:text (format #f "You ~a ~a.\n" (slot-ref actor 'sit-phrase) @@ -1273,7 +1269,7 @@ You can ask me about the following: (define* (clerk-cmd-dismiss clerk message . _) (define player-name - (mbody-val (<-wait (message-from message) 'get-name))) + (<-wait (message-from message) 'get-name)) (match (slot-ref clerk 'state) ('on-duty (<- (gameobj-loc clerk) 'tell-room @@ -1335,7 +1331,7 @@ if you need further help.") (match (slot-ref clerk 'state) ('slacking (tell-room (random-choice clerk-slacking-texts)) - (8sleep (+ (random 20) 15)) + (daydream (+ (random 20) 15)) (loop-if-not-destructed)) ('on-duty (if (> (slot-ref clerk 'patience) 0) @@ -1344,7 +1340,7 @@ if you need further help.") (tell-room (random-choice clerk-working-impatience-texts)) (slot-set! clerk 'patience (- (slot-ref clerk 'patience) (+ (random 2) 1))) - (8sleep (+ (random 60) 40)) + (daydream (+ (random 60) 40)) (loop-if-not-destructed)) ;; Back to slacking (begin @@ -1354,7 +1350,7 @@ if you need further help.") (tell-room clerk-return-to-slacking-text) ;; annnnnd back to slacking (slot-set! clerk 'state 'slacking) - (8sleep (+ (random 30) 15)) + (daydream (+ (random 30) 15)) (loop-if-not-destructed)))))) @@ -1422,7 +1418,7 @@ the paint, but the wires themselves seem to be unusually sturdy." #:accessor .state)) (define (hard-drive-act-get-state hard-drive message) - (<-reply message (.state hard-drive))) + (.state hard-drive)) (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.") @@ -1455,7 +1451,7 @@ the paint, but the wires themselves seem to be unusually sturdy." (cond ((ci-member direct-obj '("button" "load button" "load")) (tell-room-excluding-player - `(,(mbody-val (<-wait player 'get-name)) + `(,(<-wait player 'get-name) " presses the button on the hard disk.")) (<- player 'tell #:text "You press the button on the hard disk.") @@ -1465,14 +1461,14 @@ the paint, but the wires themselves seem to be unusually sturdy." ;; I have no idea what this drive did when you didn't have a platter ;; in it and pressed load, but I know there was a FAULT button. (tell-room "You hear some movement inside the hard drive...") - (8sleep 1.5) + (daydream 1.5) (tell-room '("... but then the FAULT button blinks a couple times. " "What could be missing?"))) ((with-disc) (set! (.state gameobj) 'loading) (tell-room "The hard disk begins to spin up!") - (8sleep 2) + (daydream 2) (set! (.state gameobj) 'ready) (tell-room "The READY light turns on!")) ((loading ready) @@ -1492,10 +1488,10 @@ the paint, but the wires themselves seem to be unusually sturdy." (call/ec (lambda (return) (for-each (lambda (occupant) - (define goes-by (mbody-val (<-wait occupant 'goes-by))) + (define goes-by (<-wait occupant 'goes-by)) (when (ci-member direct-obj goes-by) (return occupant))) - (mbody-val (<-wait player 'get-occupants))) + (<-wait player 'get-occupants)) ;; nothing found #f))) (cond @@ -1503,10 +1499,10 @@ the paint, but the wires themselves seem to be unusually sturdy." (<- player 'tell #:text `("You don't seem to have any such " ,direct-obj " to put " ,preposition " " ,our-name "."))) - ((not (mbody-val (<-wait this-thing 'get-prop 'hd-platter?))) + ((not (<-wait this-thing 'get-prop 'hd-platter?)) (<- player 'tell #:text `("It wouldn't make sense to put " - ,(mbody-val (<-wait this-thing 'get-name)) + ,(<-wait this-thing 'get-name) " " ,preposition " " ,our-name "."))) ((not (eq? (.state gameobj) 'empty)) (<- player 'tell @@ -1543,7 +1539,7 @@ the paint, but the wires themselves seem to be unusually sturdy." #: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))) + (<-wait (dyn-ref gameobj 'computer-room:hard-drive) 'get-state)) (define (tell-room text) (<-wait (gameobj-loc gameobj) 'tell-room #:text text)) @@ -1557,7 +1553,7 @@ the paint, but the wires themselves seem to be unusually sturdy." (cond ((ci-member direct-obj '("program")) (tell-room-excluding-player - `(,(mbody-val (<-wait player 'get-name)) + `(,(<-wait player 'get-name) " runs the program loaded on the computer...")) (tell-player "You run the program on the computer...") @@ -1574,7 +1570,7 @@ the paint, but the wires themselves seem to be unusually sturdy." (define-actor () ;; TODO: Add "open" verb, since obviously people will try that ((open? (lambda (panel message) - (<-reply message (slot-ref panel 'open)))) + (slot-ref panel 'open))) (open-up floor-panel-open-up)) (open #:init-value #f)) @@ -1605,8 +1601,8 @@ the paint, but the wires themselves seem to be unusually sturdy." #:name "Computer Room" #:desc (lambda (gameobj whos-looking) (define panel-open - (mbody-val (<-wait (dyn-ref gameobj 'computer-room:floor-panel) - 'open?))) + (<-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.") @@ -1626,8 +1622,8 @@ the paint, but the wires themselves seem to be unusually sturdy." #:traverse-check (lambda (exit room whos-exiting) (define panel-open - (mbody-val (<-wait (dyn-ref room 'computer-room:floor-panel) - 'open?))) + (<-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 " @@ -1743,8 +1739,14 @@ is a map detailing the layout of the underground structure.")) (values #f '("Ooh, if only you could go south and check this out! " "Unfortunately this whole area is sealed off... the proprietor " "probably never got around to fixing it. " - "Too bad, it would have had monsters to fight and everything!")))))) - + "Too bad, it would have had monsters to fight and everything!")))) + (make + #:name "southwest" + #:traverse-check + (lambda (exit room whos-exiting) + (values #f '("Hm, it's one of those revolving doors that only revolves in " + "one direction, and it isn't this one. You guess that while " + "this doesn't appear to be an entrance, it probably is an exit.")))))) ;; map ('underground-lab:map 'underground-lab @@ -1937,11 +1939,18 @@ as well as an exit leading to the south.")) ('gift-shop #f #:name "Museum Gift Shop" - #:desc "foo" + #:desc '("There are all sorts of scrolls and knicknacks laying around here, " + "but they all seem glued in place and instead of a person manning the shop " + "there's merely a cardboard cutout of a person with a \"shopkeeper\" nametag. " + "You can pretty well bet that someone wanted to finish this room but ran out of " + "time.") #:exits (list (make #:name "northeast" - #:to 'underground-lab) + #:to 'underground-lab + #:traverse-check + (lambda (exit room whos-exiting) + (values #t '("The revolving door spins as you walk through it. Whee!")))) (make #:name "north" #:to 'async-museum)))))