X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=worlds%2Fbricabrac.scm;h=131a79b6dade45edf0ec29910746bd8ec6ff3b09;hp=3b3f4c1c7101dfc7bc548ecd68edc972cc80fbd2;hb=bb099f0078b2164b3010aa365a2a5d7ab4b5bb0b;hpb=106536778bbd8ad0cc850cb3ef7dcc5e2499eee2

diff --git a/worlds/bricabrac.scm b/worlds/bricabrac.scm
index 3b3f4c1..131a79b 100644
--- a/worlds/bricabrac.scm
+++ b/worlds/bricabrac.scm
@@ -46,19 +46,13 @@
 ;;; 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))))
@@ -80,11 +74,6 @@
   (<- (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