syndicate-lang
/
racket-matrix-2012
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Improve chat-os2.rkt

This commit is contained in:
Tony Garnock-Jones 2012-07-17 11:58:39 -04:00
parent b8b74183b8
commit c3a95afecf
1 changed files with 15 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
chat-os2.rkt
View File

@ -20,25 +20,25 @@
(match-define (topic _ (tcp-channel connection-id _ _) _) t) (match-define (topic _ (tcp-channel connection-id _ _) _) t)
(define-values (cin cout in-topic out-topic) (tcp-accept t)) (define-values (cin cout in-topic out-topic) (tcp-accept t))
(transition 'no-state (transition 'no-state
(at-meta-level (cout (term->bytes `(you-are ,connection-id))))
(at-meta-level (cin (tcp-mode 'lines)))
(at-meta-level (cin (tcp-credit 1)))
(at-meta-level (role/anon out-topic))
(at-meta-level (role/anon in-topic
#:on-absence (kill)
[(tcp-channel _ _ (? bytes? line))
(list (at-meta-level (cin (tcp-credit 1)))
(send-message `(,connection-id says ,line)))]))
(role/anon (topic-publisher `(,connection-id says ,(wild)))) (role/anon (topic-publisher `(,connection-id says ,(wild))))
(role/anon (topic-subscriber `(,(wild) says ,(wild))) (role/anon (topic-subscriber `(,(wild) says ,(wild)))
#:topic t #:topic t
#:on-presence (match t [(topic _ `(,who ,_ ,_) _) #:on-presence (match t [(topic _ (list who _ _) _)
(when (not (equal? who connection-id)) (unless (equal? who connection-id)
(at-meta-level (cout (term->bytes `(,who arrived)))))]) (at-meta-level (cout (term->bytes `(,who arrived)))))])
#:on-absence (match t [(topic _ `(,who ,_ ,_) _) #:on-absence (match t [(topic _ (list who _ _) _)
(when (not (equal? who connection-id)) (unless (equal? who connection-id)
(at-meta-level (cout (term->bytes `(,who departed)))))]) (at-meta-level (cout (term->bytes `(,who departed)))))])
[message (at-meta-level (cout (term->bytes message)))]))) [message (at-meta-level (cout (term->bytes message)))])
(at-meta-level (cout (term->bytes `(you-are ,connection-id)))
(cin (tcp-mode 'lines))
(cin (tcp-credit 1))
(role/anon out-topic)
(role/anon in-topic
#:on-absence (kill)
[(tcp-channel _ _ (? bytes? line))
(list (at-meta-level (cin (tcp-credit 1)))
(send-message `(,connection-id says ,line)))]))))
(define (term->bytes v) (define (term->bytes v)
(with-output-to-bytes (lambda () (write v) (newline)))) (with-output-to-bytes (lambda () (write v) (newline))))