; (c) 2008 Dmitri Hrapof <hrapof@common-lisp.ru>
; This file is distributed under the terms of the LLGPL.

(defpackage oci-west
   (:use common-lisp oci cl-who hunchentoot))
(in-package oci-west)

(defmacro with-html (&body body)
  `(with-html-output-to-string (*standard-output* nil :prologue t)
     ,@body))

(defvar *utf-8* (flex:make-external-format :utf-8 :eol-style :lf)) 

(defun llygaid ()
  (no-cache)
  (recompute-request-parameters :external-format *utf-8*)
  (setf 
   (content-type*) "text/xml; charset=utf-8"                               
   (reply-external-format*) *utf-8*)
  (let ((tree (svref *oak* (read-from-string (post-parameter "s") nil 0)))
	(b (read-from-string (post-parameter "b") nil nil)))
    (if (not b) (with-html (:guesses (:letters " ") (:lines)))
	(let ((graph (graphicalize (setf *omg* (img<-path b)))) 
	      (*print-pretty* nil))
	  ;(format t "~a~%"
	  (with-html
	    (:guesses
	     (:letters 
	      (fmt "~:[☹~;~1:*~{~a ~}~]" 
		   (gather-fruit tree graph :char (null (post-parameter "c")))))
	     (:lines
	      (dolist (line (graph->lines graph))
		(htm
		 (:line
		  (loop for p in line
		     do (htm (:p :x (* 10 (cadr p)) :y (* 10 (car p)))))))))
	     (:graph (fmt "~a" (worsen-visibility graph)))))))))

(defun llen ()
  (no-cache)
  (recompute-request-parameters :external-format *utf-8*)
  (setf 
   (content-type*) "text/xml; charset=utf-8"                               
   (reply-external-format*) *utf-8*)
  (let ((l (svref *lng* (read-from-string (post-parameter "s") nil 0)))
	(b (read-from-string (post-parameter "b") nil nil)))
    (with-html
      (:guesses
       (:letters
	(fmt 
	 "~a" 
	 (if (null b) 
	     "?"
	     (string-downcase
	      (observe-word 
	       (svref *frg* (cdr l)) 
	       (svref *oak* (car l)) 
	       (setf *omg* (img<-path b)))))))
       (:lines) (:graph)))))

(defun cof ()
  (no-cache)
  (recompute-request-parameters :external-format *utf-8*)
  (setf 
   (content-type*) "text/xml; charset=utf-8"                               
   (reply-external-format*) *utf-8*)
  (multiple-value-bind (addr addr-lst *print-pretty*) (real-remote-addr)
    (if addr-lst (/ (length addr) 0))
    (with-input-from-string (s (format nil "~s" (char (post-parameter "c") 0)))
      (remember-img 
       (read-from-string (post-parameter "s") nil 0)
       (img<-path (read-from-string (post-parameter "b") nil nil))
       s))
    (with-html (:guesses (:letters "☺") (:lines) (:graph))))) 

(defun dysgu ()
  (setf 
   (content-type*) "text/html; charset=utf-8"
   (reply-external-format*) *utf-8*)
  (multiple-value-bind (addr addr-lst) (real-remote-addr)
    (declare (ignore addr))
    (if addr-lst 
	(with-html (:html))
	(with-html
	  (:html
	   (:head
	    (:script :type "text/javascript" :src "/dojo/dojo/dojo.js")
	    (:script :type "text/javascript" :src "/oci/oci.js"))
	   (:body
	    ((:form :id "toolbar")
	     ((:span :style "font-size: 300%")
	      ((:a :href "#" :onclick "calculate(\"/llygaid\"); return false;")
	       "?")
	      ((:a :href "#" :onclick "clearShapes(); return false;") "_")
	      (:input :type "hidden" :name "b")
	      ((:select :name "s" 
			:onchange "document.forms.toolbar.c.value=\"\"")
	       (loop for i from 0 for s across *scripts* do
		    (htm ((:option :value i) (str s)))))
	      (:input :type "text" :name "c" :size 5)
	      ((:a :href "#" :onclick "remember(); return false;") "!")))
	    (:div :id "drawboard" :class "boardDiv" :overflow "hidden")
	    (:div :id "swg") 
	    (:div :id "grf")))))))

(setq *dispatch-table*
      (nconc
       (list 'dispatch-easy-handlers
             (create-static-file-dispatcher-and-handler
              "/oco.html"
              (make-pathname :name "oco" :type "html" :version nil
						      :defaults *this-file*))
	     (create-static-file-dispatcher-and-handler
              "/slovo.html"
              (make-pathname :name "slovo" :type "html" :version nil
						      :defaults *this-file*))
	     (create-static-file-dispatcher-and-handler
              "/oci/oci.js"
              (make-pathname :name "oci" :type "js" :version nil
						      :defaults *this-file*))
	     (create-folder-dispatcher-and-handler
              "/dojo/"
              #P"/home/dmitri/dojo/")
	     (create-prefix-dispatcher "/dysgu" 'dysgu)
	     (create-prefix-dispatcher "/cof" 'cof)
	     (create-prefix-dispatcher "/llygaid" 'llygaid)
	     (create-prefix-dispatcher "/oko/llygaid" 'llygaid)
	     (create-prefix-dispatcher "/llen" 'llen)
	     (create-prefix-dispatcher "/oko/llen" 'llen))
       (list #'default-dispatcher)))

(defun start-server (port) (start (make-instance 'acceptor :port port)))