X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=mudsync%2Fgameobj.scm;h=1d120072380ad17d49b276c016beba8a729ace47;hp=921850eef534cde51c23a18a1d9be3a7d91d493c;hb=f2f19acbf45886ca9d66a687f98ae9f6d2bd25f6;hpb=4736bfc66c4067b0cf9daf8eb69b1fe733d54e00 diff --git a/mudsync/gameobj.scm b/mudsync/gameobj.scm index 921850e..1d12007 100644 --- a/mudsync/gameobj.scm +++ b/mudsync/gameobj.scm @@ -43,6 +43,7 @@ ;;; Actions supported by all gameobj (define gameobj-actions (build-actions + (init (wrap-apply gameobj-init)) (get-commands (wrap-apply gameobj-get-commands)) (get-container-commands (wrap-apply gameobj-get-container-commands)) (get-occupants (wrap-apply gameobj-get-occupants)) @@ -51,7 +52,7 @@ (set-loc! (wrap-apply gameobj-set-loc!)) (get-name (wrap-apply gameobj-get-name)) (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 '()) @@ -104,6 +103,22 @@ (reply-message actor message #:val (slot-ref actor slot)))) + +;; @@: This could be kind of a messy way of doing gameobj-init +;; stuff. If only we had generic methods :( +(define-mhandler (gameobj-init actor message) + "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) @@ -118,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))) @@ -146,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))) @@ -163,5 +186,3 @@ (define (gameobj-simple-name-f gameobj) "Simplest version: return ourselves for our name." (gameobj-name gameobj)) - -