X-Git-Url: https://jxself.org/git/?p=mudsync.git;a=blobdiff_plain;f=mudsync%2Fplayer.scm;h=feb14f80a2375e9b67a4d6b4728ab558226c0c12;hp=42359bd47db3a116391a788ed8bb39964d787ace;hb=060a48dce227e8c53e007941cc673b494ca36024;hpb=d13325f5f6eba20c808636948432dcdff4e138f6

diff --git a/mudsync/player.scm b/mudsync/player.scm
index 42359bd..feb14f8 100644
--- a/mudsync/player.scm
+++ b/mudsync/player.scm
@@ -17,16 +17,30 @@
 ;;; along with Mudsync.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (mudsync player)
+  #:use-module (mudsync command)
   #:use-module (mudsync gameobj)
+  #:use-module (mudsync game-master)
+  #:use-module (mudsync parser)
   #:use-module (8sync systems actors)
   #:use-module (8sync agenda)
   #:use-module (ice-9 format)
   #:use-module (oop goops)
-  #:export (<player>))
+  #:use-module (srfi srfi-1)
+  #:export (<player>
+            player-self-commands))
 
 ;;; Players
 ;;; =======
 
+(define player-actions
+  (build-actions
+   (init (wrap-apply player-init!))
+   (handle-input (wrap-apply player-handle-input))))
+
+(define player-actions*
+  (append player-actions
+          gameobj-actions))
+
 (define-class <player> (<gameobj>)
   (username #:init-keyword #:username
             #:accessor player-username)
@@ -39,20 +53,35 @@
 
   (message-handler
    #:init-value
-   (make-action-dispatch
-    (set-loc! (wrap-apply player-set-loc!))
-    (init (wrap-apply player-init!)))))
+   ;; @@: We're gonna need action inheritance real awful soon, huh?
+   (simple-dispatcher player-actions*)))
 
-;;; player message handlers
 
-(define-mhandler (player-set-loc! player message id)
-  (format #t "DEBUG: Location set to ~s for player ~s\n"
-          id (actor-id-actor player))
-  (set! (gameobj-loc player) id))
+;;; player message handlers
 
 (define-mhandler (player-init! player message)
   (player-look-around player))
 
+
+(define-mhandler (player-handle-input player message input)
+  (define split-input (split-verb-and-rest input))
+  (define input-verb (pk 'input-verb (car split-input)))
+  (define input-rest (pk 'input-rest (cdr split-input)))
+
+  (define command-candidates
+    (pk 'candidates
+        (player-gather-command-handlers player input-verb)))
+
+  (define winner
+    (pk 'winner (find-command-winner command-candidates input-rest)))
+
+  (<- player (gameobj-gm player) 'write-home
+      #:text
+      (format #f "<~a>: ~s\n"
+              (player-username player)
+              input)))
+
+
 ;;; player methods
 
 (define (player-look-around player)
@@ -68,3 +97,6 @@
     (format #f "**~a**\n~a\n" room-name room-desc))
 
   (<- player (gameobj-gm player) 'write-home #:text message-text))
+
+
+