X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=mudsync%2Fgameobj.scm;h=1d120072380ad17d49b276c016beba8a729ace47;hp=a418cf0c1566b38622dd61d74264f389605c5458;hb=f2f19acbf45886ca9d66a687f98ae9f6d2bd25f6;hpb=7525c62ccdf9e3480214831fb14d9a2d30ab139d diff --git a/mudsync/gameobj.scm b/mudsync/gameobj.scm index a418cf0..1d12007 100644 --- a/mudsync/gameobj.scm +++ b/mudsync/gameobj.scm @@ -51,7 +51,8 @@ (remove-occupant! (wrap-apply gameobj-remove-occupant!)) (set-loc! (wrap-apply gameobj-set-loc!)) (get-name (wrap-apply gameobj-get-name)) - (get-desc (wrap-apply gameobj-get-desc)))) + (get-desc (wrap-apply gameobj-get-desc)) + (goes-by (wrap-apply gameobj-goes-by)))) ;;; *all* game components that talk to players should somehow ;;; derive from this class. @@ -60,18 +61,20 @@ (define-class () ;; location id (loc #:init-value #f - #:accessor gameobj-loc) + #:getter gameobj-loc) ;; Uses a hash table like a set (values ignored) (occupants #:init-thunk make-hash-table - #:accessor gameobj-occupants) + #:getter gameobj-occupants) ;; game master id (gm #:init-keyword #:gm #:getter gameobj-gm) ;; a name to be known by (name #:init-keyword #:name - #:accessor gameobj-name) + #:init-value #f) + (goes-by #:init-keyword #:goes-by + #:init-value #f) (desc #:init-value "" #:init-keyword #:desc) @@ -81,10 +84,6 @@ #:getter gameobj-name-f #:init-value (wrap gameobj-simple-name-f)) - ;; Name aliases - (aliases #:init-keyword #:aliases - #:init-value '()) - ;; Commands we can handle (commands #:init-value '()) @@ -111,6 +110,15 @@ "Your most basic game object init procedure. Does nothing." #f) +(define (gameobj-goes-by gameobj) + "Find the name we go by. Defaults to #:name if nothing else provided." + (cond ((slot-ref gameobj 'goes-by) => + identity) + ((slot-ref gameobj 'name) => + (lambda (name) + (list name))) + (else '()))) + (define (val-or-run val-or-proc) "Evaluate if a procedure, or just return otherwise" (if (procedure? val-or-proc) @@ -125,25 +133,32 @@ commands)) (define-mhandler (gameobj-get-commands actor message verb) + "Get commands a co-occupant of the room might execute for VERB" (define filtered-commands (filter-commands (val-or-run (slot-ref actor 'commands)) verb)) - (<-reply actor message #:commands filtered-commands)) + (<-reply actor message + #:commands filtered-commands + #:goes-by (gameobj-goes-by actor))) (define-mhandler (gameobj-get-container-commands actor message verb) + "Get commands as the container / room of message's sender" (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) + "Add an actor to our list of present occupants" (hash-set! (slot-ref actor 'occupants) who #t)) (define-mhandler (gameobj-remove-occupant! actor message who) + "Remove an occupant from the room." (hash-remove! (slot-ref actor 'occupants) who)) (define-mhandler (gameobj-get-occupants actor message) + "Get all present occupants of the room." (define occupants (hash-map->list (lambda (key val) key) (gameobj-occupants actor))) @@ -153,11 +168,12 @@ ;; @@: Should it really be #:id ? Maybe #:loc-id or #:loc? (define-mhandler (gameobj-set-loc! actor message loc) + "Set the location of this object." (define old-loc (gameobj-loc actor)) (format #t "DEBUG: Location set to ~s for ~s\n" loc (actor-id-actor actor)) - (set! (gameobj-loc actor) loc) + (slot-set! actor 'loc loc) ;; Change registation of where we currently are (if loc (<-wait actor loc 'add-occupant! #:who (actor-id actor))) @@ -170,5 +186,3 @@ (define (gameobj-simple-name-f gameobj) "Simplest version: return ourselves for our name." (gameobj-name gameobj)) - -