baton.clj

;; The First Edition Of Scheme Code Baton
;;
;; * What Is This?
;;   This is a recreation that we pass Scheme codes as a baton and enjoy it
;;   changed to something interesting.
;;   Results are make public at Shibuya.lisp (event about Lisp held in Shibuya,
;;   Japan).
;;   We want code baton being a chance to write codes for beginner and to read
;;   others codes for middles.
;;
;; * Two Rules
;;
;;   (1) Pass the code to other in 2 days with your changes.
;;       Any change is welcome if it is "for others".  changes of one letter is
;;       also OK.
;;       "For others" means, for example, writting easy-to-read codes for the
;;       next person.
;;       Reducing codes is also OK.
;;
;;   (2) Pass to next parson, then you follow he or she to change codes.
;;       Make sure that he or she recognize the baton include this notices.
;;       Please help if the baton is stopped.
;;
;; * The Way To Pass The Baton
;;
;;   (1) The baton is a URL such as http://gist.github.com/xxxx , isn't it?
;;   (2) Click the "fork" button. (if you doesn't have any GitHub account,
;;       please make it for now)
;;   (3) Click the "edit" button and paste the codes modified by you.
;;   (4) Pass the new URL that you forked.
;;
;; * Frequently Asked Questions
;;
;;   (a) Q. I'm a beginner.  I want to join but I have anxiety a little.
;;       A. Don't worry!  higepon will help you.  Feel free to ask.
;;
;;   (b) Q. I can't find any person to pass.
;;       A. Tell to higepon by Twitter or comment area of his blog.
;;
;;   (c) Q. The next person has stopped the baton.
;;       A. Pass to other.
;;
;;   (d) Q. The codes must be running on Mosh? (note by the translator: Mosh is
;;          Scheme implementation by higepon.  The original codes runs on Mosh)
;;       A. No.  Anything is welcome if it is Scheme. (However, for now written
;;          in Clojure :-P)  It is interesting to port to Gauche, Ypsilon, etc.
;;          If you do so, change the booting instructions.
;;
;; * Change Log
;;   Format: Name (URL): Comment
;;   1. higepon (http://d.hatena.ne.jp/higepon/): At first, it is command line
;;      English word learning tool.  I'm looking forward to it transforming.
;;      How do you make it?
;;   2. athos (http://d.hatena.ne.jp/athos/): Port to Clojure.
;;   3. 深町英太郎 (http://e-arrows.sakura.ne.jp/): Add prompt-read and
;;      y-or-n-p.  Simplify.
;;   4. 穂苅実紀夫 (http://ctrkode-clojure.blogspot.com/): Make main-loop,
;;      sort-word-specs and file->sexp-list simple.
;;   5. manjilab (http://manjilab.com/): Speak words in Mac OS X.
;;   6. deltam (http://deltam.blogspot.com): Add feature to generate dictionary
;;      from Smart.fm. (smartfm-dict)
;;   7. omasanori (http://omasanori.github.com/): Port to latest Clojure.
;;      Correct indentations.
;;   8. tnoborio (http://tnoborio.blogspot.com/): Add GUI mode using Swing.
;;      Switch modes using multi-method.
;;   9. omasanori (http://omasanori.github.com/): Translate into English.
;; ============================================================================
;;                                Description
;; ============================================================================
;;
;; This is English word and its Japanese mean learning tool.
;; In CUI mode, English word is displayed, then think Japanese mean.  Press
;; Ctrl-D and Japanese mean is displayed.  It asks y or n, so press yes if you
;; know what it mean.
;; In GUI mode, dialog is displayed.  Press OK and dialog is displayed again.
;; Press OK if you know what it mean.
;; Answers are logged and retryed if you wrong.
;;
;; * How To Use
;;
;; It is running in Clojure. (version 1.1.0 and 1.2.0)
;; % clj baton.clj dictionary_file
;;
;; You can generate dictionary file using Smart.fm. (if you don't have Smart.fm
;; account, use "deltam")
;; % clj baton.clj -s user_name_in_smart_fm > dictionary_file
;;
;; You can also use GUI.
;; % clj baton.clj -g dictionary_file
;;
;; You must include clojure.contrib library
;; (http://richhickey.github.com/clojure-contrib/) in CLOJURE_EXT.
;;
;; * Example Of Dictionary
;;   http://gist.github.com/273424
;;
;; * The API Of Smart.fm
;;   http://developer.smart.fm/docs/user_calls/items_studied

(try
  (use '[clojure.contrib.io :only (reader writer)])
  (catch Exception e
    (use '[clojure.contrib.duck-streams :only (reader writer)])))
(use '[clojure.xml :only (parse)])
(import '(javax.swing JOptionPane))

(defn make-word-spec
  ([word meaning] [word meaning 0 0])
  ([word meaning ok ng] [word meaning ok ng]))

(defn sort-word-specs [word-specs]
  (sort-by #(- (% 2) (% 3)) word-specs))

(defn file->sexp-list [f]
  (let [r (java.io.PushbackReader. (reader f))]
    (take-while identity
                (repeatedly #(or (read r false false) (.close r))))))

(defmulti prompt-read (fn [type prompt] type))

(defmethod prompt-read :cui [_ prompt]
  (print (format "%s: " prompt))
  (flush)
  (read-line))

(defmethod prompt-read :gui [_ prompt]
  (. JOptionPane (showMessageDialog
                   nil prompt nil
                   JOptionPane/QUESTION_MESSAGE)))

(defmulti y-or-n-p (fn [type prompt] type))

(defmethod y-or-n-p :cui [_ prompt]
  (= "y"
     (loop []
       (or
         (re-matches #"[yn]" (.toLowerCase
                               (prompt-read :cui (str prompt "[yn]"))))
         (recur)))))

(defmethod y-or-n-p :gui [_ prompt]
  (let [ret (. JOptionPane
               (showConfirmDialog
                 nil prompt nil
                 JOptionPane/OK_CANCEL_OPTION JOptionPane/QUESTION_MESSAGE))]
    (= ret JOptionPane/YES_OPTION)))

(defn speak-osx [word]
  (.. Runtime (getRuntime) (exec (str "/usr/bin/say " word))))

(defn osx? []
  (= (.. System (getProperties) (get "os.name"))
     "Mac OS X"))

(defn get-content-by-tag [tag xml]
  (first
    (some #(if (= tag (:tag %)) (:content %))
          (:content xml))))

(defn smartfm-dict [username]
  (let [api_url (str "http://api.smart.fm/users/" username "/items.xml")]
    (doseq [s (for [x (xml-seq (parse api_url)) :when (= :quiz (:tag x))]
                (let [q (get-content-by-tag :question x)
                      a (get-content-by-tag :answer x)]
                  (map #(str "\"" % "\"")
                       (list
                         (.. a (replaceAll "</*spell>" "") trim)
                         q))))]
      (println s))))

(defn main-loop [type questions]
  (for [[word meaning ok ng :as question] questions]
    (do
      (if (osx?) (speak-osx word))
      (prompt-read type word)
      (apply list word meaning 
             (if (y-or-n-p type meaning) [(inc ok) ng] [ok (inc ng)])))))

(defn main [type filename]
  (let [word-specs (map #(apply make-word-spec %) (file->sexp-list filename))
        questions (sort-word-specs word-specs)
        results (main-loop type questions)]
    (with-open [w (writer filename)]
      (doseq [result results]
        (binding [*out* w] (prn (seq result)))))))

(let [args (take 2 *command-line-args*)]
  (condp = (first args)
    "-s" (smartfm-dict (last args))
    "-g" (main :gui (last args))
    (main :cui (first args))))