#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"

# ver.2.0
# - (修正) 窓幅を広げた時に表も広がるようにした。
# - (変更) pCov-init.tclの仕様を変更した。これにより旧バージョンのファイルとの互換性は無くなった。
# - (追加) 一覧表のうち、カバー率計算等の対象外にする領域を指定できるようにした(pCov-init.tclのexcludeRegion)。
# - (追加) CUIモード実装(使い方：コマンドラインから実行する際に-cuiオプションを付ける)。

# ver.1.2
# - リセットボタンを追加。
# - ファイルまたはフォルダを追加で読み込んだときに発声回数が
#   不正確になるバグ（発声回数を１回余分にカウントしてしまっていた）を修正。
# - ドラッグ＆ドロップに対応。通常のD&Dは通常解析、Ctrl+D&Dは追加解析。
 
# ver.1.1
# - バグ修正

package require Tktable
package require tkdnd

#
# ポーズ記号の定義
#
set pause "-"

#
# 入力文字列の変換規則の定義。
# transFromListに変換元文字列を列挙し、
# その変換先文字列を同じ順でtransToListに列挙する。
#   (例1) 変換が不要の場合
#     set transFromList {}
#     set transToList {}
#
#   (例2) ア→あ、カ→ka　と変換したいとき
#     set transFromList {ア カ}
#     set transToList {あ ka}
#
set transFromList {
  ア カ サ タ ナ ハ マ ヤ ラ ワ ガ ザ ダ バ パ 
  イ キ シ チ ニ ヒ ミ    リ    ギ ジ ヂ ビ ピ 
  ウ ク ス ツ ヌ フ ム ユ ル    グ ズ ヅ ブ プ 
  エ ケ セ テ ネ ヘ メ    レ    ゲ ゼ デ ベ ペ 
  オ コ ソ ト ノ ホ モ ヨ ロ ヲ ゴ ゾ ド ボ ポ 
  ン 

  イャ キャ シャ チャ ニャ ヒャ ミャ リャ ギャ ジャ ヂャ ビャ ピャ 
  イュ キュ シュ チュ ニュ ヒュ ミュ リュ ギュ ジュ ヂュ ビュ ピュ 
  イョ キョ ショ チョ ニョ ヒョ ミョ リョ ギョ ジョ ヂョ ビョ ピョ 
  イェ キェ シェ チェ ニェ ヒェ ミェ リェ ギェ ジェ ヂェ ビェ ピェ 

  ウァ クァ スァ ツァ ヌァ ファ ムァ ユァ ルァ    ヴァ グァ ズァ ヅァ ブァ プァ テァ デァ
  ウィ クィ スィ ツィ ヌィ フィ ムィ ユィ ルィ    ヴィ グィ ズィ ヅィ ブィ プィ ティ ディ
  ウェ クェ スェ ツェ ヌェ フェ ムェ ユェ ルェ    ヴェ グェ ズェ ヅェ ブェ プェ 
  ウォ クォ スォ ツォ ヌォ フォ ムォ ユォ ルォ    ヴォ グォ ズォ ヅォ ブォ プォ 
  フュ

  テュ デュ

  トゥ ドゥ
}

set transToList {
  あ か さ た な は ま や ら わ が ざ だ ば ぱ 
  い き し ち に ひ み    り    ぎ じ ぢ び ぴ 
  う く す つ ぬ ふ む ゆ る    ぐ ず づ ぶ ぷ 
  え け せ て ね へ め    れ    げ ぜ で べ ぺ 
  お こ そ と の ほ も よ ろ を ご ぞ ど ぼ ぽ 
  ん

  いゃ きゃ しゃ ちゃ にゃ ひゃ みゃ りゃ ぎゃ じゃ ぢゃ びゃ ぴゃ 
  いゅ きゅ しゅ ちゅ にゅ ひゅ みゅ りゅ ぎゅ じゅ ぢゅ びゅ ぴゅ 
  いょ きょ しょ ちょ にょ ひょ みょ りょ ぎょ じょ ぢょ びょ ぴょ 
  いぇ きぇ しぇ ちぇ にぇ ひぇ みぇ りぇ ぎぇ じぇ ぢぇ びぇ ぴぇ 

  うぁ くぁ すぁ つぁ ぬぁ ふぁ むぁ ゆぁ るぁ    ヴぁ ぐぁ ずぁ づぁ ぶぁ ぷぁ てぁ でぁ
  うぃ くぃ すぃ つぃ ぬぃ ふぃ むぃ ゆぃ るぃ    ヴぃ ぐぃ ずぃ づぃ ぶぃ ぷぃ てぃ でぃ
  うぇ くぇ すぇ つぇ ぬぇ ふぇ むぇ ゆぇ るぇ    ヴぇ ぐぇ ずぇ づぇ ぶぇ ぷぇ 
  うぉ くぉ すぉ つぉ ぬぉ ふぉ むぉ ゆぉ るぉ    ヴぉ ぐぉ ずぉ づぉ ぶぉ ぷぉ 
  ふゅ

  てゅ でゅ 

  とぅ どぅ 
}

