X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=worlds%2Fbricabrac.scm;h=8d3e03a9f8018d67843f7dcb7bd9036cd6b38981;hp=bd953aa6d6a17d4cf8e447d6bbb16e71ddd19b2b;hb=f3e31bf75eb6da69f50a2824050c240ae2a9cc9f;hpb=c89d058e1fcd7b786f0511bd9d5aafb49b7ef0ec diff --git a/worlds/bricabrac.scm b/worlds/bricabrac.scm index bd953aa..8d3e03a 100644 --- a/worlds/bricabrac.scm +++ b/worlds/bricabrac.scm @@ -1023,12 +1023,12 @@ the paint, but the wires themselves seem to be unusually sturdy." #: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 @@ -1053,7 +1053,7 @@ the paint, but the wires themselves seem to be unusually sturdy." (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 @@ -1094,6 +1094,79 @@ the paint, but the wires themselves seem to be unusually sturdy." #: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 ('computer-room @@ -1107,12 +1180,51 @@ hinges which suggest it could be opened.")) #:exits (list (make #:name "east" - #:to 'playroom))) + #:to 'playroom) + (make + #: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 '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")))) + + +(define underground-lab + (lol + ('underground-lab + #f + #:name "Underground laboratory" + #:desc '("This appears to be some sort of underground laboratory. " + ) + #:exits + (list (make + #:name "up" + #:to 'computer-room))))) @@ -1121,7 +1233,7 @@ hinges which suggest it could be opened.")) (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)