;;;; -*- mode:lisp;coding:utf-8 -*-
;;;;FILE:               loader.lisp
;;;;LANGUAGE:           Common-Lisp
;;;;SYSTEM:             Common-Lisp
;;;;    Loader for the CLAAR.
;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
;;;;    2009-07-09 <PJB> Created.
;;;;    GPL
;;;;    Copyright Pascal J. Bourguignon 2009 - 2009
;;;;    This program is free software; you can redistribute it and/or
;;;;    modify it under the terms of the GNU General Public License
;;;;    as published by the Free Software Foundation; either version
;;;;    2 of the License, or (at your option) any later version.
;;;;    This program is distributed in the hope that it will be
;;;;    useful, but WITHOUT ANY WARRANTY; without even the implied
;;;;    PURPOSE.  See the GNU General Public License for more details.
;;;;    You should have received a copy of the GNU General Public
;;;;    License along with this program; if not, write to the Free
;;;;    Software Foundation, Inc., 59 Temple Place, Suite 330,
;;;;    Boston, MA 02111-1307 USA


(in-package "COMMON-LISP-USER")

;; (asdf-install:install :lisppaste)
;; (asdf:oos 'asdf:load-op :lisppaste)

(asdf:oos 'asdf:load-op :cl-irc)
(asdf:oos 'asdf:load-op :bordeaux-threads)
(asdf:oos 'asdf:load-op :hunchentoot)

(load "packages")
(load "web")


(in-package "CLAAR")

(shadow 'quit)

(defparameter *server*  "irc.freenode.org")
#-claar-test(defparameter *channel* "#lisp")
#-claar-test(defparameter *my-nick* "claar")
#+claar-test(defparameter *channel* "#test")
#+claar-test(defparameter *my-nick* "claar-test")

(defparameter *connection* (connect :nickname *my-nick*
                                    :server *server*))

(defvar *running* t)

(defun restart-message-loop ()
  (let* ((name "irc message loop")
         (old-thread (find name (all-threads)
                           :key (function thread-name)
                           :test (function equal))))
    (when old-thread
      (destroy-thread old-thread))
    (make-thread (lambda ()
                        :while *running*
                        :do (read-message-loop *connection*)))
                 :name name)))


(sleep 10)
(join *connection* *channel*)
(sleep 10)

(privmsg *connection* *channel* "Hello")

;; (defmacro with-say (send-function &body body)
;;   `(flet ((say (ctrl &rest args)
;;             (funcall ,send-function (format nil "~?" ctrl args))))
;;      ,@body))

(defun give-help (send-response)
  (funcall send-response "draw <s-expr> -> draw the <s-expr>"))

(defun give-bots (send-response)
  (funcall send-response "claar is a bot.  For more info: /msg claar help"))

(defun give-drawing (send-response owner arguments)
  (let ((index
              (to-string (draw-list (let ((*read-eval* nil))
                                     (read-from-string arguments))
                                   :title arguments)))
           (error (err)
             (funcall send-response
                      (remove #\newline
                              (format nil "Could not draw that sexp for ~A" err)))
             (return-from give-drawing)))))
    (funcall send-response
             (format nil "~A~:[/~;~]~A" claar-web:*home-uri*
                     (char= (aref claar-web:*home-uri*
                                  (1- (length claar-web:*home-uri*)))
                            #\/) index))))

(let ((out *standard-output*))
  (defun process-command (received-time source target command send-response)
    (let ((*standard-output* out)
          (*trace-output* *standard-output*))
      (show received-time source target command send-response))
    (let* ((space (position #\space command))
           (verb  (string-upcase
                   (string-trim " " (if space
                                      (subseq command 0 space)
           (args  (if space
                    (string-trim " " (subseq command space))
      (scase verb
        (("HELP")                      (give-help    send-response))
        (("BOTS")                      (give-bots    send-response))
        (("DRAW")                      (give-drawing send-response source args))
        (otherwise (funcall send-response "What?"))))))

(defun extract-bot-command (line)
  (let ((question (position #\? line))
        (sentence (print (mapcar (function string-upcase)
                            #\space (substitute-if-not #\space (function alphanumericp) line)
                            :REMOVE-EMPTY-SUBSEQS t)))))
    (flet ((contains-some-words (words sentence)
             (intersection words sentence :test (function string=))))
      (when (and question
                 (or (and (contains-some-words '("WHAT" "WHO" "THERE")  sentence)
                          (contains-some-words '("IS" "ARE")            sentence)
                          (contains-some-words '("BOT" "BOTS")          sentence))
                 (member sentence '(("BOT") ("BOTS")) :test (function equal))))

(defun process-privmsg (message)
  (with-slots (source user host command arguments trailing-argument
                      connection received-time raw-message-string) message
    (when (string= command "PRIVMSG")
      (destructuring-bind (target &rest others) arguments
        (when (and (null others)
                   (or (string= target *my-nick*)
                       (string= target *channel*)))
          (let ((command
                 (if (string= target *channel*)
                   (let ((dot (position #\: trailing-argument)))
                     (if dot
                       (when (string= (string-trim " " (subseq trailing-argument 0 dot))
                         (subseq trailing-argument (1+ dot)))
                       (extract-bot-command trailing-argument)))
                (send-response (if (string= target *channel*)
                                 (lambda (response)
                                     (privmsg connection *channel* response))
                                 (lambda (response)
                                     (privmsg connection source response)))))
            (when command
               received-time source target
               (string-trim " " command)

  (remove-hooks *connection* 'irc-privmsg-message)
  (add-hook     *connection* 'irc-privmsg-message (quote process-privmsg)))

;; (defun my-hook (message)
;;      <do-something>)
;; (add-hook connection 'irc-join-message #'my-hook)

;; and it will be run next time the library receives an
;; irc-join-message.  For a full list of messages you can hook into,
;; look at event.lisp.

;; Your connection object will get updated by the library with regards
;; to users joining/parting channels, you joining/parting channels,
;; etc.  Look at protocol.lisp's connection object for slots and
;; methods.

(print '(restart-message-loop))
(print '(in-package "CLAAR"))