4 (chicken process-context))
10 (lambda (self . message)
13 (send-message system 'print "Welcome to chat!\n"
14 "Your client address is " self ".\n"
15 "Type '/help' for a list of commands.\n")
16 (send-message system 'read self))
17 (('show-msg from text)
18 (send-message system 'print "Message from " from ": " text))
20 (if (string-prefix? "/" str)
21 (let* ((maybe-idx (string-index str #\space))
22 (idx (if maybe-idx maybe-idx (string-length str)))
23 (cmd (substring str 1 idx))
24 (arg (string-trim (substring str idx))))
27 (send-message system 'print
28 "Command | Description\n"
29 "------------------------------\n"
30 "/help List commands\n"
31 "/name Name Set name to use in chat.\n"
32 "/join <address> Join chat with specified client\n"
33 "/clear Clear recipients\n"
34 "/list List current recipients\n"
37 (if (string-null? arg)
38 (send-message system 'print "Missing address of client.")
40 (set! recipients (cons arg recipients))
41 (send-message system 'print "Added recipient to chat."))))
44 (send-message system 'print "Cleared recipient list."))
47 (send-message system 'print "Name now set to '" name "'."))
49 (if (null? recipients)
50 (send-message system 'print "Recipients list empty.")
52 (send-message system 'print "Current recipients:")
53 (let loop ((recipients-left recipients))
54 (unless (null? recipients-left)
55 (send-message system 'print (car recipients-left))
56 (loop (cdr recipients-left)))))))
58 (send-message system 'shutdown))
60 (send-message system 'print "Unrecognised command '" cmd "'"))))
61 (if (null? recipients)
62 (send-message system 'print "Speaking to the void.")
63 (let loop ((recipients-left recipients))
64 (unless (null? recipients-left)
65 (send-message (car recipients-left) 'show-msg name str)
66 (loop (cdr recipients-left))))))))
67 (send-message system 'read self)
71 (print "Actor-driven chat client.\n")
72 (print "Usage: chat_client -h")
73 (print " chat_client [-p port_num] [-n host_name]"))
75 (let loop ((args (cdr (argv)))
81 (((or "-p" "--port") pstr rest ...)
82 (loop rest host (string->number pstr)))
83 (((or "-n" "--hostname") hstr rest ...)
84 (loop rest hstr port))
87 (send-message (make-actor client-beh) 'start)
90 (print "Unrecognised argument '" (car args) "'.\n")