chat_client.scm

   1 (import sam-macros srfi-13 matchable)
   2
   3 (define (make-rollodex-beh system)
   4   (let ((recipients '()))
   5     (make-beh (self)
   6               (('list) =>
   7                (if (null? recipients)
   8                    (send-message system 'print "Recipients list empty.")
   9                    (begin
  10                      (send-message system 'print "Current recipients")
  11                      (let loop ((r recipients))
  12                        (unless (null? r)
  13                          (send-message system 'print (address->string (car r)))
  14                          (loop (cdr r)))))))
  15               (('clear) =>
  16                (set! recipients '())
  17                (send-message system 'print "Cleared recipient list."))
  18               (('add rstr) =>
  19                (set! recipients (cons (string->address rstr) recipients))
  20                (send-message system 'print "Added recipient to chat."))
  21               (('send name str) =>
  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))))))
  28               (finally
  29                'sleep))))
  30
  31 (define (make-receiver-beh system)
  32   (make-beh (self)
  33             (('show-msg from text) =>
  34              (send-message system 'print from "> " text)
  35              'sleep)))
  36
  37
  38 (define (make-client-beh system)
  39   (let ((name "name")
  40         (rollodex (make-actor (make-rollodex-beh system)))
  41         (receiver (make-actor (make-receiver-beh system))))
  42     (make-beh (self)
  43               (('start) =>
  44                (send-message system 'print "Welcome to chat!\n"
  45                              "Your client address is " (address->string receiver) ".\n"
  46                              "Type '/help' for a list of commands.\n"))
  47               (((? string? str)) =>
  48                (if (string-prefix? "/" str)
  49                    (let* ((maybe-idx (string-index str #\space))
  50                           (idx (if maybe-idx maybe-idx (string-length str)))
  51                           (cmd (substring str 1 idx))
  52                           (arg (string-trim (substring str idx))))
  53                      (match cmd
  54                        ((or "h" "help")
  55                         (send-message system 'print
  56                                       "Command          | Description\n"
  57                                       "------------------------------\n"
  58                                       "/help              List commands\n"
  59                                       "/name Name         Set name to use in chat.\n"
  60                                       "/add <address>     Add specified client as recipient\n"
  61                                       "/clear             Clear recipients\n"
  62                                       "/list              List current recipients\n"
  63                                       "/quit              Quit chat"))
  64                        ((or "a" "add")
  65                         (if (string-null? arg)
  66                             (send-message system 'print "Missing address of client.")
  67                             (send-message rollodex 'add arg)))
  68                        ((or "c" "clear")
  69                         (send-message rollodex 'clear))
  70                        ((or "n" "name")
  71                         (set! name arg)
  72                         (send-message system 'print "Name now set to '" name "'."))
  73                        ((or "l" "list")
  74                         (send-message rollodex 'list))
  75                        ((or "q" "quit")
  76                         (send-message system 'shutdown))
  77                        (else
  78                         (send-message system 'print "Unrecognised command '" cmd "'"))))
  79                    (send-message rollodex 'send name str)))
  80
  81               (finally
  82                (send-message system 'read self)
  83                'sleep))))
  84
  85 (define-beh main-beh (self)
  86   ((system) =>
  87    (send-message (make-actor (make-client-beh system)) 'start)
  88    'done))