P2P chat works.

diff --git a/chat_client.scm b/chat_client.scm
index bb1fd28..60d0ee4 100644 (file)
--- a/chat_client.scm
+++ b/chat_client.scm
@@ -1,60 +1,92 @@
 (import sam
         matchable
-        srfi-13)
+        srfi-13
+        (chicken process-context))
 
-(define client
-  (make-actor
-   (lambda (self . message)
-     (let ((name "name")
-           (recipients '()))
-       
-       (match message
-         (('start)
-          (send-message system 'print "Welcome to chat!\n"
-                        "Your client address is " (address->string self) ".\n"
-                        "Type '/help' for a list of commands.\n")
-          (send-message system 'read self))
-         (('show-msg from text)
-          (send-message system 'print "Message from " from ": " text))
-         (((? string? str))
-          (if (string-prefix? "/" str)
-              (let* ((idx (string-index str #\space))
-                     (cmd (substring str 1 idx))
-                     (arg (substring str idx)))
-                (match cmd
-                  ("help"
-                   (send-message system 'print
-                                 "Command          | Description\n"
-                                 "------------------------------\n"
-                                 "\help              List commands\n"
-                                 "\join <address>    Join chat with specified client\n"
-                                 "\quit              Quit chat"))
-                  ("join"
-                   (set! recipients (cons (uri-reference arg) recipients))
-                   (send-message system 'print "Added recipient to chat."))
-                  ("quit"
-                   (send-message system 'exit))
-                  (else
-                   (send-message system 'print "Unrecognised command '" cmd "'"))))
-              (let loop (recipients-left recipients)
-                (unless (null? recipients-left)
-                  (send-message (car recipients-left) 'show-msg name str)
-                  (loop (cdr recipients-left)))))))
-       (send-message system 'read self)
-       'sleep))))
-                  
+(define client-beh
+  (let ((name "name")
+        (recipients '()))
+    
+    (lambda (self . message)
+      (match message
+        (('start)
+         (send-message system 'print "Welcome to chat!\n"
+                       "Your client address is " self ".\n"
+                       "Type '/help' for a list of commands.\n")
+         (send-message system 'read self))
+        (('show-msg from text)
+         (send-message system 'print "Message from " from ": " text))
+        (((? string? str))
+         (if (string-prefix? "/" str)
+             (let* ((maybe-idx (string-index str #\space))
+                    (idx (if maybe-idx maybe-idx (string-length str)))
+                    (cmd (substring str 1 idx))
+                    (arg (string-trim (substring str idx))))
+               (match cmd
+                 ((or "h" "help")
+                  (send-message system 'print
+                                "Command          | Description\n"
+                                "------------------------------\n"
+                                "/help              List commands\n"
+                                "/name Name         Set name to use in chat.\n"
+                                "/join <address>    Join chat with specified client\n"
+                                "/clear             Clear recipients\n"
+                                "/list              List current recipients\n"
+                                "/quit              Quit chat"))
+                 ((or "j" "join")
+                  (if (string-null? arg)
+                      (send-message system 'print "Missing address of client.")
+                      (begin
+                        (set! recipients (cons arg recipients))
+                        (send-message system 'print "Added recipient to chat."))))
+                 ((or "c" "clear")
+                  (set! recipients '())
+                  (send-message system 'print "Cleared recipient list."))
+                 ((or "n" "name")
+                  (set! name arg)
+                  (send-message system 'print "Name now set to '" name "'."))
+                 ((or "l" "list")
+                  (if (null? recipients)
+                      (send-message system 'print "Recipients list empty.")
+                      (begin
+                        (send-message system 'print "Current recipients:")
+                        (let loop ((recipients-left recipients))
+                          (unless (null? recipients-left)
+                            (send-message system 'print (car recipients-left))
+                            (loop (cdr recipients-left)))))))
+                 ((or "q" "quit")
+                  (send-message system 'shutdown))
+                 (else
+                  (send-message system 'print "Unrecognised command '" cmd "'"))))
+             (if (null? recipients)
+                 (send-message system 'print "Speaking to the void.")
+                 (let loop ((recipients-left recipients))
+                   (unless (null? recipients-left)
+                     (send-message (car recipients-left) 'show-msg name str)
+                     (loop (cdr recipients-left))))))))
+      (send-message system 'read self)
+      'sleep)))
+
+(define (print-usage)
+  (print "Actor-driven chat client.\n")
+  (print "Usage: chat_client -h")
+  (print "       chat_client [-p port_num] [-n host_name]"))
+
+(let loop ((args (cdr (argv)))
+           (host "localhost")
+           (port 8000))
+  (match args
+    (((or "-h" "--help"))
+     (print-usage))
+    (((or "-p" "--port") pstr rest ...)
+     (loop rest host (string->number pstr)))
+    (((or "-n" "--hostname") hstr rest ...)
+     (loop rest hstr port))
+    (()
+     (init-sam host port)
+     (send-message (make-actor client-beh) 'start)
+     (start-console))
+    (else
+     (print "Unrecognised argument '" (car args) "'.\n")
+     (print-usage))))
 
-(define (main)
-  (let loop ((args (cdr (argv)))
-             (host "localhost")
-             (port 8000))
-    (match args
-      ((or "-h" "--help")
-       (print-usage))
-      (((or "-p" "--port") pstr rest ...)
-       (loop rest host (string->number pstr)))
-      (("--hostname" hstr rest ...)
-       (loop rest hstr port))
-      (()
-       (make-sam host port)
-       (send-message client 'start)))))

diff --git a/sam.scm b/sam.scm
index c3dcbe6..29da169 100644 (file)
--- a/sam.scm
+++ b/sam.scm
@@ -79,7 +79,6 @@
   (define local-queue (make-fifo))
 
   (define (send-message address . message)
-    (print "send-message: Sending " message " to " address)
     (apply (if (address-local? address)
                send-local-message
                send-network-message)
@@ -96,7 +95,7 @@
           (uri (address->uri address))
           (packet (with-output-to-string
                     (lambda ()
-                      (print (cons address message))))))
+                      (write (cons address message))))))
       (udp-bind! s #f 0)
       (udp-connect! s
                     (uri-host uri)
@@ -131,7 +130,6 @@
          (udp-bind! s #f sam-port)
          (let loop ()
            (let-values (((n str) (udp-recv s 1024)))
-             (print "network-listener: Received " n " bytes over network: " str)
              (match (with-input-from-string str read)
                ((address message ...)
                 (apply send-message (cons address message)))
@@ -159,7 +157,6 @@
   (define (start-console)
     (let loop ()
       (let ((reader (next-reader)))
-        (print "console: received next reader: " reader)
         (##sys#thread-block-for-i/o! (current-thread) 0 #t)
         (thread-yield!)
         (send-message reader (read-line)))