X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=sam.git;a=blobdiff_plain;f=chat_client.scm;h=48736a8e684fc656d70bc94d271c22bb0d0f1e9c;hp=60d0ee4ca312bbccf0556f92cd31cd0c97422f7d;hb=HEAD;hpb=0fb9daea3d2da0258a787e5918bf5622a2f70d1e

diff --git a/chat_client.scm b/chat_client.scm
index 60d0ee4..48736a8 100644
--- a/chat_client.scm
+++ b/chat_client.scm
@@ -1,92 +1,83 @@
-(import sam
-        matchable
-        srfi-13
-        (chicken process-context))
+(import sam-macros srfi-13 matchable)
 
-(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]"))
+(define (make-rollodex-beh system)
+  (let ((recipients '()))
+    (make-beh (self)
+              (('list) =>
+               (if (null? recipients)
+                   (send-message system 'print "Recipients list empty.")
+                   (begin
+                     (send-message system 'print "Current recipients")
+                     (let loop ((r recipients))
+                       (unless (null? r)
+                         (send-message system 'print (address->string (car r)))
+                         (loop (cdr r)))))))
+              (('clear) =>
+               (set! recipients '())
+               (send-message system 'print "Cleared recipient list."))
+              (('add rstr) =>
+               (set! recipients (cons (string->address rstr) recipients))
+               (send-message system 'print "Added recipient to chat."))
+              (('send name str) =>
+               (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)))))))))
+               
+(define (make-receiver-beh system)
+  (make-beh (self)
+            (('show-msg from text) =>
+             (send-message system 'print from "> " text))))
+            
 
-(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 (make-client-beh system)
+  (let ((name "name")
+        (rollodex (make-actor (make-rollodex-beh system)))
+        (receiver (make-actor (make-receiver-beh system))))          
+    (make-beh (self)
+              (('start) =>
+               (send-message system 'print "Welcome to chat!\n"
+                             "Your client address is " (address->string receiver) ".\n"
+                             "Type '/help' for a list of commands.\n")
+               (send-message system 'read self))
+              (((? 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"
+                                      "/add <address>     Add specified client as recipient\n"
+                                      "/clear             Clear recipients\n"
+                                      "/list              List current recipients\n"
+                                      "/quit              Quit chat"))
+                       ((or "a" "add")
+                        (if (string-null? arg)
+                            (send-message system 'print "Missing address of client.")
+                            (send-message rollodex 'add arg)))
+                       ((or "c" "clear")
+                        (send-message rollodex 'clear))
+                       ((or "n" "name")
+                        (set! name arg)
+                        (send-message system 'print "Name now set to '" name "'."))
+                       ((or "l" "list")
+                        (send-message rollodex 'list))
+                       ((or "q" "quit")
+                        (send-message system 'shutdown))
+                       (else
+                        (send-message system 'print "Unrecognised command '" cmd "'"))))
+                   (send-message rollodex 'send name str))
+               (send-message system 'read self)))))
 
+(define-beh main-beh (self)
+  ((system) =>
+   (send-message (make-actor (make-client-beh system)) 'start)
+   'done))