Refactored chat client.

diff --git a/chat_client.scm b/chat_client.scm
index e6e205d..e12bc67 100644 (file)
--- a/chat_client.scm
+++ b/chat_client.scm
@@ -1,15 +1,49 @@
 (import sam-macros srfi-13 matchable)
 
+(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))))))
+              (finally
+               'sleep))))
+               
+(define (make-receiver-beh system)
+  (make-beh (self)
+            (('show-msg from text) =>
+             (send-message system 'print from "> " text)
+             'sleep)))
+            
+
 (define (make-client-beh system)
   (let ((name "name")
-        (recipients '()))
+        (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 self) ".\n"
+                             "Your client address is " (address->string receiver) ".\n"
                              "Type '/help' for a list of commands.\n"))
-              (('show-msg from text) =>
-               (send-message system 'print from "> " text))
               (((? string? str)) =>
                (if (string-prefix? "/" str)
                    (let* ((maybe-idx (string-index str #\space))
@@ -23,41 +57,27 @@
                                       "------------------------------\n"
                                       "/help              List commands\n"
                                       "/name Name         Set name to use in chat.\n"
-                                      "/join <address>    Join chat with specified client\n"
+                                      "/add <address>     Add specified client as recipient\n"
                                       "/clear             Clear recipients\n"
                                       "/list              List current recipients\n"
                                       "/quit              Quit chat"))
-                       ((or "j" "join")
+                       ((or "a" "add")
                         (if (string-null? arg)
                             (send-message system 'print "Missing address of client.")
-                            (begin
-                              (set! recipients (cons (string->address arg) recipients))
-                              (send-message system 'print "Added recipient to chat."))))
+                            (send-message rollodex 'add arg)))
                        ((or "c" "clear")
-                        (set! recipients '())
-                        (send-message system 'print "Cleared recipient list."))
+                        (send-message rollodex 'clear))
                        ((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 (address->string (car recipients-left)))
-                                  (loop (cdr recipients-left)))))))
+                        (send-message rollodex 'list))
                        ((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 rollodex 'send name str)))
+
               (finally
                (send-message system 'read self)
                'sleep))))

diff --git a/sam.scm b/sam.scm
index 846561c..f09914e 100644 (file)
--- a/sam.scm
+++ b/sam.scm
@@ -43,6 +43,7 @@
       (if trace (apply log-msg args)))))
 
 ;; Behaviours
+;; (See also macros defined in sam-macros.scm.)
 
 (define (beh-proc beh)
   (car beh))