chat_client.scm

   1 (import sam
   2         matchable
   3         srfi-13)
   4
   5 (define client
   6   (make-actor
   7    (lambda (self . message)
   8      (let ((name "name")
   9            (recipients '()))
  10
  11        (match message
  12          (('start)
  13           (send-message system 'print "Welcome to chat!\n"
  14                         "Your client address is " (address->string 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))
  19          (((? string? str))
  20           (if (string-prefix? "/" str)
  21               (let* ((idx (string-index str #\space))
  22                      (cmd (substring str 1 idx))
  23                      (arg (substring str idx)))
  24                 (match cmd
  25                   ("help"
  26                    (send-message system 'print
  27                                  "Command          | Description\n"
  28                                  "------------------------------\n"
  29                                  "\help              List commands\n"
  30                                  "\join <address>    Join chat with specified client\n"
  31                                  "\quit              Quit chat"))
  32                   ("join"
  33                    (set! recipients (cons (uri-reference arg) recipients))
  34                    (send-message system 'print "Added recipient to chat."))
  35                   ("quit"
  36                    (send-message system 'exit))
  37                   (else
  38                    (send-message system 'print "Unrecognised command '" cmd "'"))))
  39               (let loop (recipients-left recipients)
  40                 (unless (null? recipients-left)
  41                   (send-message (car recipients-left) 'show-msg name str)
  42                   (loop (cdr recipients-left)))))))
  43        (send-message system 'read self)
  44        'sleep))))
  45
  46
  47 (define (main)
  48   (let loop ((args (cdr (argv)))
  49              (host "localhost")
  50              (port 8000))
  51     (match args
  52       ((or "-h" "--help")
  53        (print-usage))
  54       (((or "-p" "--port") pstr rest ...)
  55        (loop rest host (string->number pstr)))
  56       (("--hostname" hstr rest ...)
  57        (loop rest hstr port))
  58       (()
  59        (make-sam host port)
  60        (send-message client 'start)))))