scheme_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/): 最初はコマンドライン英単語暗記ツールでした。これが何に化けるのか楽しみ。全く別物になるかな？

;; =================================================================================================================================================
;;                            これより下がコードとその説明 - 変更・削除歓迎
;; =================================================================================================================================================

;; ■英単語暗記補助ツールです
;;   起動すると辞書ファイルから単語が表示されるので意味を頭で考えます。Ctrl-D を押すと答えが表示されます。 (y/n) を聞かれるので正解なら y を押してください。
;;   間違った単語は辞書ファイルに記録され次回出題されます。
;;
;; ■動作方法
;;   Clojure (1.1.0) で動作します。(http://code.google.com/p/clojure/downloads/list)
;;   % clj scheme_button.clj 辞書ファイル
;;
;;   実行には、別途 clojure.contrib ライブラリ(http://richhickey.github.com/clojure-contrib/) が必要です。
;;
;; ■辞書ファイルの例
;;   http://gist.github.com/273424

(use '[clojure.contrib.duck-streams :only (reader writer)]
     '[clojure.contrib.fcase :only (case)])

(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 #(> (- (%1 3) (%1 2))
	    (- (%2 3) (%2 2)))
	word-specs))

(defn file->sexp-list [f]
  (letfn [(rec [r]
	    (lazy-seq
	      (if-let [sexp (read r false false)]
		(cons sexp (rec r))
		(.close r))))]
    (rec (java.io.PushbackReader. (reader f)))))

(defn main-loop [questions results]
  (let [[[word meaning ok ng :as question] & more] questions]
    (letfn [(read-char-ci []
	      (Character/toLowerCase (first (Character/toChars (.read *in*)))))
	    (update-result [ok ng]
	      (cons (make-word-spec word meaning ok ng) results))
	    (p [format & args] (apply printf format args) (flush))]
      (if (nil? question)
	results
	(do (p "%s: \n" word)
	    (read *in* false false)
	    (p "%s: y/n? " meaning)
	    (case (read-char-ci)
	      \y (recur more (update-result (inc ok) ng))
	      \n (recur more (update-result ok (inc ng)))
	      (concat (reverse results) questions)))))))

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

(main (first *command-line-args*))