From 9253a20d269814e27a00a8766a0554856233a561 Mon Sep 17 00:00:00 2001 From: Tim Vaughan Date: Wed, 28 Apr 2021 14:42:39 +0200 Subject: [PATCH] Sketched out simple chat multi-user chat client. --- chat_client.scm | 60 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 60 insertions(+) create mode 100644 chat_client.scm 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
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))))) -- 2.20.1