finishing unfinished comment
[mudsync.git] / worlds / bricabrac.scm
index 548db77b0540cf9f1866dda90bbbf6ee840a076e..ee0ff08806fee83f987274839ce00123df610225 100644 (file)
@@ -19,6 +19,7 @@
 ;;; Hotel Bricabrac
 
 (use-modules (mudsync)
 ;;; Hotel Bricabrac
 
 (use-modules (mudsync)
+             (mudsync container)
              (8sync actors)
              (8sync agenda)
              (oop goops)
              (8sync actors)
              (8sync agenda)
              (oop goops)
       #: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)))
+      (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
 ;;; -----
@@ -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
@@ -249,9 +282,20 @@ Classy!"
 wanted to."
     #:summons 'break-desk-clerk)
 
 wanted to."
     #:summons 'break-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
    ('lobby:cabinet
    ;; Object: curio cabinets
    ('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 +311,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 +328,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 +336,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 +345,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 +359,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 +373,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 +394,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,31 +412,6 @@ this general shape in the 1990s."
 ;;; Grand hallway
 ;;; -------------
 
 ;;; Grand hallway
 ;;; -------------
 
-(define-actor <hackthena> (<gameobj>)
-  ((cmd-take-from hackthena-cmd-take-from)))
-
-(define* (hackthena-cmd-take-from gameobj message
-                                  #:key direct-obj indir-obj preposition
-                                  (player (message-from message)))
-  (define keyboard-goes-by
-    (mbody-val (<-wait (dyn-ref gameobj 'grand-hallway:keyboard) 'goes-by)))
-  (define disc-platter-goes-by
-    (mbody-val (<-wait (dyn-ref gameobj 'grand-hallway:disc-platter) 'goes-by)))
-
-  (cond ((member direct-obj keyboard-goes-by)
-         (<- player 'tell
-             #:text `("Are you kidding?  Do you know how hard it is to find "
-                      "a Knight Keyboard?  There's no way she's going "
-                      "to give that up.")))
-        ((member direct-obj disc-platter-goes-by)
-         'TODO)
-        (else
-         (<- player 'tell
-             #:text
-             `("Hackthena doesn't appear to be holding " ,direct-obj
-               ".")))))
-
-
 (define grand-hallway
   (lol
    ('grand-hallway
 (define grand-hallway
   (lol
    ('grand-hallway
@@ -421,9 +435,22 @@ room\", while a door to the west is labeled \"playroom\"."))
           (make <exit>
             #:name "east"
             #:to 'smoking-parlor)))
           (make <exit>
             #:name "east"
             #:to 'smoking-parlor)))
+   ('grand-hallway:carpet
+    <gameobj> 'grand-hallway
+    #:name "the Grand Hallway carpet"
+    #:desc "It's very red, except in the places where it's very worn."
+    #:invisible? #t
+    #:goes-by '("red carpet" "carpet"))
+   ('grand-hallway:busts
+    <gameobj> 'grand-hallway
+    #:name "the busts of serious people"
+    #:desc "There are about 6 of them in total.  They look distinguished
+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
    ('grand-hallway:hackthena-statue
-    <hackthena> 'grand-hallway
-    #:name "a statue"
+    <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
 all good hacks, and legendary hacker herself.")
     #: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
 all good hacks, and legendary hacker herself.")
@@ -433,7 +460,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"
@@ -442,7 +472,23 @@ Any space cadet can see that with that kind of layout a hack-and-slayer could
 thrash out some serious key-chords like there's no tomorrow.  You guess
 Hackthena must be an emacs user."
     #:invisible? #t
 thrash out some serious key-chords like there's no tomorrow.  You guess
 Hackthena must be an emacs user."
     #:invisible? #t
+    #:take-me? (lambda _
+                 (values #f
+                         #:why-not
+                         `("Are you kidding?  Do you know how hard it is to find "
+                              "a Knight Keyboard?  There's no way she's going "
+                              "to give that up.")))
     #:goes-by '("knight keyboard" "keyboard"))
     #:goes-by '("knight keyboard" "keyboard"))
+   ('grand-hallway:hackthena-horns
+    <gameobj> 'grand-hallway
+    #:name "Hackthena's horns"
+    #:desc "They're not unlike a Gnu's horns."
+    #:invisible? #t
+    #:take-me? (lambda _
+                 (values #f
+                         #:why-not
+                         `("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"
    ('grand-hallway:disc-platter
     <gameobj> 'grand-hallway
     #:name "a hard disc platter"
@@ -468,18 +514,18 @@ if this room is intended for children or child-like adults."
             #:to 'grand-hallway)))
    ('playroom:cubey
     <gameobj> 'playroom
             #:to 'grand-hallway)))
    ('playroom:cubey
     <gameobj> 'playroom
-    #:name "cubey"
+    #:name "Cubey"
     #:take-me? #t
     #:desc "  It's a little foam cube with googly eyes on it.  So cute!")
    ('playroom:cuddles-plushie
     <gameobj> 'playroom
     #:take-me? #t
     #:desc "  It's a little foam cube with googly eyes on it.  So cute!")
    ('playroom:cuddles-plushie
     <gameobj> 'playroom
-    #:name "a cuddles plushie"
+    #:name "a Cuddles plushie"
     #:goes-by '("plushie" "cuddles plushie" "cuddles")
     #:take-me? #t
     #:desc "  A warm and fuzzy cuddles plushie!  It's a cuddlefish!")
 
    ('playroom:toy-chest
     #:goes-by '("plushie" "cuddles plushie" "cuddles")
     #:take-me? #t
     #: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)