98 lines
2.7 KiB
Racket
98 lines
2.7 KiB
Racket
#lang racket/base
|
|
|
|
(require racket/tcp)
|
|
(require racket/port)
|
|
(require racket/class)
|
|
(require racket/match)
|
|
(require racket/pretty)
|
|
|
|
(require "conversation.rkt")
|
|
(require "standard-thread.rkt")
|
|
|
|
(define r (make-room))
|
|
|
|
(standard-thread
|
|
(lambda ()
|
|
(define handle (join-room r))
|
|
(send handle assert! (topic-subscriber (wild) #:virtual? #t))
|
|
(send handle assert! (topic-publisher (wild) #:virtual? #t))
|
|
(let loop ()
|
|
(define m (send handle listen))
|
|
;;(write `(robot heard ,m)) (newline)
|
|
(match m
|
|
;;[(arrived who) (write `(robot hears arrival ,who)) (newline)]
|
|
[(says _ "die")
|
|
(error 'robot "Following orders!")]
|
|
[(says (topic 'publisher _ _) _)
|
|
(send handle say (topic-subscriber (wild)) `(robot hears ,m))]
|
|
[_ (void)])
|
|
(loop))))
|
|
|
|
(define (interaction i o)
|
|
(display "What is your name? > " o)
|
|
(flush-output o)
|
|
(define name (read-line i))
|
|
(if (eof-object? name)
|
|
(begin (display "OK, bye then!" o)
|
|
(newline o)
|
|
(flush-output o))
|
|
(let ((handle (join-room r)))
|
|
(define talk-topic (topic-publisher (list name (wild) 'speech)))
|
|
(define listen-topic (topic-subscriber (list (wild) name 'speech)))
|
|
(send handle assert! talk-topic)
|
|
(send handle assert! listen-topic)
|
|
(let loop ()
|
|
;;(pretty-print (send handle current-flows))
|
|
(display name o)
|
|
(display "@ROOM>> " o)
|
|
(flush-output o)
|
|
(sync (handle-evt (send handle listen-evt)
|
|
(lambda (m)
|
|
(write `(,name hears ,m) o)
|
|
(newline o)
|
|
(match m
|
|
[(says (topic 'publisher (list (== name) _ _) _) _)
|
|
(write `(,name not acking own utterance) o)
|
|
(newline o)]
|
|
[(says (and specific-topic (topic 'publisher _ _)) _)
|
|
(write `(,name acking) o)
|
|
(newline o)
|
|
(send handle say
|
|
(co-topic specific-topic 'subscriber)
|
|
(list name 'ack))]
|
|
[_ (void)])
|
|
(flush-output o)
|
|
(loop)))
|
|
(handle-evt (read-line-evt i 'any)
|
|
(lambda (utterance)
|
|
(when (equal? utterance "error")
|
|
(error 'interaction "Following orders!"))
|
|
(if (eof-object? utterance)
|
|
(begin (display "Closing session." o)
|
|
(newline o)
|
|
(flush-output o)
|
|
(send handle depart))
|
|
(begin (send handle say talk-topic utterance)
|
|
(loop))))))))))
|
|
|
|
(standard-thread
|
|
(lambda ()
|
|
(let loop ()
|
|
(interaction (current-input-port) (current-output-port))
|
|
(loop))))
|
|
|
|
(define port-number 5001)
|
|
(display "Listening on port ")
|
|
(display port-number)
|
|
(newline)
|
|
(let ((s (tcp-listen port-number 4 #t)))
|
|
(let accept-loop ()
|
|
(define-values (i o) (tcp-accept s))
|
|
(standard-thread
|
|
(lambda ()
|
|
(interaction i o)
|
|
(close-input-port i)
|
|
(close-output-port o)))
|
|
(accept-loop)))
|
|
|