Adjust clerk's description a bit.
[mudsync.git] / worlds / bricabrac.scm
index 3b3f4c1c7101dfc7bc548ecd68edc972cc80fbd2..131a79b6dade45edf0ec29910746bd8ec6ff3b09 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-thunk (build-actions
                          (cmd-read readable-cmd-read))))
   (<- (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,7 +94,9 @@ 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-thunk
            (build-actions
@@ -113,10 +104,9 @@ or 'skribe'?  Now *that's* composition!"))
 
 (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-thunk (build-actions
                          (cmd-sign-form sign-cmd-sign-in))))
@@ -150,18 +140,13 @@ 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-thunk (build-actions
                          (cmd-ring summoning-bell-cmd-ring))))
@@ -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,9 +452,9 @@ 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-thunk (build-actions
                          (cmd-sit-furniture furniture-cmd-sit))))
@@ -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,7 +549,13 @@ 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-thunk (build-actions
@@ -799,7 +780,7 @@ 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