cleaning up hackthena's shield a bit
[mudsync.git] / worlds / bricabrac.scm
index 442e87d225ebd996641f1d91fe3ebd71099a1044..3f71ce71aef194b94786bc7012c023403654fd39 100644 (file)
@@ -19,8 +19,8 @@
 ;;; Hotel Bricabrac
 
 (use-modules (mudsync)
 ;;; Hotel Bricabrac
 
 (use-modules (mudsync)
-             (8sync actors)
-             (8sync agenda)
+             (mudsync container)
+             (8sync)
              (oop goops)
              (ice-9 control)
              (ice-9 format)
              (oop goops)
              (ice-9 control)
              (ice-9 format)
       #:text (string-append (slot-ref actor 'read-text) "\n")))
 
 
       #:text (string-append (slot-ref actor 'read-text) "\n")))
 
 
+;; This one allows you to take from items that are proxied by it
+(define-actor <proxy-items> (<gameobj>)
+  ((cmd-take-from take-from-proxy))
+  (proxy-items #:init-keyword #:proxy-items))
+
+(define* (take-from-proxy gameobj message
+                          #:key direct-obj indir-obj preposition
+                          (player (message-from message)))
+  (call/ec
+   (lambda (escape)
+     (for-each
+      (lambda (obj-sym)
+        (define obj-id (dyn-ref gameobj obj-sym))
+        (define goes-by
+          (mbody-val (<-wait obj-id 'goes-by)))
+        (when (ci-member direct-obj goes-by)
+          (<- obj-id 'cmd-take #:direct-obj direct-obj #:player player)
+          (escape #f)))
+      (slot-ref gameobj 'proxy-items))
+
+     (<- player 'tell
+        #:text `("You don't see any such " ,direct-obj " to take "
+                 ,preposition " " ,(slot-ref gameobj 'name) ".")))))
+
+
 \f
 ;;; Lobby
 ;;; -----
 \f
 ;;; Lobby
 ;;; -----
@@ -106,6 +131,7 @@ or 'skribe'?  Now *that's* composition!"))
    #:allocation #:each-subclass
    #:init-thunk (build-commands
                  ("sign" ((prep-direct-command cmd-sign-form '("as"))))))
    #:allocation #:each-subclass
    #:init-thunk (build-commands
                  ("sign" ((prep-direct-command cmd-sign-form '("as"))))))
+
   (actions #:allocation #:each-subclass
            #:init-thunk (build-actions
                          (cmd-sign-form sign-cmd-sign-in))))
   (actions #:allocation #:each-subclass
            #:init-thunk (build-actions
                          (cmd-sign-form sign-cmd-sign-in))))
@@ -189,6 +215,13 @@ character.\n")))
     "How can you have money if none of you produces anything?"
     "On no account allow Arthur to request tea on this ship."))
 
     "How can you have money if none of you produces anything?"
     "On no account allow Arthur to request tea on this ship."))
 
+(define-class <cabinet-item> (<gameobj>)
+  (take-me? #:init-value
+            (lambda _
+              (values #f #:why-not
+                      `("Hm, well... the cabinet is locked and the properitor "
+                        "is right over there.")))))
+
 (define lobby
   (lol
    ('lobby
 (define lobby
   (lol
    ('lobby
@@ -247,11 +280,23 @@ Classy!"
     #:desc "  A shiny brass bell.  Inscribed on its wooden base is the text
 \"ring me for service\".  You probably could \"ring the bell\" if you 
 wanted to."
     #:desc "  A shiny brass bell.  Inscribed on its wooden base is the text
 \"ring me for service\".  You probably could \"ring the bell\" if you 
 wanted to."
-    #:summons 'break-desk-clerk)
+    #:summons 'break-room:desk-clerk)
+
+   ('lobby:sign-in-form
+    <sign-in-form> 'lobby
+    #:name "sign-in form"
+    #:goes-by '("sign-in form" "form" "signin form")
+    #:desc "It looks like you could sign this form and set your name.")
 
    ;; Object: curio cabinets
 
    ;; Object: curio cabinets
+   ;; TODO: respond to attempts to open the curio cabinet
    ('lobby:cabinet
    ('lobby:cabinet
-    <gameobj> 'lobby
+    <proxy-items> 'lobby
+    #:proxy-items '(lobby:porcelain-doll
+                    lobby:1950s-robots
+                    lobby:tea-set lobby:mustard-pot
+                    lobby:head-of-elvis lobby:circuitboard-of-evlis
+                    lobby:teletype-scroll lobby:orange-cat-phone)
     #:name "a curio cabinet"
     #:goes-by '("curio cabinet" "cabinet" "bricabrac cabinet"
                 "cabinet of curiosities")
     #:name "a curio cabinet"
     #:goes-by '("curio cabinet" "cabinet" "bricabrac cabinet"
                 "cabinet of curiosities")
@@ -267,21 +312,16 @@ Ooh, ~a!" (random-choice
              "the pickled circuitboard of EVLIS"
              "a scroll of teletype paper holding the software Four Freedoms"
              "a telephone shaped like an orange cartoon cat")))))
              "the pickled circuitboard of EVLIS"
              "a scroll of teletype paper holding the software Four Freedoms"
              "a telephone shaped like an orange cartoon cat")))))
-   ('lobby:sign-in-form
-    <sign-in-form> 'lobby
-    #:name "sign-in form"
-    #:goes-by '("sign-in form" "form" "signin form")
-    #:desc "It looks like you could sign this form and set your name.")
 
    ('lobby:porcelain-doll
 
    ('lobby:porcelain-doll
-    <gameobj> 'lobby
+    <cabinet-item> 'lobby
     #:invisible? #t
     #:name "a creepy porcelain doll"
     #:desc "It strikes you that while the doll is technically well crafted,
 it's also the stuff of nightmares."
     #:goes-by '("porcelain doll" "doll"))
    ('lobby:1950s-robots
     #:invisible? #t
     #:name "a creepy porcelain doll"
     #:desc "It strikes you that while the doll is technically well crafted,
 it's also the stuff of nightmares."
     #:goes-by '("porcelain doll" "doll"))
    ('lobby:1950s-robots
-    <gameobj> 'lobby
+    <cabinet-item> 'lobby
     #:invisible? #t
     #:name "a set of 1950s robots"
     #:desc "There's a whole set of these 1950s style robots.
     #:invisible? #t
     #:name "a set of 1950s robots"
     #:desc "There's a whole set of these 1950s style robots.
@@ -289,7 +329,7 @@ They seem to be stamped out of tin, and have various decorations of levers
 and buttons and springs.  Some of them have wind-up knobs on them."
     #:goes-by '("robot" "robots" "1950s robot" "1950s robots"))
    ('lobby:tea-set
 and buttons and springs.  Some of them have wind-up knobs on them."
     #:goes-by '("robot" "robots" "1950s robot" "1950s robots"))
    ('lobby:tea-set
-    <gameobj> 'lobby
+    <cabinet-item> 'lobby
     #:invisible? #t
     #:name "a tea set"
     #:desc "A complete tea set.  Some of the cups are chipped.
     #:invisible? #t
     #:name "a tea set"
     #:desc "A complete tea set.  Some of the cups are chipped.
@@ -297,7 +337,7 @@ You can imagine yourself joining a tea party using this set, around a
 nice table with some doilies, drinking some Earl Grey tea, hot.  Mmmm."
     #:goes-by '("tea set" "tea"))
    ('lobby:mustard-pot
 nice table with some doilies, drinking some Earl Grey tea, hot.  Mmmm."
     #:goes-by '("tea set" "tea"))
    ('lobby:mustard-pot
-    <gameobj> 'lobby
+    <cabinet-item> 'lobby
     #:invisible? #t
     #:name "a mustard pot"
     #:desc '((p "It's a mustard pot.  I mean, it's kind of cool, it has a
     #:invisible? #t
     #:name "a mustard pot"
     #:desc '((p "It's a mustard pot.  I mean, it's kind of cool, it has a
@@ -306,7 +346,7 @@ like this in a museum.")
              (p "Ha... imagine that... a mustard museum."))
     #:goes-by '("mustard pot" "antique mustard pot" "mustard"))
    ('lobby:head-of-elvis
              (p "Ha... imagine that... a mustard museum."))
     #:goes-by '("mustard pot" "antique mustard pot" "mustard"))
    ('lobby:head-of-elvis
-    <gameobj> 'lobby
+    <cabinet-item> 'lobby
     #:invisible? #t
     #:name "the pickled head of Elvis"
     #:desc '((p "It's a jar full of some briny-looking liquid and...
     #:invisible? #t
     #:name "the pickled head of Elvis"
     #:desc '((p "It's a jar full of some briny-looking liquid and...
@@ -320,7 +360,7 @@ everything you read."))
     #:goes-by '("pickled head of elvis" "pickled head of Elvis"
                 "elvis" "Elvis" "head" "pickled head"))
    ('lobby:circuitboard-of-evlis
     #:goes-by '("pickled head of elvis" "pickled head of Elvis"
                 "elvis" "Elvis" "head" "pickled head"))
    ('lobby:circuitboard-of-evlis
-    <gameobj> 'lobby
+    <cabinet-item> 'lobby
     #:invisible? #t
     #:name "the pickled circuitboard of Evlis"
     #:desc '((p "It's a circuitboard from a Lisp Machine called EVLIS.
     #:invisible? #t
     #:name "the pickled circuitboard of Evlis"
     #:desc '((p "It's a circuitboard from a Lisp Machine called EVLIS.
@@ -334,7 +374,7 @@ Too bad..."))
                 "pickled circuitboard of EVLIS"
                 "evlis" "Evlis" "EVLIS" "circuitboard" "pickled circuitboard"))
    ('lobby:teletype-scroll
                 "pickled circuitboard of EVLIS"
                 "evlis" "Evlis" "EVLIS" "circuitboard" "pickled circuitboard"))
    ('lobby:teletype-scroll
-    <gameobj> 'lobby
+    <cabinet-item> 'lobby
     #:invisible? #t
     #:name "a scroll of teletype"
     #:desc '((p "This is a scroll of teletype paper.  It's a bit old
     #:invisible? #t
     #:name "a scroll of teletype"
     #:desc '((p "This is a scroll of teletype paper.  It's a bit old
@@ -355,7 +395,7 @@ English language surrounding the word 'free' have lead to a lot of terminology d
                 "scroll of teletype paper holding the software Four Freedoms"
                 "scroll of teletype paper holding the software four freedoms"))
    ('lobby:orange-cat-phone
                 "scroll of teletype paper holding the software Four Freedoms"
                 "scroll of teletype paper holding the software four freedoms"))
    ('lobby:orange-cat-phone
-    <gameobj> 'lobby
+    <cabinet-item> 'lobby
     #:invisible? #t
     #:name "a telephone shaped like an orange cartoon cat"
     #:desc "It's made out of a cheap plastic, and it's very orange.
     #:invisible? #t
     #:name "a telephone shaped like an orange cartoon cat"
     #:desc "It's made out of a cheap plastic, and it's very orange.
@@ -373,28 +413,45 @@ this general shape in the 1990s."
 ;;; Grand hallway
 ;;; -------------
 
 ;;; Grand hallway
 ;;; -------------
 
-(define-actor <hackthena> (<gameobj>)
-  ((cmd-take-from hackthena-take-from-proxy)))
-
-(define* (hackthena-take-from-proxy gameobj message
-                                    #:key direct-obj indir-obj preposition
-                                    (player (message-from message)))
-  (call/ec
-   (lambda (escape)
-     (for-each
-      (lambda (obj-sym)
-        (define obj-id (dyn-ref gameobj obj-sym))
-        (define goes-by
-          (mbody-val (<-wait obj-id 'goes-by)))
-        (when (ci-member direct-obj goes-by)
-          (<- obj-id 'cmd-take #:direct-obj direct-obj #:player player)
-          (escape)))
-      '(grand-hallway:keyboard
-        grand-hallway:disc-platter grand-hallway:hackthena-horns))
-
-     (<- player 'tell
-         #:text
-         `("Hackthena doesn't appear to be holding " ,direct-obj ".")))))
+(define-actor <disc-shield> (<gameobj>)
+  ((cmd-take disc-shield-take)))
+
+(define* (disc-shield-take gameobj message
+                           #:key direct-obj
+                           (player (message-from message)))
+  (create-gameobj <glowing-disc> (gameobj-gm gameobj)
+                  player)  ;; set loc to player to put in player's inventory
+  (<- player 'tell
+      #:text '((p "As you attempt to pull the shield / disk platter
+from the statue, there is a bright glow...  and a completely separate,
+glowing copy of the disc materializes into your hands!")
+               (p "You hear a voice whispering in your ear: "
+                  (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>)
+  ((cmd-drop glowing-disc-drop-cmd))
+  (initial-props
+   #:allocation #:each-subclass
+   #:init-thunk (build-props
+                 '((hd-platter? . #t))))
+  (name #:allocation #:each-subclass
+        #:init-value "a glowing disc")
+  (desc #:allocation #:each-subclass
+        #:init-value "A brightly glowing disc.  It's shaped like a hard
+drive platter, not unlike the one from the statue it came from.  It's
+labeled \"RL02.5\".")
+  (goes-by #:init-value '("glowing disc" "glowing platter"
+                          "glowing disc platter" "glowing disk platter"
+                          "platter" "disc" "disk" "glowing shield")))
+
+(define* (glowing-disc-drop-cmd gameobj message
+                   #:key direct-obj
+                   (player (message-from message)))
+  (<- player 'tell
+      #:text "You drop the glowing disc, and it shatters into a million
+pieces!")
+  (gameobj-self-destruct gameobj))
 
 (define grand-hallway
   (lol
 
 (define grand-hallway
   (lol
@@ -433,7 +490,7 @@ but there's no indication of who they are."
     #:invisible? #t
     #:goes-by '("busts" "bust" "busts of serious people" "bust of serious person"))
    ('grand-hallway:hackthena-statue
     #:invisible? #t
     #:goes-by '("busts" "bust" "busts of serious people" "bust of serious person"))
    ('grand-hallway:hackthena-statue
-    <hackthena> 'grand-hallway
+    <proxy-items> 'grand-hallway
     #:name "the statue of Hackthena"
     #:desc '((p "The base of the statue says \"Hackthena, guardian of the hacker
 spirit\".  You've heard of Hackthena... not a goddess, but spiritual protector of
     #:name "the statue of Hackthena"
     #:desc '((p "The base of the statue says \"Hackthena, guardian of the hacker
 spirit\".  You've heard of Hackthena... not a goddess, but spiritual protector of
@@ -444,7 +501,10 @@ head, wears a pair of horn-rimmed glasses, and appears posed as if for battle.
 But instead of a weapon, she seems to hold some sort of keyboard.  And her
 shield... well it's round like a shield, but something seems off about it.
 You'd better take a closer look to be sure."))
 But instead of a weapon, she seems to hold some sort of keyboard.  And her
 shield... well it's round like a shield, but something seems off about it.
 You'd better take a closer look to be sure."))
-    #:goes-by '("hackthena statue" "hackthena" "statue" "statue of hackthena"))
+    #:goes-by '("hackthena statue" "hackthena" "statue" "statue of hackthena")
+    #:proxy-items '(grand-hallway:keyboard
+                    grand-hallway:disc-platter
+                    grand-hallway:hackthena-horns))
    ('grand-hallway:keyboard
     <gameobj> 'grand-hallway
     #:name "a Knight Keyboard"
    ('grand-hallway:keyboard
     <gameobj> 'grand-hallway
     #:name "a Knight Keyboard"
@@ -471,12 +531,12 @@ Hackthena must be an emacs user."
                          `("Are you seriously considering desecrating a statue?")))
     #:goes-by '("hackthena's horns" "horns" "horns of hacktena"))
    ('grand-hallway:disc-platter
                          `("Are you seriously considering desecrating a statue?")))
     #:goes-by '("hackthena's horns" "horns" "horns of hacktena"))
    ('grand-hallway:disc-platter
-    <gameobj> 'grand-hallway
-    #:name "a hard disc platter"
-    #:desc "This isn't a shield after all, it seems to be a hard disc
-platter!  It looks kind of loose..."
+    <disc-shield> 'grand-hallway
+    #:name "Hackthena's shield"
+    #:desc "This isn't a shield after all, it seems to be a hard disk
+platter!  It has \"RL02.5\" written on it.  It looks kind of loose..."
     #:invisible? #t
     #:invisible? #t
-    #:goes-by '("hard disc platter" "disc platter" "disc" "shield" "platter"))))
+    #:goes-by '("hackthena's shield" "shield" "platter"))))
 
 \f
 ;;; Playroom
 
 \f
 ;;; Playroom
@@ -487,12 +547,16 @@ platter!  It looks kind of loose..."
    ('playroom
     <room> #f
     #:name "The Playroom"
    ('playroom
     <room> #f
     #:name "The Playroom"
-    #:desc "  There are toys scattered everywhere here.  It's really unclear
-if this room is intended for children or child-like adults."
+    #:desc '(p ("  There are toys scattered everywhere here.  It's really unclear
+if this room is intended for children or child-like adults.")
+               ("  There are doors to both the east and the west."))
     #:exits
     (list (make <exit>
             #:name "east"
     #:exits
     (list (make <exit>
             #:name "east"
-            #:to 'grand-hallway)))
+            #:to 'grand-hallway)
+          (make <exit>
+            #:name "west"
+            #:to 'computer-room)))
    ('playroom:cubey
     <gameobj> 'playroom
     #:name "Cubey"
    ('playroom:cubey
     <gameobj> 'playroom
     #:name "Cubey"
@@ -506,7 +570,7 @@ if this room is intended for children or child-like adults."
     #:desc "  A warm and fuzzy cuddles plushie!  It's a cuddlefish!")
 
    ('playroom:toy-chest
     #:desc "  A warm and fuzzy cuddles plushie!  It's a cuddlefish!")
 
    ('playroom:toy-chest
-    <gameobj> 'playroom
+    <container> 'playroom
     #:name "a toy chest"
     #:goes-by '("toy chest" "chest")
     #:desc (lambda (toy-chest whos-looking)
     #:name "a toy chest"
     #:goes-by '("toy chest" "chest")
     #:desc (lambda (toy-chest whos-looking)
@@ -906,13 +970,59 @@ the paint, but the wires themselves seem to be unusually sturdy."
 ;;; Computer room
 ;;; -------------
 
 ;;; Computer room
 ;;; -------------
 
+;; Our computer and hard drive are based off the PDP-11 and the RL01 /
+;; RL02 disk drives.  However we increment both by .5 (a true heresy)
+;; to distinguish both from the real thing.
+
+(define-actor <hard-drive> (<gameobj>)
+  ()
+  ;; the state moves from: empty -> with-disc -> loading -> ready
+  (state #:init-value 'empty
+         #:accessor .state))
+
+(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, "
+       ,(if (eq? (.state hard-drive) 'empty)
+            "which is currently empty"
+            "which contains a glowing platter")
+       ". There is a LOAD button "
+       ,(if (member (.state hard-drive) '(empty with-disc))
+            "which is glowing"
+            "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."))))
+
+(define computer-room
+  (lol
+   ('computer-room
+    <room> #f
+    #:name "Computer Room"
+    #:desc '((p "A sizable computer cabinet covers a good portion of the left
+wall.  It emits a pleasant hum which covers the room like a warm blanket.
+Connected to a computer is a large hard drive.")
+             (p "On the floor is a large steel panel.  It is closed, but it has
+hinges which suggest it could be opened."))
+    #:exits
+    (list (make <exit>
+            #:name "east"
+            #:to 'playroom)))
+   ('computer-room:hard-drive
+    <hard-drive> 'computer-room
+    #:name "a hard drive"
+    #:desc (wrap-apply hard-drive-desc)
+    #:goes-by '("hard drive" "drive" "hard disk"))))
+
+
 \f
 ;;; Game
 ;;; ----
 
 (define (game-spec)
   (append lobby grand-hallway smoking-parlor
 \f
 ;;; Game
 ;;; ----
 
 (define (game-spec)
   (append lobby grand-hallway smoking-parlor
-          playroom break-room))
+          playroom break-room computer-room))
 
 ;; TODO: Provide command line args
 (define (run-game . args)
 
 ;; TODO: Provide command line args
 (define (run-game . args)