X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;f=mudsync%2Fgameobj.scm;h=fa3554865b61eb306a66ceee6f1ce55840b52a6c;hb=4d1280ec16d7645817bf741cde658e358de66327;hp=7be08654a72e0e5bec190d9df03ddcf7ba208313;hpb=7248fd4470039dab59a8e3a95829952e91c0fd19;p=mudsync.git diff --git a/mudsync/gameobj.scm b/mudsync/gameobj.scm index 7be0865..fa35548 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. @@ -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,15 @@ (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 + #:init-keyword #:generally-visible) + ;; @@: 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 +128,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 +147,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 +156,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,6 +182,7 @@ ;; @@: 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)) @@ -175,8 +195,37 @@ (<-wait actor old-loc 'remove-occupant! #:who (actor-id actor)))) (define gameobj-get-name (simple-slot-getter 'name)) -(define gameobj-get-desc (simple-slot-getter 'desc)) + +(define-mhandler (gameobj-get-desc actor message whos-looking) + (define desc-text + (match (slot-ref actor 'desc) + ((? procedure? desc-proc) + (desc-proc actor whos-looking)) + (desc desc))) + (<-reply actor message #:val desc-text)) (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))