scheme_baton.lisp

;; 第1回 Scheme コードバトン
;;
;; ■ これは何か？
;;   「Scheme のコードをバトンのように回していき面白い物ができあがるのを楽しむ遊びです。」のCL版です。
;;   次回 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. g000001 (http://cadr.g.hatena.ne.jp/g000001/): CLに翻訳してみましたが、higeponさんのコードとは考え方が結構違うものになってしまいました!

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

;; ■英単語暗記補助ツールです
;;   起動すると辞書ファイルから単語が表示されるので意味を頭で考えます。改行を入力すると答えが表示されます。 (y/n) を聞かれるので正解なら y を押してください。
;;   間違った単語は辞書ファイルに記録され次回出題されます。
;;
;; ■動作方法
;;   ANSI Common Lisp で動作します。
;;   (main "辞書ファイル")
;;   オリジナルはシェルスクリプトとして動作しますが、CL版は現状REPLでの対話です。
;;   ※R6RS Schemeで書かれたオリジナル版
;;     http://gist.github.com/273431
;;
;; ■辞書ファイルの例
;;   http://gist.github.com/273424

(defpackage :hige
  (:use :cl))

(in-package :hige)

(defstruct (entry (:type list))
  word meaning ok-count ng-count)

(defun read-dict (file)
  (with-open-file (in file)
    (nomalize-dict 
     (loop :for word := (read in nil in) :until (eq word in)
           :collect word))))

(defun nomalize-dict (dict)
  (mapcar (lambda (e)
            (make-entry :word (entry-word e) 
                        :meaning (entry-meaning e)
                        :ok-count (or (entry-ok-count e) 0)
                        :ng-count (or (entry-ng-count e) 0)))
          dict))

(defun write-dict (file data)
  (with-open-file (out file :direction :output :if-exists :supersede)
    (with-standard-io-syntax 
      (loop :for word :in data 
            :do (print word out)))))

(defun sort-word-spec* (word-spec*)
  (sort word-spec*
        #'>
        :key (lambda (e) 
               (- (entry-ng-count e) (entry-ok-count e)))))

(defun query ()
  (prog2                       ;1年に1度も遭遇するかしないかのprog2が使いたい状況
    (clear-input *query-io*)
    (read-char *query-io*)
    (clear-input *query-io*)))

(defun pr (&rest args)
  (apply #'format *query-io* args))

(defun ready? ()
  (read-char *query-io*))

;; main
(defun main (file)
  (let ((dict (sort-word-spec* (read-dict file))))
    (dolist (e dict)
      (pr "~&~A: " (entry-word e))
      (ready?)    
      (pr "~&~A y/n? " (entry-meaning e))
    :again
      (case (query)
        ((#\Y #\y) (incf (entry-ok-count e)))
        ((#\N #\n) (incf (entry-ng-count e)))
        ((#\Q #\q) (return))
        (otherwise
           (pr "~&Please type Y for yes or N for no or Q for quit.~%")
           (go :again))))
    (write-dict file dict)))