X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=mudsync%2Fgameobj.scm;h=921850eef534cde51c23a18a1d9be3a7d91d493c;hp=ba0d8291b3ddcbbfcf4871ec1616ade69e94d6d1;hb=4736bfc66c4067b0cf9daf8eb69b1fe733d54e00;hpb=a841e7c04e355dd1d25c0c0a5a254bbd185cdc38 diff --git a/mudsync/gameobj.scm b/mudsync/gameobj.scm index ba0d829..921850e 100644 --- a/mudsync/gameobj.scm +++ b/mudsync/gameobj.scm @@ -20,8 +20,11 @@ ;;; ========== (define-module (mudsync gameobj) + #:use-module (mudsync command) #:use-module (8sync systems actors) #:use-module (8sync agenda) + #:use-module (srfi srfi-1) + #:use-module (ice-9 match) #:use-module (oop goops) #:export ( gameobj-simple-name-f @@ -101,11 +104,30 @@ (reply-message actor message #:val (slot-ref actor slot)))) +(define (val-or-run val-or-proc) + "Evaluate if a procedure, or just return otherwise" + (if (procedure? val-or-proc) + (val-or-proc) + val-or-proc)) + +(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 (val-or-run (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 (val-or-run (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) @@ -131,9 +153,9 @@ (set! (gameobj-loc actor) loc) ;; Change registation of where we currently are (if loc - (<- actor loc 'add-occupant! #:who (actor-id actor))) + (<-wait actor loc 'add-occupant! #:who (actor-id actor))) (if old-loc - (<- actor old-loc 'remove-occupant! #:who (actor-id actor)))) + (<-wait actor old-loc 'remove-occupant! #:who (actor-id actor)))) (define gameobj-get-name (simple-slot-getter 'name)) (define gameobj-get-desc (simple-slot-getter 'desc))