+ "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 <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?"))))