The Lambda Lab
/
projects
/
sam.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Replaced URIs as optional string representation of addresses.
[sam.git]
/
chat_client.scm
diff --git
a/chat_client.scm
b/chat_client.scm
index
60d0ee4
..
947418f
100644
(file)
--- a/
chat_client.scm
+++ b/
chat_client.scm
@@
-3,19
+3,18
@@
srfi-13
(chicken process-context))
srfi-13
(chicken process-context))
-(define
client-beh
+(define
(make-client-beh system)
(let ((name "name")
(recipients '()))
(let ((name "name")
(recipients '()))
-
(lambda (self . message)
(match message
(('start)
(send-message system 'print "Welcome to chat!\n"
(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)
"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))
(((? 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
(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 '())
(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 "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))
(loop (cdr recipients-left)))))))
((or "q" "quit")
(send-message system 'shutdown))
@@
-67,6
+66,10
@@
(send-message system 'read self)
'sleep)))
(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")
(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))
(()
(((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))))
(else
(print "Unrecognised argument '" (car args) "'.\n")
(print-usage))))