baton.clj

;; 第1回 Scheme コードバトン
;;
;; ■ これは何か？
;;   Scheme のコードをバトンのように回していき面白い物ができあがるのを楽しむ遊びです。
;;   次回 Shibuya.lisp で成果を発表します。
;;   Scheme 初心者のコードを書くきっかけに、中級者には他人のコードを読む機会になればと思います。
;;
;; ■ 2 つのルール
;;
;;   (1)自分がこれだと思える変更をコードに加えて2日以内に次の人にまわしてください。
;;      「人に優しい」変更なら何でも良い。1文字の変更でも可。
;;      「人に優しい」とは例えば、次の人が読みやすいコードを書くなど。
;;       コードを削るのもあり。
;;
;;   (2)次の人にまわしコードが変更されるのを"見守る"。
;;       この説明書きを含めてバトンが伝わった事を必ず確認してください。
;;       止まっていたら助けてあげてください。
;;
;; ■ バトンの回し方
;;
;;    (1) 回ってきたバトンは http://gist.github.com/xxxx という URL のはずです。
;;    (2) fork をクリックしてください（アカウントを持っていない人はこのとき作成します）
;;    (3) edit で変更したファイルを貼り付けます。
;;    (4) 自分が fork した新しい URL を回してください
;;
;;
;; ■ 良くある質問
;;
;;   (a) 初心者です。参加したいけどちょっと不安です。
;;      higepon がフォローしますので大丈夫です。分からない事があれば遠慮無く聞いてください。
;;
;;   (b) 次にまわす人がいません
;;      higepon に知らせてください。twitter, 日記のコメントなどで。
;;
;;   (c) 次の人がコードを止めてしまいました
;;      残念ですが別の人にバトンを渡してください。
;;
;;   (d) Mosh で動かないとダメですか？
;;      いいえ。Scheme なら何でも良いです。Gauche, Ypsilon 用に書き換えるのも面白いですね。
;;      そのときは起動方法の説明も変えてください。
;;
;; ■ バトンの行方を記録
;;   名前(URL)：一言
;;   1. higepon (http://d.hatena.ne.jp/higepon/): 最初はコマンドライン英単語暗記ツールでした。これが何に化けるのか楽しみ。全く別物になるかな？
;;   2. athos (http://d.hatena.ne.jp/athos/): Clojureに移植。
;;   3. 深町英太郎 (http://e-arrows.sakura.ne.jp/): prompt-read, y-or-n-pを追加。コードを簡単に。
;;   4. 穂苅実紀夫 (http://ctrkode-clojure.blogspot.com/): main-loop、sort-word-specs、file->sexp-listを簡単に。
;;   5. manjilab (http://manjilab.com/): Mac OS X でのみ、出題される英単語を音声でも出力するようにした。
;;   6. deltam (http://deltam.blogspot.com): Smart.fmの学習アイテムから辞書ファイルを生成できるようにした。(smartfm-dict)
;;   7. omasanori (http://omasanori.github.com/): 最新のClojureでも動くように修正。インデントの修正。
;;   8. tnoborio (http://tnoborio.blogspot.com/): Swingを使いGUIモードを追加。マルチメソッドを使ってCUI/GUIを切換え。
;; =================================================================================================================================================
;;                            これより下がコードとその説明 - 変更・削除歓迎
;; =================================================================================================================================================

;; ■英単語暗記補助ツールです
;;   起動すると辞書ファイルから単語が表示されるので意味を頭で考えます。Ctrl-D を押すと答えが表示されます。 (y/n) を聞かれるので正解なら y を押してください。
;;   間違った単語は辞書ファイルに記録され次回出題されます。
;;
;; ■動作方法
;;   Clojure (1.1.0, 1.2.0) で動作します。(http://code.google.com/p/clojure/downloads/list)
;;   % clj baton.clj 辞書ファイル
;;
;;   Smart.fmのユーザ名を指定して辞書ファイルを作れます。（Smart.fmユーザでない人はdeltamでお試しください）
;;   % clj baton.clj -s Smart.fmのユーザ名 > 辞書ファイル
;;
;;   GUIでも動作します。
;;   % clj baton.clj -g 辞書ファイル
;;
;;   実行には、別途 clojure.contrib ライブラリ(http://richhickey.github.com/clojure-contrib/) が必要です。
;;
;; ■辞書ファイルの例
;;   http://gist.github.com/273424
;;
;; ■Smart.fmのユーザ別英単語アイテム取得APIのドキュメント
;;   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))))