#
# 一つの音声単位として扱う文字(または文字列)の定義
#
set unitList {
  あ か さ た な は ま や ら わ が ざ だ ば ぱ 
  い き し ち に ひ み    り    ぎ じ ぢ び ぴ 
  う く す つ ぬ ふ む ゆ る    ぐ ず づ ぶ ぷ 
  え け せ て ね へ め    れ    げ ぜ で べ ぺ 
  お こ そ と の ほ も よ ろ を ご ぞ ど ぼ ぽ 
  ん
  ヴ

  いゃ きゃ しゃ ちゃ にゃ ひゃ みゃ りゃ ぎゃ じゃ ぢゃ びゃ ぴゃ 
  いゅ きゅ しゅ ちゅ にゅ ひゅ みゅ りゅ ぎゅ じゅ ぢゅ びゅ ぴゅ 
  いょ きょ しょ ちょ にょ ひょ みょ りょ ぎょ じょ ぢょ びょ ぴょ 
  いぇ きぇ しぇ ちぇ にぇ ひぇ みぇ りぇ ぎぇ じぇ ぢぇ びぇ ぴぇ 

  うぁ くぁ すぁ つぁ ぬぁ ふぁ むぁ ゆぁ るぁ    ヴぁ ぐぁ ずぁ づぁ ぶぁ ぷぁ てぁ でぁ
  うぃ くぃ すぃ つぃ ぬぃ ふぃ むぃ ゆぃ るぃ    ヴぃ ぐぃ ずぃ づぃ ぶぃ ぷぃ てぃ でぃ
  うぇ くぇ すぇ つぇ ぬぇ ふぇ むぇ ゆぇ るぇ    ヴぇ ぐぇ ずぇ づぇ ぶぇ ぷぇ 
  うぉ くぉ すぉ つぉ ぬぉ ふぉ むぉ ゆぉ るぉ    ヴぉ ぐぉ ずぉ づぉ ぶぉ ぷぉ 
  ふゅ

  てゅ でゅ 

  とぅ どぅ 
}

#
# 先行音名関係の定義。
# prevList(prev)の内容が一覧表の列となる。
#
array unset prevList
# ↓prevList(prev)に先行音を列挙する
set prevList(prev) {a i u e o n}

# ↓ポーズを便宜上登録しておく。
lappend prevList(prev) $pause

# ↓母音/a/に変換する文字のリスト
set prevList(a) {あ か さ た な は ま や ら わ が ざ だ ば ぱ ゃ ぁ ゎ }
# ↓母音/i/に変換する文字のリスト
set prevList(i) {い き し ち に ひ み    り    ぎ じ ぢ び ぴ    ぃ }
# ↓母音/u/に変換する文字のリスト
set prevList(u) {う く す つ ぬ ふ む ゆ る    ぐ ず づ ぶ ぷ ゅ ぅ ヴ}
# ↓母音/e/に変換する文字のリスト
set prevList(e) {え け せ て ね へ め    れ    げ ぜ で べ ぺ    ぇ }
# ↓母音/o/に変換する文字のリスト
set prevList(o) {お こ そ と の ほ も よ ろ を ご ぞ ど ぼ ぽ ょ ぉ }
# ↓撥音/n/に変換する文字のリスト
set prevList(n) {ん}
# ↓ポーズに変換するリスト（ここは変更しないこと）
lappend prevList($pause) $pause

