;-----------------------------------------------------------------------------
; [2016-03-19] Challenge #258 [Hard]
; IRC: Interactivity
;
; Tetsumi <tetsumi@vmail.me>
;
; Compatible with
;  RACKET
;-----------------------------------------------------------------------------

#lang racket/gui

(require racket/tcp racket/date)

(define-values (address port) (apply values (string-split (read-line) ":")))
(define nickname (read-line))
(define username (read-line))
(define realname (read-line))
(define serverEditor (new text% [auto-wrap #t]))
(define pmEditor (new text% [auto-wrap #t]))
(define channels (make-hash (list (cons "Server" (cons serverEditor (set)))
				  (cons nickname (cons pmEditor     (set))))))

(define (onTabSwitch field event)
  (define sel (send tabPanel get-selection))
  (define chanData (hash-ref channels (send
				       tabPanel
				       get-item-label
				       sel)))
  (define shown? (send usersListBox is-shown?))
  (if (>= 1 sel)
      (when shown? (send tabHorPanel delete-child usersListBox))
      (unless shown?
	(send tabHorPanel add-child usersListBox)))
  (send editorBox
	set-editor
	(car chanData))
  (send (car chanData) move-position 'end)
  (updateusersListBox (cdr chanData)))

(define frame (new frame% [label "DP 258 Hard"]))

(define tabPanel (new tab-panel%
		      [parent frame]
		      [choices (list "Server" nickname)]
		      [callback onTabSwitch]))

(define tabHorPanel (new horizontal-panel%
			 [parent tabPanel]))

(define editorBox (new editor-canvas%
		       [parent tabHorPanel]
		       [editor serverEditor]
		       [style '(no-hscroll no-border)]))

(define usersListBox (new list-box%
			  [label #f]
			  [parent tabHorPanel]
			  [choices null]
			  [style (list 'single
				       'column-headers
				       'deleted)]
			  [columns '("Users")]
			  [stretchable-width #f]))

(define (handleInput s)
  (define curTab (send tabPanel get-item-label (send tabPanel get-selection)))
  (define split (regexp-match #px"(/)?(\\S+)? ?(\\S+)? ?(.+)?" s))
  (define cmd? (second split))
  (define cmd  (third split))
  (define arg  (fourth split))
  (define mes  (fifth split))
  (if cmd?
      (case cmd
	[("join") (when arg (sendMsg (JOIN arg)))]
	[("part") (if arg (sendMsg (PART arg)) (sendMsg (PART curTab)))]
	[("quit") (sendMsg "QUIT") (exit)]
	[("msg")
	 (when (and arg mes)
	   (sendMsg (PRIVMSG arg mes))
	   (editorInsert pmEditor
			 (string-append "--> ( " arg " ) " mes "\n")))])
      (unless (or (string=? curTab nickname) (string=? curTab "Server"))
	(sendMsg (PRIVMSG curTab s))
	(editorInsert (car (hash-ref channels curTab))
		      (string-append "( " nickname " ) " s "\n")))))
      
(define inputBox (new text-field%
		      [parent frame]
		      [label #f]
		      [callback
		       (lambda (tf event)
			 (when (eq? (send event get-event-type) 'text-field-enter)
			   (define ted (send tf get-editor))
			   (define t (send ted get-text))
			   (unless (string=? "" t)
			     (handleInput t)
			     (send ted erase))))]))

(define (editorInsert editor str)
  (define d (current-date))
  (define (f s) (~a s #:width 2 #:align 'right #:pad-string "0"))    
  (send* editor
    (move-position 'end)
    (lock #f)
    (insert (string-append "["
			   (f (date-hour d))
			   ":"
			   (f (date-minute d))
			   "] "
			   str))
    (lock #t)))

(define (updateusersListBox s)
  (send usersListBox set (sort (set->list s) string<?)))

(define (USER user mode realname)
  (string-append "USER " user " " mode " :" realname))

(define JOIN
  (case-lambda
    [(channels)      (string-append "JOIN " channels)]
    [(channels keys) (string-append "JOIN " channels " " keys)]))

(define (PONG server) (string-append "PONG :" server))
(define (NICK nickname) (string-append "NICK " nickname))
(define (PRIVMSG target text) (string-append "PRIVMSG " target " :" text))
(define (PART channel) (string-append "PART " channel))

(define-values (in out) (tcp-connect address (string->number port)))

(define (sendMsg msg)
  (printf "< ~a~n" msg)
  (fprintf out "~a\r\n" msg)
  (flush-output out))

(define (parseMsg str)
  (define strSplit
    (regexp-match
     #px"^(?:[:](\\S+) )?(\\S+)(?: (?!:)(.+?))?(?: (?!:)(.+?))?(?: [:](.+))?$"
     str))
  (define num (string->number (list-ref strSplit 2)))
  (apply values (if num (list-set strSplit 2 num) strSplit)))

(define (handleMsg msg)
  (printf "> ~a~n" msg)
  
  (define-values (str prefix command dest params mes) (parseMsg msg))

  (define (userHas editor nick caption)
    (editorInsert editor (string-append "* " nick " has " caption " *\n")))

  (define (nickPrefix) (car (string-split prefix "!")))
  
  (case command
    [(353)
     (set-union!
      (cdr (hash-ref channels (cadr (string-split params))))
      (list->set (string-split mes)))]
    [("JOIN")
     (unless (hash-has-key? channels dest)
       (hash-set! channels dest (cons (new text% [auto-wrap #t])
				      (mutable-set)))
       (send tabPanel append dest))
     (define channelData (hash-ref channels dest))
     (define editor (car channelData))
     (define s (cdr channelData))
     (define nick (nickPrefix))
     (set-add! s nick)
     (when (string=? dest (send
			   tabPanel
			   get-item-label
			   (send tabPanel get-selection)))
       (updateusersListBox s))
     (userHas editor nick "joined")]
    [("PART")
     (define channelData (hash-ref channels dest))
     (define editor (car channelData))
     (define s (cdr channelData))
     (define nick (nickPrefix))
     (if (string=? nick nickname)
	 (begin (hash-remove! channels dest)
		(for/first ([i (send tabPanel get-number)]
			    #:when (string=? dest
					     (send tabPanel get-item-label i)))
		  (send tabPanel delete i)
		  (onTabSwitch #f #f)))
	 (begin (set-remove! s nick)
		(when (string=? dest
				(send tabPanel get-item-label (send
							       tabPanel
							       get-selection)))
		  (updateusersListBox s))
		(userHas editor nick "left")))]		
    [("PING")
     (sendMsg (PONG mes))]
    [("PRIVMSG")
     (editorInsert (car (hash-ref channels dest))
		   (string-append "( " (nickPrefix) " ) " mes "\n"))]
    [else
     (editorInsert
      serverEditor
      (string-join (filter values (list ">" params mes "\n"))))]))

(define (loop)
  (define msg (read-line in 'return-linefeed))
  (when (not (eof-object? msg)) 
    (handleMsg msg)
    (loop)))

(send frame show #t)
(sendMsg (NICK nickname))
(sendMsg (USER username "0 *" realname))
(thread loop)