Add proxy-items as its own little class
authorChristopher Allan Webber <cwebber@dustycloud.org>
Sat, 28 Jan 2017 21:58:27 +0000 (15:58 -0600)
committerChristopher Allan Webber <cwebber@dustycloud.org>
Sat, 28 Jan 2017 21:58:27 +0000 (15:58 -0600)
worlds/bricabrac.scm

index 442e87d225ebd996641f1d91fe3ebd71099a1044..6ac795a3eda6bf79e3e6db0e480c9c1dcb4bd91a 100644 (file)
       #: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 
+
+(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))
+
+     (cmd-take-from gameobj message
+                    #:direct-obj direct-obj #:indir-obj indir-obj
+                    #:preposition preposition #:player player))))
+
+
 \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... no... 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,29 +412,6 @@ 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 grand-hallway
   (lol
    ('grand-hallway
 (define grand-hallway
   (lol
    ('grand-hallway
@@ -433,7 +449,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 +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"