syndicate-rkt/OLD-syndicate-examples/chat-client.rkt

38 lines
1.4 KiB
Racket

;;; SPDX-License-Identifier: LGPL-3.0-or-later
;;; SPDX-FileCopyrightText: Copyright © 2010-2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
#lang syndicate
(require/activate syndicate/drivers/tcp)
(require/activate syndicate/drivers/external-event)
(require/activate syndicate/reassert)
(require (only-in racket/port read-bytes-line-evt))
(spawn (define id 'chat)
(define root-facet (current-facet))
(reassert-on (tcp-connection id (tcp-address "localhost" 5999))
(retracted (tcp-accepted id))
(asserted (tcp-rejected id _)))
(on (asserted (tcp-rejected id $reason))
(printf "*** ~a\n" (exn-message reason)))
(during (tcp-accepted id)
(on-start (printf "*** Connected.\n")
(issue-credit! tcp-in id))
(on (retracted (tcp-accepted id)) (printf "*** Remote EOF.\n"))
;; ^ Not on-stop, because the facet is stopped by local EOF too!
(on (message (tcp-in-line id $bs))
(write-bytes bs)
(newline)
(flush-output)
(issue-credit! tcp-in id))
(define stdin-evt (read-bytes-line-evt (current-input-port) 'any))
(on (message (inbound (external-event stdin-evt (list $line))))
(if (eof-object? line)
(stop-facet root-facet (printf "*** Local EOF. Terminating.\n"))
(send! (tcp-out id (bytes-append line #"\n")))))))