#
# 結果表のうち、収録不要な組み合わせの集まった領域を指定する。
# ここで指定された領域はカバー率などの計算対象外になる。
# 厳密には、収録不要な個所がすべて一か所に集まるわけではないので、
# 本機能を使っても厳密に正しいカバー率が求まる保証はない。
# 本機能はあくまでも正しいカバー率に"近づける"ための機能である。
#
# よく分からない場合は set excludeRegion {} とすること(本機能が無効になる)。
#
# 除外領域の位置は空白刻みで以下のように指定する。
#
#   set excludeRegion { 左上の行番号 左上の列番号 右下の行番号 右下の列番号 }
#
#   ※行は表の縦方向、列は横方向を意味する。
#   ※表の一番左上にある数値が1行1列目。
#
#   例： 1行2列目から3行4列目までを除外するなら → { 1 2 3 4 }
#
#   また、表の一番右下は文字列"end"で表記しても良い。
#   すなわち表の一番右下にある数値はend行end列である。
#   さらに"end-数値"と書けば右下から指定数値分左(上)にずれた位置を指定できる。
#
#   例： 5行6列目から、最下行、表右-2列目までを除外するなら
#        → { 5 6 end end-2 }
#
set excludeRegion {}

set fontName "ＭＳ ゴシック" 
set fontSize 10

#---------------------------------------------------
# 変数初期化
#
set appname pCov
set version 2.0
set lyrics ""
set loadedFiles ""
set lyricsFile ""
set ui "gui"
array unset prof
  # prof(combNum)  .... 組み合わせ数
  # prof(uttNum)   .... 発声回数
  # prof(uttMoraNum) .... 発声モーラ数
  # prof(coveredNum) .... カバーした組み合わせ数
  # prof(notCoveredNum) .... カバーしていない組み合わせ数
array unset histo

if {[info exists ::starkit::topdir]} {
  set topdir [file dirname [info nameofexecutable]]
} else {
  set topdir [file dirname $argv0]
}
set initFile "$topdir/$appname-init.tcl"

#---------------------------------------------------
# アスキーファイルを読み込む。失敗したときは""を返す
#
proc readFile {fn {encode ""}} {
  if [catch {open $fn r} in] {
    tk_messageBox -message "ファイル読み込みに失敗しました" \
      -title "error" -icon warning
    return ""
  }
  if {$encode != ""} {
    fconfigure $in -encoding $encode
  }
  set data ""
  if [catch {set data [read -nonewline $in]}] {
    tk_messageBox -message "ファイル読み込みに失敗しました" \
      -title "error" -icon warning
  }
  close $in
  return $data
}

#---------------------------------------------------
# xmlファイルのエンコード指定を探す
#
proc guessEncode {data} {
  set encode ""
  set xmlTag ""
  regexp -nocase {<?xml [^>]+>} $data xmlTag
  regexp -nocase {encoding="([^"]+)"} $xmlTag dummy encode   ;#"
 
  return $encode
}

#---------------------------------------------------
# 解析対象ファイルを読み込む
#
proc readLyrics {args} {
  global v pause lyricsFile

  set fn ""
  if {[llength $args] == 0} {
    if {$lyricsFile != ""} {
      # 前回読んだファイルがあるなら
      if [file isdirectory $lyricsFile] {
        set initDir $lyricsFile
      } else {
        set initDir [file dirname $lyricsFile]
      }
      set fn [tk_getOpenFile \
              -title "ファイルを開く" -defaultextension "txt" \
              -initialdir $initDir \
              -filetypes { {{related files} {.txt .ust .wav .xml}} \
                           {{text file} {.txt}} {{UTAU ust file}  {.ust}}  \
                           {{wav file}  {.wav}} {{MusicXML file}  {.xml}}  \
                           {{All Files} {*}   } }]
    } else {
      # 前回読んだファイルがないなら
      set fn [tk_getOpenFile \
              -title "ファイルを開く" -defaultextension "txt" \
              -filetypes { {{related files} {.txt .ust .wav .xml}} \
                           {{text file} {.txt}} {{UTAU ust file}  {.ust}}  \
                           {{wav file}  {.wav}} {{MusicXML file}  {.xml}}  \
                           {{All Files} {*}   } }]
    }
  } else {
    set fn [lindex $args 0]
  }
  if {$fn == ""} {return ""}
  set lyricsFile $fn

  set result ""
  if [regexp -nocase {\.txt$} $lyricsFile] {
    # ファイルがtxtファイルなら
    set data [readFile $lyricsFile]
    if {$data == ""} {return ""}

    set result " $data "
    regsub -all {[[:space:]]+} $result $pause result
    return $result

  } elseif [regexp -nocase {\.wav$} $lyricsFile] {
    # ファイルがwavファイルなら
    regsub -nocase {\.wav$} $lyricsFile "" result  ;# 拡張子を除去
    regsub -all {_} $result "" result              ;# UTAU連続音wav冒頭の_を除去
    return $result

  } elseif [regexp -nocase {\.ust$} $lyricsFile] {
    # ファイルがustファイルなら
    set data [readFile $lyricsFile]
    if {$data == ""} {return ""}

    foreach l [split $data "\n"] {
      if [regexp {^Lyric=} $l] {
        regsub {^Lyric=} $l "" l
        if {$l == "R"} {
          set result "$result "
        } else {
          set result "$result$l"
        }
      }
    }
    set result " $result "
    regsub -all {[[:space:]]+} $result $pause result
    return $result

  } elseif [regexp -nocase {\.xml$} $lyricsFile] {
    # ファイルがxmlファイルなら（一行に一対のタグがある場合のみを想定）
    set data [readFile $lyricsFile]
    if {$data == ""} {return ""}
    set encode [guessEncode $data]  ;# ファイルの文字コードを得る
    if {$encode != [encoding system]} {
      set data [readFile $lyricsFile $encode]
    }

    # xmlから歌詞部分と休符を抽出する（一行に一対のタグがある場合のみを想定）
    foreach l [split $data "\n"] {
      if [regexp -nocase {<text>.+</text>} $l] {
        regsub -nocase {^.*<text>[[:space:]]*} $l "" l
        regsub -nocase {[[:space:]]*</text>.*$} $l "" l
        set result "$result$l"
      } elseif [regexp -nocase {<rest/>} $l] {
        set result "$result "
      }
    }
    set result " $result "
    regsub -all {[[:space:]]+} $result $pause result
    return $result
  }
}

