X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=mudsync%2Fplayer.scm;h=6e4be5738b2f289ed93decb95a258f2df22f0073;hp=09fc6d7aad49de4c282672ed05d5bfeecaec4f9a;hb=50cd2aba8f13ec7aecb58a683aa55ae665cf83ab;hpb=af6f936a671c835bc6d9aadc59fd8ff5969fe1ad diff --git a/mudsync/player.scm b/mudsync/player.scm index 09fc6d7..6e4be57 100644 --- a/mudsync/player.scm +++ b/mudsync/player.scm @@ -39,7 +39,8 @@ (build-actions (init (wrap-apply player-init)) (handle-input (wrap-apply player-handle-input)) - (tell (wrap-apply player-tell)))) + (tell (wrap-apply player-tell)) + (disconnect-self-destruct (wrap-apply player-disconnect-self-destruct)))) (define player-actions* (append player-actions @@ -91,6 +92,16 @@ (<- player (gameobj-gm player) 'write-home #:text text)) +(define-mhandler (player-disconnect-self-destruct player message) + "Action routine for being told to disconnect and self destruct." + (define loc (gameobj-loc player)) + (when loc + (<- player loc 'tell-room + #:exclude (actor-id player) + #:text (format #f "~a disappears in a puff of entropy!\n" + (slot-ref player 'name)))) + (gameobj-self-destruct player)) + ;;; Command handling ;;; ================ @@ -134,12 +145,10 @@ ;; returns false for in the command response (fold (lambda (co-occupant prev) - (display "pre-message\n") (let* ((result (<-wait player co-occupant 'get-commands #:verb verb)) (commands (message-ref result 'commands)) (goes-by (message-ref result 'goes-by))) - (display "post-message\n") (append (map (lambda (command) (list command goes-by co-occupant)) @@ -177,7 +186,7 @@ (define (find-command-winner sorted-candidates line) "Find a command winner from a sorted list of candidates" ;; A cache of results from matchers we've already seen - ;; TODO: fill this in + ;; TODO: fill in this cache. This is a *critical* optimization! (define matcher-cache '()) (call/ec (lambda (return)