4 (chicken process-context))
6 (define (make-client-beh system)
9 (lambda (self . message)
12 (send-message system 'print "Welcome to chat!\n"
13 "Your client address is " (address->string self) ".\n"
14 "Type '/help' for a list of commands.\n")
15 (send-message system 'read self))
16 (('show-msg from text)
17 (send-message system 'print "Message from " from ": " text))
19 (if (string-prefix? "/" str)
20 (let* ((maybe-idx (string-index str #\space))
21 (idx (if maybe-idx maybe-idx (string-length str)))
22 (cmd (substring str 1 idx))
23 (arg (string-trim (substring str idx))))
26 (send-message system 'print
27 "Command | Description\n"
28 "------------------------------\n"
29 "/help List commands\n"
30 "/name Name Set name to use in chat.\n"
31 "/join <address> Join chat with specified client\n"
32 "/clear Clear recipients\n"
33 "/list List current recipients\n"
36 (if (string-null? arg)
37 (send-message system 'print "Missing address of client.")
39 (set! recipients (cons (string->address arg) recipients))
40 (send-message system 'print "Added recipient to chat."))))
43 (send-message system 'print "Cleared recipient list."))
46 (send-message system 'print "Name now set to '" name "'."))
48 (if (null? recipients)
49 (send-message system 'print "Recipients list empty.")
51 (send-message system 'print "Current recipients:")
52 (let loop ((recipients-left recipients))
53 (unless (null? recipients-left)
54 (send-message system 'print (car recipients-left))
55 (loop (cdr recipients-left)))))))
57 (send-message system 'shutdown))
59 (send-message system 'print "Unrecognised command '" cmd "'"))))
60 (if (null? recipients)
61 (send-message system 'print "Speaking to the void.")
62 (let loop ((recipients-left recipients))
63 (unless (null? recipients-left)
64 (send-message (car recipients-left) 'show-msg name str)
65 (loop (cdr recipients-left))))))))
66 (send-message system 'read self)
69 (define (main-beh self system)
70 (send-message (make-actor (make-client-beh system)) 'start)
74 (print "Actor-driven chat client.\n")
75 (print "Usage: chat_client -h")
76 (print " chat_client [-p port_num] [-n host_name]"))
78 (let loop ((args (cdr (argv)))
84 (((or "-p" "--port") pstr rest ...)
85 (loop rest host (string->number pstr)))
86 (((or "-n" "--hostname") hstr rest ...)
87 (loop rest hstr port))
89 (boot-sam host port main-beh))
91 (print "Unrecognised argument '" (car args) "'.\n")