X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=mudsync%2Fgameobj.scm;h=3e23ae6ff7b7054e7fe3fe26e614588b724f1b2f;hp=351abe7c22a9094f0666938b73620f7669406ca9;hb=d198683d31a3b359e26cc688cc04cebc8ca978c6;hpb=8a2341e98f75a5df295f49c08485eb6339dda19e diff --git a/mudsync/gameobj.scm b/mudsync/gameobj.scm index 351abe7..3e23ae6 100644 --- a/mudsync/gameobj.scm +++ b/mudsync/gameobj.scm @@ -24,6 +24,7 @@ #:use-module (8sync systems actors) #:use-module (8sync agenda) #:use-module (srfi srfi-1) + #:use-module (ice-9 match) #:use-module (oop goops) #:export ( gameobj-simple-name-f @@ -42,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)) @@ -50,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-act-goes-by)) + (visible-name (wrap-apply gameobj-visible-name)))) ;;; *all* game components that talk to players should somehow ;;; derive from this class. @@ -59,20 +62,22 @@ (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 "" + (desc #:init-value #f #:init-keyword #:desc) ;; how to print our name @@ -80,10 +85,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 '()) @@ -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 @@ -103,6 +111,33 @@ (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 (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) + (val-or-proc) + val-or-proc)) + (define (filter-commands commands verb) (filter (lambda (cmd) @@ -111,25 +146,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 (slot-ref actor '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 (slot-ref actor 'container-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))) @@ -139,16 +181,17 @@ ;; @@: 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 - (<- actor loc 'add-occupant! #:who (actor-id actor))) + (<-wait actor loc 'add-occupant! #:who (actor-id actor))) (if old-loc - (<- actor old-loc 'remove-occupant! #:who (actor-id actor)))) + (<-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)) @@ -157,4 +200,24 @@ "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))