X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=worlds%2Fbricabrac.scm;h=582e7019e9071630441528e14cf97e6fbeb4939b;hp=0c92246a82c485e113e99b363f47eec3a55a0967;hb=1c10b6fdd8662522b6a2103f7ad59c588acfa2dc;hpb=bbeef9fc42f1fa6edad329de0fed1fc3865445c4 diff --git a/worlds/bricabrac.scm b/worlds/bricabrac.scm index 0c92246..582e701 100644 --- a/worlds/bricabrac.scm +++ b/worlds/bricabrac.scm @@ -423,10 +423,18 @@ this general shape in the 1990s." player) ;; set loc to player to put in player's inventory (<- player 'tell #:text '((p "As you attempt to pull the shield / disk platter -from the statue, there is a bright glow... and a completely separate, -glowing copy of the disc materializes into your hands!") - (p "You hear a voice whispering in your ear: " - (i "\"Share the software... and you'll be free...\""))))) +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) + (<- (gameobj-loc gameobj) 'tell-room + #:text + '(p "You hear a voice whisper: " + (i "\"Share the software... and you'll be free...\"")))) ;;; This is the disc that gets put in the player's inventory (define-actor () @@ -449,8 +457,11 @@ labeled \"RL02.5\".") #:key direct-obj (player (message-from message))) (<- player 'tell - #:text "You drop the glowing disc, and it shatters into a million -pieces!") + #: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)) + " drops a glowing disc, and it shatters into a million pieces!") + #:exclude player) (gameobj-self-destruct gameobj)) (define grand-hallway @@ -536,7 +547,7 @@ Hackthena must be an emacs user." #:desc "No wonder the \"shield\" looks unusual... it seems to be a hard disk platter! It has \"RL02.5\" written on it. It looks kind of loose." #:invisible? #t - #:goes-by '("hackthena's shield" "shield" "platter")))) + #:goes-by '("hackthena's shield" "shield" "platter" "hard disk platter")))) ;;; Playroom @@ -797,7 +808,7 @@ with tuition at where it is...")) #:allow-other-keys) (match (slot-ref clerk 'state) ('on-duty - (match (assoc (pk 'indir indir-obj) clerk-help-topics) + (match (assoc indir-obj clerk-help-topics) ((_ . info) (<- (message-from message) 'tell #:text @@ -916,7 +927,7 @@ if you need further help.") (begin (tell-room clerk-slack-excuse-text) ;; back bto the break room - (gameobj-set-loc! clerk (pk 'break-room (dyn-ref clerk 'break-room))) + (gameobj-set-loc! clerk (dyn-ref clerk 'break-room)) (tell-room clerk-return-to-slacking-text) ;; annnnnd back to slacking (slot-set! clerk 'state 'slacking) @@ -975,11 +986,21 @@ the paint, but the wires themselves seem to be unusually sturdy." ;; to distinguish both from the real thing. (define-actor () - () + ((cmd-put-in hard-drive-insert) + (cmd-push-button hard-drive-push-button) + (get-state hard-drive-act-get-state)) + (commands #:allocation #:each-subclass + #:init-thunk (build-commands + ("insert" ((prep-indir-command cmd-put-in + '("in" "inside" "into")))) + (("press" "push") ((prep-indir-command cmd-push-button))))) ;; the state moves from: empty -> with-disc -> loading -> ready (state #:init-value 'empty #:accessor .state)) +(define (hard-drive-act-get-state hard-drive message) + (<-reply message (.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.") (p "There is a slot where a disk platter could be inserted, " @@ -992,8 +1013,159 @@ the paint, but the wires themselves seem to be unusually sturdy." "which is pressed in and unlit") ". There is a READY indicator " ,(if (eq? (.state hard-drive) 'ready) - "which is glowing. The machine emits a gentle whirring noise." - "which is unlit.")))) + "which is glowing." + "which is unlit.") + ,(if (member (.state hard-drive) '(loading ready)) + " The machine emits a gentle whirring noise." + "")))) + +(define* (hard-drive-push-button gameobj message + #:key direct-obj indir-obj preposition + (player (message-from message))) + (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)) + (cond + ((ci-member direct-obj '("button" "load button" "load")) + (tell-room-excluding-player + `(,(mbody-val (<-wait player 'get-name)) + " presses the button on the hard disk.")) + (<- player 'tell + #:text "You press the button on the hard disk.") + + (case (.state gameobj) + ((empty) + ;; 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) + (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) + (set! (.state gameobj) 'ready) + (tell-room "The READY light turns on!")) + ((loading ready) + (<- player 'tell + #:text '("Pressing the button does nothing right now, " + "but it does feel satisfying."))))) + (else + (<- player 'tell + #:text '("How could you think of pressing anything else " + "but that tantalizing button right in front of you?"))))) + +(define* (hard-drive-insert gameobj message + #:key direct-obj indir-obj preposition + (player (message-from message))) + (define our-name (slot-ref gameobj 'name)) + (define this-thing + (call/ec + (lambda (return) + (for-each (lambda (occupant) + (define goes-by (mbody-val (<-wait occupant 'goes-by))) + (when (ci-member direct-obj goes-by) + (return occupant))) + (mbody-val (<-wait player 'get-occupants))) + ;; nothing found + #f))) + (cond + ((not this-thing) + (<- 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?))) + (<- player 'tell + #:text `("It wouldn't make sense to put " + ,(mbody-val (<-wait this-thing 'get-name)) + " " ,preposition " " ,our-name "."))) + ((not (eq? (.state gameobj) 'empty)) + (<- player 'tell + #:text "The disk drive already has a platter in it.")) + (else + (set! (.state gameobj) 'with-disc) + (<- player 'tell + #:text '((p "You insert the glowing disc into the drive.") + (p "The LOAD button begins to glow.")))))) + +;; The computar +(define-actor () + ((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 () + ;; 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 @@ -1011,9 +1183,22 @@ hinges which suggest it could be opened.")) #:to 'playroom))) ('computer-room: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-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 + 'computer-room + #:name "a floor panel" + #:desc (wrap-apply floor-panel-desc) + #:invisible? #t + #:goes-by '("floor panel" "panel"))))