#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)))