X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=mudsync%2Fgameobj.scm;h=07b3ddbc728957e33fe5b68bafb5efdbd40a5349;hp=8b1040fbcaee86df2aab20369c0ecd6db7486f79;hb=c8c47c9d61abd219f561c020e9147d715717a16f;hpb=6cff5b0062ef928204295ab4327bf2d417070421 diff --git a/mudsync/gameobj.scm b/mudsync/gameobj.scm index 8b1040f..07b3ddb 100644 --- a/mudsync/gameobj.scm +++ b/mudsync/gameobj.scm @@ -21,7 +21,7 @@ (define-module (mudsync gameobj) #:use-module (mudsync command) - #:use-module (8sync systems actors) + #:use-module (8sync actors) #:use-module (8sync agenda) #:use-module (srfi srfi-1) #:use-module (ice-9 format) @@ -35,7 +35,6 @@ gameobj-act-init gameobj-set-loc! gameobj-occupants - gameobj-actions gameobj-self-destruct slot-ref-maybe-runcheck @@ -47,30 +46,6 @@ ;;; ======= -;;; Actions supported by all gameobj -(define gameobj-actions - (build-actions - (init (wrap-apply gameobj-act-init)) - ;; Commands for co-occupants - (get-commands (wrap-apply gameobj-get-commands)) - ;; Commands for participants in a room - (get-container-commands (wrap-apply gameobj-get-container-commands)) - ;; Commands for inventory items, etc (occupants of the gameobj commanding) - (get-contained-commands (wrap-apply gameobj-get-contained-commands)) - (get-occupants (wrap-apply gameobj-get-occupants)) - (add-occupant! (wrap-apply gameobj-add-occupant!)) - (remove-occupant! (wrap-apply gameobj-remove-occupant!)) - (get-loc (wrap-apply gameobj-act-get-loc)) - (set-loc! (wrap-apply gameobj-act-set-loc!)) - (get-name (wrap-apply gameobj-get-name)) - (set-name! (wrap-apply gameobj-act-set-name!)) - (get-desc (wrap-apply gameobj-get-desc)) - (goes-by (wrap-apply gameobj-act-goes-by)) - (visible-name (wrap-apply gameobj-visible-name)) - (self-destruct (wrap-apply gameobj-act-self-destruct)) - (tell (wrap-apply gameobj-tell-no-op)) - (assist-replace (wrap-apply gameobj-act-assist-replace)))) - ;;; *all* game components that talk to players should somehow ;;; derive from this class. ;;; And all of them need a GM! @@ -104,10 +79,6 @@ ;; Commands we can handle by being contained by something else (contained-commands #:init-value '()) - (message-handler - #:init-value - (simple-dispatcher gameobj-actions)) - ;; Most objects are generally visible by default (generally-visible #:init-value #t #:init-keyword #:generally-visible) @@ -118,7 +89,32 @@ ;; Set this on self-destruct ;; (checked by some "long running" game routines) - (destructed #:init-value #f)) + (destructed #:init-value #f) + + (actions #:allocation #:each-subclass + ;;; Actions supported by all gameobj + #:init-value + (build-actions + (init gameobj-act-init) + ;; Commands for co-occupants + (get-commands gameobj-get-commands) + ;; Commands for participants in a room + (get-container-commands gameobj-get-container-commands) + ;; Commands for inventory items, etc (occupants of the gameobj commanding) + (get-contained-commands gameobj-get-contained-commands) + (get-occupants gameobj-get-occupants) + (add-occupant! gameobj-add-occupant!) + (remove-occupant! gameobj-remove-occupant!) + (get-loc gameobj-act-get-loc) + (set-loc! gameobj-act-set-loc!) + (get-name gameobj-get-name) + (set-name! gameobj-act-set-name!) + (get-desc gameobj-get-desc) + (goes-by gameobj-act-goes-by) + (visible-name gameobj-visible-name) + (self-destruct gameobj-act-self-destruct) + (tell gameobj-tell-no-op) + (assist-replace gameobj-act-assist-replace)))) ;;; gameobj message handlers @@ -127,8 +123,7 @@ ;; Kind of a useful utility, maybe? (define (simple-slot-getter slot) (lambda (actor message) - (<-reply actor message - #:val (slot-ref actor slot)))) + (<-reply actor message (slot-ref actor slot)))) (define (gameobj-replace-step-occupants actor occupants) ;; Snarf all the occupants! @@ -249,8 +244,7 @@ Assists in its replacement of occupants if necessary and nothing else." #:occupants occupants)) (define (gameobj-act-get-loc actor message) - (<-reply actor message - #:val (slot-ref actor 'loc))) + (<-reply actor message (slot-ref actor 'loc))) (define (gameobj-set-loc! gameobj loc) "Set the location of this object." @@ -281,7 +275,7 @@ and whos-asking, and see if we should just return it or run it." (define gameobj-get-name (simple-slot-getter 'name)) -(define* (gameobj-act-set-name! actor message #:key val) +(define* (gameobj-act-set-name! actor message val) (slot-set! actor 'name val)) (define* (gameobj-get-desc actor message #:key whos-looking) @@ -290,7 +284,7 @@ and whos-asking, and see if we should just return it or run it." ((? procedure? desc-proc) (desc-proc actor whos-looking)) (desc desc))) - (<-reply actor message #:val desc-text)) + (<-reply actor message desc-text)) (define (gameobj-visible-to-player? gameobj whos-looking) "Check to see whether we're visible to the player or not. @@ -356,10 +350,8 @@ By default, this is whether or not the generally-visible flag is set." (match special-symbol ;; if it's a symbol, look it up dynamically ((? symbol? _) - (msg-receive (_ #:key val) - (<-wait gameobj (slot-ref gameobj 'gm) 'lookup-special - #:symbol special-symbol) - val)) + (msg-val (<-wait gameobj (slot-ref gameobj 'gm) 'lookup-special + #:symbol special-symbol))) ;; if it's false, return nothing (#f #f) ;; otherwise it's probably an address, return it as-is