Add wire cage
[mudsync.git] / worlds / bricabrac.scm
index 18fd6f28303b91f7769207d0a549faf24a009bcb..cf34903e0d1df476f2198c759db7fa768a1e49e0 100644 (file)
 ;;; Some simple object types.
 ;;; =========================
 
-(define readable-commands
-  (list
-   (direct-command "read" 'cmd-read)))
-
-(define readable-commands*
-  (append readable-commands
-          thing-commands))
-
 (define-class <readable> (<thing>)
   (read-text #:init-value "All it says is: \"Blah blah blah.\""
              #:init-keyword #:read-text)
   (commands
-   #:init-value readable-commands*)
+   #:allocation #:each-subclass
+   #:init-thunk (build-commands
+                 ("read" ((direct-command cmd-read)))))
   (actions #:allocation #:each-subclass
-           #:init-value (build-actions
+           #:init-thunk (build-actions
                          (cmd-read readable-cmd-read))))
 
 (define (readable-cmd-read actor message)
   (<- (message-from message) 'tell
       #:text text-to-send))
 
-(define chat-commands
-  (list
-   (direct-command "chat" 'cmd-chat)
-   (direct-command "talk" 'cmd-chat)))
-
 (define hotel-owner-grumps
   '("Eight sinks!  Eight sinks!  And I couldn't unwind them..."
     "Don't mind the mess.  I built this place on a dare, you
@@ -105,20 +94,21 @@ or 'skribe'?  Now *that's* composition!"))
   (catchphrases #:init-value '("Blarga blarga blarga!")
                 #:init-keyword #:catchphrases)
   (commands
-   #:init-value chat-commands)
+   #:allocation #:each-subclass
+   #:init-thunk (build-commands
+                 (("chat" "talk") ((direct-command cmd-chat)))))
   (actions #:allocation #:each-subclass
-           #:init-value
+           #:init-thunk
            (build-actions
             (cmd-chat npc-chat-randomly))))
 
 (define-class <sign-in-form> (<gameobj>)
   (commands
-   #:init-value
-   (list
-    (prep-direct-command "sign" 'cmd-sign-form
-                         '("as"))))
+   #:allocation #:each-subclass
+   #:init-thunk (build-commands
+                 ("sign" ((prep-direct-command cmd-sign-form '("as"))))))
   (actions #:allocation #:each-subclass
-           #:init-value (build-actions
+           #:init-thunk (build-actions
                          (cmd-sign-form sign-cmd-sign-in))))
 
 
@@ -150,20 +140,15 @@ Alphanumerics, _ and - only, 2-15 characters, starts with an alphabetic
 character.\n")))
 
 
-(define summoning-bell-commands
-  (list
-   (direct-command "ring" 'cmd-ring)))
-(define summoning-bell-commands*
-  (append summoning-bell-commands
-          thing-commands*))
-
 (define-class <summoning-bell> (<thing>)
   (summons #:init-keyword #:summons)
 
   (commands
-   #:init-value summoning-bell-commands*)
+   #:allocation #:each-subclass
+   #:init-thunk (build-commands
+                 ("ring" ((direct-command cmd-ring)))))
   (actions #:allocation #:each-subclass
-           #:init-value (build-actions
+           #:init-thunk (build-actions
                          (cmd-ring summoning-bell-cmd-ring))))
 
 (define* (summoning-bell-cmd-ring bell message . _)
@@ -339,7 +324,7 @@ everything you read."))
     <thing> 'room:lobby
     #:generally-visible #f
     #:name "the pickled circuitboard of Evlis"
-    #:desc '((p "It's a circuitboard from a Lisp Machine called Evlis.
+    #:desc '((p "It's a circuitboard from a Lisp Machine called EVLIS.
 This is quite the find, and you bet just about anyone interested in
 preserving computer history would love to get their hands on this.")
              (p "Unfortunately, whatever moron did acquire this has
@@ -467,11 +452,11 @@ if this room is intended for children or child-like adults."
   (sit-name #:init-keyword #:sit-name)
 
   (commands
-   #:init-value
-   (list
-    (direct-command "sit" 'cmd-sit-furniture)))
+   #:allocation #:each-subclass
+   #:init-thunk (build-commands
+                 ("sit" ((direct-command cmd-sit-furniture)))))
   (actions #:allocation #:each-subclass
-           #:init-value (build-actions
+           #:init-thunk (build-actions
                          (cmd-sit-furniture furniture-cmd-sit))))
 
 (define* (furniture-cmd-sit actor message #:key direct-obj)
@@ -557,16 +542,6 @@ It has some bits of bubble gum stuck to it... yuck."
 ;;; Breakroom
 ;;; ---------
 
-(define clerk-commands
-  (list
-   (direct-command "talk" 'cmd-chat)
-   (direct-command "chat" 'cmd-chat)
-   (direct-command "ask" 'cmd-ask-incomplete)
-   (prep-direct-command "ask" 'cmd-ask-about)
-   (direct-command "dismiss" 'cmd-dismiss)))
-(define clerk-commands*
-  (append clerk-commands thing-commands*))
-
 (define-class <desk-clerk> (<thing>)
   ;; The desk clerk has three states:
   ;;  - on-duty: Arrived, and waiting for instructions (and losing patience
@@ -574,10 +549,16 @@ It has some bits of bubble gum stuck to it... yuck."
   ;;  - slacking: In the break room, probably smoking a cigarette
   ;;    or checking text messages
   (state #:init-value 'slacking)
-  (commands #:init-value clerk-commands*)
+  (commands #:allocation #:each-subclass
+            #:init-thunk
+            (build-commands
+             (("talk" "chat") ((direct-command cmd-chat)))
+             ("ask" ((direct-command cmd-ask-incomplete)
+                     (prep-direct-command cmd-ask-about)))
+             ("dismiss" ((direct-command cmd-dismiss)))))
   (patience #:init-value 0)
   (actions #:allocation #:each-subclass
-           #:init-value (build-actions
+           #:init-thunk (build-actions
                          (init clerk-act-init)
                          (cmd-chat clerk-cmd-chat)
                          (cmd-ask-incomplete clerk-cmd-ask-incomplete)
@@ -799,14 +780,23 @@ the scenery tapers off nothingness.  But that can't be right, can it?"
     <desk-clerk> 'room:break-room
     #:name "the hotel desk clerk"
     #:desc "  The hotel clerk is wearing a neatly pressed uniform bearing the
-hotel insignia.  She looks like she'd much rather be somewhere else."
+hotel insignia.  She appears to be rather exhausted."
     #:goes-by '("hotel desk clerk" "clerk" "desk clerk"))
    ('thing:break-room:void
     <thing> 'room:break-room
     #:generally-visible #f
     #:name "The Void"
     #:desc "As you stare into the void, the void stares back into you."
-    #:goes-by '("void" "abyss" "nothingness"))))
+    #:goes-by '("void" "abyss" "nothingness" "scenery"))
+   ('thing:break-room:fence
+    <thing> 'room:break-room
+    #:generally-visible #f
+    #:name "break room cage"
+    #:desc "It's a mostly-cubical wire mesh surrounding the break area.
+You can see through the gaps, but they're too small to put more than a
+couple of fingers through.  There appears to be some wear and tear to
+the paint, but the wires themselves seem to be unusually sturdy."
+    #:goes-by '("fence" "cage" "wire cage"))))
 
 
 \f