3 (chicken process-context))
5 (define (make-client-beh system)
8 (lambda (self . message)
11 (send-message system 'print "Welcome to chat!\n"
12 "Your client address is " (address->string self) ".\n"
13 "Type '/help' for a list of commands.\n")
14 (send-message system 'read self))
15 (('show-msg from text)
16 (send-message system 'print from "> " text))
18 (if (string-prefix? "/" str)
19 (let* ((maybe-idx (string-index str #\space))
20 (idx (if maybe-idx maybe-idx (string-length str)))
21 (cmd (substring str 1 idx))
22 (arg (string-trim (substring str idx))))
25 (send-message system 'print
26 "Command | Description\n"
27 "------------------------------\n"
28 "/help List commands\n"
29 "/name Name Set name to use in chat.\n"
30 "/join <address> Join chat with specified client\n"
31 "/clear Clear recipients\n"
32 "/list List current recipients\n"
35 (if (string-null? arg)
36 (send-message system 'print "Missing address of client.")
38 (set! recipients (cons (string->address arg) recipients))
39 (send-message system 'print "Added recipient to chat."))))
42 (send-message system 'print "Cleared recipient list."))
45 (send-message system 'print "Name now set to '" name "'."))
47 (if (null? recipients)
48 (send-message system 'print "Recipients list empty.")
50 (send-message system 'print "Current recipients:")
51 (let loop ((recipients-left recipients))
52 (unless (null? recipients-left)
53 (send-message system 'print (address->string (car recipients-left)))
54 (loop (cdr recipients-left)))))))
56 (send-message system 'shutdown))
58 (send-message system 'print "Unrecognised command '" cmd "'"))))
59 (if (null? recipients)
60 (send-message system 'print "Speaking to the void.")
61 (let loop ((recipients-left recipients))
62 (unless (null? recipients-left)
63 (send-message (car recipients-left) 'show-msg name str)
64 (loop (cdr recipients-left))))))))
65 (send-message system 'read self)
68 (define (main-beh self system)
69 (send-message (make-actor (make-client-beh system)) 'start)