X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=mudsync%2Fgameobj.scm;h=bb4c8520628ba0a0b4dcb56f9babfb86564b9a64;hp=37f8bfefa8d07ebb85be81a9e17705089703f2b8;hb=d539213774955a5593ec760f06022aeecf4e1abc;hpb=4738c5ae39e26b65cdba3bec005bfe034c4ea2c2 diff --git a/mudsync/gameobj.scm b/mudsync/gameobj.scm index 37f8bfe..bb4c852 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,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. @@ -70,7 +72,9 @@ #: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) @@ -80,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 '()) @@ -103,6 +103,28 @@ (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) + (val-or-proc) + val-or-proc)) + (define (filter-commands commands verb) (filter (lambda (cmd) @@ -112,13 +134,15 @@ (define-mhandler (gameobj-get-commands actor message 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) (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)) @@ -156,5 +180,3 @@ (define (gameobj-simple-name-f gameobj) "Simplest version: return ourselves for our name." (gameobj-name gameobj)) - -