;;; kana-drill.el -- Learn Hiragana and Katakana

;; Author:         Alex Shinn <foof@eyeofdog.com>
;; Keywords:       educational, japanese, kana
;; Version:        0.2
;; Created:        15 July, 1999
;; Time-stamp:     <Wed Mar 22 03:57:58 EST 2000>

;; XEmacs is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; XEmacs is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with XEmacs; see the file COPYING.  If not, write to the Free
;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
;; 02111-1307, USA.

;; Warning:  When I began writing this, I knew
;;
;;    Some Kanji but no Kana
;;    Some common lisp but no emacs lisp
;;    Some vague idea of what I wanted to write, but no top-level design
;;
;; Therefore to say this code is a little crufty and hard to read
;; is an understatement.  Nonetheless it works, and seems (to me)
;; to be a good way to learn kana.  Any comments or suggestions for
;; improvement are welcome.

;; TODO:
;;
;;   * Switch to defcustoms and deffaces
;;   * Add highlighting on mouse-overs
;;   * Add menus for controlling current groups/charsets
;;   * Improve trial selection and scoring qualifications

;; BUGS:
;;
;; Probably very, very many.  Oh, I know one... if num-choices is
;; greater than the total number of possible choices you get an
;; infinite loop.

(require 'cl)

;;;
;;; Variables
;;;

(defvar kana-drill-groups
  [ "a" "k" "s" "t" "n" "h" "m" "y" "r" "wn" "g" "z" "d" "b" "p" ]
  ;; not including these groups
  ;; "ky" "sh" "ch" "ny" "hy" "my" "ry" "gy" "j" "by" "py"
  "List of all kana groups" )

(defvar kana-drill-version "0.2")

;;; Katakana - Hiragana - Romaji vectors
;;; Grouped by beginning sound

(defvar kana-drill-vector-a
  [ [ "ア" "あ" "a" ]
    [ "イ" "い" "i" ]
    [ "ウ" "う" "u" ]
    [ "エ" "え" "e" ]
    [ "オ" "お" "o" ] ]
  "Array of the five Japanese vowels" )

(defvar kana-drill-vector-k
  [ [ "カ" "か" "ka" ]
    [ "キ" "き" "ki" ]
    [ "ク" "く" "ku" ]
    [ "ケ" "け" "ke" ]
    [ "コ" "こ" "ko" ] ]
  "Array of the five standard kana beginning with k" )

(defvar kana-drill-vector-s
  [ [ "サ" "さ" "sa" ]
    [ "シ" "し" "shi" ]
    [ "ス" "す" "su" ]
    [ "セ" "せ" "se" ]
    [ "ソ" "そ" "so" ] ]
  "Array of the five standard kana beginning with s" )

(defvar kana-drill-vector-t
  [ [ "タ" "た" "ta" ]
    [ "チ" "ち" "chi" ]
    [ "ツ" "つ" "tsu" ]
    [ "テ" "て" "te" ]
    [ "ト" "と" "to" ] ]
  "Array of the five standard kana beginning with t" )

(defvar kana-drill-vector-n
  [ [ "ナ" "な" "na" ]
    [ "ニ" "に" "ni" ]
    [ "ヌ" "ぬ" "nu" ]
    [ "ネ" "ね" "ne" ]
    [ "ノ" "の" "no" ] ]
  "Array of the five standard kana beginning with n" )

(defvar kana-drill-vector-h
  [ [ "ハ" "は" "ha" ]
    [ "ヒ" "ひ" "hi" ]
    [ "フ" "ふ" "hu" ]
    [ "ヘ" "へ" "he" ]
    [ "ホ" "ほ" "ho" ] ]
  "Array of the five standard kana beginning with h" )

(defvar kana-drill-vector-m
  [ [ "マ" "ま" "ma" ]
    [ "ミ" "み" "mi" ]
    [ "ム" "む" "mu" ]
    [ "メ" "め" "me" ]
    [ "モ" "も" "mo" ] ]
  "Array of the five standard kana beginning with m" )

(defvar kana-drill-vector-y
  [ [ "ヤ" "や" "ya" ]
    [ "ユ" "ゆ" "yu" ]
    [ "ヨ" "よ" "yo" ] ]
  "Array of the three standard kana beginning with y" )

(defvar kana-drill-vector-r
  [ [ "ラ" "ら" "ra" ]
    [ "リ" "り" "ri" ]
    [ "ル" "る" "ru" ]
    [ "レ" "れ" "re" ]
    [ "ロ" "ろ" "ro" ] ]
  "Array of the five standard kana beginning with r" )

(defvar kana-drill-vector-wn
  [ [ "ワ" "わ" "wa" ]
    [ "ヲ" "を" "wo" ]
    [ "ン" "ん" "n" ] ]
  "Array of three additional standard kana" )

(defvar kana-drill-vector-g
  [ [ "ガ" "が" "ga" ]
    [ "ギ" "ぎ" "gi" ]
    [ "グ" "ぐ" "gu" ]
    [ "ゲ" "げ" "ge" ]
    [ "ゴ" "ご" "go" ] ]
  "Array of the five kana beginning with g" )

(defvar kana-drill-vector-z
  [ [ "ザ" "ざ" "za" ]
    [ "ジ" "じ" "zi" ]
    [ "ズ" "ず" "zu" ]
    [ "ゼ" "ぜ" "ze" ]
    [ "ゾ" "ぞ" "zo" ] ]
  "Array of the five kana beginning with z" )

(defvar kana-drill-vector-d
  [ [ "ダ" "だ" "da" ]
    [ "ヂ" "ぢ" "di" ]
    [ "ヅ" "づ" "du" ]
    [ "デ" "で" "de" ]
    [ "ド" "ど" "do" ] ]
  "Array of the five kana beginning with d" )

(defvar kana-drill-vector-b
  [ [ "バ" "ば" "ba" ]
    [ "ビ" "び" "bi" ]
    [ "ブ" "ぶ" "bu" ]
    [ "ベ" "べ" "be" ]
    [ "ボ" " ぼ" "bo" ] ]
  "Array of the five kana beginning with b" )

(defvar kana-drill-vector-p
  [ [ "パ" "ぱ" "pa" ]
    [ "ピ" "ぴ" "pi" ]
    [ "プ" "ぷ" "pu" ]
    [ "ペ" "ぺ" "pe" ]
    [ "ポ" "ぽ" "po" ] ]
  "Array of the five kana beginning with p" )


;; Not really seperate kana, but these sounds are written with the
;; smaller "vowel" endings.  I decided not to include them as seperate
;; groups to be quizzed on.

;(defvar kana-drill-vector-ky
;  [ [ "キャ" "きゃ" "kya" ]
;    [ "キィ" "きぃ" "kyi" ]
;    [ "キュ" "きゅ" "kyu" ]
;    [ "キェ" "きぇ" "kye" ]
;    [ "キョ" "きょ" "kyo" ] ]
;  "Array of five kana beginning with ky" )

;(defvar kana-drill-vector-sh
;  [ [ "シャ" "しゃ" "sha" ]
;    [ "シュ" "しゅ" "shu" ]
;    [ "シェ" "しぇ" "she" ]
;    [ "ショ" "しょ" "sho" ] ]
;  "Array of four kana beginning with sh" )

;(defvar kana-drill-vector-ch
;  [ [ "チャ" "ちゃ" "cha" ]
;    [ "チュ" "ちゅ" "chu" ]
;    [ "チェ" "ちぇ" "che" ]
;    [ "チョ" "ちょ" "cho" ] ]
;  "Array of four kana beginning with ch" )

;(defvar kana-drill-vector-ny
;  [ [ "ニャ" "にゃ" "nya" ]
;    [ "ニィ" "にぃ" "nyi" ]
;    [ "ニュ" "にゅ" "nyu" ]
;    [ "ニェ" "にぇ" "nye" ]
;    [ "ニョ" "にょ" "nyo" ] ]
;  "Array of five kana beginning with ny" )

;(defvar kana-drill-vector-hy
;  [ [ "ヒャ" "ひゃ" "hya" ]
;    [ "ヒィ" "ひぃ" "hyi" ]
;    [ "ヒュ" "ひゅ" "hyu" ]
;    [ "ヒェ" "ひぇ" "hye" ]
;    [ "ヒョ" "ひょ" "hyo" ] ]
;  "Array of five kana beginning with hy" )

;(defvar kana-drill-vector-my
;  [ [ "ミャ" "みゃ" "mya" ]
;    [ "ミィ" "みぃ" "myi" ]
;    [ "ミュ" "みゅ" "myu" ]
;    [ "ミェ" "みぇ" "mye" ]
;    [ "ミョ" "みょ" "myo" ] ]
;  "Array of five kana beginning with my" )

;(defvar kana-drill-vector-ry
;  [ [ "リャ" "りゃ" "rya" ]
;    [ "リィ" "りぃ" "ryi" ]
;    [ "リュ" "りゅ" "ryu" ]
;    [ "リェ" "りぇ" "rye" ]
;    [ "リョ" "りょ" "ryo" ] ]
;  "Array of five kana beginning with ry" )

;(defvar kana-drill-vector-gy
;  [ [ "ギャ" "ぎゃ" "gya" ]
;    [ "ギィ" "ぎぃ" "gyi" ]
;    [ "ギュ" "ぎゅ" "gyu" ]
;    [ "ギェ" "ぎぇ" "gye" ]
;    [ "ギョ" "ぎょ" "gyo" ] ]
;  "Array of five kana beginning with gy" )

;(defvar kana-drill-vector-j
;  [ [ "ジャ" "じゃ" "ja" ]
;    [ "ジュ" "じゅ" "ju" ]
;    [ "ジェ" "じぇ" "je" ]
;    [ "ジョ" "じょ" "jo" ] ]
;  "Array of four kana beginning with j" )

;(defvar kana-drill-vector-by
;  [ [ "ビャ" "びゃ" "bya" ]
;    [ "ビィ" "びぃ" "byi" ]
;    [ "ビュ" "びゅ" "byu" ]
;    [ "ビェ" "びぇ" "bye" ]
;    [ "ビョ" "びょ" "byo" ] ]
;  "Array of five kana beginning with by" )

;(defvar kana-drill-vector-py
;  [ [ "ピャ" "ぴゃ" "pya" ]
;    [ "ピィ" "ぴぃ" "pyi" ]
;    [ "ピュ" "ぴゅ" "pyu" ]
;    [ "ピェ" "ぴぇ" "pye" ]
;    [ "ピョ" "ぴょ" "pyo" ] ]
;  "Array of five kana beginning with py" )


(defvar kana-drill-num-groups nil
  "Total number of kana groups" )

(if kana-drill-num-groups ()
  (setq kana-drill-num-groups (length kana-drill-groups)) )

(defvar kana-drill-current-group nil
  "The current group we are drilling" )

(defvar kana-drill-current-sound nil
  "The sound, in Romaji, of the current group we are drilling" )

(defvar kana-drill-answer nil
  "The current correct answer" )

(defvar kana-drill-trial-index nil
  "The current trial index" )

(defvar kana-drill-trial nil
  "The current trial" )

(defvar kana-drill-choice nil
  "The current choice" )

(defvar kana-drill-query nil
  "The current query" )

(defvar kana-drill-active-groups nil
  "List of all kana groups we are currently drilling" )

(defvar kana-drill-completed-groups nil
  "List of all kana groups we've completed" )

(defvar kana-drill-domain '(0)
  "What character sets can be used for queries." )

(defvar kana-drill-range '(2)
  "What character sets can be used for choices." )

(defvar kana-drill-charset-map [ "H" "K" "E" ]
  "Single letter representations of the character sets." )

(defvar kana-drill-completed-charsets nil
  "Which character sets we've completed" )

(defvar kana-drill-complete-limit 70
  "Default score for characters" )

(defvar kana-drill-right-score 10
  "Amount to reduce score by when a trial is correct" )

(defvar kana-drill-wrong-score 20
  "Amount to reduce score by when a trial is incorrect" )

(defvar kana-drill-num-choices 5
  "Number of samples to choose from each trial." )

(defvar kana-drill-choices nil
  "List of choices for a given trial." )

(defface kana-drill-query-face
  '((t
     (:foreground "green") ))
  "The face for kana-drill trial characters." )

