X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=mudsync%2Fplayer.scm;h=00b28edde4cbeab67239e2266dd462d06469c9d6;hp=3aa22873a257155d994c5aced4310f12738e3060;hb=d539213774955a5593ec760f06022aeecf4e1abc;hpb=8c357c87019a70aabdfadb4c71e3b063251cff87 diff --git a/mudsync/player.scm b/mudsync/player.scm index 3aa2287..00b28ed 100644 --- a/mudsync/player.scm +++ b/mudsync/player.scm @@ -37,7 +37,7 @@ (define player-actions (build-actions - (init (wrap-apply player-init!)) + (init (wrap-apply player-init)) (handle-input (wrap-apply player-handle-input)) (tell (wrap-apply player-tell)))) @@ -66,8 +66,9 @@ ;;; player message handlers -(define-mhandler (player-init! player message) - (player-look-around player)) +(define-mhandler (player-init player message) + ;; Look around the room we're in + (<- player (gameobj-loc player) 'look-room)) (define-mhandler (player-handle-input player message input) @@ -94,23 +95,6 @@ #:text text)) -;;; player methods - -(define (player-look-around player) - (define room-name - (message-ref - (<-wait player (gameobj-loc player) 'get-name) - 'val)) - (define room-desc - (message-ref - (<-wait player (gameobj-loc player) 'get-desc) - 'val)) - (define message-text - (format #f "**~a**\n~a\n" room-name room-desc)) - - (<- player (gameobj-gm player) 'write-home #:text message-text)) - - ;;; Command handling ;;; ================ @@ -151,14 +135,20 @@ (define co-occupant-commands ;; TODO: Switch this to a fold. Ignore a result if it ;; returns false for in the command response - (map - (lambda (co-occupant) - (let ((result (<-wait player co-occupant 'get-commands - #:verb verb))) - (list - (message-ref result 'commands) - (message-ref result 'goes-by) - co-occupant))) + (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)) + commands) + prev))) + '() co-occupants)) ;; Append our own command handlers @@ -183,8 +173,10 @@ (sort actors-and-commands (lambda (x y) - (> (command-priority (car (pk 'x x))) - (command-priority (car (pk 'y y))))))) + (pk 'x x) + (pk 'y y) + (> (command-priority (car x)) + (command-priority (car y)))))) (define (find-command-winner sorted-candidates line)