Inserting the disc and all that finally works
authorChristopher Allan Webber <cwebber@dustycloud.org>
Mon, 30 Jan 2017 05:37:25 +0000 (23:37 -0600)
committerChristopher Allan Webber <cwebber@dustycloud.org>
Mon, 30 Jan 2017 05:37:25 +0000 (23:37 -0600)
worlds/bricabrac.scm

index 49fcff0e236ca894f3240ea407de1ed073dff134..bd953aa6d6a17d4cf8e447d6bbb16e71ddd19b2b 100644 (file)
@@ -425,9 +425,16 @@ this general shape in the 1990s."
       #: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>)
@@ -450,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
@@ -798,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
@@ -917,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)
@@ -976,11 +986,21 @@ the paint, but the wires themselves seem to be unusually sturdy."
 ;; 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, "
@@ -993,8 +1013,86 @@ 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)
+    (<- (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