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

(ns arabic-flashdeck
  (:use [clojure.contrib.duck-streams :only (slurp* spit)]
        [clojure.contrib.fcase :only (case)]
        [clojure.contrib.math :only (floor)]
        [clojure.contrib.seq-utils :only (shuffle)]
        [clojure.contrib.str-utils :only (re-split)])
  (:import (java.awt BorderLayout Font GridBagConstraints GridBagLayout Insets)
           (java.awt.event ActionListener KeyListener)
           (javax.swing JButton JFileChooser JFrame JLabel JOptionPane
                        JScrollPane JTextArea)))

;;; Parameters
(def global-font (Font. "SansSerif" Font/PLAIN 18))
(def definition-font (Font. "SansSerif" Font/ITALIC 16))
(def solution-font (Font. "Scheherazade" Font/PLAIN 36))
(def window-width 400)
(def default-close JFrame/EXIT_ON_CLOSE) ; or: JFrame/DISPOSE_ON_CLOSE
(def buffer-size (ref 20))
(def successive-correct-answers (ref 2))

;;; Variables
(def words (ref nil))
(def buffer (ref nil))
(def current (ref nil))

(defn generate-words [str]
  (filter identity
          (for [line (re-split #"\n" str)]
            (let [split (re-split #" = " line)]
              (and (= (count split) 2) split)))))

(defn remove-current-word []
  (let [new-buffer (concat (take @current @buffer)
                           (drop (inc @current) @buffer))]
    (dosync (ref-set buffer new-buffer)
            (alter current dec))))

(defn move-one-word []
  (let [new-buffer (concat (take @current @buffer)
                           (list (cons (ref 0) (first @words)))
                           (drop (inc @current) @buffer))]
    (dosync (ref-set buffer new-buffer)
            (alter words rest))))

(defn accept-current-word []
  (dosync (alter (first (nth @buffer @current)) inc))
  (when (= @(first (nth @buffer @current)) @successive-correct-answers)
    (if (empty? @words)
      (remove-current-word)
      (move-one-word))
    (empty? @buffer)))

(defn show-answer []
  [nil (nth (nth @buffer @current) 2)])

(defn initialize-words []
  (let [n (min (count @words) @buffer-size)]
    (dosync (alter words shuffle)
            (ref-set buffer (map #(cons (ref 0) %) (take n @words)))
            (ref-set current 0)
            (ref-set words (drop n @words))))
  [(second (first @buffer)) "?"])

(defn next-word []
  (dosync (alter current inc))
  (when (>= @current (count @buffer))
    (let [k (floor (/ (count @buffer) 2))]
      (dosync (ref-set buffer (concat (shuffle (take k @buffer))
                                      (shuffle (drop k @buffer))))
              (ref-set current 0))))
  [(second (nth @buffer @current)) "?"])

(defn reject-current-word []
  (dosync (ref-set (first (nth @buffer @current)) 0)))

;;; dummy definition for backward reference
(def flashdeck nil)

(defn start-the-questions []
  (let [frame (JFrame.)
        remaining (JLabel.)
        definition (JLabel. "" JLabel/CENTER)
        solution (JLabel.  "" JLabel/CENTER)
        update-fields (fn [[def sol]]
                        (.setText remaining (format "Remaining: %d word(s)."
                                                    (+ (count @buffer)
                                                       (count @words))))
                        (when def (.setText definition def))
                        (when sol (.setText solution sol)))
        state (ref 'question)
        listener (proxy [KeyListener] []
                   (keyPressed [e]
                     (case (.getKeyChar e)
                       \n (when (= @state 'answer)
                            (dosync (ref-set state 'question))
                            (reject-current-word)
                            (update-fields (next-word)))
                       \y (when (= @state 'answer)
                            (dosync (ref-set state 'question))
                            (if (accept-current-word)
                              (do (.dispose frame) (flashdeck))
                              (update-fields (next-word))))
                       \space (when (= @state 'question)
                                (dosync (ref-set state 'answer))
                                (update-fields (show-answer)))
                       \q (do (.dispose frame)
                              (dosync (ref-set words (concat (map rest @buffer)
                                                             @words)))
                              (flashdeck))))
                   (keyReleased [e])
                   (keyTyped [e]))]
    (.setFont definition definition-font)
    (.setFont solution solution-font)
    (update-fields (initialize-words))
    (doto frame
      (.setTitle "Arabic Flashdeck")
      (.addKeyListener listener)
      (.setDefaultCloseOperation default-close)
      (.setLayout (BorderLayout.))
      (.add remaining BorderLayout/PAGE_START)
      (.add definition BorderLayout/CENTER)
      (.add solution BorderLayout/PAGE_END)
      (.pack)
      (.setSize window-width (.getHeight frame))
      (.setLocationRelativeTo nil)
      (.setVisible true))))

(defn constraints [x y n]
  (GridBagConstraints. x y n 1 1 1 GridBagConstraints/CENTER
                       GridBagConstraints/HORIZONTAL (Insets. 0 0 0 0) 0 0))

(defn no-overwrite? [frame]
  (= (JOptionPane/showConfirmDialog
      frame "Overwrite existing file?" "Confirm Overwrite"
      JOptionPane/OK_CANCEL_OPTION JOptionPane/QUESTION_MESSAGE)
     JOptionPane/CANCEL_OPTION))

(defn flashdeck []
  (let [frame (JFrame.)
        text (JTextArea. 20 30)
        load (JButton. "Load")
        save (JButton. "Save")
        start (JButton. "Start")
        listener (proxy [ActionListener] []
                   (actionPerformed [e]
                     (case (.getSource e)
                       start (let [str (generate-words (.getText text))]
                               (dosync (ref-set words str))
                               (.dispose frame)
                               (start-the-questions))
                       load (let [chooser (JFileChooser.)]
                              (when (= (.showOpenDialog chooser frame)
                                       JFileChooser/APPROVE_OPTION)
                                (let [file (.getSelectedFile chooser)]
                                  (.setText text (slurp* file)))))
                       save (let [chooser (JFileChooser.)]
                              (when (= (.showSaveDialog chooser frame)
                                       JFileChooser/APPROVE_OPTION)
                                (let [file (.getSelectedFile chooser)]
                                  (when-not (and (.exists file)
                                                 (no-overwrite? frame))
                                      (spit file (.getText text)))))))))]
    (doto text
      (.setFont global-font)
      (.setText (apply str
                       (reduce concat
                               (map #(format "%s = %s\n" (first %) (second %))
                                    @words)))))
    (.addActionListener load listener)
    (.addActionListener save listener)
    (.addActionListener start listener)
    (doto frame
      (.setTitle "Dictionary Setup")
      (.setDefaultCloseOperation default-close)
      (.setLayout (GridBagLayout.))
      (.add (JScrollPane. text) (constraints 0 0 2))
      (.add load (constraints 0 1 1))
      (.add save (constraints 1 1 1))
      (.add start (constraints 0 2 2))
      (.pack)
      (.setLocationRelativeTo nil)
      (.setVisible true))))

(defn load-dictionary [filename]
  (let [str (generate-words (slurp filename))]
    (dosync (ref-set words str)))
  (start-the-questions))

(defn set-optional-int-arg [place n]
  (when (> (count *command-line-args*) 0)
    (dosync (ref-set place (Integer/parseInt (nth *command-line-args* n))))))

(set-optional-int-arg buffer-size 0)
(set-optional-int-arg successive-correct-answers 1)

(if (> (count *command-line-args*) 2)
  (load-dictionary (nth *command-line-args* 2))
  (flashdeck))