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

# ver.0.2
# - (追加) 再合成用ustの出力機能を追加。ファイル名は「入力ust-resyn.ust」となる。
# - (追加) 出力oto.iniの重複エイリアスに通し番号を付けた。

# ver.0.1
# - (修正) ustを開けないときにエラー窓を出さないようにした(openUstFile, makeCorpus)

package require -exact snack 2.2

array unset v
set v(appname) fransing
set v(version) 0.2
if {$::tcl_platform(os) == "Darwin"} {
  set scriptDir [file dirname [info script]]
  set d [split "$scriptDir" "/"]
  set topdir [join [lrange $d 0 [expr [llength $d] - 5]] "/"]
} elseif {[info exists ::starkit::topdir]} {
  set topdir [file dirname [info nameofexecutable]]
} else {
  set topdir [file dirname $argv0]
}
set v(inDir)  "$topdir/in"
set v(outDir) "$topdir/out"
set v(inExt)  "wav"          ;# 入力波形ファイルの拡張子
set v(outExt) "wav"          ;# 出力波形ファイルの拡張子
set v(maxO)      0.05         ;# オーバーラップの最大値
set v(maxP)      0.4          ;# 先行発声の最大値
set v(marginL)   0.2          ;# wav切り出し時の、左側に確保する余白
set v(marginR)   0.2          ;# wav切り出し時の、右側に確保する余白
set v(nameRule)  "_%p+%m%r"   ;# 命名規則
set v(gobi)      0            ;# 1=語尾の無音を保存する
set v(outUst)    0            ;# 1=再合成用ustを出力する
set v(progress)  0
set paramUsize   0
array unset paramU
set prgWindow .progress

if {$::tcl_platform(os) == "Darwin"} {
  set nkf "$scriptDir/nkf"     ;# oto.iniをsjisに変換するためのnkf
  set nkfResult "$scriptDir/nkfTmpResult"  ;# nkfの出力結果を一時保存するファイル
}

#---------------------------------------------------
# 一モーラの母音部の音素を返す
#
proc getVowel {mora} {
  set vA {あ か さ た な は ま や ら わ が ざ だ ば ぱ ゃ ぁ ゎ \
          ア カ サ タ ナ ハ マ ヤ ラ ワ ガ ザ ダ バ パ ャ ァ ヮ }
  set vI {い き し ち に ひ み    り    ぎ じ ぢ び ぴ    ぃ ゐ \
          イ キ シ チ ニ ヒ ミ    リ    ギ ジ ヂ ビ ピ    ィ ヰ }
  set vU {う く す つ ぬ ふ む ゆ る    ヴ ぐ ず づ ぶ ぷ ぅ ゅ っ \
          ウ ク ス ツ ヌ フ ム ユ ル       グ ズ ヅ ブ プ ゥ ュ ッ }
  set vE {え け せ て ね へ め    れ    げ ぜ で べ ぺ    ぇ ゑ \
          エ ケ セ テ ネ ヘ メ    レ    ゲ ゼ デ ベ ペ    ェ ヱ }
  set vO {お こ そ と の ほ も よ ろ を ご ぞ ど ぼ ぽ ょ ぉ    \
          オ コ ソ ト ノ ホ モ ヨ ロ ヲ ゴ ゾ ド ボ ポ ョ ォ    }
  set vN {ん ン}
  set vR {R _}

  set last [expr [string length $mora] -1]
  for {set i $last} {$i >= 0} {incr i -1} {  ;# 文字列の右側から該当するものを探す。"か3"などに対応。
    set char [string range $mora $i $i]

    if {[lsearch $vA $char] >= 0} { return "a" }
    if {[lsearch $vI $char] >= 0} { return "i" }
    if {[lsearch $vU $char] >= 0} { return "u" }
    if {[lsearch $vE $char] >= 0} { return "e" }
    if {[lsearch $vO $char] >= 0} { return "o" }
    if {[lsearch $vN $char] >= 0} { return "n" }
    if {[lsearch $vR $char] >= 0} { return "-" }   ;# 休符だった場合
  }
  return "-"
}

