From 0fb9daea3d2da0258a787e5918bf5622a2f70d1e Mon Sep 17 00:00:00 2001 From: Tim Vaughan Date: Wed, 28 Apr 2021 21:37:34 +0200 Subject: [PATCH] P2P chat works. --- chat_client.scm | 144 +++++++++++++++++++++++++++++------------------- sam.scm | 5 +- 2 files changed, 89 insertions(+), 60 deletions(-) diff --git a/chat_client.scm b/chat_client.scm index bb1fd28..60d0ee4 100644 --- a/chat_client.scm +++ b/chat_client.scm @@ -1,60 +1,92 @@ (import sam matchable - srfi-13) + srfi-13 + (chicken process-context)) -(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 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
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]")) + +(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 (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))))) diff --git a/sam.scm b/sam.scm index c3dcbe6..29da169 100644 --- a/sam.scm +++ b/sam.scm @@ -79,7 +79,6 @@ (define local-queue (make-fifo)) (define (send-message address . message) - (print "send-message: Sending " message " to " address) (apply (if (address-local? address) send-local-message send-network-message) @@ -96,7 +95,7 @@ (uri (address->uri address)) (packet (with-output-to-string (lambda () - (print (cons address message)))))) + (write (cons address message)))))) (udp-bind! s #f 0) (udp-connect! s (uri-host uri) @@ -131,7 +130,6 @@ (udp-bind! s #f sam-port) (let loop () (let-values (((n str) (udp-recv s 1024))) - (print "network-listener: Received " n " bytes over network: " str) (match (with-input-from-string str read) ((address message ...) (apply send-message (cons address message))) @@ -159,7 +157,6 @@ (define (start-console) (let loop () (let ((reader (next-reader))) - (print "console: received next reader: " reader) (##sys#thread-block-for-i/o! (current-thread) 0 #t) (thread-yield!) (send-message reader (read-line))) -- 2.20.1