From dd9d28a6e6bb76533890d84cb48900352ff8fa68 Mon Sep 17 00:00:00 2001 From: Tim Vaughan Date: Mon, 3 May 2021 00:16:33 +0200 Subject: [PATCH] Refactored chat client. --- chat_client.scm | 70 +++++++++++++++++++++++++++++++------------------ sam.scm | 1 + 2 files changed, 46 insertions(+), 25 deletions(-) diff --git a/chat_client.scm b/chat_client.scm index e6e205d..e12bc67 100644 --- 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
Join chat with specified client\n" + "/add
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 --- 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)) -- 2.20.1