#---------------------------------------------------
# 収録テキストファイルを集めたフォルダを読み込む
#
proc readLyricsDir {args} {
  global v pause lyricsFile

  set d ""
  if {[llength $args] == 0} {
    if {$lyricsFile != ""} {
      # 前回読んだファイルがあるなら
      if [file isdirectory $lyricsFile] {
        set initDir $lyricsFile
      } else {
        set initDir [file dirname $lyricsFile]
      }
      set d [tk_chooseDirectory -initialdir $initDir -title "フォルダの選択"]
    } else {
      # 前回読んだファイルがないなら
      set d [tk_chooseDirectory -title "フォルダの選択"]
    }
  } else {
    set d [lindex $args 0]
  }
  if {$d == ""} {return ""}

  set lyrics ""
  foreach fn [glob -nocomplain -directory $d *.{txt,wav,ust,xml}] {
    set lyricsTmp [readLyrics $fn]
    set lyrics "$lyrics$lyricsTmp"
  }
 
  set lyricsFile $d
  return $lyrics
}

#---------------------------------------------------
# charが一モーラなら1を、拗音などなら2を、想定外の音なら0を返す
#
#proc isMora {char} {
#  global unitList joinToPreceding pause
#  if {[lsearch $joinToPreceding $char] >= 0} {
#    return 2
#  } elseif {[lsearch $unitList $char] >= 0 || $char == $pause} {
#    return 1
#  } else {
#    return 0
#  }
#}

#---------------------------------------------------
# transFromList transToListの規則に従って文字列を変更する
#
proc transStr {inStr} {
  global transFromList transToList

  # 変換規則を文字列の長い順にソートする
  set from {}
  set to {}
  for {set i 0} {$i < [llength $transFromList]} {incr i} {
    set insFrom [lindex $transFromList $i]
    set insTo   [lindex $transToList   $i]
    for {set j 0} {$j < [llength $from]} {incr j} {
      if {$insFrom >= [string length [lindex $from $j]]} break
    }
    set from [linsert $from $j $insFrom]
    set to   [linsert $to   $j $insTo]
  }

  for {set i 0} {$i < [llength $from]} {incr i} {
    set f [lindex $from $i]
    set t [lindex $to   $i]
    regsub -all -- $f $inStr $t inStr
  }

  return $inStr
}

#---------------------------------------------------
# リストを文字列の長い順にソートして返す
#
proc sortStrList {inList} {
  set result {}
  for {set i 0} {$i < [llength $inList]} {incr i} {
    set ins [lindex $inList $i]
    for {set j 0} {$j < [llength $result]} {incr j} {
      if {$ins >= [string length [lindex $result $j]]} break
    }
    set result [linsert $result $j $ins]
  }
  return $result
}

