#:text '((p "As you attempt to pull the shield / disk platter
from the statue a shining outline appears around it... and a
completely separate, glowing copy of the disc materializes into your
-hands!")
- (p "You hear a voice whispering: "
- (i "\"Share the software... and you'll be free...\"")))))
+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 <glowing-disc> (<gameobj>)
#: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
#: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
(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)
;; to distinguish both from the real thing.
(define-actor <hard-drive> (<gameobj>)
- ()
+ ((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, "
"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)
+ (<- (gameobj-loc gameobj) 'tell-room
+ #:text text))
+ (define (tell-room-excluding-player text)
+ (<- (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)
+ (<- 'tell player
+ #: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."))))))
(define computer-room
(lol
projects / mudsync.git / commitdiff