(require (lib "unit.ss"))

(define chat-window@
  (unit
    ; send-message should be str -> void
    (import send-message) 
    
    ; receive-message : str -> void
    (export receive-message)
    
    ; send-message-int : _ _ -> void
    (define (send-message-int obj evnt)
      (send-message (send my-text get-text))
      (send my-text insert "" 0 (string-length (send my-text get-text))))
    
    ; receive-message : str -> void
    ; causes the window to receive a message
    (define (receive-message str)
      (send their-text lock #f)
      (send their-text insert (string-append str "\n"))
      (send their-text lock #t))
    
    (define frame (instantiate frame% ()
                    (label "Example")
                    (height 200)
                    (width 300)))
    (define main-panel (instantiate vertical-panel% ()
                         (parent frame)
                         (alignment '(left top))))
    
    ; text window for the person you're talking to
    (define their-editor (instantiate editor-canvas% (main-panel)))
    (define their-text (instantiate text% ()))
    (send their-editor set-editor their-text)
    (send their-text lock #t) 
    (send their-text hide-caret #t)
    
    ; your text editor
    (define my-editor (instantiate editor-canvas% (main-panel)))
    (define my-text (instantiate text% ()))
    (send my-editor set-editor my-text)
    
    ; the "send message" button
    '(define button-panel (instantiate horizontal-panel% 
                           (main-panel) 
                           (alignment '(center center))))
    (instantiate button% ("Send message" main-panel send-message-int))
        
    (send frame show #t)))

  
(define chatter1@
  (compound-unit
    (import)
    (link (W1 (chat-window@ (W2 receive-message)))
          (W2 (chat-window@ (W1 receive-message))))
    (export)))

(define server-communicator@
  (unit
    (import receive-text LISTEN-PORT)
    (export send-text)

    (define (send-text str) (internal-text-sender str))
    (define internal-text-sender void)
    
    (define (establish-connection)
      (let ((l (tcp-listen LISTEN-PORT)))
        (let-values ([(ip op) (tcp-accept l)])
          (set! internal-text-sender  (lambda (str) (fprintf op "~a\n" str)))
          (receive-text-from ip))))

    (define (receive-text-from ip)
      (thread (lambda ()
                (let loop ()
                  (let ((str (read-line ip)))
                    (cond
                      [(eof-object? str) (void)]
                      [else 
                       (receive-text str)
                       (loop)]))))))
    
    (thread establish-connection)))

(define client-communicator@
  (unit
    (import receive-text HOST CONNECT-PORT)
    (export send-text)

    (define (send-text str) (internal-text-sender str))
    (define internal-text-sender void)
    
    (define (connect-to-server)
      (let-values ([(ip op) (tcp-connect HOST CONNECT-PORT)])
        (set! internal-text-sender (lambda (str) (fprintf op "~a\n" str)))
        (receive-text-from ip)))

    (define (receive-text-from ip)
      (thread (lambda ()
                (let loop ()
                  (let ((str (read-line ip)))
                    (cond
                      [(eof-object? str) (void)]
                      [else 
                       (receive-text str)
                       (loop)]))))))
    
    (thread connect-to-server)))


(define chatter-server@
  (compound-unit
    (import tcp-port)
    (link (WINDOW (chat-window@ (SERVER send-text)))
          (SERVER (server-communicator@ (WINDOW receive-message) tcp-port)))
    (export)))

(define chatter-client@
  (compound-unit
    (import hostname tcp-port)
    (link (WINDOW (chat-window@ (CLIENT send-text)))
          (CLIENT (client-communicator@ (WINDOW receive-message) hostname tcp-port)))
    (export)))

; to start a server: (invoke-unit chatter-server@ <port>)
; to start a client: (invoke-unit chatter-client@ <string[host name]> <port>)