X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=mudsync%2Fgameobj.scm;h=3e23ae6ff7b7054e7fe3fe26e614588b724f1b2f;hp=bb4c8520628ba0a0b4dcb56f9babfb86564b9a64;hb=d198683d31a3b359e26cc688cc04cebc8ca978c6;hpb=d539213774955a5593ec760f06022aeecf4e1abc diff --git a/mudsync/gameobj.scm b/mudsync/gameobj.scm index bb4c852..3e23ae6 100644 --- a/mudsync/gameobj.scm +++ b/mudsync/gameobj.scm @@ -52,7 +52,8 @@ (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)))) + (goes-by (wrap-apply gameobj-act-goes-by)) + (visible-name (wrap-apply gameobj-visible-name)))) ;;; *all* game components that talk to players should somehow ;;; derive from this class. @@ -61,11 +62,11 @@ (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 @@ -76,7 +77,7 @@ (goes-by #:init-keyword #:goes-by #:init-value #f) - (desc #:init-value "" + (desc #:init-value #f #:init-keyword #:desc) ;; how to print our name @@ -91,7 +92,14 @@ (container-commands #:init-value '()) (message-handler #:init-value - (simple-dispatcher gameobj-actions))) + (simple-dispatcher gameobj-actions)) + + ;; Most objects are generally visible by default + (generally-visible #:init-value #t) + ;; @@: Would be preferable to be using generic methods for this... + ;; Hopefully we can port this to Guile 2.2 soon... + (visible-to-player? + #:init-value (wrap-apply gameobj-visible-to-player?))) ;;; gameobj message handlers @@ -119,6 +127,11 @@ (list name))) (else '()))) +(define (gameobj-act-goes-by actor message) + "Reply to a message requesting what we go by." + (<-reply actor message + #:goes-by (gameobj-goes-by actor))) + (define (val-or-run val-or-proc) "Evaluate if a procedure, or just return otherwise" (if (procedure? val-or-proc) @@ -133,6 +146,7 @@ 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)) @@ -141,19 +155,23 @@ #: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))) @@ -163,11 +181,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))) @@ -180,3 +199,25 @@ (define (gameobj-simple-name-f gameobj) "Simplest version: return ourselves for our name." (gameobj-name gameobj)) + +(define (gameobj-visible-to-player? gameobj whos-looking) + "Check to see whether we're visible to the player or not. +By default, this is whether or not the generally-visible flag is set." + (slot-ref gameobj 'generally-visible)) + +(define-mhandler (gameobj-visible-name actor message whos-looking) + ;; Are we visible? + (define we-are-visible + ((slot-ref actor 'visible-to-player?) actor whos-looking)) + + (define name-to-return + (if we-are-visible + ;; Return our name + (match (slot-ref actor 'name) + ((? procedure? name-proc) + (name-proc actor whos-looking)) + ((? string? name) + name) + (#f #f)) + #f)) + (<-reply actor message #:text name-to-return))