From 669edc75ebfbb547053f4aa0a67be6c3754ccb65 Mon Sep 17 00:00:00 2001 From: Christopher Allan Webber Date: Sat, 4 Feb 2017 11:36:17 -0600 Subject: [PATCH] rube goldberg machine (with intentional error) --- worlds/bricabrac.scm | 313 ++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 312 insertions(+), 1 deletion(-) diff --git a/worlds/bricabrac.scm b/worlds/bricabrac.scm index 8ea7451..ba6f3e9 100644 --- a/worlds/bricabrac.scm +++ b/worlds/bricabrac.scm @@ -597,6 +597,218 @@ platter! It has \"RL02.5\" written on it. It looks kind of loose." ;;; Playroom ;;; -------- +(define-actor () + ((cmd-run rgb-machine-cmd-run) + (cmd-reset rgb-machine-cmd-reset)) + (commands + #:allocation #:each-subclass + #:init-thunk (build-commands + (("run" "start") ((direct-command cmd-run))) + ("reset" ((direct-command cmd-reset))))) + (resetting #:init-value #f + #:accessor .resetting) + ;; used to reset, and to kick off the first item in the list + (rgb-items #:init-keyword #:rgb-items + #:accessor .rgb-items)) + +(define (rgb-machine-cmd-run rgb-machine message . _) + (define player (message-from message)) + (<-wait player 'tell + #:text '("You start the rube goldberg machine.")) + (<-wait (gameobj-loc rgb-machine) 'tell-room + #:text `(,(mbody-val (<-wait player 'get-name)) + " runs the rube goldberg machine.") + #:exclude player) + (8sleep 1) + (match (.rgb-items rgb-machine) + ((first-item rest ...) + (<- (dyn-ref rgb-machine first-item) 'trigger)))) + +(define (rgb-machine-cmd-reset rgb-machine message . _) + (define player (message-from message)) + (cond + ((not (.resetting rgb-machine)) + (set! (.resetting rgb-machine) #t) + (<-wait player 'tell + #:text '("You reset the rube goldberg machine.")) + (<-wait (gameobj-loc rgb-machine) 'tell-room + #:text `(,(mbody-val (<-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)) + (for-each + (lambda (rgb-item) + (<- (dyn-ref rgb-machine rgb-item) 'reset) + (8sleep (/ 1 2))) + (.rgb-items rgb-machine)) + (<- (gameobj-loc rgb-machine) 'tell-room + #:text "The machine's mechanical arm retreats into the wall!") + (set! (.resetting rgb-machine) #f)) + (else + (<-wait player 'tell + #:text '("But it's in the middle of resetting right now!"))))) + +(define-actor () + ((trigger rgb-item-trigger) + (reset rgb-item-reset)) + (invisible? #:init-value #t) + (steps #:init-keyword #:steps + #:accessor .steps) + (triggers-as #:init-value #f + #:init-keyword #:triggers-as + #:getter .triggers-as) + (reset-msg #:init-keyword #:reset-msg + #:getter .reset-msg) + ;; States: ready -> running -> ran + (state #:init-value 'ready + #:accessor .state)) + + +(define (rgb-item-trigger rgb-item message . _) + (define room (gameobj-loc rgb-item)) + (case (.state rgb-item) + ((ready) + ;; Set state to running + (set! (.state rgb-item) 'running) + + ;; Loop through all steps + (for-each + (lambda (step) + (match step + ;; A string? That's the description of what's happening, tell players + ((? string? str) + (<- room 'tell-room #:text str)) + ;; A number? Sleep for that many secs + ((? number? num) + (8sleep num)) + ;; A symbol? That's another gameobj to look up dynamically + ((? symbol? sym) + (<- (dyn-ref rgb-item sym) 'trigger + #:triggered-by (.triggers-as rgb-item))) + (_ (throw 'unknown-step-type + "Don't know how to process rube goldberg machine step type?" + #:step step)))) + (.steps rgb-item)) + + ;; We're done! Set state to ran + (set! (.state rgb-item) 'ran)) + + (else + (<- room 'tell-room + #:text `("... but " ,(slot-ref rgb-item 'name) + " has already been triggered!"))))) + +(define (rgb-item-reset rgb-item message . _) + (define room (gameobj-loc rgb-item)) + (case (.state rgb-item) + ((ran) + (set! (.state rgb-item) 'ready) + (<- room 'tell-room + #:text (.reset-msg rgb-item))) + ((running) + (<- room 'tell-room + #:text `("... but " ,(slot-ref rgb-item 'name) + " is currently running!"))) + ((ready) + (<- room 'tell-room + #:text `("... but " ,(slot-ref rgb-item 'name) + " has already been reset."))))) + +(define-actor () + ((trigger rgb-kettle-trigger) + (reset rgb-kettle-reset)) + (heated #:accessor .heated + #:init-value #f) + (filled #:accessor .filled + #:init-value #f)) + +(define* (rgb-kettle-trigger rgb-item message #:key triggered-by) + (define room (gameobj-loc rgb-item)) + (if (not (eq? (.state rgb-item) 'ran)) + (begin + (match triggered-by + ('water-demon + (set! (.state rgb-item) 'running) + (set! (.filled rgb-item) #t)) + ('quik-heater + (set! (.state rgb-item) 'running) + (set! (.heated rgb-item) #t))) + (when (and (.filled rgb-item) + (.heated rgb-item)) + (<- room 'tell-room + #:text '((i "*kshhhhhh!*") + " The water has boiled!")) + (8sleep .25) + (set! (.state rgb-item) 'ran) + ;; insert a cup of hot tea in the room + (create-gameobj (gameobj-gm rgb-item) room) + (<- room 'tell-room + #:text '("The machine pours out a cup of hot tea! " + "Looks like the machine finished!")))) + (<- room 'tell-room + #:text `("... but " ,(slot-ref rgb-item 'name) + " has already been triggered!")))) + +(define (rgb-kettle-reset rgb-item message . rest-args) + (define room (gameobj-loc rgb-item)) + (when (eq? (.state rgb-item) 'ran) + (set! (.heated rgb-item) #f) + (set! (.filled rgb-item) #f)) + (apply rgb-item-reset rgb-item message rest-args)) + +(define-actor () + ((cmd-drink hot-tea-cmd-drink) + (cmd-sip hot-tea-cmd-sip) + (cmd-gotta-hold hot-tea-cmd-gotta-hold)) + (contained-commands + #:allocation #:each-subclass + #:init-thunk (build-commands + ("drink" ((direct-command cmd-drink))) + ("sip" ((direct-command cmd-sip))))) + + (sips-left #:init-value 4 + #:accessor .sips-left) + (name #:init-value "a cup of hot tea") + (take-me? #:init-value #t) + (goes-by #:init-value '("cup of hot tea" "cup of tea" "tea" "cup")) + (desc #:init-value "It's a steaming cup of hot tea. It looks pretty good!")) + +(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))) + (<- player 'tell + #:text "You drink a steaming cup of hot tea all at once... hot hot hot!") + (<- player-loc 'tell-room + #:text `(,player-name + " drinks a steaming cup of hot tea all at once.") + #:exclude player) + (gameobj-self-destruct hot-tea)) + +(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))) + (set! (.sips-left hot-tea) (- (.sips-left hot-tea) 1)) + (<- player 'tell + #:text "You take a sip of your steaming hot tea. How refined!") + (<- player-loc 'tell-room + #:text `(,player-name + " takes a sip of their steaming hot tea. How refined!") + #:exclude player) + (when (= (.sips-left hot-tea) 0) + (<- player 'tell + #:text "You've finished your tea!") + (<- player-loc 'tell-room + #:text `(,player-name + " finishes their tea!") + #:exclude player) + (gameobj-self-destruct hot-tea))) + (define playroom (lol ('playroom @@ -648,7 +860,106 @@ if this room is intended for children or child-like adults.") #:name "a rubber duck" #:goes-by '("rubber duck" "duck") #:take-me? #t - #:desc "It's a yellow rubber duck with a bright orange beak."))) + #:desc "It's a yellow rubber duck with a bright orange beak.") + + ('playroom:rgb-machine + 'playroom + #:name "a Rube Goldberg machine" + #:goes-by '("rube goldberg machine" "machine") + #:rgb-items '(playroom:rgb-dominoes + playroom:rgb-switch-match + playroom:rgb-candle + playroom:rgb-catapult + playroom:rgb-water-demon + playroom:rgb-quik-heater + playroom:rgb-kettle) + #:desc "It's one of those hilarious Rube Goldberg machines. +What could happen if you started it?") + + ;; Dominoes topple + ('playroom:rgb-dominoes + 'playroom + #:name "some dominoes" + #:goes-by '("dominoes" "some dominoes") + #:steps `("The dominoes topple down the line..." + 1 + "The last domino lands on a switch!" + 1.5 + playroom:rgb-switch-match) + #:reset-msg "The dominoes are placed back into position.") + + ;; Which hit the switch and strike a match + ('playroom:rgb-switch-match + 'playroom + #:name "a switch" + #:goes-by '("switch" "match") + #:steps `("The switch lights a match!" + ,(/ 2 3) + "The match lights a candle!" + 1.5 + playroom:rgb-candle) + #:reset-msg "A fresh match is installed and the switch is reset.") + ;; which lights a candle and burns a rope + ('playroom:rgb-candle + 'playroom + #:name "a candle" + #:goes-by '("candle") + #:steps `("The candle burns..." + (/ 2 3) ; oops! + "The candle is burning away a rope!" + 2 + "The rope snaps!" + .5 + playroom:rgb-catapult) + #:reset-msg "A fresh candle is installed.") + ;; which catapults a rock + ('playroom:rgb-catapult + 'playroom + #:name "a catapult" + #:goes-by '("catapult") + #:steps `("The snapped rope unleashes a catapult, which throws a rock!" + 2 + "The rock flies through a water demon, startling it!" + .5 + playroom:rgb-water-demon + 2 + "The rock whacks into the quik-heater's on button!" + .5 + playroom:rgb-quik-heater) + #:reset-msg + '("A fresh rope is attached to the catapult, which is pulled taught. " + "A fresh rock is placed on the catapult.")) + ;; which both: + ;; '- panics the water demon + ;; '- which waters the kettle + ('playroom:rgb-water-demon + 'playroom + #:name "the water demon" + #:triggers-as 'water-demon + #:goes-by '("water demon" "demon") + #:steps `("The water demon panics, and starts leaking water into the kettle below!" + 3 + "The kettle is filled!" + playroom:rgb-kettle) + #:reset-msg '("The water demon is scratched behind the ears and calms down.")) + ;; '- bops the quik-heater button + ;; '- which heats the kettle + ('playroom:rgb-quik-heater + 'playroom + #:name "the quik heater" + #:triggers-as 'quik-heater + #:goes-by '("quik heater" "heater") + #:steps `("The quik-heater heats up the kettle above it!" + 3 + "The kettle is heated up!" + playroom:rgb-kettle) + #:reset-msg '("The quik heater is turned off.")) + ;; Finally, the kettle + ('playroom:rgb-kettle + 'playroom + #:name "the kettle" + #:goes-by '("kettle") + #:reset-msg '("The kettle is emptied.")))) -- 2.31.1