(in-package :jbominji-irc)

;; IRC stuff

(require 'cl-irc)

(defvar *irc-connection*)

(defvar *output-gloss-to-irc* nil)

; settings

(defvar irc-nick "jbominji")
(defvar irc-server "irc.freenode.net")
(defvar irc-realname "http://subvert-the-dominant-paradigm.net:9073/jbominji/irc (John Leuner)")
(defvar irc-listen-room "#lojban")
;(defvar irc-listen-room "#lojbantest")
(defvar irc-alternative-listen-room "#lojbantest")
(defvar irc-log-room "#jbokumfa")


(defun irc-listen-loop ()
  (handler-case
      (progn  (setup-connection)
	      (identify)
	      (join-log-room)
	      (join-listen-room)
	      (setup-hooks)
	      (cl-irc:read-message-loop *irc-connection*)
	      (format t "finished read loop")
	      (cl-irc:quit *irc-connection*)
	      )
    (sb-bsd-sockets:try-again-error () (format t "host name lookup failure in jbominji irc irc-listen-loop~%")))
  (sleep 30)
  (irc-listen-loop)
)
; control methods

(defun setup-connection ()
  (setf *irc-connection* (cl-irc:connect :nickname irc-nick :realname irc-realname :server irc-server :logging-stream t ))
)

(defun drop-connection ()
  (cl-irc:die *irc-connection*)
)

(defun identify ()
  (cl-irc:privmsg *irc-connection* "nickserv" "identify objobj")
)

(defun join-listen-room ()
  (cl-irc:join *irc-connection* irc-listen-room)
)
(defun join-alternative-room ()
  (cl-irc:join *irc-connection* irc-alternative-listen-room))
(defun leave-listen-room () (cl-irc:part *irc-connection* irc-listen-room))
(defun leave-alternative-listen-room () (cl-irc:part *irc-connection* irc-alternative-listen-room))
(defun join-log-room ()
  (cl-irc:join *irc-connection* irc-log-room)
)

(defun setup-hooks() 
  (cl-irc:add-hook *irc-connection* 'irc::irc-privmsg-message #'handle-message)
  (cl-irc:add-hook *irc-connection* 'irc::irc-kick-message #'handle-kick)

;  (cl-irc:add-hook *irc-connection* 'irc::ir #'handle-kick)
)

(defun switch-to-alternative-room () 
  (loop for th in (sb-thread:list-all-threads) when (equal (sb-thread:thread-name th) "jbominji-irc") do 
	(sb-thread:interrupt-thread th 
				    #'(lambda () 
					(leave-listen-room)
					(join-alternative-room)
					))))

(defun switch-to-primary-room () 
  (loop for th in (sb-thread:list-all-threads) when (equal (sb-thread:thread-name th) "jbominji-irc") do 
	(sb-thread:interrupt-thread th 
				    #'(lambda () 
					(leave-alternative-listen-room)
					(join-listen-room)
					))))

;(defmethod cl-irc:remo
(defun quit-irc ()
  (cl-irc:quit *irc-connection*)
;  (setf *irc-connection* nil)
)

(defun handle-kick (message) (declare (ignore message))
  (quit-irc)
)

(defun handle-message (message)
;  (format t "command is ~a ~%" (cl-irc:command message))
; ; (format t "args is ~a ~%" (cl-irc:arguments message))
 ; (format t "args is ~a ~%" (cl-irc:trailing-argument message))
  (let* ((is-public (or (equal (first (cl-irc:arguments message)) irc-listen-room)
			 (equal (first (cl-irc:arguments message)) irc-alternative-listen-room)))
	 (type (if is-public :irc :irc-private))
	 (text-array (copy-seq (cl-irc:trailing-argument message)))
	 (cleaned-event-text (progn 
			       (loop for index from 0 to (- (length text-array) 1) when (> (char-code (elt text-array index)) 127) do (setf (elt text-array index) #\W) )
			       text-array))
	 (response-hook (if is-public
			    #'(lambda (text) (cl-irc:privmsg *irc-connection* (first (cl-irc:arguments message)) text))
			    #'(lambda (text) (cl-irc:privmsg *irc-connection* (cl-irc:source message) text)))))
	 (when (listp (cl-irc:arguments message))
	   (jbominji:incoming-event cleaned-event-text type (first (cl-irc:arguments message)) (cl-irc:source message) response-hook))))

(defun do-gloss (tree pr output-function)
  (output-text-gloss tree pr output-function)
)



;	(handle-room-message message)
;	(handle-personal-message message))))

;(defun handle-room-message (message)
;  (jbominji:incoming-event (cl-irc:trailing-argument message)  (cl-irc:source message) 
;			   (if *output-gloss-to-irc*
;			       #'(lambda (pr)
;; 				   (let ((tree (lojban-parser:make-parse-tree pr)))
;; 				     (output-text-gloss tree pr #'(lambda (gloss)
;; 								    (cl-irc:privmsg *irc-connection* irc-log-room gloss)))))					    
;; 			       )
;; 			   (if *output-gloss-to-irc*
;; 			       #'(lambda (condition error-message) (declare (ignore condition))
;; 					 (cl-irc:privmsg *irc-connection* irc-log-room error-message))
;; 			       )
;; 			   )
;;  )


