X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=mudsync%2Froom.scm;h=1a898cc5262347c485487556dca357135a5a6d8a;hp=09ebdcbc0db8531802edf22e6e56d69ea702befa;hb=8a2341e98f75a5df295f49c08485eb6339dda19e;hpb=a91cab366a655c3162fb516b7b1242d60f0e2d2a diff --git a/mudsync/room.scm b/mudsync/room.scm index 09ebdcb..1a898cc 100644 --- a/mudsync/room.scm +++ b/mudsync/room.scm @@ -17,6 +17,7 @@ ;;; along with Mudsync. If not, see . (define-module (mudsync room) + #:use-module (mudsync command) #:use-module (mudsync gameobj) #:use-module (8sync systems actors) #:use-module (8sync agenda) @@ -59,30 +60,11 @@ #:optional (target-actor (actor-id actor))) ((slot-ref exit 'traverse-check) exit actor target-actor)) - -;; Kind of a useful utility, maybe? -(define (simple-slot-getter slot) - (lambda (actor message) - (reply-message actor message - #:val (slot-ref actor slot)))) - -(define always (const #t)) - -;; TODO: remove hack -(define full-command list) - -;; TODO: fill these in -(define cmatch-just-verb #f) -(define cmatch-direct-verb #f) -(define cmatch-direct-obj #f) - (define %room-contain-commands (list - (full-command "look" cmatch-just-verb always 'look-room) - (full-command "look" cmatch-direct-obj always 'look-member) - (full-command "go" cmatch-just-verb always 'go-where) - (full-command "go" cmatch-direct-obj always 'go-exit))) - + (loose-direct-command "look" 'cmd-look-at) + (empty-command "look" 'cmd-look-room) + (loose-direct-command "go" 'cmd-go))) ;; TODO: Subclass from container? (define-class () @@ -90,7 +72,7 @@ (exits #:init-value '() #:getter room-exits) - (contain-commands + (container-commands #:init-value %room-contain-commands) (message-handler