;;; SPDX-License-Identifier: LGPL-3.0-or-later ;;; SPDX-FileCopyrightText: Copyright © 2010-2021 Tony Garnock-Jones #lang syndicate (require/activate syndicate/distributed) (require/activate syndicate/drivers/external-event) (require (only-in racket/port read-line-evt)) (assertion-struct Present (name)) (message-struct Says (who what)) (define host (make-parameter "localhost")) (define port (make-parameter 8001)) (define scope (make-parameter "chat")) (define initial-username (make-parameter (symbol->string (strong-gensym 'chatter-)))) (file-stream-buffer-mode (current-output-port) 'line) (module+ main (require racket/cmdline) (command-line #:once-each ["--host" hostname "Server hostname" (host hostname)] ["--port" portnum "Server port number" (port (string->number portnum))] ["--scope" scopename "Server scope" (scope scopename)] ["--nick" nick "User nickname" (initial-username nick)])) (spawn #:name 'main (field [username (initial-username)]) (define root-facet (current-facet)) (define url (server-tcp-connection (host) (port) (scope))) (during (server-connected url) (on-start (log-info "Connected to server.")) (on-stop (log-info "Disconnected from server.")) (on (asserted (from-server url (Present $who))) (printf "~a arrived.\n" who)) (on (retracted (from-server url (Present $who))) (printf "~a departed.\n" who)) (on (message (from-server url (Says $who $what))) (printf "~a: ~a\n" who what)) (assert (to-server url (Present (username)))) (define stdin-evt (read-line-evt (current-input-port) 'any)) (on (message (inbound (external-event stdin-evt (list $line)))) (match line [(? eof-object?) (stop-facet root-facet)] [(pregexp #px"^/nick (.+)$" (list _ newnick)) (username newnick)] [other (send! (to-server url (Says (username) other)))]))))