;; (defun handle-personal-message (message)
;;   (jbominji:incoming-event (cl-irc:trailing-argument message)  (cl-irc:source message) 
;; 			   #'(lambda (pr)
;; 			       (let ((tree (lojban-parser:make-parse-tree pr)))
;; 				 (output-text-gloss tree pr #'(lambda (gloss)
;; 								(cl-irc:privmsg *irc-connection* (cl-irc:source message) gloss)))
;; 			       ))
;; 			   #'(lambda (condition error-message) (declare (ignore condition))
;; 				     (cl-irc:privmsg *irc-connection* (cl-irc:source message) error-message)
;; 				     )
;; ))

;(defun is-instruction-to-jbominji (message text

(defun output-text-gloss (tree pr output-function)
  (funcall output-function (format nil "<< ~A >> ~A" (lojban-parser:show-parsed-text pr) (lojban-parser:show-unparsed-text pr)))
  (walk-gloss (build-gloss tree pr) output-function)
)



(defun walk-gloss (gloss fn)
  (cond ((listp gloss) (loop for i in gloss do (walk-gloss i fn)))
	 (t (apply fn (list gloss)))))

(defun test-irc (body)
  (lojban-parser:initialize-parser)
  (let* ((pr (lojban-parser:parse-lojban body :save-parse-tree t))
	 (matched (cl-peg:parse-result-matched pr)))
    (if matched
	(progn 
	  (format t "<< ~A >> ~A~%" (lojban-parser:show-parsed-text pr) (lojban-parser:show-unparsed-text pr))
	  (let ((tree (lojban-parser:make-parse-tree pr)))
	    (loop for i in (build-gloss tree pr) do
		  (format t "gloss ~a ~%" (first i))))
))))

; glossing code


(defun build-gloss (tree pr)
  (walk-pv-tree tree pr nil)
)

; walking the parse tree
(defgeneric walk-pv-tree (tree pr output))

(defmethod walk-pv-tree ((tree lojban::|gismu|) pr output)
  (let* ((input (slot-value tree 'lojban:text))
	 (gloss (format nil ".i zo ~a cu gismu la'e zoi gy. ~a gy.~%" input (string-trim " " (lojban:lookup-gismu input)))))
;    (concatenate 'string gloss output)
    (append (list gloss) output)
  ))

(defmethod walk-pv-tree ((cmavo lojban:cmavo-group) pr output)
  (let* ((input (slot-value cmavo 'lojban:text))
	 (gloss (format nil ".i zo ~a cu cmavo la'e zoi gy. ~a gy.~%" input (string-trim " " (lojban:lookup-cmavo input)))))
 ;   (concatenate 'string gloss output)
   (append (list gloss) output)
  ))


(defmethod walk-pv-tree ((l list) pr output)
  (cond ((null l) nil)
	(t (append (list (walk-pv-tree (first l) pr nil)) (walk-pv-tree (rest l) pr nil) output))
))

(defmethod walk-pv-tree ((tree lojban:jbovalsi) pr output)
  (walk-pv-tree (slot-value tree 'lojban:children) pr output)
  )