#---------------------------------------------------
# 文字列を単位文字に分解して返す
#
proc unitSplit {inStr} {
  global unitList pause

  ;# 文字列の長い順にunitListをソートしたものをulに入れる
  set ul [sortStrList $unitList]
  lappend ul $pause

  ;# 規則に沿って文字列を変換する
  set inStr [transStr $inStr]

  set result {}
  while {[string length $inStr] > 0} {
    for {set i 0} {$i < [llength $ul]} {incr i} {
      set u [lindex $ul $i]
      if {[string first $u $inStr] == 0} {
        lappend result $u
        set inStr [string range $inStr [string length $u] end]
        break
      }
    }
    ;# inStr先頭から単位文字列を抽出できなかったとき
    if {$i >= [llength $ul]} {
      set inStr [string range $inStr 1 end]
    }
  }
  return $result
}

#---------------------------------------------------
# 一モーラの母音部の音素を返す
#
proc getPrev {mora} {
  global prevList
  set last [expr [string length $mora] -1]
  set char [string range $mora $last $last]

  foreach key $prevList(prev) {
    if {[array names prevList $key] != "" && [lsearch $prevList($key) $char] >= 0} {
      return $key
    }
  }
  return $mora
}

#---------------------------------------------------
# 指定した音に対応する欄番号を返す。不明の場合は-1を返す
proc getPrevSeq {prev} {
  global prevList

  set ret [lsearch $prevList(prev) $prev]
  if {$ret < 0} {
    return $ret
  } else {
    return [expr $ret + 1]  ;#+1するのは項目名欄があるため
  }
}

#---------------------------------------------------
# 指定した音に対応する欄番号を返す。不明の場合は-1を返す
proc getMoraSeq {mora} {
  global unitList

  set ret [lsearch $unitList $mora]
  if {$ret < 0} {
    return $ret
  } else {
    return [expr $ret + 1]  ;#+1するのは項目名欄があるため
  }
}

#---------------------------------------------------
# ヒストグラムの各セルをリセットする
#
proc resetHistogram {} {
  global table histo rSize cSize unitList prevList

  # 各組み合わせを0にする
  array unset histo
  for {set r 1} {$r < $rSize} {incr r} {
    for {set c 1} {$c < $cSize} {incr c} {
      set histo($r,$c) 0
      if {[isExcludeRegion $r $c] == 0} {
        $table tag celltag none $r,$c
      } else {
        $table tag celltag excld $r,$c
      }
    }
  }
  # 当該音名をセット
  set r 1
  foreach mora $unitList {
    set histo($r,0) $mora
    incr r
  }
  # 先行音名をセット
  set c 1
  foreach prev $prevList(prev) {
    set histo(0,$c) $prev
    incr c
  }
  set histo(0,0) ""
}

#---------------------------------------------------
# 解析結果を初期化する
proc resetProf {} {
  global prof

  # prof(combNum) 組み合わせ数はクリアせず起動時に求めたものを使う
  set prof(coveredNum) 0
  set prof(uttNum) 0
  set prof(uttMoraNum) 0
  set prof(notCoveredNum) 0
}

#---------------------------------------------------
proc makeHistogram {lyrics} {
  global histo pause prevList unitList table rSize cSize prof

  set u [unitSplit $lyrics]  ;# 歌詞文字列を単位毎に分解する

  # 初期化
  resetHistogram
  resetProf

  for {set i 1} {$i < [llength $u]} {incr i} {
    set mora [lindex $u $i]
    if {$mora == $pause} {
      incr prof(uttNum)      ;# 発声数を増やす
    } else {
      set prev [getPrev [lindex $u [expr $i - 1]]]
      set r [getMoraSeq $mora]
      set c [getPrevSeq $prev]
      if {[array names histo "$r,$c"] != "" && $r >= 0 && $c >= 0} {
        incr histo($r,$c)
        if {$histo($r,$c) == 1 && [isExcludeRegion $r $c] == 0} {
          incr prof(coveredNum)
        }
      } else {
        puts "warning: 想定していないパターン：$prev-$mora"
      }
      incr prof(uttMoraNum)   ;# 発声モーラ数を増やす
    }
  }

  # 頻度0のセルにnoneタグを付ける
  $table tag delete none
  $table tag delete excld
  for {set r 1} {$r < $rSize} {incr r} {
    for {set c 1} {$c < $cSize} {incr c} {
      if {$histo($r,$c) <= 0} {
        if {[isExcludeRegion $r $c] == 0} {
          $table tag celltag none $r,$c
          incr prof(notCoveredNum)
        } else {
          $table tag celltag excld $r,$c
        }
      } else {
        if {[isExcludeRegion $r $c]} {
          $table tag celltag err $r,$c
        }
      }
    }
  }
  $table tag configure excld  -bg #808050  ;# 除外領域のセルの背景色
  $table tag configure err    -bg #FFA050  ;# 除外領域なのに出現したセルの背景色
  $table tag configure none   -bg #C0C050  ;# 頻度０のセルの背景色
}

