62 lines
1.5 KiB
Racket
62 lines
1.5 KiB
Racket
#lang racket/base
|
|
|
|
(require racket/tcp)
|
|
(require racket/port)
|
|
(require racket/class)
|
|
(require racket/match)
|
|
|
|
(require "conversation.rkt")
|
|
(require "standard-thread.rkt")
|
|
|
|
(define r (make-room))
|
|
|
|
(thread (lambda ()
|
|
(define handle (join-room r 'robot))
|
|
(let loop ()
|
|
(match (send handle listen)
|
|
((says _ "die" _)
|
|
(error 'robot "Following orders!"))
|
|
((and m (says _ _ _))
|
|
(send handle say `(robot hears ,m) 'echo))
|
|
(else (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)
|
|
(flush-output o))
|
|
(let ((handle (join-room r name)))
|
|
(let loop ()
|
|
(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)
|
|
(flush-output o)
|
|
(loop)))
|
|
(handle-evt (read-line-evt i 'any)
|
|
(lambda (utterance)
|
|
(when (equal? utterance "error")
|
|
(error 'interaction "Following orders!"))
|
|
(when (not (eof-object? utterance))
|
|
(send handle say utterance 'speech)
|
|
(loop)))))))))
|
|
|
|
(thread (lambda ()
|
|
(interaction (current-input-port) (current-output-port))))
|
|
|
|
(let ((s (tcp-listen 5001 4 #t)))
|
|
(let accept-loop ()
|
|
(define-values (i o) (tcp-accept s))
|
|
(thread (lambda ()
|
|
(interaction i o)
|
|
(close-input-port i)
|
|
(close-output-port o)))
|
|
(accept-loop)))
|
|
|