chat_client.scm

   1 (import sam-macros srfi-13 matchable)
   2
   3 (define (make-client-beh system)
   4   (let ((name "name")
   5         (recipients '()))
   6     (make-beh (self)
   7               (('start) =>
   8                (send-message system 'print "Welcome to chat!\n"
   9                              "Your client address is " (address->string self) ".\n"
  10                              "Type '/help' for a list of commands.\n"))
  11               (('show-msg from text) =>
  12                (send-message system 'print from "> " text))
  13               (((? string? str)) =>
  14                (if (string-prefix? "/" str)
  15                    (let* ((maybe-idx (string-index str #\space))
  16                           (idx (if maybe-idx maybe-idx (string-length str)))
  17                           (cmd (substring str 1 idx))
  18                           (arg (string-trim (substring str idx))))
  19                      (match cmd
  20                        ((or "h" "help")
  21                         (send-message system 'print
  22                                       "Command          | Description\n"
  23                                       "------------------------------\n"
  24                                       "/help              List commands\n"
  25                                       "/name Name         Set name to use in chat.\n"
  26                                       "/join <address>    Join chat with specified client\n"
  27                                       "/clear             Clear recipients\n"
  28                                       "/list              List current recipients\n"
  29                                       "/quit              Quit chat"))
  30                        ((or "j" "join")
  31                         (if (string-null? arg)
  32                             (send-message system 'print "Missing address of client.")
  33                             (begin
  34                               (set! recipients (cons (string->address arg) recipients))
  35                               (send-message system 'print "Added recipient to chat."))))
  36                        ((or "c" "clear")
  37                         (set! recipients '())
  38                         (send-message system 'print "Cleared recipient list."))
  39                        ((or "n" "name")
  40                         (set! name arg)
  41                         (send-message system 'print "Name now set to '" name "'."))
  42                        ((or "l" "list")
  43                         (if (null? recipients)
  44                             (send-message system 'print "Recipients list empty.")
  45                             (begin
  46                               (send-message system 'print "Current recipients:")
  47                               (let loop ((recipients-left recipients))
  48                                 (unless (null? recipients-left)
  49                                   (send-message system 'print (address->string (car recipients-left)))
  50                                   (loop (cdr recipients-left)))))))
  51                        ((or "q" "quit")
  52                         (send-message system 'shutdown))
  53                        (else
  54                         (send-message system 'print "Unrecognised command '" cmd "'"))))
  55                    (if (null? recipients)
  56                        (send-message system 'print "Speaking to the void.")
  57                        (let loop ((recipients-left recipients))
  58                          (unless (null? recipients-left)
  59                            (send-message (car recipients-left) 'show-msg name str)
  60                            (loop (cdr recipients-left)))))))
  61               (finally
  62                (send-message system 'read self)
  63                'sleep))))
  64
  65 (define-beh main-beh (self)
  66   ((system) =>
  67    (send-message (make-actor (make-client-beh system)) 'start)
  68    'done))