Make commands use the inheritable rmeta-slot tooling

[mudsync.git] / mudsync / gameobj.scm

diff --git a/mudsync/gameobj.scm b/mudsync/gameobj.scm
index 370ba47d2d67ecb104a9d37d0950a85dd6b81fa2..00858522281f2bc5257b6b13e51fe2c14aad469c 100644 (file)
--- a/mudsync/gameobj.scm
+++ b/mudsync/gameobj.scm
@@ -23,6 +23,7 @@
   #:use-module (mudsync command)
   #:use-module (8sync actors)
   #:use-module (8sync agenda)
+  #:use-module (8sync rmeta-slot)
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
@@ -71,13 +72,16 @@
         #:init-keyword #:desc)
 
   ;; Commands we can handle
-  (commands #:init-value '())
+  (commands #:allocation #:each-subclass
+            #:init-thunk (build-commands))
 
   ;; Commands we can handle by being something's container
-  (container-commands #:init-value '())
+  (container-commands #:allocation #:each-subclass
+                      #:init-thunk (build-commands))
 
   ;; Commands we can handle by being contained by something else
-  (contained-commands #:init-value '())
+  (contained-commands #:allocation #:each-subclass
+                      #:init-thunk (build-commands))
 
   ;; Most objects are generally visible by default
   (generally-visible #:init-value #t
@@ -93,7 +97,7 @@
 
   (actions #:allocation #:each-subclass
            ;;; Actions supported by all gameobj
-           #:init-value
+           #:init-thunk
            (build-actions
             (init gameobj-act-init)
             ;; Commands for co-occupants
@@ -173,36 +177,30 @@ Assists in its replacement of occupants if necessary and nothing else."
       (val-or-proc)
       val-or-proc))
 
-(define (filter-commands commands verb)
-  (filter
-   (lambda (cmd)
-     (equal? (command-verbs cmd)
-             verb))
-   commands))
+(define (get-candidate-commands actor rmeta-sym verb)
+  (class-rmeta-ref (class-of actor) rmeta-sym verb
+                   #:dflt '()))
 
 (define* (gameobj-get-commands actor message #:key verb)
   "Get commands a co-occupant of the room might execute for VERB"
-  (define filtered-commands
-    (filter-commands (val-or-run (slot-ref actor 'commands))
-                     verb))
+  (define candidate-commands
+    (get-candidate-commands actor 'commands verb))
   (<-reply message
-           #:commands filtered-commands
+           #:commands candidate-commands
            #:goes-by (gameobj-goes-by actor)))
 
 (define* (gameobj-get-container-commands actor message #:key verb)
   "Get commands as the container / room of message's sender"
-  (define filtered-commands
-    (filter-commands (val-or-run (slot-ref actor 'container-commands))
-                     verb))
-  (<-reply message #:commands filtered-commands))
+  (define candidate-commands
+    (get-candidate-commands actor 'container-commands verb))
+  (<-reply message #:commands candidate-commands))
 
 (define* (gameobj-get-contained-commands actor message #:key verb)
   "Get commands as being contained (eg inventory) of commanding gameobj"
-  (define filtered-commands
-    (filter-commands (val-or-run (slot-ref actor 'contained-commands))
-                     verb))
+  (define candidate-commands
+    (get-candidate-commands actor 'contained-commands verb))
   (<-reply message
-           #:commands filtered-commands
+           #:commands candidate-commands
            #:goes-by (gameobj-goes-by actor)))
 
 (define* (gameobj-add-occupant! actor message #:key who)
@@ -314,7 +312,7 @@ By default, this is whether or not the generally-visible flag is set."
   ;; Boom!
   (self-destruct gameobj))
 
-(define (gameobj-act-self-destruct gameobj message)
+(define* (gameobj-act-self-destruct gameobj message #:key why)
   "Action routine for self destruction"
   (gameobj-self-destruct gameobj))