(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)))
(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) (def buffer-size (ref 20))
(def successive-correct-answers (ref 2))
(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)))
(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))