X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=mudsync%2Fplayer.scm;h=0879300e34177e9d2187b3faa0a32cd436c57fba;hp=784db7c6f9a08691d919ad1a66a26693bbe24e5d;hb=36143a12b1510b687d8ac1c18749c0db06f64e34;hpb=e5a7edc560717c95542df4b338ea14502e424694 diff --git a/mudsync/player.scm b/mudsync/player.scm index 784db7c..0879300 100644 --- a/mudsync/player.scm +++ b/mudsync/player.scm @@ -23,35 +23,30 @@ #:use-module (mudsync parser) #:use-module (8sync actors) #:use-module (8sync agenda) + #:use-module (8sync rmeta-slot) #:use-module (ice-9 control) #:use-module (ice-9 format) #:use-module (ice-9 match) #:use-module (oop goops) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) - #:export ( - player-self-commands)) + #:export ()) ;;; Players ;;; ======= -(define player-self-commands - (list - (empty-command "inventory" 'cmd-inventory) - ;; aliases... - ;; @@: Should use an "alias" system for common aliases? - (empty-command "inv" 'cmd-inventory) - (empty-command "i" 'cmd-inventory) - (empty-command "help" 'cmd-help))) - (define-class () (username #:init-keyword #:username #:getter player-username) - (self-commands #:init-value (wrap player-self-commands)) + (self-commands #:allocation #:each-subclass + #:init-thunk + (build-commands + (("inventory" "inv" "i") ((empty-command cmd-inventory))) + ("help" ((empty-command cmd-help))))) (actions #:allocation #:each-subclass - #:init-value + #:init-thunk (build-actions (init player-init) (handle-input player-handle-input) @@ -84,7 +79,7 @@ (apply <- winner-id cmd-action message-args)) (#f (<- (gameobj-gm player) 'write-home - #:text "Huh? (type \"help\" for common commands)\n")))) + #:text "Sorry, I didn't understand that? (type \"help\" for common commands)\n")))) (define* (player-tell player message #:key text) (<- (gameobj-gm player) 'write-home @@ -165,9 +160,7 @@ (define co-occupants (remove (lambda (x) (equal? x (actor-id player))) - (mbody-receive (_ #:key occupants) - (<-wait player-loc 'get-occupants) - occupants))) + (mbody-val (<-wait player-loc 'get-occupants)))) ;; @@: There's a race condition here if someone leaves the room ;; during this, heh... @@ -191,11 +184,8 @@ ;; Append our own command handlers (define our-commands - (filter - (lambda (cmd) - (equal? (command-verbs cmd) verb)) - (val-or-run - (slot-ref player 'self-commands)))) + (class-rmeta-ref (class-of player) 'self-commands verb + #:dflt '())) ;; Append our inventory's relevant command handlers (define inv-items