computer / panel / etc added

diff --git a/worlds/bricabrac.scm b/worlds/bricabrac.scm
index 085822681aede781b2ae326cd68d622f56029bd7..582e7019e9071630441528e14cf97e6fbeb4939b 100644 (file)
--- 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
@@ -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 <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
@@ -1110,9 +1183,22 @@ hinges which suggest it could be opened."))
             #:to 'playroom)))
    ('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"))))
 
 
 \f