X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=sam.git;a=blobdiff_plain;f=chat_client.scm;h=947418f09d7be452767bcedfa7c9487469aa00c3;hp=60d0ee4ca312bbccf0556f92cd31cd0c97422f7d;hb=d9768084b4cde1dd4ac4edcbb432b7df4101bfc2;hpb=0fb9daea3d2da0258a787e5918bf5622a2f70d1e diff --git a/chat_client.scm b/chat_client.scm index 60d0ee4..947418f 100644 --- a/chat_client.scm +++ b/chat_client.scm @@ -3,19 +3,18 @@ srfi-13 (chicken process-context)) -(define client-beh +(define (make-client-beh system) (let ((name "name") (recipients '())) - (lambda (self . message) (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)) @@ -37,7 +36,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 '()) @@ -52,7 +51,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)) @@ -67,6 +66,10 @@ (send-message system 'read self) 'sleep))) +(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") @@ -83,9 +86,7 @@ (((or "-n" "--hostname") hstr rest ...) (loop rest hstr port)) (() - (init-sam host port) - (send-message (make-actor client-beh) 'start) - (start-console)) + (boot-sam host port main-beh)) (else (print "Unrecognised argument '" (car args) "'.\n") (print-usage))))