X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=mudsync%2Froom.scm;fp=mudsync%2Froom.scm;h=1e0f354ec0cc01a74f51235f3b9de953a92a80bb;hp=4c02e7fe3c8d3ed18601434cb0314f7d1a442763;hb=4d4af0656b0402e630eea9393420197152945e5b;hpb=8df43947a29393266da4df9e43f7656e56558fd6 diff --git a/mudsync/room.scm b/mudsync/room.scm index 4c02e7f..1e0f354 100644 --- a/mudsync/room.scm +++ b/mudsync/room.scm @@ -59,18 +59,6 @@ ;;; Rooms ;;; ===== -(define %room-contain-commands - (list - (loose-direct-command "look" 'cmd-look-at) - (empty-command "look" 'cmd-look-room) - (empty-command "go" 'cmd-go-where) - (loose-direct-command "go" 'cmd-go) - (greedy-command "say" 'cmd-say) - (greedy-command "\"" 'cmd-say) - (greedy-command "'" 'cmd-say) - (greedy-command "emote" 'cmd-emote) - (greedy-command "/me" 'cmd-emote))) - ;; TODO: Subclass from container? (define-class () ;; A list of @@ -79,7 +67,15 @@ #:getter room-exits) (container-commands - #:init-value (wrap %room-contain-commands)) + #:allocation #:each-subclass + #:init-thunk + (build-commands + ("look" ((loose-direct-command cmd-look-at) + (empty-command cmd-look-room))) + ("go" ((empty-command cmd-go-where) + (loose-direct-command cmd-go))) + (("say" "\"" "'") ((greedy-command cmd-say))) + (("emote" "/me") ((greedy-command cmd-emote))))) (actions #:allocation #:each-subclass #:init-thunk