#---------------------------------------------------
# CSV形式でファイル保存する
proc saveCSV {} {
  global rSize cSize histo

  set fn [tk_getSaveFile -initialfile "result.csv" \
    -title "解析結果の保存" -defaultextension "csv" ]
  if {$fn == ""} return

  if [catch {open $fn w} out] {
    tk_messageBox -message "保存できませんでした" \
      -title "エラー" -icon warning
    return
  }

  for {set r 0} {$r < $rSize} {incr r} {
    for {set c 0} {$c < $cSize} {incr c} {
      puts -nonewline $out $histo($r,$c)
      if {[expr $c + 1] < $cSize} {
        puts -nonewline $out ","
      }
    }
    puts $out ""
  }

  close $out
}

#---------------------------------------------------
# カバー率を求める
#
proc getCoverage {} {
  global prof
  if {[array names prof "uttNum"] != ""} {
    if {$prof(combNum) > 0} {
      return [expr 100.0 * $prof(coveredNum) / $prof(combNum)]
    } else {
      return 0
    }
  }
}

#---------------------------------------------------
# 収録効率を求める
#
proc getEfficiency {} {
  global prof
  if {[array names prof "uttNum"] != ""} {
    if {$prof(uttMoraNum) > 0} {
      return [expr 100.0 * $prof(coveredNum) / $prof(uttMoraNum)]
    } else {
      return 0
    }
  }
}

#---------------------------------------------------
# 指定した位置が計算対象外かどうか調べる
#
proc isExcludeRegion {r c} {
  global excludeRegion

  if {[llength $excludeRegion] != 4} {
    return 0
  }
  if {$r >= [lindex $excludeRegion 0] &&
      $c >= [lindex $excludeRegion 1] &&
      $r <= [lindex $excludeRegion 2] &&
      $c <= [lindex $excludeRegion 3] } {
    return 1
  } else {
    return 0
  }
}

#---------------------------------------------------
# 収録されない音パターンを求める
#
proc getLackPattern {} {
  global rSize cSize histo
  set result ""
  for {set r 1} {$r < $rSize} {incr r} {
    for {set c 1} {$c < $cSize} {incr c} {
      if {$histo($r,$c) <= 0 && [isExcludeRegion $r $c] == 0} {
        set lackPattern "$histo(0,$c) $histo($r,0)"
        set result "$result$lackPattern\n"
      }
    }
  }
  return $result
}

#---------------------------------------------------
# 解析結果文を作る
#
proc makeAnalysisResult {} {
  global prof loadedFiles
  if {[array names prof "uttNum"] != ""} {
    set coverage    [getCoverage]
    set efficiency  [getEfficiency]
    set lackPattern [getLackPattern]
    # prof(combNum)  .... 組み合わせ数
    # prof(uttNum)   .... 発声回数
    # prof(uttMoraNum) .... 発声モーラ数
    # prof(coveredNum) .... カバーした組み合わせ数
    # prof(notCoveredNum) .... カバーしていない組み合わせ数
    return "
解析対象：
$loadedFiles

発声回数：\t$prof(uttNum) 回
発声モーラ数：\t$prof(uttMoraNum) 個
組み合わせ総数：\t$prof(combNum) とおり
カバー済組み合わせ数：\t$prof(coveredNum) とおり
未カバー組み合わせ数：\t$prof(notCoveredNum) とおり
カバー率：\t$coverage %
収録効率：\t$efficiency %

未収録パターン：
$lackPattern
    "
  } else {
    return ""
  }
}

#---------------------------------------------------
proc analysis {} {
  set w .analysis
  if [winfo exists $w] {destroy $w}
  toplevel $w
  wm title $w "解析結果"
  text $w.t -width 80 -height 25 -yscrollcommand "$w.y set"
  scrollbar $w.y -command "$w.t yview" -orient vertical
  button $w.b -text "閉じる" -command "destroy $w"
  grid $w.t $w.y -sticky news
  grid rowconfigure    $w 0 -weight 1
  grid columnconfigure $w 0 -weight 1
  grid $w.b

  $w.t insert end [makeAnalysisResult]
}