#------------------------------------------------------------
# NoteNumから音高を得る
#
proc noteNum2Note {NoteNum} {
  if {$NoteNum < 0} return ""
  set tone   [lindex {C C# D D# E F F# G G# A A# B} [expr $NoteNum % 12]]
  set octave [expr int(($NoteNum - 12) / 12)]
  return "$tone$octave"
}

#------------------------------------------------------------
# ustファイルを読み込む
#
#   ust(num)         ... 音符数
#   ust(番号,Left)   ... 開始時刻(秒)
#   ust(番号,Right)  ... 終了時刻(秒)
#   ust(番号,Length) ... 音符長(秒)
#   ust(番号,Lyric)  ... 音名(単独音ustでも連続音名形式にして記憶する)
# 読み込み成功は0、失敗は1を返す
#
proc openUstFile {fn ust} {
  global v
  upvar $ust _ust

  if {$::tcl_platform(os) == "Darwin"} {
    global nkf nkfResult
    exec -- $nkf -w8 $fn > $nkfResult     ;# 漢字コードをutf-8に変換
    set fn $nkfResult
  }

  if [catch {open $fn r} in] { return 1 }
  if [catch {set ustall [read $in]}] { return 1 }
  array unset _ust
  set _ust(num) 0
  close $in
  set Tempo 120
  set Length 0
  set Label   ""
  set NoteNum -1 
  set labelOld  "R"
  set end   0       ;# ラベル時刻
  set endOld 0      ;# ラベル時刻
  foreach row [split $ustall \n] {
    regexp {^Tempo=([0-9\.]+)}  $row dummy Tempo   ;# テンポ
    regexp {^Length=([0-9\.]+)} $row dummy Length  ;# 音符長
    regexp {^Lyric=(.+)$}       $row dummy Label   ;# 音名
    regexp {^NoteNum=(.+)$}     $row dummy NoteNum ;# 音高番号
    ;# 音符のセクション区切り、#TRACKEND
    if {[regexp {^\[#([0-9]+)\]$} $row dummy seq]  || $row == "\[#TRACKEND\]"} {
      if {$seq == "0000"} continue         ;# 最初の音符セクション名は飛ばす
      set _ust($_ust(num),Length) [expr $Length / 480.0 * 60.0 / $Tempo]  ;# 音符長を記録
      set _ust($_ust(num),Note)   [noteNum2Note $NoteNum]  ;# 音高番号を音高に
      set end [expr $end + $_ust($_ust(num),Length)]
      set _ust($_ust(num),Left) $endOld                    ;# 開始時刻を記録
      set _ust($_ust(num),Right) $end                      ;# 終了時刻を記録
      if {$seq == "0001" && $Label != "R"} {
        tk_messageBox -message "ustファイルの最初の音符が休符になっていません。" \
          -title "エラー" -icon warning
        return 1
      }
      if {[regexp {[^ ] [^ ]} $Label]} {
        ;# 入力ustが連続音データだった場合
        set preVowel [string range $Label 0 0]  ;# 先行母音を得る
        set mora ""
        for {set i 2} {$i < [string length $Label]} {incr i} {  ;# 当該モーラ名を抜き出す(強や3などのsuffixを除去)
          set char [string range $Label $i $i]
          if {$char != "_" && [isKana $char]} {
            set mora "$mora$char"
          } else {
            break
          }
        }
        set _ust($_ust(num),Lyric) "$preVowel $mora"               ;# 音名を記録
      } else {
        ;# 入力ustが単独音データだった場合
        set preVowel [getVowel $labelOld]  ;# ラベルを連続音名にする
        set mora ""
        for {set i 0} {$i < [string length $Label]} {incr i} {  ;# 当該モーラ名を抜き出す(強や3などのsuffixを除去)
          set char [string range $Label $i $i]
          if {$char != "_" && [isKana $char]} {
            set mora "$mora$char"
          } else {
            break
          }
        }
        set _ust($_ust(num),Lyric) "$preVowel $mora"               ;# 音名を記録
      }
      incr _ust(num)
      set endOld $end
      set labelOld $Label
    }
  }
  return 0
}

#------------------------------------------------------------
# wav+ustから分割wavとoto.iniを作る
#
proc makeCorpus {} {
  global v paramU paramUsize

  ;# 命名規則に必須パラメータが無ければ終了
  if {[regexp {%p} $v(nameRule)] == 0 || 
      [regexp {%m} $v(nameRule)] == 0 || [regexp {%r} $v(nameRule)] == 0} {
    tk_messageBox -message "必ず命名規則に%p、%m、%rを指定して下さい。" -title "エラー" -icon warning
    return
  }

  ;# 処理するファイルのID群を集める
  set ustFileIDs {}
  foreach fn [glob -nocomplain "$v(inDir)/*.$v(inExt)"] {
    set fn [file rootname [file tail $fn]]
    if {$fn == "" || ! [file exists "$v(inDir)/$fn.ust"]} continue
    lappend ustFileIDs $fn
  }

  ;# 出力ディレクトリが無ければ作る
  if {! [file exists "$v(outDir)"]} {
    file mkdir "$v(outDir)"
  } else {
    if {[llength [glob -nocomplain "$v(outDir)/*"]] > 0} {
      set ret [tk_dialog .confm "確認" "出力フォルダ内にファイルがあります。\n処理を続行しますか？" \
                question 2 "フォルダを空にして実行" "フォルダを空にせず実行" "処理中止"]
      if {$ret == 2} {
        return
      } elseif {$ret == 0} {
        file delete -force -- "$v(outDir)"
        file mkdir "$v(outDir)"
      }
    }
  }

  ;# 既存oto.iniのエイリアスを配列に入れる
  set aliasList [readAlias "$v(outDir)/oto.ini"]

  ;# wav、ustの組を処理する
  set paramUsize 1
  set iU   1  ;# paramUは1からカウントする(0から始めない。setParamの仕様にあわせるため)
  array unset paramU
  snack::sound sndOrg
  foreach s $ustFileIDs {
    array unset ust
    set ret [openUstFile "$v(inDir)/$s.ust" ust]   ;# ustデータを読み込む。重複があれば番号をつける
    if {$ret != 0} continue                        ;# ustを読めなかった場合は次へ

    sndOrg flush
    sndOrg read "$v(inDir)/$s.$v(inExt)"
    initProgressWindow "processing: $s"
    set sndOrg [sndOrg convert -channels Mono]
    set sampleRate [sndOrg cget -rate]
    set maxOMS [cut3 [expr $v(maxO) * 1000]]       ;# オーバーラップ最大値(単位msec)
    for {set i 1} {$i < $ust(num)} {incr i} {
      set iOld [expr $i - 1]

      ;# start〜end間を切り出してwav保存する
      set tmpP [expr $ust($iOld,Length) / 2.0]
      if {$tmpP > $v(maxP)} {
        set tmpP $v(maxP)
      }
      set start [expr $ust($i,Left) - $tmpP - $v(marginL)]
      set Sadj 0
      if {$start < 0} {
        set Sadj $start  ;# もし指定した幅を確保出来なかった時は不足分を記憶してSの値を補正する
        set start 0
      }
      set tmpNextP [expr $ust($i,Length) / 2.0]
      if {$tmpNextP > $v(maxP)} {
        set tmpNextP $v(maxP)
      }
      set end [expr $ust($i,Right) - $tmpNextP + $v(marginR)]
      if {$end >= [sndOrg length -unit SECONDS]} {
        set end -1
      }

      if {$ust($i,Lyric) != "- R"} {
        if {$v(gobi) == 0 && [regexp {^. R} $ust($i,Lyric)]} continue   ;# 語尾を登録しないなら次へ
        ;# wavファイルを保存する
        snack::sound snd
        if {$end >= 0} {
          snd copy sndOrg -start [expr int($start * $sampleRate)] -end [expr int($end * $sampleRate)]
        } else {
          snd copy sndOrg -start [expr int($start * $sampleRate)] -end $end
        }
        set choufukuNum 1
        set outFileWithR [makeWavNameID "$ust($i,Lyric)" "$v(nameRule)" "$ust($i,Note)" $i "$s"]
        set outFile [string map {"%r" ""} $outFileWithR]
        while {[file exists "$v(outDir)/$outFile.$v(outExt)"]} {
          incr choufukuNum
          set outFile [string map [eval format "{%%r \"$choufukuNum\"}"] $outFileWithR]
        }
        snd write "$v(outDir)/$outFile.$v(outExt)"

        ;# oto.iniのパラメータを作る

        ;# S
        set S  [cut3 [expr ($v(marginL) + $Sadj) * 1000]]
        if {$S < 0} {
          set S 0
        }
        set paramU($iU,1) $S

        ;# O
        set O [cut3 [expr ($ust($iOld,Length) / 3.0) * 1000]]
        if {$O > $maxOMS} {
          set O $maxOMS
        }
        set paramU($iU,2) $O

        ;# P
        set P [cut3 [expr ($ust($i,Left) - ($start + $S / 1000.0)) * 1000]]
        set paramU($iU,3) $P

        ;# C
        set paramU($iU,4) [cut3 [expr $P + $ust($i,Length) / 6.0 * 1000]]

        ;# E
        set tmpNextP [expr $ust($i,Length) / 2.0]
        if {$tmpNextP > $v(maxP)} {
          set tmpNextP $v(maxP)
        }
        set E [cut3 [expr -($ust($i,Right) - $tmpNextP - ($start + $S / 1000.0)) * 1000]] ;# 負数表現
        set paramU($iU,5) $E
        if {[regexp {^_} $outFile] == 0} { ;# wavファイルが「_」で始まらない場合
          set paramU($iU,5) [cut3 [expr [snd length -unit SECONDS] * 1000 - (abs($E) + $S)]] ;# 正数表現(ファイル末尾からの時間長)にする
          if {$paramU($iU,5) < 0} {
            set paramU($iU,5) 0
          }
        }

        ;# Alias
        set aliasChoufukuNum 1
        set outAlias $ust($i,Lyric)
        while {[lsearch -exact $aliasList $outAlias] >= 0} {
          incr aliasChoufukuNum
          set outAlias $ust($i,Lyric)$aliasChoufukuNum
        }
        lappend aliasList $outAlias
        set paramU($iU,6) $outAlias

        ;# wavFile
        set paramU($iU,0) "$outFile"
        ;#puts "$paramU($iU,6): ($start - $end), \t$paramU($iU,1)\t$paramU($iU,2)\t$paramU($iU,3)\t$paramU($iU,4)\t$paramU($iU,5)"
        incr iU
        incr paramUsize
      }
      updateProgressWindow [expr 100 * $i / $ust(num)]
    }
    deleteProgressWindow

    ;# 再合成用ustを出力する
    if $v(outUst) { makeResynthesisUst $s }
  }
  ;#puts "lyric: (wavstart wavend), \tS\tO\tP\tC\tE"
  saveParamFile "$v(outDir)/oto.ini"
  set num [expr $paramUsize - 1]
  tk_messageBox -message "$num個のwavに分割しました。" -title "終了" -icon info
}

#---------------------------------------------------
# 再合成用ustファイルを作成する
#
proc makeResynthesisUst {inUstFid} {
  global v paramU paramUsize

  set inUst  "$v(inDir)/$inUstFid.ust"
  set outUst "$v(outDir)/$inUstFid-resyn.ust"

  ;# MacOSならいったん漢字コードをutf-8にする
  if {$::tcl_platform(os) == "Darwin"} {
    global nkf nkfResult
    exec -- $nkf -w8 $inUst > $nkfResult     ;# 漢字コードをutf-8に変換
    set inUst $nkfResult
  }

  ;# 入力ustを取り込む
  if [catch {open $inUst r} in] { return 1 }
  if [catch {set ustall [read $in]}] { return 1 }
  close $in

  ;# 出力ustを作る
  if {$::tcl_platform(os) == "Darwin"} {
    if [catch {open $nkfResult w} out] { return 1 } ;# 後で漢字コードをsjisにするので
  } else {
    if [catch {open $outUst    w} out] { return 1 }
  }
  set i 1
  foreach row [split $ustall \n] {
    if {[regexp {^Lyric=(.+)$} $row dummy Lyric]} {
      if {$Lyric == "R"} {
        puts $out "$row"
      } else {
        puts $out "Lyric=$paramU($i,6)"                        ;# 音名を差し替えて出力
        incr i
      }
    } elseif {[regexp {^VoiceDir=} $row]} {
      set VoiceDir [file nativename [file normalize $v(outDir)]]  ;# 音源フォルダを差し替えて出力
      puts $out "VoiceDir=$VoiceDir"
    } elseif {[regexp {^CacheDir=} $row]} {
      puts $out "CacheDir=$inUstFid-resyn.cache"               ;# キャッシュフォルダを差し替えて出力
    } else {
      puts $out "$row"
    }
  }
  close $out

  if {$::tcl_platform(os) == "Darwin"} {
    global nkf nkfResult
    exec -- $nkf -s $nkfResult > $outUst    ;# 漢字コードをsjisに変換
  }
}

#---------------------------------------------------
# 実数を小数点以下3桁で打ち切る
#
proc cut3 {val} {
  if {$val >= 0} {
    return [expr int($val * 1000 + 0.5) / 1000.0 ]
  } else {
    return [expr int($val * 1000 - 0.5) / 1000.0 ]
  }
}

#---------------------------------------------------
# 原音パラメータのエイリアス一覧(リスト)を得る
#
proc readAlias {fn} {
  global v

  set aliasList {}
  if [catch {open $fn r} fp] {
    return $aliasList
  }

  while {![eof $fp]} {
    set p [split [gets $fp] "=,"]   ;# "fname,A,S,C,E,P,O"
    if {[llength $p] == 7} {
      lappend aliasList [lindex $p 1]
    }
  }
  close $fp
  return $aliasList
}

#---------------------------------------------------
# 原音パラメータを保存する
# return: 1=保存した。0=保存しなかった。
#
proc saveParamFile {fn} {
  global paramU paramUsize v

  if {$fn == ""} {return 0}

  ;# 保存ファイルを開く
  set mode w
  if {[file exists $fn]} {
    set mode a              ;# 既にoto.iniがあれば追記モードにする
  }
  if [catch {open $fn $mode} fp] {
    tk_messageBox -message "error: can not open $fn" -title "エラー" -icon warning
    return
  }

  for {set i 1} {$i < $paramUsize} {incr i} {
    if {[array names paramU "$i,0"] != ""} {
      set name $paramU($i,0).$v(outExt)
      set S 0; set O 0; set P 0; set C 0; set E 0; set A "";
      if {[array names paramU "$i,1"] != ""} { set S $paramU($i,1) }
      if {[array names paramU "$i,2"] != ""} { set O $paramU($i,2) }
      if {[array names paramU "$i,3"] != ""} { set P $paramU($i,3) }
      if {[array names paramU "$i,4"] != ""} { set C $paramU($i,4) }
      if {[array names paramU "$i,5"] != ""} { set E $paramU($i,5) }
      if {[array names paramU "$i,6"] != ""} { set A $paramU($i,6) }
      puts $fp $name=$A,$S,$C,$E,$P,$O    ;# ファイルへ書き出し
      #puts $name=$A,$S,$C,$E,$P,$O
    }
  }
  close $fp        ;# ファイルを閉じる

  if {$::tcl_platform(os) == "Darwin"} {
    global nkf
    exec -- $nkf -s --in-place $fn      ;# 漢字コードをsjisに変換
  }
  return 1
}

#---------------------------------------------------
# charが平仮名または片仮名なら1を、それ以外なら0を返す
#
proc isKana {char} {
  set kanaList {あ か さ た な は ま や ら わ    が ざ だ ば ぱ ゃ ぁ ゎ \
                ア カ サ タ ナ ハ マ ヤ ラ ワ    ガ ザ ダ バ パ ャ ァ ヮ \
                い き し ち に ひ み    り       ぎ じ ぢ び ぴ    ぃ ゐ \
                イ キ シ チ ニ ヒ ミ    リ       ギ ジ ヂ ビ ピ    ィ ヰ \
                う く す つ ぬ ふ む ゆ る       ぐ ず づ ぶ ぷ ゅ ぅ っ \
                ウ ク ス ツ ヌ フ ム ユ ル    ヴ グ ズ ヅ ブ プ ュ ゥ ッ \
                え け せ て ね へ め    れ       げ ぜ で べ ぺ    ぇ ゑ \
                エ ケ セ テ ネ ヘ メ    レ       ゲ ゼ デ ベ ペ    ェ ヱ \
                お こ そ と の ほ も よ ろ を    ご ぞ ど ぼ ぽ ょ ぉ    \
                オ コ ソ ト ノ ホ モ ヨ ロ ヲ    ゴ ゾ ド ボ ポ ョ ォ    \
                ん ン ゛ ゜ °\
                R _ }
  if {[lsearch $kanaList $char] >= 0} {
    return 1
  } else {
    return 0
  }
}

#---------------------------------------------------
# wavファイル名を求める（ディレクトリ、拡張子、重複の通し番号はつけない）
# なお、命名規則の%rはここでは%rのまま返す（後段の処理で重複数を調べて対応する）
# 引数choufukuが""でなければ%rを置換して返す
#
proc makeWavNameID {Lyric nameRule note noteSeq orgName {choufuku ""}} {
  global v

  set nameID $nameRule

  ;# %p,%mの処理（%pに先行母音、%mに当該モーラ名を挿入）
  set str ""
  set preVowel ""
  regexp {^([^ ]+) (.+)$} $Lyric dummy preVowel str  ;# 先行母音部をpreVowelへ
  ;# 当該モーラ名をmoraへ
  set mora ""
  for {set i 0} {$i < [string length $str]} {incr i} {
    set char [string range $str $i $i]
    if {$char != "_" && [isKana $char]} {
      set mora "$mora$char"
    } else {
      break
    }
  }
  set nameID [string map [eval format "{%%p \"$preVowel\"}"] $nameID]
  set nameID [string map [eval format "{%%m \"$mora\"}"]     $nameID]

  ;# %nの処理（%nに音高名を挿入）
  if {[regexp {%n} $nameID]} {
    set nameID [string map [eval format "{%%n \"$note\"}"] $nameID]
  }

  ;# %oの処理（%oに元ファイル名を挿入）
  if {[regexp {%o} $nameID]} {
    set nameID [string map [eval format "{%%o \"$orgName\"}"] $nameID]
  }

  ;# %tの処理（%tに各ustでの音符の通し番号を挿入）
  if {[regexp {%t} $nameID]} {
    set nameID [string map [eval format "{%%t \"$noteSeq\"}"] $nameID]
  }

  ;# %rの処理 (%rにwavファイルの重複通し番号を挿入)
  if {[regexp {%r} $nameID] && $choufuku != ""} {
    set nameID [string map [eval format "{%%r \"$choufuku\"}"] $nameID]
  }

  return $nameID
}

#---------------------------------------------------
# プログレスバーを初期化して表示する
#
proc initProgressWindow {{title "now processing..."}} {
  global prgWindow v
  if [isExist $prgWindow] return

  toplevel $prgWindow
  wm title $prgWindow $title
  if {$::tcl_platform(os) != "Darwin"} {
    wm attributes $prgWindow -toolwindow 1
    wm attributes $prgWindow -topmost 1
  }
  bind $prgWindow <Escape> "destroy $prgWindow"
  set topg [split [wm geometry .] "x+"]
  set x [expr [lindex $topg 2] + [lindex $topg 0] / 2 - 100]
  set y [expr [lindex $topg 3] + [lindex $topg 1] / 2 - 5]
  wm geometry $prgWindow "+$x+$y"

  set v(progress) 0

  ttk::progressbar $prgWindow.p -length 200 -variable v(progress) -mode determinate
  pack $prgWindow.p

  raise $prgWindow
  focus $prgWindow
}

#---------------------------------------------------
# プログレスバーを更新する。進捗状況は$progress(0〜100)で指定する)
#
proc updateProgressWindow {progress} {
  global v prgWindow

  set v(progress) $progress
  raise $prgWindow
  focus $prgWindow
  update
}

#---------------------------------------------------
# プログレスバーを消去する
#
proc deleteProgressWindow {} {
  global prgWindow
  destroy $prgWindow
}

#---------------------------------------------------
#   指定した窓が起動済みかチェック。起動済みならフォーカスする。
#
proc isExist {w} {
  if [winfo exists $w] {
    raise $w
    focus $w
    return 1
  } else {
    return 0
  }
}

#---------------------------------------------------
# 入力内容が正の実数なら1を、そうでないなら0を返す
#
proc isPlusDouble {x} {
  if {[string is double "$x"] && "$x" >= 0} {
    return 1
  }
  return 0
}

#---------------------------------------------------
# tk_chooseDirectory 用のラッパー(主にmac対応のため)
# MacOSでは-initialdirに存在しないファイルを指定するとエラーをおこした
#
proc my_chooseDirectory {{args {}}} {
  global topdir
  array set a $args

  if {$::tcl_platform(os) == "Darwin"} {
    if {[array names a "-initialdir"] == "" || ! [file exists $a(-initialdir)] } {
      set a(-initialdir) $topdir
    }
  }
  if {[array names a "-initialdir"] != ""} {
    set a(-initialdir) "\"$a(-initialdir)\""
  }
  set command [join "tk_chooseDirectory [array get a]" " "]
  eval $command
}

#---------------------------------------------------
# GUI
#
snack::createIcons    ;# アイコンを使用する

# 入出力フォルダ
labelframe  .fIO -text "入出力" -relief groove -padx 5 -pady 5
label  .fIO.inDir(l)  -text "入力フォルダ"
entry  .fIO.inDir(e)  -textvar v(inDir) -width 85
button .fIO.inDir(b)  -image snackOpen -text "選択" -command {
  set d [my_chooseDirectory -initialdir "$v(inDir)" -title "入力フォルダの選択"]
  if {$d != ""} {
    set v(inDir) $d
  }
}
label  .fIO.outDir(l) -text "出力フォルダ"
entry  .fIO.outDir(e) -textvar v(outDir) -width 85
button .fIO.outDir(b) -image snackOpen -text "選択" -command {
  set d [my_chooseDirectory -initialdir "$v(outDir)" -title "出力フォルダの選択"]
  if {$d != ""} {
    set v(outDir) $d
  }
}
grid .fIO.inDir(l)   -row 0 -column 0 -pady 2 -sticky nse
grid .fIO.inDir(e)   -row 0 -column 1 -columnspan 3 -pady 2 -sticky nswe -ipady 0
grid .fIO.inDir(b)   -row 0 -column 4 -pady 2
grid .fIO.outDir(l)  -row 1 -column 0 -pady 2 -sticky nse
grid .fIO.outDir(e)  -row 1 -column 1 -pady 2 -sticky nswe -ipady 0 -columnspan 3
grid .fIO.outDir(b)  -row 1 -column 4 -pady 2

# パラメータ
labelframe  .fp -text "パラメータ設定" -relief groove -padx 5 -pady 5
label  .fp.maxP(l)    -text "(1) 先行発声の最大値(秒)"
entry  .fp.maxP(e)    -textvar v(maxP)    -validate all -vcmd {isPlusDouble "%P"}
label  .fp.maxO(l)    -text "(2) オーバーラップの最大値(秒)"
entry  .fp.maxO(e)    -textvar v(maxO) -validate all -vcmd {
  if {[string is double "%P"]} {
    return 1
  }
  return 0
}
label  .fp.marginL(l) -text "(3) wav切り出し時の余白(当該音符の左側)(秒)"
entry  .fp.marginL(e) -textvar v(marginL) -validate all -vcmd {isPlusDouble "%P"}
label  .fp.marginR(l) -text "(4) wav切り出し時の余白(当該音符の右側)(秒)"
entry  .fp.marginR(e) -textvar v(marginR) -validate all -vcmd {isPlusDouble "%P"}
frame  .fp.right
grid .fp.right      -row 0 -column 2 -padx 2 -pady 2 -sticky ne -rowspan 5
grid .fp.maxP(l)    -row 0 -column 0 -padx 2 -pady 2 -sticky ne
grid .fp.maxP(e)    -row 0 -column 1 -padx 2 -pady 2 -sticky nw
grid .fp.maxO(l)    -row 1 -column 0 -padx 2 -pady 2 -sticky ne
grid .fp.maxO(e)    -row 1 -column 1 -padx 2 -pady 2 -sticky nw
grid .fp.marginL(l) -row 2 -column 0 -padx 2 -pady 2 -sticky ne
grid .fp.marginL(e) -row 2 -column 1 -padx 2 -pady 2 -sticky nw
grid .fp.marginR(l) -row 3 -column 0 -padx 2 -pady 2 -sticky ne
grid .fp.marginR(e) -row 3 -column 1 -padx 2 -pady 2 -sticky nw

# 例図
canvas .fp.right.c    -width 283 -height 277
if {$::tcl_platform(os) == "Darwin"} {
  image create photo rule -file "$scriptDir/rule.gif"
} else {
  image create photo rule -file "$topdir/rule.gif"
}
.fp.right.c create image 0 0 -image rule -anchor nw
# その他
labelframe    .fp.right.fo   -text "その他" -relief groove -padx 5 -pady 5
checkbutton   .fp.right.fo.cb(gobi) -text "語尾付近(a Rなど)を保存する" -variable v(gobi)
checkbutton   .fp.right.fo.cb(ust)  -text "再合成用ustを出力する" -variable v(outUst)
label         .fp.right.fo.exl      -text "入力波形フォーマット"
if {$::tcl_platform(os) == "Darwin"} {
  tk_optionMenu .fp.right.fo.ext v(inExt) wav aiff
} else {
  tk_optionMenu .fp.right.fo.ext v(inExt) wav mp3 aiff
}
grid .fp.right.fo.cb(gobi) -row 0 -column 0 -padx 2 -pady 0 -sticky nw -columnspan 2
grid .fp.right.fo.cb(ust)  -row 1 -column 0 -padx 2 -pady 0 -sticky nw -columnspan 2
grid .fp.right.fo.exl      -row 2 -column 0 -padx 2 -pady 0 -sticky nw
grid .fp.right.fo.ext      -row 2 -column 1 -padx 2 -pady 0 -sticky nw
pack .fp.right.c
pack .fp.right.fo -fill both -expand 1

# wavファイル名
labelframe .fp.fn   -text "wavファイル名の付け方" -relief groove -padx 5 -pady 5
grid .fp.fn -row 4  -column 0 -padx 2 -pady 2 -sticky nsew -columnspan 2
label .fp.fn.rule(l) -text "命名規則"
entry .fp.fn.rule(e) -textvar v(nameRule) -width 40 -validate all -vcmd {
  set v(nameSample)   "[makeWavNameID "a い" %P "A4" 3 "USTFILE" 5].$v(outExt)"
  set v(nameTemplate) "[makeWavNameID "(先行母音) い" %P "(音高名)" "(音符通し番号)" "(元ust名)" "(wav重複通し番号)"].$v(outExt)"
  return 1
}
label .fp.fn.exp(1)  -text "%p ... 先行母音名(必須)"
label .fp.fn.exp(2)  -text "%m ... 当該音名(必須)"
label .fp.fn.exp(3)  -text "%r ... wavファイル名重複時の通し番号(必須)"
label .fp.fn.exp(4)  -text "%n ... 音高名(任意)"
label .fp.fn.exp(5)  -text "%t ... ustファイル内での音符通し番号(任意)"
label .fp.fn.exp(6)  -text "%o ... 入力ust名(任意)"

label .fp.fn.rule(1)   -textvar v(nameTemplate) -foreground #ff0000
label .fp.fn.sample(0) -text "例："
label .fp.fn.sample(1) -textvar v(nameSample) -foreground #ff0000
grid .fp.fn.rule(l)    -row 0 -column 0 -padx 2 -pady 2 -sticky ne
grid .fp.fn.rule(e)    -row 0 -column 1 -padx 2 -pady 2 -sticky nwse
grid .fp.fn.rule(1)    -row 1 -column 1 -padx 2 -pady 0 -sticky nw -columnspan 3
grid .fp.fn.sample(0)  -row 2 -column 0 -padx 2 -pady 0 -sticky ne
grid .fp.fn.sample(1)  -row 2 -column 1 -padx 2 -pady 0 -sticky nw -columnspan 3
grid .fp.fn.exp(1)     -row 3 -column 1 -padx 2 -pady 0 -sticky nw -columnspan 3
grid .fp.fn.exp(2)     -row 4 -column 1 -padx 2 -pady 0 -sticky nw -columnspan 3
grid .fp.fn.exp(3)     -row 5 -column 1 -padx 2 -pady 0 -sticky nw -columnspan 3
grid .fp.fn.exp(4)     -row 6 -column 1 -padx 2 -pady 0 -sticky nw -columnspan 3
grid .fp.fn.exp(5)     -row 7 -column 1 -padx 2 -pady 0 -sticky nw -columnspan 3
grid .fp.fn.exp(6)     -row 8 -column 1 -padx 2 -pady 0 -sticky nw -columnspan 3

# 実行
frame .fdo
button .fdo.b(do)     -text "実行" -command makeCorpus
button .fdo.b(cancel) -text "終了" -command exit
grid .fdo.b(do) .fdo.b(cancel)

grid .fIO -row 0 -column 0 -padx 2 -pady 0 -sticky new
grid .fp  -row 1 -column 0 -padx 2 -pady 0 -sticky new
grid .fdo -row 2 -column 0 -padx 2 -pady 0 -sticky nw

wm title . "$v(appname) $v(version)"
set v(nameSample)   "[makeWavNameID "a い" "$v(nameRule)" "A4" 3 "USTFILE" 5].$v(outExt)"
set v(nameTemplate) "[makeWavNameID "(先行母音) い" "$v(nameRule)" "(音高名)" "(音符通し番号)" "(元ust名)" "(wav重複通し番号)"].$v(outExt)"

