X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=mudsync%2Fplayer.scm;h=f04c2feea3e6870326d4b2e5b32da951e7e19b04;hp=a0caf239940198eb80808925ae652b00d295caa2;hb=f077644528d3ff0aa8b64c3050f72e9b08b80d49;hpb=ed1ef3172af4c2621e2b746824b7defa6f0dcedd diff --git a/mudsync/player.scm b/mudsync/player.scm index a0caf23..f04c2fe 100644 --- a/mudsync/player.scm +++ b/mudsync/player.scm @@ -23,40 +23,37 @@ #: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))) - (define-class () (username #:init-keyword #:username #:getter player-username) - (self-commands #:init-value 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) (tell player-tell) (disconnect-self-destruct player-disconnect-self-destruct) - (cmd-inventory player-cmd-inventory)))) + (cmd-inventory player-cmd-inventory) + (cmd-help player-cmd-help)))) ;;; player message handlers @@ -82,7 +79,7 @@ (apply <- winner-id cmd-action message-args)) (#f (<- (gameobj-gm player) 'write-home - #:text "Huh?\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 @@ -108,13 +105,33 @@ (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) + (<- (actor-id player) 'tell + #:text '((strong "** Mudsync Help **")(br) + (p "You're playing Mudsync, a multiplayer text-adventure. " + "Type different commands to interact with your surroundings " + "and other players.") + (p "Some common commands:" + (ul (li (strong "say ") " -- " + "Chat with other players in the same room. " + "(Also aliased to the " (b "\"") " character.)") + (li (strong "look") " -- " + "Look around the room you're in.") + (li (strong "look [at] ") " -- " + "Examine a particular object.") + (li (strong "go ") " -- " + "Move to another room in direction."))) + (p "Different objects can be interacted with in different ways. " + "For example, if there's a bell in the same room as you, " + "you might try typing " (em "ring bell") + " and see what happens.")))) + ;;; Command handling ;;; ================ @@ -142,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... @@ -168,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