#: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
#: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
#: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"))))
+
+
+(define underground-lab
+ (lol
+ ('underground-lab
+ <room> #f
+ #:name "Underground laboratory"
+ #:desc '("This appears to be some sort of underground laboratory. "
+ )
+ #:exits
+ (list (make <exit>
+ #:name "up"
+ #:to 'computer-room)))))
\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