1 (import sam-macros srfi-13 matchable)
3 (define (make-rollodex-beh system)
4 (let ((recipients '()))
8 (send-message system 'print "Recipients list empty.")
10 (send-message system 'print "Current recipients")
11 (let loop ((r recipients))
13 (send-message system 'print (address->string (car r)))
17 (send-message system 'print "Cleared recipient list."))
19 (set! recipients (cons (string->address rstr) recipients))
20 (send-message system 'print "Added recipient to chat."))
22 (if (null? recipients)
23 (send-message system 'print "Speaking to the void.")
24 (let loop ((recipients-left recipients))
25 (unless (null? recipients-left)
26 (send-message (car recipients-left) 'show-msg name str)
27 (loop (cdr recipients-left)))))))))
29 (define (make-receiver-beh system)
31 (('show-msg from text) =>
32 (send-message system 'print from "> " text))))
35 (define (make-client-beh system)
37 (rollodex (make-actor (make-rollodex-beh system)))
38 (receiver (make-actor (make-receiver-beh system))))
41 (send-message system 'print "Welcome to chat!\n"
42 "Your client address is " (address->string receiver) ".\n"
43 "Type '/help' for a list of commands.\n")
44 (send-message system 'read self))
46 (if (string-prefix? "/" str)
47 (let* ((maybe-idx (string-index str #\space))
48 (idx (if maybe-idx maybe-idx (string-length str)))
49 (cmd (substring str 1 idx))
50 (arg (string-trim (substring str idx))))
53 (send-message system 'print
54 "Command | Description\n"
55 "------------------------------\n"
56 "/help List commands\n"
57 "/name Name Set name to use in chat.\n"
58 "/add <address> Add specified client as recipient\n"
59 "/clear Clear recipients\n"
60 "/list List current recipients\n"
63 (if (string-null? arg)
64 (send-message system 'print "Missing address of client.")
65 (send-message rollodex 'add arg)))
67 (send-message rollodex 'clear))
70 (send-message system 'print "Name now set to '" name "'."))
72 (send-message rollodex 'list))
74 (send-message system 'shutdown))
76 (send-message system 'print "Unrecognised command '" cmd "'"))))
77 (send-message rollodex 'send name str))
78 (send-message system 'read self)))))
80 (define-beh main-beh (self)
82 (send-message (make-actor (make-client-beh system)) 'start)