#---------------------------------------------------
# ドラッグ＆ドロップの処理
proc procDnd {objList {mode 0}} {     ;# mode=0..通常の解析、1..追加解析
  for {set i 0} {$i < [llength $objList]} {incr i} {
    set obj [lindex $objList $i]
    set obj [file normalize $obj]
    if [file isdirectory $obj] {       ;# フォルダをドロップされた場合
      if {$i <= 0 && $mode == 0} {
        folderAnalysis $obj
      } else {
        addedFolderAnalysis $obj
      }
    } elseif [regexp -nocase {\.(txt|wav|ust|xml)$} $obj] {  ;# 各種ファイルをドロップされた場合
      if {$i <= 0 && $mode == 0} {
        fileAnalysis $obj
      } else {
        addedFileAnalysis $obj
      }
    }
  }
}

#---------------------------------------------------
# ファイルを開く
proc fileAnalysis {{fn ""}} {
  global lyrics loadedFiles lyricsFile
  if {$fn == ""} {
    set lyricsTmp [readLyrics]   ;# 歌詞ファイルを読む
  } else {
    set lyricsTmp [readLyrics $fn]   ;# 歌詞ファイルを読む
  }
  if {$lyricsTmp != ""} {
    set lyrics $lyricsTmp
    set loadedFiles $lyricsFile
    makeHistogram $lyrics     ;# 度数分布を計算
  }
}

#---------------------------------------------------
# ファイルを開く(追加)
proc addedFileAnalysis {{fn ""}} {
  global lyrics loadedFiles lyricsFile pause
  if {$fn == ""} {
    set lyricsTmp [readLyrics]   ;# 歌詞ファイルを読む
  } else {
    set lyricsTmp [readLyrics $fn]   ;# 歌詞ファイルを読む
  }
  if {$lyricsTmp != ""} {
    set lyrics "$lyrics$lyricsTmp"
    set loadedFiles "$loadedFiles\n$lyricsFile"
    regsub -all -- "$pause+" $lyrics $pause lyrics
    makeHistogram $lyrics     ;# 度数分布を計算
  }
}

#---------------------------------------------------
# フォルダを開く
proc folderAnalysis {{fn ""}} {
  global lyrics loadedFiles lyricsFile
  if {$fn == ""} {
    set lyricsTmp [readLyricsDir]   ;# 歌詞フォルダを読む
  } else {
    set lyricsTmp [readLyricsDir $fn]   ;# 歌詞フォルダを読む
  }
  if {$lyricsTmp != ""} {
    set lyrics $lyricsTmp
    set loadedFiles $lyricsFile
    makeHistogram $lyrics     ;# 度数分布を計算
  }
}

#---------------------------------------------------
# フォルダを開く(追加)
proc addedFolderAnalysis {{fn ""}} {
  global lyrics loadedFiles lyricsFile pause
  if {$fn == ""} {
    set lyricsTmp [readLyricsDir]   ;# 歌詞フォルダを読む
  } else {
    set lyricsTmp [readLyricsDir $fn]   ;# 歌詞フォルダを読む
  }
  if {$lyricsTmp != ""} {
    set lyrics "$lyrics$lyricsTmp"
    set loadedFiles "$loadedFiles\n$lyricsFile"
    regsub -all -- "$pause+" $lyrics $pause lyrics
    makeHistogram $lyrics     ;# 度数分布を計算
  }
}

#---------------------------------------------------
# main

# コマンドラインオプション処理
for {set i 0} {$i < $argc} {incr i} {
  regsub -all -- "(\r|\n)" [lindex $argv $i] "" tmp   ;# 改行コード除去
  lset argv $i $tmp
}
while {$argc > 0 && [regexp {^-} [lindex $argv 0]]} {
  set opt [lindex $argv 0]
  if {$opt == "-f" && $argc >= 2} {   ;# 初期化ファイルを指定
    set initFile [lindex $argv 1]
    set argv [lreplace $argv 0 1]
    incr argc -2
  } elseif {$opt == "-cui"} {           ;# CUIモード
    set ui "cui"
    set argv [lreplace $argv 0 0]
    incr argc -1
  } else {
    puts "usage: $argv0 (-f initFile |-cui)"
    exit
  }
}

# 初期設定ファイルを読み込む
if {[file exists $initFile]} {
  source $initFile
}
set rSize [expr [llength $unitList] + 1]         ;# +1は項目名欄があるため
set cSize [expr [llength $prevList(prev)] + 1] ;# +1は項目名欄があるため

