X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=mudsync.scm;h=35cc0befcf641f3da7b286e831656d6e98d7ed71;hp=7219c37e947883daa75f9baa711b6395affc5394;hb=d9edc0edd5263888911dae51c113cb536b5c62f2;hpb=f30bd11e2979247edc97671357d1f02d2fa72775 diff --git a/mudsync.scm b/mudsync.scm index 7219c37..35cc0be 100644 --- a/mudsync.scm +++ b/mudsync.scm @@ -398,7 +398,9 @@ with an anonymous persona" #:init-value '()) ;; Commands we can handle - (commands #:init-value #f) + (dirobj-commands #:init-value '()) + (indirobj-commands #:init-value '()) + ;; Commands we can handle by being something's container (contain-commands #:init-value #f)) @@ -452,9 +454,11 @@ with an anonymous persona" #:val (slot-ref actor slot)))) +;; TODO: Subclass from container? (define-class () (desc #:init-value "" #:init-keyword #:desc) + ;; TODO: Switch this to be loc based ;; Uses a hash table like a set (values ignored) (occupants #:init-thunk make-hash-table) ;; A list of @@ -463,6 +467,9 @@ with an anonymous persona" ;; @@: Maybe eventually will inherit from some more general ;; game object class + (contain-commands + #:init-value %room-contain-commands) + (message-handler #:allocation #:each-subclass #:init-value @@ -480,6 +487,16 @@ with an anonymous persona" (hash-remove! (slot-ref actor 'occupants) who)) (wire-exits! (wrap-apply room-wire-exits!))))) +(define always (const #t)) + +(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" cmathc-just-verb always 'go-where) + (full-command "go" cmatch-direct-obj always 'go-exit))) + + (define (room-wire-exits! room message) "Actually hook up the rooms' exit addresses to the rooms they claim to point to." @@ -505,7 +522,7 @@ claim to point to." (client #:accessor player-client) (self-commands - #:init-value #f ; TODO: Set me to a reasonable default + #:init-value '() #:accessor player-self-commands) (message-handler