X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=mudsync%2Fplayer.scm;h=f04c2feea3e6870326d4b2e5b32da951e7e19b04;hp=45cb9743c635c82a100e115078ebaa8cfb4aa26e;hb=f077644528d3ff0aa8b64c3050f72e9b08b80d49;hpb=116dc1f3e5ff87b07602989017ea489414a4eabb diff --git a/mudsync/player.scm b/mudsync/player.scm index 45cb974..f04c2fe 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,8 +79,7 @@ (apply <- winner-id cmd-action message-args)) (#f (<- (gameobj-gm player) 'write-home - ;; #:text "? (type \"help\" for common commands)\n" - #:text "?\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 @@ -111,11 +105,10 @@ (define text-to-show (if (eq? inv-names '()) "You aren't carrying anything.\n" - (apply string-append - "You are carrying:\n" - (map (lambda (item-name) - (string-append " * " item-name "\n")) - inv-names)))) + `((p "You are carrying:") + (ul ,(map (lambda (item-name) + `(li ,item-name)) + inv-names))))) (<- (actor-id player) 'tell #:text text-to-show)) (define (player-cmd-help player message) @@ -166,9 +159,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... @@ -192,11 +183,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