X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=chat_client.scm;h=d50057992ec5df9432d78dbcc8dc59540c881a0a;hb=5d2d076345efb45ced333e832d1cbf766bcd5e8a;hp=4bf02d8f018bbd17f004e0ce406d43755b2866a8;hpb=38a62fdef7fe2929d7e0bba8a847a3e1cc50c177;p=sam.git diff --git a/chat_client.scm b/chat_client.scm index 4bf02d8..d500579 100644 --- a/chat_client.scm +++ b/chat_client.scm @@ -1,5 +1,4 @@ -(import sam - matchable +(import matchable srfi-13 (chicken process-context)) @@ -10,11 +9,11 @@ (match message (('start) (send-message system 'print "Welcome to chat!\n" - "Your client address is " self ".\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)) + (send-message system 'print from "> " text)) (((? string? str)) (if (string-prefix? "/" str) (let* ((maybe-idx (string-index str #\space)) @@ -36,7 +35,7 @@ (if (string-null? arg) (send-message system 'print "Missing address of client.") (begin - (set! recipients (cons arg recipients)) + (set! recipients (cons (string->address arg) recipients)) (send-message system 'print "Added recipient to chat.")))) ((or "c" "clear") (set! recipients '()) @@ -51,7 +50,7 @@ (send-message system 'print "Current recipients:") (let loop ((recipients-left recipients)) (unless (null? recipients-left) - (send-message system 'print (car recipients-left)) + (send-message system 'print (address->string (car recipients-left))) (loop (cdr recipients-left))))))) ((or "q" "quit") (send-message system 'shutdown)) @@ -69,25 +68,3 @@ (define (main-beh self system) (send-message (make-actor (make-client-beh system)) 'start) 'done) - -(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)) - (() - (boot-sam host port main-beh)) - (else - (print "Unrecognised argument '" (car args) "'.\n") - (print-usage)))) -