# 除外領域設定に"end"があれば数値に変換する
for {set i 0} {$i < [llength $excludeRegion]} {incr i} {
  set str [lindex $excludeRegion $i]
  set offset ""
  if {[regexp {^end(-[0-9]+|)$} $str dummy offset]} {
    if {$offset == ""} {
      if {$i == 0 || $i == 2} {
        lset excludeRegion $i [expr $rSize - 1]
      } else {
        lset excludeRegion $i [expr $cSize - 1]
      }
    } else {
      if {$i == 0 || $i == 2} {
        lset excludeRegion $i [expr $rSize - 1 + $offset]
      } else {
        lset excludeRegion $i [expr $cSize - 1 + $offset]
      }
    }
  }
}
if {[llength $excludeRegion] != 4} {
  set prof(combNum) [expr [llength $unitList] * [llength $prevList(prev)]]
} else {
  set prof(combNum) [expr [llength $unitList] * [llength $prevList(prev)] \
    - ([lindex $excludeRegion 2] - [lindex $excludeRegion 0] + 1) \
    * ([lindex $excludeRegion 3] - [lindex $excludeRegion 1] + 1) ]
}

set fseq 0
set f($fseq) [frame .fb]
button $f($fseq).open -text "ファイルを開く" -command fileAnalysis
button $f($fseq).reset -text "リセット" -command {
  set lyrics ""
  set loadedFiles ""
  set lyricsFile ""
  resetHistogram
  resetProf
}
button $f($fseq).open2 -text "ファイルを開く(追加)" -command addedFileAnalysis
button $f($fseq).analysis -text "解析" -command analysis
button $f($fseq).save -text "csv形式で保存" -command saveCSV
button $f($fseq).openDir -text "フォルダを開く" -command folderAnalysis
button $f($fseq).openDir2 -text "フォルダを開く(追加)" -command addedFolderAnalysis
button $f($fseq).exit -text "終了" -command {exit}
if {$ui == "gui"} {
  grid $f($fseq).open $f($fseq).open2 $f($fseq).analysis $f($fseq).reset -sticky ewsn
  grid $f($fseq).openDir $f($fseq).openDir2 $f($fseq).save $f($fseq).exit -sticky ewsn
  grid $f($fseq) -sticky news
}
incr fseq

set f($fseq) [frame .fe]
entry $f($fseq).e -textvar loadedFiles
if {$ui == "gui"} {
  pack $f($fseq).e -expand 1 -fill x
  grid $f($fseq) -sticky new
}
incr fseq

font create kfont -family $fontName -size $fontSize -weight normal -slant roman
set table [table .t -variable histo -rows $rSize -cols $cSize \
    -colwidth 8 \
    -multiline 0 -selectmode extended \
    -titlerows 1 -titlecols 1 -selecttitle 0 \
    -colstretchmode none -rowstretchmode none \
    -padx 1 -pady 1 \
    -font kfont \
    -xscrollcommand {.x set} -yscrollcommand {.y set} ]
scrollbar .x -command {$table xview} -orient horizontal
scrollbar .y -command {$table yview} -orient vertical
resetHistogram

if {$ui == "gui"} {
  grid $table .y -sticky news
  grid rowconfigure . $fseq -weight 1
  grid columnconfigure . 0 -weight 1
  incr fseq
  grid .x -sticky news
}

#$table width 0 10                        ;# 0列目の横幅を変更
$table tag configure active -bg #A0A0A0  ;# アクティブなセルの背景色
$table tag configure none   -bg #C0C050  ;# 頻度０のセルの背景色
$table tag configure excld  -bg #808050  ;# 除外領域のセルの背景色
$table tag configure err    -bg #FFA050  ;# 除外領域なのに出現したセルの背景色
$table configure -resizeborders none
#$table configure -rows $rSize
#$table configure -cols $cSize

bind Table <MouseWheel> {
  if {%D > 0} {
    ::tk::table::MoveCell $table  -1 0  ;# 上へ
  } else {
    ::tk::table::MoveCell $table   1 0  ;# 下へ
  }
  $table selection anchor active
}
bind . <Control-Alt-d> { console show }
dnd bindtarget . text/uri-list <Drop> {procDnd %D}  ;# D&Dしたデータを解析
dnd bindtarget . text/uri-list <Control-Drop> {procDnd %D 1} ;# D&Dしたデータを追加解析

wm title . "$appname ver.$version"

if {$ui == "cui"} {
  if {$argc > 0} {
    fileAnalysis [lindex $argv 0]
    for {set i 1} {$i < $argc} {incr i} {
      addedFileAnalysis [lindex $argv $i]
    }
    puts [makeAnalysisResult]  ;#koko
  }
  exit
}

