From: Tim Vaughan <plugd@thelambdalab.xyz>
Date: Wed, 28 Apr 2021 12:42:39 +0000 (+0200)
Subject: Sketched out simple chat multi-user chat client.
X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=9253a20d269814e27a00a8766a0554856233a561;p=sam.git

Sketched out simple chat multi-user chat client.
---

diff --git a/chat_client.scm b/chat_client.scm
new file mode 100644
index 0000000..bb1fd28
--- /dev/null
+++ b/chat_client.scm
@@ -0,0 +1,60 @@
+(import sam
+        matchable
+        srfi-13)
+
+(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 (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)))))