X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=mudsync%2Fthing.scm;h=a964c50e56aea0cc5233539ce3418d8ae6fdfa3f;hp=64ceeee5a094550584d9844ebf97957ee0cf6986;hb=4d4af0656b0402e630eea9393420197152945e5b;hpb=8df43947a29393266da4df9e43f7656e56558fd6 diff --git a/mudsync/thing.scm b/mudsync/thing.scm index 64ceeee..a964c50 100644 --- a/mudsync/thing.scm +++ b/mudsync/thing.scm @@ -26,27 +26,7 @@ #:use-module (oop goops) #:use-module (ice-9 match) #:use-module (ice-9 format) - #:export ( - thing-commands - thing-commands* - thing-contained-commands - thing-contained-commands*)) - -(define thing-commands - (list - (direct-command "take" 'cmd-take))) - -;; Doesn't inherit anything (gameobj has no commands) -;; so it's an alias. -(define thing-commands* thing-commands) - -(define thing-contained-commands - (list - (direct-command "drop" 'cmd-drop))) - -;; Doesn't inherit anything (gameobj has no contained-commands) -;; so it's an alias. -(define thing-contained-commands* thing-contained-commands) + #:export ()) (define-class () ;; Can be a boolean or a procedure accepting two arguments @@ -58,9 +38,13 @@ (dropable #:init-value #t #:init-keyword #:dropable) (commands - #:init-value (wrap thing-commands)) + #:allocation #:each-subclass + #:init-thunk (build-commands + ("take" ((direct-command cmd-take))))) (contained-commands - #:init-value (wrap thing-contained-commands)) + #:allocation #:each-subclass + #:init-value (build-commands + ("drop" ((direct-command cmd-drop))))) (actions #:allocation #:each-subclass #:init-thunk (build-actions