X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=mudsync%2Fgameobj.scm;h=351abe7c22a9094f0666938b73620f7669406ca9;hp=ba0d8291b3ddcbbfcf4871ec1616ade69e94d6d1;hb=8a2341e98f75a5df295f49c08485eb6339dda19e;hpb=a91cab366a655c3162fb516b7b1242d60f0e2d2a diff --git a/mudsync/gameobj.scm b/mudsync/gameobj.scm index ba0d829..351abe7 100644 --- a/mudsync/gameobj.scm +++ b/mudsync/gameobj.scm @@ -20,8 +20,10 @@ ;;; ========== (define-module (mudsync gameobj) + #:use-module (mudsync command) #:use-module (8sync systems actors) #:use-module (8sync agenda) + #:use-module (srfi srfi-1) #:use-module (oop goops) #:export ( gameobj-simple-name-f @@ -101,11 +103,24 @@ (reply-message actor message #:val (slot-ref actor slot)))) +(define (filter-commands commands verb) + (filter + (lambda (cmd) + (equal? (command-verbs cmd) + verb)) + commands)) + (define-mhandler (gameobj-get-commands actor message verb) - (<-reply actor message #:commands (slot-ref actor 'commands))) + (define filtered-commands + (filter-commands (slot-ref actor 'commands) + verb)) + (<-reply actor message #:commands filtered-commands)) (define-mhandler (gameobj-get-container-commands actor message verb) - (<-reply actor message #:commands (slot-ref actor 'container-commands))) + (define filtered-commands + (filter-commands (slot-ref actor 'container-commands) + verb)) + (<-reply actor message #:commands filtered-commands)) (define-mhandler (gameobj-add-occupant! actor message who) (hash-set! (slot-ref actor 'occupants)