(defface kana-drill-choice-face
  '((t
     (:foreground "cyan") ))
  "The face for kana-drill trial choices." )

(defvar kana-drill-keymap nil
  "Keymap to use for choice text." )

(if kana-drill-keymap ()
  (setq kana-drill-keymap (make-sparse-keymap))
  (suppress-keymap kana-drill-keymap)
  (define-key kana-drill-keymap [(return)] 'kana-drill-key-return)
  (define-key kana-drill-keymap [(tab)] 'kana-drill-key-tab)
  (define-key kana-drill-keymap [(shift tab)] 'kana-drill-key-shift-tab)
  (define-key kana-drill-keymap [(right)] 'kana-drill-key-tab)
  (define-key kana-drill-keymap [(left)] 'kana-drill-key-shift-tab)
  (define-key kana-drill-keymap [(button2)] 'undefined)
  (define-key kana-drill-keymap [(button2up)] 'kana-drill-click-button2)
  (define-key kana-drill-keymap ?? 'kana-drill-help)
  (define-key kana-drill-keymap ?q 'kana-drill-quit)
  (define-key kana-drill-keymap ?R 'kana-drill-reset-scores)
  (define-key kana-drill-keymap ?S 'kana-drill-save)
  (define-key kana-drill-keymap ?1 '(lambda () (interactive)
                                      (kana-drill-select
                                       (nth 0 kana-drill-choices) )))
  (define-key kana-drill-keymap ?2 '(lambda () (interactive)
                                      (kana-drill-select
                                       (nth 1 kana-drill-choices) )))
  (define-key kana-drill-keymap ?3 '(lambda () (interactive)
                                      (kana-drill-select
                                       (nth 2 kana-drill-choices) )))
  (define-key kana-drill-keymap ?4 '(lambda () (interactive)
                                      (kana-drill-select
                                       (nth 3 kana-drill-choices) )))
  (define-key kana-drill-keymap ?5 '(lambda () (interactive)
                                      (kana-drill-select
                                       (nth 4 kana-drill-choices) )))
  (define-key kana-drill-keymap ?6 '(lambda () (interactive)
                                      (kana-drill-select
                                       (nth 5 kana-drill-choices) )))
  (define-key kana-drill-keymap ?7 '(lambda () (interactive)
                                      (kana-drill-select
                                       (nth 6 kana-drill-choices) )))
  (define-key kana-drill-keymap ?8 '(lambda () (interactive)
                                      (kana-drill-select
                                       (nth 7 kana-drill-choices) )))
  (define-key kana-drill-keymap ?9 '(lambda () (interactive)
                                      (kana-drill-select
                                       (nth 8 kana-drill-choices) )))
  (define-key kana-drill-keymap ?a '(lambda () (interactive)
                                      (kana-drill-type-choice ?a)))
  (define-key kana-drill-keymap ?e '(lambda () (interactive)
                                      (kana-drill-type-choice ?e)))
  (define-key kana-drill-keymap ?i '(lambda () (interactive)
                                      (kana-drill-type-choice ?i)))
  (define-key kana-drill-keymap ?o '(lambda () (interactive)
                                      (kana-drill-type-choice ?o)))
  (define-key kana-drill-keymap ?u '(lambda () (interactive)
                                      (kana-drill-type-choice ?u)))
  (define-key kana-drill-keymap ?k '(lambda () (interactive)
                                      (kana-drill-type-choice ?k)))
  (define-key kana-drill-keymap ?s '(lambda () (interactive)
                                      (kana-drill-type-choice ?s)))
  (define-key kana-drill-keymap ?t '(lambda () (interactive)
                                      (kana-drill-type-choice ?t)))
  (define-key kana-drill-keymap ?n '(lambda () (interactive)
                                      (kana-drill-type-choice ?n)))
  (define-key kana-drill-keymap ?h '(lambda () (interactive)
                                      (kana-drill-type-choice ?h)))
  (define-key kana-drill-keymap ?m '(lambda () (interactive)
                                      (kana-drill-type-choice ?m)))
  (define-key kana-drill-keymap ?y '(lambda () (interactive)
                                      (kana-drill-type-choice ?y)))
  (define-key kana-drill-keymap ?r '(lambda () (interactive)
                                      (kana-drill-type-choice ?r)))
  (define-key kana-drill-keymap ?w '(lambda () (interactive)
                                      (kana-drill-type-choice ?w)))
  (define-key kana-drill-keymap ?g '(lambda () (interactive)
                                      (kana-drill-type-choice ?g)))
  (define-key kana-drill-keymap ?z '(lambda () (interactive)
                                      (kana-drill-type-choice ?z)))
  (define-key kana-drill-keymap ?d '(lambda () (interactive)
                                      (kana-drill-type-choice ?d)))
  (define-key kana-drill-keymap ?b '(lambda () (interactive)
                                      (kana-drill-type-choice ?b)))
  (define-key kana-drill-keymap ?p '(lambda () (interactive)
                                      (kana-drill-type-choice ?p)))
  (define-key kana-drill-keymap ?c '(lambda () (interactive)
                                      (kana-drill-type-choice ?c)))
  (define-key kana-drill-keymap ?j '(lambda () (interactive)
                                      (kana-drill-type-choice ?j)))
  (define-key kana-drill-keymap ?f '(lambda () (interactive)
                                      (kana-drill-type-choice ?f)))
  (define-key kana-drill-keymap ?v '(lambda () (interactive)
                                      (kana-drill-type-choice ?v))) )

