74 lines
1.7 KiB
Racket
74 lines
1.7 KiB
Racket
#lang racket/base
|
|
|
|
(require racket/list)
|
|
(require racket/port)
|
|
(require racket/match)
|
|
(require "os2.rkt")
|
|
(require "fake-tcp.rkt")
|
|
|
|
(define (term->bytes v)
|
|
(with-output-to-bytes (lambda () (write v) (newline))))
|
|
|
|
;;---------------------------------------------------------------------------
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define listener
|
|
(nested-vm
|
|
(at-meta-level
|
|
(role (tcp-listener 5999)
|
|
#:topic t
|
|
#:on-presence
|
|
(spawn (connection-handler t))))))
|
|
|
|
(define (connection-handler t)
|
|
(define me (gensym 'user))
|
|
(define-values
|
|
(cin cout in-topic out-topic)
|
|
(tcp-accept t))
|
|
(transition 'no-state
|
|
(chat-roles me cout)
|
|
(net-roles me
|
|
cin cout
|
|
in-topic out-topic)))
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define (chat-roles me cout)
|
|
(define (announce t did-what)
|
|
(define who (first (topic-pattern t)))
|
|
(unless (equal? who me)
|
|
(at-meta-level
|
|
(cout (term->bytes
|
|
`(,who ,did-what))))))
|
|
(list
|
|
(role (topic-publisher
|
|
`(,me says ,(wild))))
|
|
(role (topic-subscriber
|
|
`(,(wild) says ,(wild)))
|
|
#:topic t
|
|
#:on-presence (announce t 'arrived)
|
|
#:on-absence (announce t 'departed)
|
|
[msg (at-meta-level
|
|
(cout (term->bytes msg)))])))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define (net-roles me
|
|
cin cout
|
|
in-topic out-topic)
|
|
(at-meta-level
|
|
(cout (term->bytes `(you-are ,me)))
|
|
(cin (tcp-mode 'lines))
|
|
(cin (tcp-credit 1))
|
|
(role out-topic)
|
|
(role in-topic
|
|
#:on-absence (kill)
|
|
[(tcp-channel _ _ (? bytes? line))
|
|
(list (at-meta-level
|
|
(cin (tcp-credit 1)))
|
|
(send-message
|
|
`(,me says ,line)))])))
|
|
|
|
(ground-vm
|
|
(spawn tcp-driver)
|
|
(spawn listener))
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|