;;; -*- mode: clojure -*-

(ns arabic-dictionary
  (:use [clojure.contrib.duck-streams :only (read-lines)]
        [clojure.contrib.prxml :only (prxml)]
        [clojure.contrib.str-utils :only (re-gsub re-split)])
  (:import (java.awt BorderLayout Font Rectangle)
           (java.awt.event ActionListener KeyEvent KeyListener)
           (java.io FileInputStream)
           (javax.swing JEditorPane JFrame JScrollPane JTextField
           (javax.swing.text StyleConstants)
           (javax.swing.text.html HTMLDocument)))

;;; Parameters
(def dictionary-file "/home/salvi/share/clojure/work/buckwalter.txt")
(def english-font (Font. "SansSerif" Font/PLAIN 16))
(def arabic-font
     (with-open [stream (FileInputStream. "/home/salvi/.fonts/ScheherazadeRegOT.ttf")]
       (.deriveFont (Font/createFont Font/TRUETYPE_FONT stream) (float 36))))
(def window-width 400)
(def window-height 400)
(def default-close JFrame/EXIT_ON_CLOSE) ; or: JFrame/DISPOSE_ON_CLOSE

;;; Main code
(def arabic-chars #{\ا \ب \ت \ث \ج \ح \خ \د \ذ \ر \ز \س \ش \ص \ض \ط \ظ \ع
                    \غ \ف \ق \ك \ل \م \ن \ه \و \ي \ء \إ \أ \ؤ \ئ \آ \ٱ \ى \ة})
(def arabic-punctuation #{\ٰ \َ \ُ \ِ \ً \ٌ \ٍ \ّ \ْ})
(defn alif? [c] (contains? #{\ا \إ \أ \آ \ٱ} c))
(defn arabic-punctuation? [c] (contains? arabic-punctuation c))
(defn arabic-char? [c] (contains? arabic-chars c))

(defn purge-word [s] (remove #(= % \ـ) s))

(defn ar= [s s-full]
  (cond (and (empty? s) (empty? s-full)) true
        (empty? s) (every? arabic-punctuation? s-full)
        (empty? s-full) (every? arabic-punctuation? s)
        (or (= (first s) (first s-full))
            (and (= (first s) \ا) (alif? (first s-full))))
        (ar= (rest s) (rest s-full))
        (and (arabic-char? (first s)) (arabic-punctuation? (first s-full)))
        (ar= s (rest s-full))
        true false))

(def dictionary
     (doall (map #(re-split #"\t" %)
                 (read-lines dictionary-file))))

(defn real-part [word]
  (or (second (re-find #"(^[^-]+)-" word)) word))

(defn search-word [word]
  (if (arabic-char? (first word))
    (filter #(ar= (purge-word word) (real-part (second %))) dictionary)
    (filter #(re-find (re-pattern word) (first %)) dictionary)))

;;; It turned out that HTML does _not_ have ''' defined, unlike XML...
(defn xml->html [str]
  (re-gsub #"'" "'" str))

(defn formatted-search [word]
     (prxml [:doctype! "html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" "
            [:html [:meta {:http-equiv "Content-Type"
                           :content "text/html;charset=utf-8"}]
             [:style {:type "text/css"}
               "table { width: \"90%\" } "
               ".english { font-family: \"EnglishFont\"; "
               "text-align: \"left\" } "
               ".arabic { font-family: \"ArabicFont\"; "
               "text-align: \"right\" } "]]
               (map (fn [[english arabic]]
                       [:td {:class "english"} english]
                       [:td {:class "arabic"} arabic]])
                    (search-word word))]]]))))

;;; GUI

(defn exit-if-needed []
  (when (= default-close JFrame/EXIT_ON_CLOSE)
    (System/exit 0)))

(defn show-dictionary []
  (let [frame (JFrame.)
        search (JTextField. 20)
        entries (JEditorPane. "text/html" "")
        action (proxy [ActionListener] []
                 (actionPerformed [e]
                   (.setText entries (formatted-search (.getText search)))
                   (.setSelectionStart search 0)
                   (let [len (count (.getText search))]
                     (.setSelectionEnd search len))
                    (Thread. #(.scrollRectToVisible entries (Rectangle.))))))
        listener (proxy [KeyListener] []
                   (keyPressed [e]
                     (when (= (.getKeyCode e) KeyEvent/VK_ESCAPE)
                       (.dispose frame)
                   (keyReleased [e])
                   (keyTyped [e]))]
    (doto search
      (.setFont arabic-font)
      (.addActionListener action)
      (.addKeyListener listener))
    (doto entries
      (.setDocument                     ; This is needed because we want to
       (proxy [HTMLDocument] []         ; display OUR fonts in the JEditorPane
         (getFont [attr]
           (if (= (.getAttribute attr StyleConstants/FontFamily) "ArabicFont") 
      (.setEditable false))
    (doto frame
      (.setTitle "Arabic Dictionary")
      (.setDefaultCloseOperation default-close)
      (.setLayout (BorderLayout.))
      (.add search BorderLayout/PAGE_START)
      (.add (JScrollPane. entries) BorderLayout/CENTER)
      (.setSize window-width window-height)
      (.setLocationRelativeTo nil)
      (.setVisible true))))