(defvar kana-drill-query-properties nil
  "Property list for choice text." )

(if (not kana-drill-query-properties)
    (setq kana-drill-query-properties
          (list
           'atomic      t
           'face        'kana-drill-query-face
           'mouse-face  nil )))

(defvar kana-drill-choice-properties nil
  "Property list for choice text." )

(if (not kana-drill-choice-properties)
    (setq kana-drill-choice-properties
          (list
           'atomic      t
           'face        'kana-drill-choice-face
           'mouse-face  nil
           'action      'kana-drill-select )))

;;;
;;; Functions
;;;

(defun kana-drill-key-tab ()
  "Cycle to the next choice"
  (interactive)
  (let ((next (next-single-property-change (point) 'action
                                           (current-buffer) )))
    (if (not next)
        (setq next 1) )
    (setq next (next-single-property-change next 'action
                                            (current-buffer) ))
    (if (or (not next) (not (get-text-property next 'action)))
        (goto-char (next-single-property-change 1 'action
                                                (current-buffer) ))
      (goto-char next) )))


(defun kana-drill-key-shift-tab ()
  "Cylce to the previous choice"
  (interactive)
  (let ((prev (previous-single-property-change
              (point) 'action (current-buffer) )))
    (if (not prev)
        (setq prev (point-max)) )
    (setq prev (previous-single-property-change
                prev 'action (current-buffer) ))
    (if (or (not prev) (not (get-text-property prev 'action)))
        (goto-char (previous-single-property-change
                    prev 'action (current-buffer) ))
      (goto-char prev) )))


(defun kana-drill-key-return ()
  "Choose the current selection by pressing return"
  (interactive)
  (let ((kana-drill-action (get-text-property (point) 'action))
        (start 0)
        (end 0))
    (if (not kana-drill-action)
        (beep)
      (setq start (previous-single-property-change
                      (+ 1 (point)) 'action (current-buffer) ))
      (if (not (get-text-property start 'action))
          (setq start (+ start 1)) )
      (setq end (next-single-property-change
                 (point) 'action (current-buffer) ))
      (funcall kana-drill-action (buffer-substring start end)) )))


(defun kana-drill-click-button2 (event)
  "Make a selection by clicking on it"
  (interactive "e")
  (goto-char (event-closest-point event))
  (let ((kana-drill-action (get-text-property (point) 'action))
        (start 0)
        (end 0))
    (if (not kana-drill-action)
        (beep)
      (setq start (previous-single-property-change
                      (+ 1 (point)) 'action (current-buffer) ))
      (if (not (get-text-property start 'action))
          (setq start (+ start 1)) )
      (setq end (next-single-property-change
                 (point) 'action (current-buffer) ))
      (funcall kana-drill-action (buffer-substring start end)) )))


(defun kana-drill-type-choice (char)
  "Read a choice from the keyboard"
  (kana-drill-select (read-from-minibuffer "Answer: " char)) )


(defun kana-drill-select (choice)
  "Make a selection"
  (if (string-equal choice kana-drill-answer)
      (kana-drill-correct choice)
    (kana-drill-incorrect choice) ))


(defun kana-drill-check-char-complete (char-score-vector)
  "Check to see if a given character has been completed"
  (let ((i 0)
        (complete t))
    (while (< i (length kana-drill-domain))
      (if (< 0 (aref char-score-vector (nth i kana-drill-domain)))
          (setq complete nil) )
      (setq i (+ i 1)) )
    complete ))


(defun kana-drill-check-group-complete (group-score-vector index)
  "Check to see if we are ready to move to the next group"
  (cond ((eq index (length group-score-vector)) t)
        (t (and (kana-drill-check-char-complete
                 (aref group-score-vector index))
                (kana-drill-check-group-complete group-score-vector
                                                 (+ index 1) )))))

(defun kana-drill-new-charset ()
  "Mark the current charset as complete and move on to the next"
  (setq kana-drill-completed-charsets
        (union kana-drill-completed-charsets kana-drill-domain) )
  (cond ((equal kana-drill-domain '(0))
         (setq kana-drill-domain '(1)))
        ((equal kana-drill-domain '(1))
         (setq kana-drill-domain '(2))
         (setq kana-drill-range '(0 1)))
        ((equal kana-drill-domain '(2))
         (setq kana-drill-domain '(0 1))
         (setq kana-drill-range '(2)))
        ((equal kana-drill-domain '(0 1))
         (setq kana-drill-domain '(0 1 2))
         (setq kana-drill-range '(0 1 2)))
        (t (setq kana-drill-domain '(0))
           (setq kana-drill-range '(2))))
  (setq kana-drill-active-groups '("a"))
  (setq kana-drill-completed-groups nil) )


(defun kana-drill-new-group ()
  "Mark the current group complete and add the next"
  (setq kana-drill-completed-groups (cons kana-drill-current-sound
                                          kana-drill-completed-groups ))
  (let ((i 0)
        (next nil))
    (while (< i (length kana-drill-groups))
      (if (and (not next)
               (not (member (aref kana-drill-groups i)
                            kana-drill-completed-groups) ))
          (setq next (aref kana-drill-groups i)) )
      (setq i (+ i 1)) )
    (if (not next)
        (kana-drill-new-charset)
      (setq kana-drill-active-groups (cons next kana-drill-active-groups)) ))
  (kana-drill-show-group (car kana-drill-active-groups)) )


(defun kana-drill-show-group (group)
  "Display the current group characters"
  (setq inhibit-read-only t)
  (erase-buffer)
  (insert "\n\n\t\tGroup " group "\n\n\n")
  (mapcar (lambda (l)
            (insert "\t")
            (mapcar (lambda (x)
                      (if (member x kana-drill-domain)
                          (insert (aref l x) "\t") ))
                    '(0 1 2) )
            (insert "-\t")
            (mapcar (lambda (x)
                      (if (member x kana-drill-range)
                          (insert (aref l x) "\t") ))
                    '(0 1 2) )
            (insert "\n\n") )
          (eval (intern (concat "kana-drill-vector-" group))) )
  (read-key-sequence "Press any key to continue")
  (erase-buffer)
  (setq inhibit-read-only nil) )


(defun kana-drill-help ()
  "Show the current group characters"
  (interactive)
  (kana-drill-show-group (car kana-drill-active-groups))
  (kana-drill-new-trial) )


(defun kana-drill-correct (choice)
  "Announce that a correct choice was made and update the scores"
  (message "Correct!")
  ;; Decrement the score for each currently active charset
  (let* ((group-score-vector
          (eval (intern (concat "kana-drill-score-"
                                kana-drill-current-sound ))))
         (score-vector (aref group-score-vector kana-drill-trial-index))
         (check-group-complete nil)
         (i 0) )
    (while (< i (length kana-drill-domain))
      (let* ((domain (nth i kana-drill-domain))
             (score (aref score-vector domain)) )
        (cond ((eq score 0) nil)
              ((<= score kana-drill-right-score)
               (setq check-group-complete t)
               (aset score-vector domain 0) )
              (t (aset score-vector
                       domain (- score kana-drill-right-score) ))))
      (setq i (+ i 1)) )
    ;; If any score was set to 1, check to see if the group is complete
    (if (and check-group-complete
             (not (member kana-drill-current-sound
                          kana-drill-completed-groups ))
             (kana-drill-check-group-complete group-score-vector 0) )
        (kana-drill-new-group) )
    (kana-drill-new-trial) ))


(defun kana-drill-incorrect (choice)
  "Announce that an incorrect choice was made and update the scores"
  (message "Wrong!")
  (beep)
  ;; Decrement the score for each currently active charset
  (let ((score-vector (aref (eval (intern (concat "kana-drill-score-"
                                                  kana-drill-current-sound )))
                            kana-drill-trial-index ))
        (i 0) )
    (while (< i (length kana-drill-domain))
      (let ((domain (nth i kana-drill-domain)))
        (aset score-vector domain (+ kana-drill-wrong-score
                                     (aref score-vector domain) ))
        (setq i (+ i 1)) ))))


(defun kana-drill-choose-group ()
  "Choose the sound of a group to use for a trial"
  (if (< (random 3) 2)
      (nth (random (length kana-drill-active-groups))
           kana-drill-active-groups )
    (let ((incomplete (set-difference kana-drill-active-groups
                                      kana-drill-completed-groups
                                      :test 'equal )))
      (if incomplete
          (nth (random (length incomplete)) incomplete)
        (nth (random (length kana-drill-active-groups))
             kana-drill-active-groups )))))


(defun kana-drill-choose-trial-index (sound)
  "Choose an index of a kana group to use for a trial"
  (let ((i 0)
        (j 0)
        (sum 0)
        (limit 0)
        (target 0)
        (scores (eval (intern (concat "kana-drill-score-" sound)))) )
    (setq j (length scores))
    (while (> j 0)
      (setq j (- j 1))
      (setq i (length kana-drill-domain))
      (while (> i 0)
        (setq i (- i 1))
        (setq limit (+ limit (aref (aref scores j)
                                   (nth i kana-drill-domain) )))))
    (setq limit (+ limit (length scores)))
    (setq target (+ (random limit) 1))
    (setq j (length scores))
    (while (and (< sum target)
                (> j 0) )
      (setq j (- j 1))
      (setq i (length kana-drill-range))
      (while (and (< sum target)
                  (> i 0) )
        (setq i (- i 1))
        (setq sum (+ sum (aref (aref scores j)
                               (nth i kana-drill-domain) ))))
      (setq sum (+ sum 1)) )
    j ))


(defun kana-drill-new-trial ()
  "Construct a new kana trial to guess"
  ;; Clear the buffer
  (setq inhibit-read-only t)
  (erase-buffer)
  (let ((i 0) n domain range group group-sound index)
    ;; Choose a domain and range
    (setq domain (nth (random (length kana-drill-domain)) kana-drill-domain))
    (setq range (nth (random (length kana-drill-range)) kana-drill-range))
    ;; Choose a character to drill
    (setq kana-drill-current-sound (kana-drill-choose-group))
    (setq kana-drill-current-group
          (intern (concat "kana-drill-vector-" kana-drill-current-sound)))
    (setq kana-drill-trial-index
          (kana-drill-choose-trial-index kana-drill-current-sound) )
    (setq kana-drill-trial
          (aref (eval kana-drill-current-group) kana-drill-trial-index))
    (setq kana-drill-query (aref kana-drill-trial domain))
    (setq kana-drill-answer (aref kana-drill-trial range))
    ;; Build the choices list
    (setq kana-drill-choices (list kana-drill-answer))
    (while (< i (- kana-drill-num-choices 1))
      (setq range (nth (random (length kana-drill-range))
                       kana-drill-range ))
      (setq group-sound (kana-drill-choose-group))
      (setq group (intern (concat "kana-drill-vector-" group-sound)))
      (setq index (kana-drill-choose-trial-index group-sound))
      (setq kana-drill-choice (aref (aref (eval group) index) range ))
      (while (member kana-drill-choice kana-drill-choices)
        (setq group-sound (kana-drill-choose-group))
        (setq group (intern (concat "kana-drill-vector-" group-sound)))
        (setq index (kana-drill-choose-trial-index group-sound))
        (setq kana-drill-choice (aref (aref (eval group) index) range )) )
      (setq kana-drill-choices (cons kana-drill-choice kana-drill-choices))
      (setq i (+ 1 i)) )
    ;; Randomize the position of the correct answer (currently last)
    (setq n (random kana-drill-num-choices))
    (if (not (equal n (- kana-drill-num-choices 1)))
        (progn (setcar (nthcdr (- kana-drill-num-choices 1) kana-drill-choices)
                       (nth n kana-drill-choices) )
               (setcar (nthcdr n kana-drill-choices) kana-drill-answer) ))
    ;; Print the trial
    (insert "\n\n\t\t\t")
    (insert kana-drill-query)
    (add-text-properties (- (point) (length kana-drill-query)) (point)
                         kana-drill-query-properties )
    (insert "\n\n\n")
    (mapcar '(lambda (x) (insert (concat "\t" x))
               (add-text-properties (- (point) (length x)) (point)
                                    kana-drill-choice-properties ))
            kana-drill-choices )
    (insert "\t\n")
    (goto-char (next-single-property-change 1 'action (current-buffer)))
    (setq inhibit-read-only nil) ))


(defun kana-drill-buffer-init ()
  "Set up the kana-drill buffer, keymap and so on."
  (switch-to-buffer (get-buffer-create "*kana-drill*"))
  (setq inhibit-read-only t)
  (erase-buffer)
  (kill-all-local-variables)
  (use-local-map kana-drill-keymap)
  (setq buffer-read-only t)
  (setq truncate-lines 't)
  (setq major-mode 'kana-drill-mode)
  (setq mode-name "Kana-Drill")
  (put 'kana-drill-mode 'mode-class 'special)
  (buffer-disable-undo (current-buffer))
  (setq inhibit-read-only nil)
  (run-hooks 'kana-drill-mode-hook) )


(defun kana-drill-score-init ()
  "Restore a saved game or initialize fresh scores"
  (if (file-readable-p "~/.kana-drill")
      (load "~/.kana-drill")
    (kana-drill-reset-scores t) ))


(defun kana-drill-reset-scores (arg)
  "Reset the scores"
  (interactive "P")
  (if (or arg (y-or-n-p "Reset all scores? "))
      (progn
        (setq kana-drill-active-groups (list "a"))
        (setq kana-drill-completed-groups nil)
        (let ((i 0) j group scores sound)
          (while (< i kana-drill-num-groups)
            (setq sound (aref kana-drill-groups i))
            (setq group (intern (concat "kana-drill-vector-" sound)))
            (setq scores (intern (concat "kana-drill-score-" sound)))
            (set scores (make-vector (length (eval group)) nil))
            (setq j 0)
            (while (< j (length (eval group)))
              (aset (eval scores) j
                (make-vector 3 kana-drill-complete-limit) )
              (setq j (+ j 1)) )
            (setq i (+ i 1)) )))))


(defun kana-drill-save ()
  "Save the current scores"
  (interactive)
  (save-excursion
    (find-file "~/.kana-drill")
    (erase-buffer)
    (insert ";; save file for Emacs kana-drill -- do not edit\n"
            ";; last saved " (current-time-string) "\n\n"
            (format "(setq kana-drill-active-groups '%S)\n"
                    kana-drill-active-groups )
            (format "(setq kana-drill-completed-groups '%S)\n"
                    kana-drill-completed-groups )
            (format "(setq kana-drill-completed-charsets '%S)\n"
                    kana-drill-completed-charsets )
            (format "(setq kana-drill-domain '%S)\n" kana-drill-domain)
            (format "(setq kana-drill-range '%S)\n\n" kana-drill-range))
    (mapcar (lambda (group)
              (insert (format "(setq kana-drill-score-%s %S)\n"
                              group
                              (eval (intern (concat "kana-drill-score-"
                                                    group ))))))
            kana-drill-groups )
    (write-file "~/.kana-drill")
    (kill-buffer (current-buffer)) ))

(defun kana-drill-quit ()
  "Quit Kana Drill"
  (interactive)
  (and (y-or-n-p "Save scores and quit? ")
       (kana-drill-save)
       (kill-buffer "*kana-drill*") ))

;;; Starting the mode
(defun kana-drill-mode ()
  "A mode for learning Japanese Kana"
  (interactive)
  (random t)
  (kana-drill-buffer-init)
  (kana-drill-score-init)
  (kana-drill-show-group (car kana-drill-active-groups))
  (kana-drill-new-trial) )

;;; Short name
(fset 'kana-drill 'kana-drill-mode)

;;; Announce a new feature
(provide 'kana-drill)