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

#file open->power extract->another power open->パワー曲線の縮尺がおかしい？
#拡大したときのパワー抽出を早くできない？

# ＜ver 2.6 での主な変更点＞
# - (修正) 別のwavファイルを読んだ直後にパワー曲線が更新されないバグを修正した(OpenFiles)
# - (修正) 波形拡大したときに、波形全体を上部に表示しないバグを修正した。(Redraw)
# - (追加) 拍単位の時間軸を表示できるようにした。
# - (追加) 各窓のリサイズを禁止した。

# ＜ver 2.5 での主な変更点＞
# - (追加) マウスで範囲選択してF4を押すと選択領域の両端にS、Eラベルを付けるようにした。

# ＜ver 2.4 での主な変更点＞
# ラベル検索を追加した(searchLabel, doSearchLabel)
# 切り出し時に保存フォルダを選択できるようにした(CutFile)
# 切り出し時に同名wavファイルがあった際に名前を変更して保存できるようにした(CutFile)
# 重複ラベルに通し番号を付ける機能を追加した(addChoufukuSeq)
# 指定したフォルダのwavを結合し、結合wavファイルとラベルファイルを作る(concatWav, wavJoin)

# ＜ver 2.3 での主な変更点＞
# - (変更) 編集後に別のファイルを開く際の確認窓のふるまいを変更した(2回出る場合があったのを1回にした)。
# - (変更) 「自動ラベリング」のパラメータ"平均平滑化のサンプル数"を"抽出窓長"に変更した。
#          以前あったパワー平均平滑化を廃止し、同種の機能である窓長を使うようにした。
# - (変更) パワー曲線表示をやや高速化した。またプログレスバーを表示させた。
# - (変更)ファイルオープン窓の拡張子指定を変更（.wav、.labを表示するようにした）。
# - (追加) 各設定窓がESCキーで閉じるようにした。
# - (追加) パラメータ値の自動抽出機能を追加した(autoLabeling)
# - (修正) _で始まるファイル名の_を削除してしまうバグを修正した(CutFile)。
# - (修正) 「自動ラベリング」のショートカット(Ctrl+F11)を削除した(波形縮小のショートカットと同じなので)
# - (修正) 「詳細設定」のショートカット(Ctrl+F12)を削除した(波形縮小のショートカットと同じなので)

# ＜ver 2.2 での主な変更点＞
# - バグフィックス(拡大表示の際のパワー表示のずれを修正)。
# - バグフィックス(ファイルを閉じた際のパワー表示のエラーを修正)。
# - 起動時にファイルオープンダイアログを自動で開かないようにした。
# - パワー計算時に経過窓を表示するようにした。
# - 本体窓へのD&Dに対応。

# ＜ver 2.1 での主な変更点＞
# - バグフィックス(スペクトル縦軸の表示)
# - ヘルプのオンラインマニュアルURLを変更
# - atode, redrawでのmarginを削除すべき(axisが若干ずれるため)
# - atode, Settingsで値変更に応じて自動計算するところはtraceの方がよいのでは

# ＜ver 2.0 での主な変更点＞
# - パワー表示
# - パワーに基づく自動ラベリング
# - パワー、スペクトルの表示/非表示を右クリックメニューから切替可能
# - メニュー構成に「表示」を追加し、表示関係のメニューをまとめた

package require -exact snack 2.2
# Try to load optional file format handlers
# catch { package require snacksphere }
# catch { package require snackogg }
package require http
package require tkdnd

set debug 0
snack::debug $debug
snack::sound snd -debug $debug
snack::sound cbs -debug $debug

set f(prog) [info script]
set f(labfile) ""
set f(sndfile) ""
set f(lpath)   ""
set f(header)  ""
# set mexhome "~/snack/"
# catch {source $mexhome/ipa_tmh.tcl}
# set f(ipapath) $mexhome/ipa_xbm
set v(labfmt) WAVES
set v(smpfmt) WAV
set v(ashost) localhost
set labels {}
set labelSeq {}
set undo {}
set v(labchanged) 0
set v(smpchanged) 0
set v(initWinWidth) 600   ;# 窓の横幅の初期値
set v(width) 600     ;# 波形全体を描画するのに必要な横サイズ
set v(toth) 286
set v(msg) "Press right mouse button for menu"
set v(timeh) 20
set v(yaxisw) 40
set v(labelh) 20
set v(vchan)   -1
#set v(offset) 0
#set v(zerolabs) 0
set v(startsmp) 0
set v(lastmoved) -1
set v(p_version) 2.2
set v(s_version) 2.2
set v(plugins) {}
set v(scroll) 1
set v(rate) 44100    ;# 16000    ;# サンプリング周波数
set v(sfmt) Lin16                ;# 形式
set v(chan) 1                    ;# チャンネル数
set v(topfr) 8000
set v(rp_sock) ""
#set v(propflag) 0
set v(pause) 0
set v(recording) 1
set v(activerec) 0
set v(cmap) grey
set v(grey) " "
#set v(color1) {#000 #006 #00B #00F #03F #07F #0BF #0FF #0FB #0F7 \
	      #0F0 #3F0 #7F0 #BF0 #FF0 #FB0 #F70 #F30 #F00}
set v(color1) {#000 #004 #006 #00A #00F \
 	       #02F #04F #06F #08F #0AF #0CF #0FF #0FE \
	       #0FC #0FA #0F8 #0F6 #0F4 #0F2 #0F0 #2F0 \
	       #4F0 #6F0 #8F0 #AF0 #CF0 #FE0 #FC0 #FA0 \
	       #F80 #F60 #F40 #F20 #F00}
set v(color2) {#FFF #BBF #77F #33F #00F #07F #0BF #0FF #0FB #0F7 \
	      #0F0 #3F0 #7F0 #BF0 #FF0 #FB0 #F70 #F30 #F00}
set v(fg) black
set v(wavcolor) black
set v(powcolor) #0000ff
set v(contrast) 0
set v(brightness) 0
set v(autoplay) 0
set v(showspeg) 0
set v(remspegh) 200
set v(showpower) 0
set v(rempowerh) 100
set v(remote) 0
set v(asport) 23654
set v(handle) ""
set v(s0) 0
set v(emphasizelb) 1   ;# 1=ラベル境界線をパネル全体に広げる
set v(version) 2.6
set v(keyword) ""               ;# ラベル検索キーワード
set v(sdirection) 1             ;# 1=下方向へ検索
set v(outDir) cut
set v(timeUnit) "Sec."          ;# 時間軸の表示方法。Sec. or Bar
set v(bpm) 120                  ;# 拍単位の時間軸(単位=BPM)
set v(bpmTmp) $v(bpm)           ;# 拍単位の時間軸、入力用(単位=BPM)
set v(bpmOffset) 0              ;# 拍単位の時間軸の左側オフセット値(単位=sec)
set v(bpmOffsetTmp) $v(bpmOffset) ;# 拍単位の時間軸の左側オフセット値、入力用(単位=sec)
set searchWindow .searchWindow  ;# 検索窓のウィジェット
set bpmWindow .bpmWindow        ;# 拍単位の時間軸用の設定窓


set z(zoomwinh) 200
set z(zoomwinw) 600
set z(zoomwinx) 200
set z(zoomwiny) 200
set z(zoomwavh) 0
set z(zoomwavw) 0
set z(f) 1

set s(sectwinh) 400
set s(sectwinw) 400
set s(sectwinx) 200
set s(sectwiny) 200
set s(secth) 400
set s(sectw) 400
set s(rx) -1

proc sec2samp {sec length} {
  if {[string length $sec] == 0 || [string length $length] == 0} {
    return 0
  }
  if {[string is double $sec] && [string is double $length]} {
    return [expr int(double($sec) / $length)] 
  } else {
    return -1
  }
}

;# パワー関係の設定
set power(coord) {}           ;# キャンバスに描画したパワー曲線の座標リスト
                              ;#   x1,y1,x2,y2,...
set power(pwchanged) 1        ;# 1=(パラメータを書き換えたため、)パワーを再抽出させる
set power(frameLength) 0.02   ;# パワー抽出刻み[sec]
set power(window)  Hanning    ;# パワー抽出時の窓
set power(preemphasis)  0.97  ;# パワー抽出時のプリエンファシス
#set power(smLength) 5 ;# 平滑化で平均をとるサンプル数
set power(uttLow)  10    ;# 無音とみなされる振幅の閾値[dB]
set power(uttHigh) 20    ;# 発話とみなされる振幅の閾値[dB]
set power(uttLengthSec) 0.1  ;# 発話中とみなされる時間長[sec]
set power(uttLength) [sec2samp $power(uttLengthSec) $power(frameLength)]  ;# 発話中とみなされる時間長[sample]
set power(silLengthSec) 0.1  ;# ポーズとみなされる時間長[sec]
set power(silLength) [sec2samp $power(silLengthSec) $power(frameLength)]  ;# ポーズとみなされる時間長[sample]
set power(pwMax) 0           ;# 抽出したパワーの最大値
set power(pwMin) 0           ;# 抽出したパワーの最小値
set power(N) 0               ;# 抽出したパワーの点数
set power(windowLengthSec) $power(frameLength)                             ;# パワー抽出時の窓長[sec]
set power(windowLength) [expr int([snd cget -rate] * $power(frameLength))] ;# パワー抽出時の窓長
array unset power_bk  ;# パワー設定のバックアップ
array unset powerDat  ;# パワー値系列

#---------------------------------------------------------------
# パワー平均値を求める
#
proc getPowerStats {} {
  global power powerDat

  if {[getPower]} {
    return   ;# エラーがあればここで終了
  }
  set ave  0
  set ave2 0
  set sd   0
  initProgressWindow
  set N $power(N)
  if {$N >= 50000} {
    set N 50000
  }
  for {set i 0} {$i < $N} {incr i} {
    set ave  [expr $ave  + $powerDat($i)]
    set ave2 [expr $ave2 + $powerDat($i) * $powerDat($i)]
    updateProgressWindow [expr $i * 100 / $N]
  }
  set ave [expr $ave / $N]
  set sd  [expr sqrt($ave2 / $N - $ave * $ave)]

  deleteProgressWindow
  return [list $ave $sd]
}

#---------------------------------------------------------------
# ヒストグラムを求める
if {1 == 0} {
proc getHisto {} {
  global power powerDat

  if {[getPower]} {
    return   ;# エラーがあればここで終了
  }

  array unset histo
  set kmin 0
  set kmax 0
  set N $power(N)
  if {$N >= 50000} {
    set N 50000
  }
  for {set i 0} {$i < $N} {incr i} {
    set k [expr int($powerDat($i) / 5)]
    if {[array names histo $k] != ""} {
      incr histo($k)
    } else {
      set histo($k) 1
      if {$k < $kmin} {
        set kmin $k
      }
      if {$k > $kmax} {
        set kmax $k
      }
    }
  }

  for {set k $kmin} {$k <= $kmax} {incr k} {
    if {[array names histo $k] != ""} {
      set db [expr $k * 5]
      puts "$db : $histo($k)"
    }
  }
  array unset powerDat
  set power(N) 0
}
}

#
#---------------------------------------------------
# 実数を小数点以下3桁で打ち切る
#
proc cut3 {val} {
  return [expr int($val * 1000) / 1000.0 ]
}
#
#---------------------------------------------------
#   指定した窓が起動済みかチェック。起動済みならフォーカスする。
#
proc isExist {w} {
  if [winfo exists $w] {
    raise $w
    focus $w
    return 1
  } else {
    return 0
  }
}

#---------------------------------------------------
# 検索窓
#
proc searchLabel {} {
  global v searchWindow t

  ;# 二重起動を防止
  if [winfo exists $searchWindow] {
    raise $searchWindow.f.e
    focus $searchWindow.f.e
    return
  }
  toplevel $searchWindow
  wm title $searchWindow "検索"
  wm resizable $searchWindow 0 0
  bind $searchWindow <Escape> "destroy $searchWindow"

  set f [frame $searchWindow.f]
  entry  $f.e  -textvar v(keyword) -wi 30
  button $f.bs -text "検索" -command doSearchLabel
  button $f.bc -text "キャンセル" -command {destroy $searchWindow}
  radiobutton $searchWindow.rup   -variable v(sdirection) -value 0 \
    -text "上方向へ検索"
  radiobutton $searchWindow.rdown -variable v(sdirection) -value 1 \
    -text "下方向へ検索"
  label $searchWindow.lsw   -text "Ctrl+Alt+f ... 検索窓を開く"
  label $searchWindow.lup   -text "Ctrl+N     ... 上方向へ次検索"
  label $searchWindow.ldown -text "Ctrl+n     ... 下方向へ次検索"
  pack $f.e $f.bs $f.bc -side left -anchor nw
  pack $f $searchWindow.rup $searchWindow.rdown -anchor nw
  pack $searchWindow.lsw   -anchor nw
  pack $searchWindow.lup   -anchor nw
  pack $searchWindow.ldown -anchor nw

  bind $searchWindow <Return> doSearchLabel
  raise $f.e
  focus $f.e
}

#---------------------------------------------------------------
# 検索
proc doSearchLabel {{sdirection -1}} {
  global .cf.fc.c c labels v
  if {$sdirection == -1} {
    set sdirection $v(sdirection)
  }
  set str $v(keyword)
  set w .cf.fc.c
  if {[$w focus] != {}} {
    set iNow [lindex [$c gettags [$w focus]] 0]
    if {$sdirection != 0} {
      incr iNow
    } else {
      incr iNow -1
    }
  } else {
    if {$sdirection != 0} {
      set iNow 0
    } else {
      set iNow [expr [llength $labels] - 1]
    }
  }

  if {$sdirection != 0} {
    ;# 下方向検索
    for {set i $iNow} {$i < [llength $labels]} {incr i} {
      set l [split [lindex $labels $i] "\n"]  ;# t, 121, labelName
      set t         [lindex $l 0]
      set labelName [lindex $l 2]
      if {[regexp "$str" $labelName]} {
        $c xview moveto [expr double(([Time2Coord $t] - [winfo width .] / 2) / $v(width))]
        $c focus lab$i
        $c icursor lab$i end
        break
      }
    }
  } else {
    ;# 上方向検索
    for {set i $iNow} {$i >= 0} {incr i -1} {
      set l [split [lindex $labels $i] "\n"]  ;# t, 121, labelName
      set t         [lindex $l 0]
      set labelName [lindex $l 2]
      if {[regexp "$str" $labelName]} {
        $c xview moveto [expr double(([Time2Coord $t] - [winfo width .] / 2) / $v(width))]
        $c focus lab$i
        $c icursor lab$i end
        break
      }
    }
  }
}

#---------------------------------------------------------------
# 指定したフォルダのwavを結合しラベルファイルを作る
proc concatWav {} {
  set procDir [tk_chooseDirectory -title "結合対象フォルダを選択" -mustexist 1]
  if {$procDir == ""} return

  set saveWavFilename [tk_getSaveFile -initialfile "$procDir.wav" \
            -title "結合wavファイルの名前を指定" -defaultextension "wav" ]
  if {$saveWavFilename == ""} return

  set saveLabFilename [format "%s.lab" [file rootname $saveWavFilename]]
  wavJoin $procDir $saveWavFilename $saveLabFilename
}

#---------------------------------------------------
# procDir/*.wavを結合して$saveWavFilename に保存する
# wavTarの同名プロシージャを変更したもの
#
proc wavJoin {procDir saveWavFilename saveLabFilename} {
  if {[file extension $saveLabFilename] == ".lab"} {
    set labType waves
  } else {
    set labType wavTar
  }

  if {[file exists $procDir] == 0} {
    tk_messageBox -title "エラー" -message "$procDir が見つかりません。"
    return
  }

  set filenames [glob -nocomplain [format "%s/*.wav" $procDir]]
  if {[llength $filenames] < 1} {
    tk_messageBox -title "エラー" \
      -message "指定したフォルダにはwavファイルがありません。"
    return
  }
  set fp [open $saveLabFilename w]

  if {$labType == "waves"} {
    puts $fp "#"
  }

  initProgressWindow

  # １つめのwavファイルを取り込んでヘッダ情報を得る
  set fn [lindex $filenames 0]
  set filenames [lreplace $filenames 0 0]
  snack::sound sndTmp0 -load $fn
  set outHeader [sndTmp0 info]

  # rawファイルで書き出して再び読み込む
  set workfile $saveWavFilename.raw
  sndTmp0 write $workfile -fileformat RAW -byteorder littleEndian
  snack::sound snd -load $workfile \
    -rate     [lindex $outHeader 1] \
    -encoding [lindex $outHeader 4] \
    -channels [lindex $outHeader 5] \
    -fileformat RAW \
    -byteorder littleEndian

  set ln [file rootname [file tail $fn]]
  if {$labType == "waves"} {
    set p [snd length -unit SECONDS]
    puts $fp "    $p 121 E_$ln"
  } else {
    set p [snd length]
    puts $fp "$p $ln"
  }
  set cnt 1
  updateProgressWindow [expr 100 * $cnt / [llength $filenames]]

  foreach fn $filenames {
    # wavファイルをrawファイルに書き出して再び読み込む
    snack::sound sndTmp2 -load $fn
    sndTmp2 write $workfile -fileformat RAW -byteorder littleEndian
    snack::sound sndTmp3 -load $workfile \
      -rate     [lindex $outHeader 1] \
      -encoding [lindex $outHeader 4] \
      -channels [lindex $outHeader 5] \
      -fileformat RAW \
      -byteorder littleEndian
    # 結合
    snd concatenate sndTmp3
    set ln [file rootname [file tail $fn]]
    if {$labType == "waves"} {
      set p [snd length -unit SECONDS]
      puts $fp "    $p 121 E_$ln"
    } else {
      set p [snd length]
      puts $fp "$p $ln"
    }
    incr cnt
    updateProgressWindow [expr 100 * $cnt / [llength $filenames]]
  }
  # 0.1秒の無音を最後に挿入する(最後のラベルが右端に出ずに編集不可になることを防ぐため)
  snack::sound sndTmp4 \
    -rate     [lindex $outHeader 1] \
    -encoding [lindex $outHeader 4] \
    -channels [lindex $outHeader 5] \
    -fileformat RAW \
    -byteorder littleEndian
  sndTmp4 length [expr int([lindex $outHeader 1] * 0.1)]
  for {set i 0} {$i < [sndTmp4 length]} {incr i} {
    sndTmp4 sample $i 0
  }
  snd concatenate sndTmp4

  # 結合wavファイルを保存
  snd write $saveWavFilename -fileformat WAV
  file delete $workfile

  close $fp
  deleteProgressWindow

  tk_messageBox -title "結合終了" \
    -message [format "%d個のwavをファイル%sに結合しました。" $cnt $saveWavFilename]
}


#---------------------------------------------------------------
# 重複ラベルに通し番号を付ける
proc addChoufukuSeq {} {
  global labels

  array unset choufuku
  set doneSetUndo 0
  set change 0
  for {set i 0} {$i < [llength $labels]} {incr i} {
    set l [split [lindex $labels $i] "\n"]  ;# t, 121, labelName
    set t         [lindex $l 0]
    set color     [lindex $l 1]
    set labelName [lindex $l 2]
    if {! [regexp {^E_} $labelName]} continue

    set newLabel $labelName
    set seq 1
    while {[array names choufuku $newLabel] != ""} {
      incr seq
      set newLabel "$labelName$seq"
    }
    set choufuku($newLabel) 1
    if {$newLabel != $labelName} {
      if {$doneSetUndo == 0} {
        SetUndo $labels
        set doneSetUndo 1
      }
	    set labels [lreplace $labels $i $i "$t\n$color\n$newLabel"]
      incr change
    }
  }
	Redraw quick
  SetMsg "$change個の重複ラベルを書き換えました"
}

#---------------------------------------------------------------
# パワーに基づく自動ラベリングを行う
proc autoLabeling {} {
  global power power_bk v

  if [isExist .al] return ;# 二重起動を防止

  array set power_bk [array get power] ;# パラメータバックアップ

  toplevel .al
  wm title .al "自動ラベリング"
  wm resizable .al 0 0
  bind .al <Escape> "destroy .al"

  set r 0

  ;# パワー抽出刻みの設定
  # frame .al.ffl
  label .al.lfl -text "パワー抽出間隔"
  entry .al.efl -textvariable power(frameLength) \
    -validate all -validatecommand {
         if {[string is double %P]} {
           if {[string length %P] > 0 && %P > 0} {
             set tmp [sec2samp $power(uttLengthSec) %P]
             if {$tmp >= 0} {
               set power(uttLength) $tmp
             }
	   }
           expr {1}
         } else {
           expr {0}
	 }
    }
  label .al.lflu -text "(sec)"
  grid .al.lfl  -sticky w -row $r -column 0
  grid .al.efl  -sticky w -row $r -column 1
  grid .al.lflu -sticky w -row $r -column 2 -columnspan 2
  incr r

  ;# プリエンファシスの設定
  # frame .al.fem
  label .al.lem -text "プリエンファシス"
  entry .al.eem -textvariable power(preemphasis)
  grid .al.lem  -sticky w -row $r -column 0
  grid .al.eem  -sticky w -row $r -column 1 -columnspan 3
  incr r

  ;# 平滑化に使うサンプル数の設定
  # frame .al.fsm
  label .al.lsm -text "パワー抽出窓長"
  entry .al.esm -textvariable power(windowLengthSec) \
    -validate all -validatecommand {
      if {[string is double %P]} {
        return 1
      } else {
        return 0
      }
    }
  label .al.lsmu -text "(sec)"
  grid .al.lsm  -sticky w -row $r -column 0
  grid .al.esm  -sticky w -row $r -column 1
  grid .al.lsmu -sticky w -row $r -column 2 -columnspan 2
  incr r

  ;# 窓の選択
  # frame .al.fwn
  label .al.lwn -text "窓の種類"
  tk_optionMenu .al.mwn power(window) \
    Hamming Hanning Bartlett Blackman Rectangle
  grid .al.lwn  -sticky w -row $r -column 0
  grid .al.mwn  -sticky w -row $r -column 1 -columnspan 3
  incr r

  ;# パラメータ自動推定
  button .al.bal -text "↓以下のパラメータ値をwavから自動推定する↓" -command {
    set ret [getPowerStats]
    set avePw [cut3 [lindex $ret 0]]
    set sdPw  [cut3 [lindex $ret 1]]
    set power(uttHigh) [cut3 [expr $avePw - $sdPw]]    ;# 平均-標準偏差を閾値にする。約7割が発声区間
    set power(uttLow)  [cut3 [expr $avePw - $sdPw]]    ;# 平均-標準偏差を閾値にする。約7割が発声区間
    set power(uttLengthSec) 0.1  ;# 発話中とみなされる時間長[sec]
    set power(uttLength) [sec2samp $power(uttLengthSec) $power(frameLength)]  ;# 発話中とみなされる時間長[sample]
    set power(silLengthSec) 0.1  ;# ポーズとみなされる時間長[sec]
    set power(silLength) [sec2samp $power(silLengthSec) $power(frameLength)]  ;# ポーズとみなされる時間長[sample]
  }
  grid .al.bal  -sticky w -row $r -column 0 -columnspan 4
  incr r

  ;# 発話中とみなされるパワーの設定
  # frame .al.fhi
  label .al.lhi -text "発声中のパワー最小値"
  entry .al.ehi -textvariable power(uttHigh)
  label .al.lhiu -text "(db)"
  grid .al.lhi  -sticky w -row $r -column 0
  grid .al.ehi  -sticky w -row $r -column 1
  grid .al.lhiu -sticky w -row $r -column 2 -columnspan 2
  incr r

  ;# 発話中とみなされる時間長の設定
  # frame .al.ful
  label .al.lul -text "最短発声時間"
  entry .al.eulSec -textvariable power(uttLengthSec) \
    -validate all -validatecommand {
         set tmp [sec2samp %P $power(frameLength)]
         if {$tmp >= 0} {
           set power(uttLength) $tmp
           expr {1}
         } else {
           expr {0}
         }
    }
  label .al.lulSec -text "(sec) = "
  label .al.lulSamp -textvariable power(uttLength)
  label .al.lulSampu -text "(sample)"
  grid .al.lul      -sticky w -row $r -column 0
  grid .al.eulSec   -sticky w -row $r -column 1
  grid .al.lulSec   -sticky w -row $r -column 2
  grid .al.lulSamp  -sticky w -row $r -column 3
  grid .al.lulSampu -sticky w -row $r -column 4
  incr r

  ;# ポーズ中とみなされるパワーの設定
  # frame .al.flw
  label .al.llw -text "無音中のパワー最大値"
  entry .al.elw -textvariable power(uttLow)
  label .al.llwu -text "(db)"
  grid .al.llw  -sticky w -row $r -column 0
  grid .al.elw  -sticky w -row $r -column 1
  grid .al.llwu -sticky w -row $r -column 2 -columnspan 2
  incr r

  ;# ポーズとみなされる時間長の設定
  # frame .al.fsl
  label .al.lsl -text "最短無音時間"
  entry .al.eslSec -textvariable power(silLengthSec) \
    -validate all -validatecommand {
         set tmp [sec2samp %P $power(frameLength)]
         if {$tmp >= 0} {
           set power(silLength) $tmp
           expr {1}
         } else {
           expr {0}
         }
    }
  label .al.lslSec -text "(sec) = "
  label .al.lslSamp -textvariable power(silLength)
  label .al.lslSampu -text "(sample)"
  grid .al.lsl      -sticky w -row $r -column 0
  grid .al.eslSec   -sticky w -row $r -column 1
  grid .al.lslSec   -sticky w -row $r -column 2
  grid .al.lslSamp  -sticky w -row $r -column 3
  grid .al.lslSampu -sticky w -row $r -column 4
  incr r

  ;# ボタンの設定
  # frame .al.fbt
  button .al.do -text "実行" -command { 
    ;# もしエントリ欄が空欄だったなら0を代入
    if {[string length $power(silLengthSec)] == 0} {
      set power(silLengthSec) 0
    }
    if {[string length $power(uttLengthSec)] == 0} {
      set power(uttLengthSec) 0
    }

    destroy .al 

    grab set .bf.lab     ;# ラベリング中は他の操作が出来ないようにする
	  SetMsg "自動ラベリング中です。しばらくお待ち下さい..."
    doAutoLabeling
    grab release .bf.lab ;# ラベリング中は他の操作が出来ないようにする
  }
  button .al.cancel -text "キャンセル" -command {
    ;# もしエントリ欄が空欄だったなら0を代入
    if {[string length $power(silLengthSec)] == 0} {
      set power(silLengthSec) 0
    }
    if {[string length $power(uttLengthSec)] == 0} {
      set power(uttLengthSec) 0
    }
    array set power [array get power_bk] ;# パラメータを以前の状態に戻す
    destroy .al
  }
  grid .al.do     -sticky w -row $r -column 0
  grid .al.cancel -sticky w -row $r -column 1 -columnspan 3
  incr r
}

;# パワーを抽出して平滑化
proc getPower {} {
  global power powerDat

  # initProgressWindow

  set power(windowLength) [expr int([snd cget -rate] * $power(windowLengthSec))]
  ;# パワーを抽出
  if {[catch {set pw [snd power -framelength $power(frameLength) \
    -windowtype $power(window) -preemphasisfactor $power(preemphasis) \
    -windowlength $power(windowLength) \
    -start 0 -end -1 ]} ret]} {
    # deleteProgressWindow
    return 1
  }

  array unset powerDat
  for {set i 0} {$i < [llength $pw]} {incr i} {
    set powerDat($i) [lindex $pw $i]
  }

  # deleteProgressWindow
  set power(pwchanged) 1
  set power(N) [array size powerDat]
  return 0
}

;# パワーを抽出→平滑化→発話区間抽出→ラベル付与
proc doAutoLabeling {} {
  global v f power saveseq saveseq_sw labels labelSeq powerDat

  ;# すでにラベルが存在するなら上書きして良いか確認する
  if {[llength $labels] > 0} {
    if {[tk_dialog .confm "確認" \
        "既にラベルがあります。\n消去して上書きして良いですか？" \
        question 1 "はい" "いいえ"]} {
      return
    }
  }
  initProgressWindow

  ;# ラベル列を初期化する
  set labels {}
  set labelSeq {}

  ;# パワーを抽出
  if {[getPower]} {
    return   ;# エラーがあればここで終了
  }
  updateProgressWindow 1

  ;# 発話開始点を探す
  set sil 0         ;# 直前の無音の位置
  set length 0   ;# 発話が連続しているサンプル数
  if {$powerDat(0) < $power(uttHigh)} {
    set target start
  } else {
    set target end
  }
  set target
  set prog 0  ;# 何割進捗したか
  set prog_pre -1  ;# 何割進捗したか
  for {set i 0} {$i < $power(N)} {incr i} {
    ;# puts "$i    $powerDat($i)"   ;# for debug
    set prog [expr int(double($i) / $power(N) * 10)]
    if {$prog != $prog_pre} { 
      SetMsg "自動ラベリング中です。しばらくお待ち下さい... ($prog 割終了)"
    }
    set prog_pre $prog

    if {$target == "start"} {
      ;# 発話開始点を探索中の場合の処理

      if {$powerDat($i) >= $power(uttHigh)} {
        incr length
      } else {
        set length 0
      }
      if {$length >= [expr $power(uttLength) + 1]} {
        ;# powerDat(i)から左にたどって発話開始点を求める
        set length 0
        for {set j $i} {$j > $sil} {incr j -1} {
          if {$powerDat($j) <= $power(uttLow)} {
            incr length
          } else {
            set length 0
          }
          if {$length >= [expr $power(silLength) + 1]} {
            break
          }
        }
        ;# 開始ラベルを挿入する(既に同位置にE_ラベルがあればskip)
        ;# puts "------ start: $j"            ;# for debug
        if {$j != $sil} {
          set t [expr $j * $power(frameLength)] ;# 時刻[sec]を計算
          InsertLabelEntryWithLabelName $t "S"
        }
        set target end    ;# 探索モードを切り替える
      }
    } else {
      ;# 発話終了点を探索中の場合の処理

      if {$powerDat($i) <= $power(uttLow)} {
        incr length
      } else {
        set length 0
      }
      if {$length >= [expr $power(silLength) + 1]} {
        ;# puts "------ end: $i"                 ;# for debug
        set t [expr $i * $power(frameLength)] ;# 時刻[sec]を計算
        InsertLabelEntryWithLabelName $t "E_"
        if {$saveseq_sw == 1} {
          incr saveseq
        }
        set sil $i
        set target start    ;# 探索モードを切り替える
      }
    }
    updateProgressWindow [expr $i * 100 / $power(N)]
  }
  set power(pwchanged) 1
  set v(labchanged) 1
  deleteProgressWindow
  SetMsg "自動ラベリング終了"
  Redraw
}

proc SetDefaultVars {} {
    global f v s

    set v(waveh) 50    ;#  波形表示の高さ
    set v(spegh) 0
    set v(powerh) 0
    set v(scrw) 32767
    set v(pps) 400     ;#  縮尺。pixel per second。１秒の描画に必要なピクセル数
    set v(opps) 400
    set v(fftlen) 256
    set v(winlen) 128
    set v(anabw) 125
    set v(preemph) 0.97
    set v(ipa) 0
    set v(autoload) 0
    set v(ch) 0
    set v(slink) 0
    set v(mlink) 0
    if {$::tcl_platform(platform) == "unix"} {
        set v(pluginfiles) [glob -nocomplain *.plg]
        # set v(browser) "netscape"
        if {$::tcl_platform(os) == "HP-UX"} {
            option add *font {Helvetica 10 bold}
        } else {
            option add *font {Helvetica 12 bold}
        }
    } else {
        set v(pluginfiles) [glob -nocomplain *.plg]
        #set v(browser) "c:/program files/netscape/communicator/program/netscape.exe"
    }
    set v(ipafmt) TMH
    ;# set v(labalign) w
    set v(labfmt) WAVES
    set v(labalign) e
    set v(fg) black
    set v(bg) [. cget -bg]
    if {[string match macintosh $::tcl_platform(platform)] || \
        [string match Darwin $::tcl_platform(os)]} {
        set v(fillmark) 0
    } else {
        set v(fillmark) 1
    }
    set v(font)  {Courier 10}
    if {[string match unix $::tcl_platform(platform)] } {
        set v(sfont) {Helvetica 10 bold}
    } else {
        set v(sfont) {Helvetica 8 bold}
    }
    set v(gridfspacing) 0
    set v(gridtspacing) 0
    set v(gridcolor) red
    set v(cmap) grey
    set v(showspeg) 0
    set v(remspegh) 200
    set v(showpower) 0
    set v(rempowerh) 100
    set v(linkfile) 0
    set f(skip) 0
    set f(byteOrder) ""
    set f(ipath) ""
    # set f(ihttp) "http://www.speech.kth.se/~kare/ex1.wav"
    set f(ihttp) ""
    #"http://www.speech.kth.se/cgi-bin/TransAll?this_is_an_example+am"

    set s(fftlen) 512
    set s(anabw)  31.25
    set s(ref)    -110.0
    set s(range)  110.0
    set s(wintype) Hamming
    set s(atype) FFT
    set s(lpcorder) 20

#     if {[info exists snack::snackogg]} {
#       set ::ogg(nombr) 128000
#       set ::ogg(maxbr) -1
#       set ::ogg(minbr) -1
#       set ::ogg(com)   ""
#       set ::ogg(query) 1
#     }
}

SetDefaultVars
catch { source [file join ~ .xsrc] }
catch { source [file join ~ .xsrf] }

snd config -rate $v(rate)
snd config -encoding $v(sfmt)
snd config -channels $v(chan)

set filt(f) [snack::filter map 0.0]

set echo(f) [snack::filter echo 0.6 0.6 30 0.4]
set echo(n) 1
set echo(drain) 1
set echo(iGain) 60
set echo(oGain) 60

set mix(f) [snack::filter map 0.0]

set amplify(f) [snack::filter map 1.0]
set amplify(v) 100.0
set amplify(db) 0

set normalize(f) [snack::filter map 1.0]
set normalize(v) 100.0
set normalize(db) 0
set normalize(allEqual) 1

set remdc(f) [snack::filter iir -numerator "0.99 -0.99" -denominator "1 -0.99"]

set f(spath) $f(ipath)
set f(http) $f(ihttp)
set f(urlToken) ""

if {$v(p_version) != $v(s_version)} {
     set v(msg) "Warning, you have saved settings from an older version!"
    SetDefaultVars
}

# Put custom settings between the lines below
# Custom settings start here
# Custom settings end here

snack::menuInit
snack::menuPane ファイル
snack::menuCommand ファイル "開く" GetOpenFileName
snack::menuBind . o ファイル "開く"
# snack::menuCommand ファイル {Get URL...} OpenGetURLWindow
snack::menuCommand ファイル "保存" Save
snack::menuBind . s ファイル "保存"
snack::menuCommand ファイル "名前を付けて保存" SaveAs
snack::menuCommand ファイル "閉じる" Close
snack::menuBind . w ファイル "閉じる"
# snack::menuSeparator ファイル
# snack::menuCommand ファイル Print... {Print .cf.fc.c -1}
# snack::menuCommand ファイル Info {set v(msg) [InfoStr nopath]}
snack::menuSeparator ファイル
if [info exists recentFiles] {
    foreach e $recentFiles {
        snack::menuCommand ファイル $e [list OpenFiles $e]
    }
    snack::menuSeparator ファイル
}
snack::menuCommand ファイル Exit Exit

# 表示メニュー
snack::menuPane 表示 0
snack::menuCascade 表示 {表示する波形のチャンネル}
snack::menuRadio {表示する波形のチャンネル} \
  "LR混合" v(vchan) -1 { Redraw;DrawZoom 1;DrawSect }
snack::menuRadio {表示する波形のチャンネル} \
  "L-chを表示" v(vchan) 0  { Redraw;DrawZoom 1;DrawSect }
snack::menuRadio {表示する波形のチャンネル} \
  "R-chを表示" v(vchan) 1 { Redraw;DrawZoom 1;DrawSect }
snack::menuCascade 表示 {時間軸}
snack::menuRadio {時間軸} "秒単位" v(timeUnit) "Sec." { Redraw }
snack::menuRadio {時間軸} "拍単位" v(timeUnit) "Bar"  { Redraw ; setBPMWindow}
snack::menuCheck 表示 {スペクトルを表示} v(showspeg) ToggleSpeg
snack::menuCheck 表示 {パワーを表示} v(showpower) TogglePower
snack::menuCheck 表示 {十字線を表示} v(ch) DrawCrossHairs
snack::menuCheck 表示 {マウス選択領域を網掛け表示} v(fillmark) {
    $c coords mfill -1 -1 -1 -1 ; Redraw quick
}
snack::menuCheck 表示 {ラベル境界線を強調} v(emphasizelb) ToggleLB

# オプションメニュー
snack::menuPane オプション 0 ConfigOptionsMenu
snack::menuCheck オプション {カーソル移動時に自動再生} v(autoplay) {}
snack::menuCheck オプション {波形をメモリに一時記憶しない} v(linkfile) Link2File
snack::menuCommand オプション "詳細設定" Settings
#snack::menuBind . F12 オプション "詳細設定"

snack::menuPane ツール 0
snack::menuCommand ツール "ラベル検索"     searchLabel
snack::menuCommand ツール "自動ラベリング" autoLabeling
snack::menuCommand ツール "重複ラベルの末尾に通し番号を付ける" addChoufukuSeq
snack::menuCommand ツール "指定フォルダのwavを結合し、wavファイルとそのラベルファイルを作る" concatWav

snack::menuPane ヘルプ
snack::menuCommand ヘルプ バージョン Version
snack::menuCommand ヘルプ オンラインマニュアル {Help http://freett.com/nwp8861/soft/wavdivider/manual/tutorial.html}

if {$tcl_platform(platform) == "windows"} {
    set border 1
} else {
    set border 0
}

#------------------ アイコン設置
snack::createIcons
pack [frame .tb -highlightthickness 1] -anchor w
# ファイルを開く
pack [button .tb.open -command GetOpenFileName -image snackOpen -highlightthickness 0 -border $border] -side left
bind .tb.open <Enter> {SetMsg "ファイルを開く"}
# ファイルを保存
pack [button .tb.save -command Save -image snackSave -highlightthickness 0 -border $border] -side left
bind .tb.save <Enter> {SetMsg "ファイルに上書き保存"}
# アンドゥ
pack [button .tb.undo -command Undo -image snackUndo -highlightthickness 0 -border $border -state disabled] -side left
bind .tb.undo <Enter> {SetMsg "アンドゥ。一つ前の状態に戻す(うまく戻らない場合もありそうです)"}

pack [frame .tb.dummyspace -width 1 -height 20 -highlightth 1] -side left -padx 5
set saveseq 1
set saveseq_sw 2

pack [label .tb.lablabsuf -text "接尾辞"] -side left
bind .tb.lablabsuf <Enter> {SetMsg "切り出しファイル名に追加したい文字列を入力しておく"}
pack [entry .tb.entlabsuf -width 6 -textvariable labSuffix] -side left
bind .tb.entlabsuf <Enter> {SetMsg "切り出しファイル名に追加したい文字列を入力しておく"}
pack [radiobutton .tb.saveseq_sw2 -text "Eラベルをファイル名にする" -variable saveseq_sw -value 2 -command {
    ;# .tb.saveseq    configure -fg gray
    ;# .tb.saveseqinc configure -fg gray
    ;# .tb.saveseqdec configure -fg gray
}] -side left
bind .tb.saveseq_sw2 <Enter> {SetMsg "切り出しファイル名の決め方：E_ラベルに追記した文字+接尾辞+.wav にする"}
# pack [radiobutton .tb.saveseq_sw1 -text "Eラベル挿入時に通し番号を自動付与" -variable saveseq_sw -value 1 -command {
#     .tb.saveseq    configure -fg black
#     .tb.saveseqinc configure -fg black
#     .tb.saveseqdec configure -fg black
# }] -side left
pack [radiobutton .tb.saveseq_sw0 -text "通し番号をファイル名にする" -variable saveseq_sw -value 0 -command {
    ;# .tb.saveseq    configure -fg black
    ;# .tb.saveseqinc configure -fg black
    ;# .tb.saveseqdec configure -fg black
}] -side left
bind .tb.saveseq_sw0 <Enter> {SetMsg "切り出しファイル名の決め方：E_ラベルの通し番号+接尾辞+.wav にする"}
pack [frame .tb.dummyspace3 -width 1 -height 20 -highlightth 1] -side left -padx 5
pack [button .tb.cutfile -text "切り出し" -command CutFile] -side left
bind .tb.cutfile <Enter> {SetMsg "ファイルを切り出して保存"}

bind .tb <Leave> {SetMsg ""}
#----------------------

# .of= 波形を拡大したときに波形全体を表示するフレーム
frame .of
pack [canvas .of.c -width $v(width) -height 30 -bg $v(bg)] -fill x -expand true
# スクロールバー
pack [scrollbar .of.xscroll -orient horizontal -command ScrollCmd] -fill x -expand true
bind .of.xscroll <ButtonPress-1> { set v(scroll) 1 }
bind .of.xscroll <ButtonRelease-1> RePos
bind .of.c <1> {OverPlay %x}

# 窓最下段のメッセージ欄
pack [ frame .bf] -side bottom -fill x
entry .bf.lab -textvar v(msg) -width 1 -relief sunken -bd 1 -state disabled
pack .bf.lab -side left -expand yes -fill x

set v(toth) [expr $v(waveh) + $v(spegh) + $v(powerh) + $v(timeh)+ $v(labelh)]
pack [ frame .cf] -fill both -expand true
pack [ frame .cf.fyc] -side left -anchor n
canvas .cf.fyc.yc2 -height 0 -width $v(yaxisw) -highlightthickness 0
pack [ canvas .cf.fyc.yc -width $v(yaxisw) -height $v(toth) -highlightthickness 0 -bg $v(bg)]

pack [ frame .cf.fc] -side left -fill both -expand true
# ここでキャンバスの変数 c を作っている
set c [canvas .cf.fc.c -width $v(width) -height $v(toth) -xscrollcommand [list .cf.fc.xscroll set] -yscrollcommand [list .cf.fc.yscroll set] -closeenough 5 -highlightthickness 0 -bg $v(bg)]
scrollbar .cf.fc.xscroll -orient horizontal -command [list $c xview]
scrollbar .cf.fc.yscroll -orient vertical -command yScroll
#pack .cf.fc.xscroll -side bottom -fill x
#pack .cf.fc.yscroll -side right -fill y
pack $c -side left -fill both -expand true

proc yScroll {args} {
    global c

    eval .cf.fyc.yc yview $args
    eval $c yview $args
}

$c create rect -1 -1 -1 -1 -tags mfill -fill yellow -stipple gray25
$c create line -1 0 -1 $v(toth) -width 1 -tags [list mark [expr 0 * $v(rate)/$v(pps)] m1] -fill $v(fg)
$c create line -1 0 -1 $v(toth) -width 1 -tags [list mark [expr 0 * $v(rate)/$v(pps)] m2] -fill $v(fg)

bind . <Escape>        StopPlay 
bind . <Control-c>     StopPlay 
bind . <Control-Alt-f> searchLabel        ;# 検索窓を開く
bind . <Control-n>     {doSearchLabel 1}  ;# 下方向へ次検索
bind . <Control-N>     {doSearchLabel 0}  ;# 上方向へ次検索

set conState 0  ;# console がshowなら1、hideなら0であることをあらわす
bind . <Control-Alt-d> {
  if {$conState} {
    console hide
    set conState 0
  } else {
    console show
    set conState 1
  }
}

bind $c <Alt-F4> Exit
bind $c <KeyPress-F4> {
    set L [Marker2Time m1]
    set R [Marker2Time m2]
    if {$L < $R} {
      if {$saveseq_sw == 1} {
        set lnameR [join [list  "E_" $saveseq] ""]
        incr saveseq
      } else {
        set lnameR "E_"
      }
      InsertLabelWithLabelNameOnBorder $L $R "S" $lnameR
    }
}
bind $c <F2> {
    InsertLabelWithLabelName %x %y "S"
}
bind $c <F3> {
    if {$saveseq_sw == 1} {
      InsertLabelWithLabelName %x %y [join [list  "E_" $saveseq] ""]
      incr saveseq
    } else {
      InsertLabelWithLabelName %x %y "E_"
    }
}
# 再生設定
event add <<Play>> <F5> <Control-p>
bind $c <<Play>>        { PlayComm %W %x }
# マウスホイールで波形を左右に動かす
bind . <MouseWheel> {
  if {%D > 0} {
    $c xview scroll -1 unit
  } else {
    $c xview scroll 1 unit
  }
}
# 波形拡大(縦方向, Shift+マウスホイール)
bind . <Shift-MouseWheel> {
  if {%y <= $v(waveh)} {
    # 波形を拡大・縮小
    if {%D > 0} {
      if {$v(waveh) <= 50} {  ;# 上向き回転
        set v(waveh) 50
      } else {
        incr v(waveh) -20
      }
    } else {
      incr v(waveh) +20     ;# 下向き回転
    }
    Redraw
  } elseif {%y <= [expr $v(waveh) + $v(spegh)]} {
    # スペクトルを拡大・縮小
    if {%D > 0} {
      if {$v(spegh) <= 100} {  ;# 上向き回転
        set v(spegh) 100
      } else {
        incr v(spegh) -20
      }
    } else {
      incr v(spegh) +20     ;# 下向き回転
    }
    Redraw
  } elseif {%y <= [expr $v(waveh) + $v(spegh) + $v(powerh)]} {
    # パワーを拡大・縮小
    if {%D > 0} {
      if {$v(powerh) <= 50} {  ;# 上向き回転(縮小)
        set v(powerh) 50       ;# 縮小の最小値
      } else {
        incr v(powerh) -20
      }
    } else {
      incr v(powerh) +20     ;# 下向き回転
    }
    Redraw
  }
}
# 波形拡大縮小(ctrl+マウスホイール)
bind . <Control-MouseWheel> {
  if {%D > 0} {
    incr v(pps) +40
  } elseif {$v(pps) <= 40} {
    set v(pps) 1
  } else {
    incr v(pps) -40
  }
  Redraw
}
# 波形縮小
bind $c <F11> {
  if {$v(pps) <= 20} {
    set v(pps) 1
  } else {
    incr v(pps) -20
  }
  Redraw
}
bind $c <Control-F11> {
  if {$v(pps) <= 60} {
    set v(pps) 1
  } else {
    incr v(pps) -60
  }
  Redraw
}
# 波形拡大
bind $c <F12> {
  incr v(pps) +20
  Redraw
}
bind $c <Control-F12> {
  incr v(pps) +60
  Redraw
}

# ファイルのD&D
dnd bindtarget . text/uri-list <Drop> {procDnd %D}

#----------------------

$c bind text <Button-1> {
    %W focus current
    %W icursor current @[$c canvasx %x],[$c canvasy %y]
    set i [lindex [$c gettags [%W focus]] 0]
    SetMsg [lindex $labels $i] $i
    SetUndo $labels

    set start [Marker2Sample m1]
    set end   [Marker2Sample m2]

    if {$start != $end} {
        PutMarker m1 0 0 1
        SendPutMarker m1 0
        PutMarker m2 0 0 1
        SendPutMarker m2 0
      set _mx 1
    }
}

event add <<Delete>> <Delete>
catch {event add <<Delete>> <hpDeleteChar>}

$c bind text <<Delete>> {
    if {[%W focus] != {}} {
	%W dchars [%W focus] insert
	SetLabelText [lindex [$c gettags [%W focus]] 0] [$c itemcget [%W focus] -text]
	set i [lindex [$c gettags [%W focus]] 0]
	SetMsg [lindex $labels $i] $i
    }
}

$c bind text <BackSpace> {
    if {[%W focus] != {}} {
	set _tmp [%W focus]
	set _ind [expr [%W index $_tmp insert]-1]
	if {$_ind >= 0} {
	    %W icursor $_tmp $_ind
	    %W dchars $_tmp insert
	    SetLabelText [lindex [$c gettags [%W focus]] 0] [$c itemcget [%W focus] -text]
	    set i [lindex [$c gettags [%W focus]] 0]
	    SetMsg [lindex $labels $i] $i
	}
	unset _tmp _ind
    }
}

event add <<Kaigyo>> <Return> <Enter>
$c bind text <<Kaigyo>> {
#   %W insert current insert ""
#   %W focus {}
}
$c bind text <Tab> {}

$c bind text <Control-Any-Key> { break }

$c bind text <Any-Key> {
  if {[%W focus] != {}} {
    %W insert [%W focus] insert %A
    SetLabelText [lindex [$c gettags [%W focus]] 0] [$c itemcget [%W focus] -text]
    set i [lindex [$c gettags [%W focus]] 0]
    SetMsg [lindex $labels $i] $i
  }
  set v(labchanged) 1
}

# スペースを入力した場合は_に置き換える
$c bind text <space> {
  if {[%W focus] != {}} {
    %W insert [%W focus] insert _
    SetLabelText [lindex [$c gettags [%W focus]] 0] [$c itemcget [%W focus] -text]
    set i [lindex [$c gettags [%W focus]] 0]
    SetMsg [lindex $labels $i] $i
  }
}

# 現在フォーカスしているラベルを削除して右のラベルへ
$c bind text <Control-Delete> {
  set v(labchanged) 1
	set i [lindex [%W gettags [%W focus]] 0]
	RemoveLabelEntry $i
	Redraw quick
  if {$i >= [llength $labels]} {set i [expr [llength $labels] - 1]}
  %W focus lab$i
  %W icursor [%W focus] end
}

# 現在フォーカスしているラベルを削除して左のラベルへ
$c bind text <Control-BackSpace> {
  set v(labchanged) 1
	set i [lindex [%W gettags [%W focus]] 0]
	RemoveLabelEntry $i
	Redraw quick
  if {$i >= 1} { incr i -1}
  %W focus lab$i
  %W icursor [%W focus] end
}

event add <<MoveToLeft>>  <Key-Left>   <Control-b> <Control-h>
event add <<MoveToRight>> <Key-Right>  <Control-f> <Control-l>
event add <<MoveToPrevLabel>> <Alt-Key-Left>  <Alt-b>
event add <<MoveToNextLabel>> <Alt-Key-Right> <Alt-f> <Alt-w>
$c bind text <<MoveToLeft>>      { MoveCurLeft  %W 0 }
$c bind text <<MoveToRight>>     { MoveCurRight %W 0 }
$c bind text <<MoveToPrevLabel>> { MoveCurLeft  %W 1 }
$c bind text <<MoveToNextLabel>> { MoveCurRight %W 1 }


#
# ラベル上でカーソルを右に移動させる
#   mode=1...右隣のラベルへ移動、mode=0...一文字分ずつ右へ移動
#
proc MoveCurRight {W mode} {
    global c labels v

    if {[$W focus] != {}} {
        set __index [$W index [$W focus] insert]
        $W icursor [$W focus] [expr $__index + 1]
        # 右隣のラベルに移動する場合
        if {$mode || $__index == [$W index [$W focus] insert]} {
            set __focus [expr [lindex [$c gettags [$W focus]] 0] + 1]
            $W focus lab$__focus
            if {$mode} {
                # カーソルをラベルテキストの右端に持っていくかどうか
                $W icursor lab$__focus end
            } else { 
                $W icursor lab$__focus 0
            }
            set i [lindex [$c gettags [$W focus]] 0]
            SetMsg [lindex $labels $i] $i
            while {[expr $v(width) * [lindex [$c xview] 1] -10] < [lindex [$W coords [$W focus]] 0] && [lindex [$c xview] 1] < 1} {
	              $c xview scroll 1 unit
            }
	    # 自動再生モードで E_ ラベルに移動した場合
            if { $v(autoplay) && \
                 [string match "E_*" [lindex [lindex $labels $i] 2]] } {
                PlayNthLab $i
            }
        }
    }
}

#
# ラベル上でカーソルを左に移動させる
#   mode=1...左隣のラベルへ移動、mode=0...一文字分ずつ左へ移動
#
proc MoveCurLeft {W mode} {
    global c labels v

    if {[$W focus] != {}} {
        set __index [$W index [$W focus] insert]
        $W icursor [$W focus] [expr [$W index [$W focus] insert] - 1]
        # 左隣のラベルに移動する場合
        if {$mode || $__index == [$W index [$W focus] insert]} {
            set __focus [expr [lindex [$c gettags [$W focus]] 0] - 1]
            $W focus lab$__focus
            $W icursor lab$__focus end
            set i [lindex [$c gettags [$W focus]] 0]
            SetMsg [lindex $labels $i] $i
            while {[expr $v(width) * [lindex [$c xview] 0] +10] > [lindex [$W coords [$W focus]] 0] && [lindex [$c xview] 0] > 0} {
                $c xview scroll -1 unit
            }
	    # 自動再生モードで E_ ラベルに移動した場合
            if { $v(autoplay) && \
                 [string match "E_*" [lindex [lindex $labels $i] 2]] } {
                PlayNthLab $i
            }
        }
    }
}

set _mx 1
set _mb 0
#$c bind bound  <B1-Motion> { MoveBoundary %x }
$c bind bound  <ButtonRelease-1> { set _mb 0 ; Redraw quick }
$c bind m1     <B1-Motion> { PutMarker m1 %x %y 1 }
$c bind m2     <B1-Motion> { PutMarker m2 %x %y 1 }
$c bind m1     <ButtonPress-1>   { set _mx 0 }
$c bind m2     <ButtonPress-1>   { set _mx 0 }
$c bind obj    <ButtonPress-1> { PutMarker m1 %x %y 1 }
$c bind obj    <B1-Motion>     { PutMarker m2 %x %y 1 }
$c bind m1     <ButtonRelease-1> { SendPutMarker m1 %x ; set _mx 0 }
$c bind m2     <ButtonRelease-1> { SendPutMarker m2 %x ; set _mx 0 }
$c bind bound  <Any-Enter> { BoundaryEnter %x }
$c bind mark   <Any-Enter> { MarkerEnter %x }
$c bind bound  <Any-Leave> { BoundaryLeave %x }
$c bind mark   <Any-Leave> { MarkerLeave %x }
bind $c <ButtonPress-1> {
    if {%y > [expr $v(waveh)+$v(spegh)+$v(powerh)+$v(timeh)]} {
    } else {
        PutMarker m1 %x %y 1
        SendPutMarker m1 %x
        set _mx 1
        $c focus ""   ;# フォーカスを外す
    }
}

bind $c <ButtonRelease-1> {
    set _mb 0
    if {%y > [expr $v(waveh)+$v(spegh)+$v(powerh)+$v(timeh)]} {
	focus %W
	if {[%W find overlapping [expr [$c canvasx %x]-2] [expr [$c canvasy %y]-2] [expr [$c canvasx %x]+2] [expr [$c canvasy %y]+2]] == {}} {
	    %W focus {}
	}
    } else {
	PutMarker m2 %x %y 1
	SendPutMarker m2 %x
	set _mx 1
    }
}
#bind $c <Delete> Cut
bind $c <Motion> { PutCrossHairs %x %y }
bind $c <Leave>  {
    $c coords ch1 -1 -1 -1 -1
    $c coords ch2 -1 -1 -1 -1
}

if {[string match macintosh $::tcl_platform(platform)] || \
	[string match Darwin $::tcl_platform(os)]} {
 bind $c <Control-1> { PopUpMenu %X %Y %x %y }
} else {
 bind $c <3> { PopUpMenu %X %Y %x %y }
}

bind .cf.fc.xscroll <ButtonRelease-1> SendXScroll
bind .bf.lab <Any-KeyRelease> { InputFromMsgLine %K }
# bind all <Control-c> Exit
wm protocol . WM_DELETE_WINDOW Exit
wm resizable . 1 0
bind .cf.fc.c <Configure> { if {"%W" == ".cf.fc.c"} Reconf }
# bind $c <F1> { PlayToCursor %x }
# bind $c <2>  { PlayToCursor %x }
focus $c

proc RecentFile fn {
    global recentFiles

    if {$fn == ""} return
    if [info exists recentFiles] {
        foreach e $recentFiles {
            snack::menuDelete ファイル $e
        }
        snack::menuDeleteByIndex ファイル 6  ;# 多分メニューセパレータを消している
    } else {
        set recentFiles {}
    }
    snack::menuDelete ファイル Exit
    set index [lsearch -exact $recentFiles $fn]
    if {$index != -1} {
        set recentFiles [lreplace $recentFiles $index $index]
    }
    set recentFiles [linsert $recentFiles 0 $fn]
    if {[llength $recentFiles] > 6} {
        set recentFiles [lreplace $recentFiles 6 end]
    }
    foreach e $recentFiles {
        snack::menuCommand ファイル $e [list OpenFiles $e]
    }
    snack::menuSeparator ファイル
    snack::menuCommand ファイル Exit Exit
    if [catch {open [file join ~ .xsrf] w} out] {
    } else {
        puts $out "set recentFiles \[list $recentFiles\]"
        close $out
    }
}

proc GetOpenFileName {} {
    global f v labels labelSeq

    if {$v(smpchanged) || $v(labchanged)} {
        if {[DisposalConfirmation]} return
    }

    # set gotfn [snack::getOpenFile -initialdir $f(spath) \
    #     -initialfile $f(sndfile) -format $v(smpfmt)]
    set openTypes [ list {{various files} {.wav .lab}} \
                         {{MS Wav Files} {.wav}} \
                         {{Waves Label Files} {.lab}} \
                         {{All Files} {*}} ]
    set gotfn [tk_getOpenFile -initialdir $f(spath) \
        -initialfile $f(sndfile) -defaultextension "wav" \
        -filetypes $openTypes]

    # Ugly hack for Tk8.0
    if {$gotfn != ""} {
        set tmp [file split $gotfn]
        if {[lindex $tmp 0] == [lindex $tmp 1]} {
            set tmp [lreplace $tmp 0 0]
            set gotfn [eval file join $tmp]
        }
    }
    ;# 各種再初期化
    preprocessingOfDraw
    update
    postprocessingOfDraw
	  set v(smpchanged) 0
    if [string compare $gotfn ""] {
        OpenFiles $gotfn
    }
}

;# 各種再初期化
proc preprocessingOfDraw {} {
  global v labels labelSeq power

  set labels {}           ;# ラベル列を初期化
  set labelSeq {}         ;# ラベル番号を初期化
#  set v(smpchanged) 1     ;# 波形を変更したフラグを立てる
#  set v(labchanged) 1     ;# ラベルを変更したフラグを立てる
#  set power(pwchanged) 1  ;# パワーを変更したフラグを立てる
}

;# 各種再初期化
proc postprocessingOfDraw {} {
  global v labels labelSeq power

  set v(smpchanged) 0     ;# 波形を変更したフラグを立てる
  set v(labchanged) 0     ;# ラベルを変更したフラグを立てる
  set power(pwchanged) 0  ;# パワーを変更したフラグを立てる
}

proc GetSaveFileName {title} {
  global f v labels

  if {$labels != {} && [string compare $title "音声ファイルを保存"] != 0} {
    set saveTypes [ list {{Waves Label Files} {.lab}} {{All Files} {*}} ]
    set gotfn [tk_getSaveFile -initialdir $f(lpath) \
        -initialfile $f(labfile) -title $title -defaultextension "lab" \
        -filetypes $saveTypes]
  } else {
    SetMsg "ラベルが無いので保存しません"
    return ""
  }
  update
  return $gotfn
}

proc SaveAs {} {
    set gotfn [GetSaveFileName "ラベルファイルを保存"]
    if {[string compare $gotfn ""] != 0} {
        SaveFile $gotfn
    }
}

proc Save {} {
    global f v

    # ラベルファイル保存
    if $v(labchanged) {
        set fn $f(lpath)$f(labfile)
        if {[string compare $f(lpath)$f(labfile) ""] == 0} {
            set fn [GetSaveFileName "ラベルファイルを保存"]
        }
        if {$fn != ""} {
            SaveFile $fn
        }
    } else {
        SetMsg "ラベルに変更が無いので保存しません"
    }
}

proc SaveFile {{fn ""}} {
  global f v labels

  SetCursor watch
  set strip_fn [lindex [file split [file rootname $fn]] end]
  set ext  [file extension $fn]
  if [string match macintosh $::tcl_platform(platform)] {
    set path [file dirname $fn]:
  } else {
    set path [file dirname $fn]/
  }
  if {$path == "./"} { set path ""}
  if {![IsLabelFile $fn]} {
  } elseif {$labels != {}} {
    SaveLabelFile $labels $fn
    set v(labchanged) 0
    # wm title . "wavDivider: $f(spath)$f(sndfile) - $fn"
    wm title . "wavDivider: [InfoStr path]"
    set f(lpath) $path
    set f(labfile) $strip_fn$ext
  }
  SetCursor ""
}

proc IsLabelFile {fn} {
    set ext [file extension $fn]
    if {$ext == ".lab"} { return 1 }
    return 0
}

proc OpenFiles {fn} {
    global c labels v f power

    if {$v(smpchanged) || $v(labchanged)} {
        if {[DisposalConfirmation]} return
    }

    if {![file readable $fn]} {
        tk_messageBox -icon warning -type ok -message "No such file: $fn"
        return
    }
    SetCursor watch
    set strip_fn [lindex [file split [file rootname $fn]] end]
    set ext  [file extension $fn]
    if [string match macintosh $::tcl_platform(platform)] {
	set path [file dirname $fn]:
    } else {
	set path [file dirname $fn]/
    }
    if {$path == "./"} { set path ""}

    if [IsLabelFile $fn] {
	set type "lab"
	set f(lpath) $path
	set f(labfile) "$strip_fn.lab"
	set v(labfmt) WAVES
	set v(labalign) e
    } else {
	set type "smp"
	set f(spath) $path
    }

    switch $ext {
      .lab {
        set f(labfile) "$strip_fn.lab"
        set v(labfmt) WAVES
        set v(labalign) e
      }
      .wav {
        set f(sndfile) "$strip_fn.wav"
        # set v(labfmt) TIMIT
        set v(labfmt) WAVES
        set v(labalign) e
        if $v(autoload) {
          set f(labfile) "$strip_fn.lab"
          if {$f(lpath) == ""} { set f(lpath) $f(spath) }
        }
      }
      default {
        if {$type == "smp"} {
          set f(sndfile) "$strip_fn$ext"
          if $v(autoload) {
            set f(labfile) "$strip_fn.lab"
            set v(labfmt) WAVES
            if {$f(lpath) == ""} { set f(lpath) $f(spath) }
          }
        } else {
          set f(labfile) "$strip_fn$ext"
          if $v(autoload) {
            set f(sndfile) "$strip_fn.smp"
            if {$f(spath) == ""} { set f(spath) $f(lpath) }
          }
        }
      }
    }

    if {($v(autoload) == 1) || ($type == "smp")} {
	$c delete wave speg
	.of.c delete overwave
	catch {.sect.c delete sect}
	StopPlay

	set f(byteOrder) [snd cget -byteorder]
	set tmps [snack::sound -debug $::debug]
	set ffmt [$tmps read $f(spath)$f(sndfile) -end 1 -guessproperties 1]
	if {$ffmt == "RAW"} {
	    set v(rate)      [$tmps cget -rate]
	    set v(sfmt)      [$tmps cget -encoding]
	    set v(chan)      [$tmps cget -channels]
	    set f(byteOrder) [$tmps cget -byteorder]
	    if {[InterpretRawDialog] == "cancel"} {
		$tmps destroy
		SetCursor ""
		return
	    }
	}
	$tmps destroy
	if {$v(linkfile)} {
	    if [catch {snd configure -file $f(spath)$f(sndfile) \
		    -skip $f(skip) -byteorder $f(byteOrder) \
		    -rate $v(rate) -encoding $v(sfmt) -channels $v(chan) \
	    	     } ret] {
		 SetMsg "$ret"
		 return
	     }
	     set v(smpfmt) [lindex [snd info] 6]
	} else {
	    if [catch {set v(smpfmt) [snd read $f(spath)$f(sndfile) \
		    -skip $f(skip) -byteorder $f(byteOrder) \
		    -rate $v(rate) -encoding $v(sfmt) -channels $v(chan) \
		    -progress snack::progressCallback]} ret] {
		SetMsg "$ret"
		return
	    }
	}
	set v(rate) [snd cget -rate]
	set v(sfmt) [snd cget -encoding]
	set v(chan) [snd cget -channels]
	set v(startsmp) 0
	if {[snd cget -channels] == 1} {
	    set v(vchan) -1
	}
	set v(smpchanged) 0
	.tb.undo config -state disabled
    if {![regexp $v(rate) [snack::audio rates]]} {
      tk_messageBox -icon warning -type ok -message "You need to \
      convert this sound\nif you want to play it"
    }
    }

    if {[snd length -unit seconds] > 50 && $v(pps) > 100} {
      set v(pps) [expr $v(pps)/10]
    }
    if {[snd length -unit seconds] < 50 && $v(pps) < 100} {
      set v(pps) [expr $v(pps)*10]
    }

    ;# 各種再初期化
    preprocessingOfDraw

    ;# ラベルを読む
    if {($v(autoload) == 1) || ($type == "lab")} {
      set labels [OpenLabelFile $f(lpath)$f(labfile)]
    if {$labels == {}} { set f(labfile) "" }
    }

    wm title . "wavDivider: [InfoStr path]"
    wm geometry . {}
    ;# 窓の最大横幅を画面いっぱい - 10 にする
    ;# 私のPCでは -10 でちょうど画面いっぱいになった
    set maxw [lindex [wm maxsize .] 0]
    wm maxsize . [expr $maxw - 10] [lindex [wm maxsize .] 1]
    set power(N) 0
    Redraw
    postprocessingOfDraw
    ;# 窓が画面いっぱいの場合は窓を左端へ寄せる
    scan [wm geometry .] "%dx%d+%d+%d" w h x y
    if {$maxw <= [expr $w + $x]} { wm geometry . +0+$y }
    event generate .cf.fc.c <Configure>
    SetMsg [InfoStr nopath]
#    MarkAll
    RecentFile $f(spath)$f(sndfile)
}

proc InterpretRawDialog {} {
    global f v

    set w .rawDialog
    toplevel $w -class Dialog
    frame $w.q
    pack $w.q -expand 1 -fill both -side top
    pack [frame $w.q.f1] -side left -anchor nw -padx 3m -pady 2m
    pack [frame $w.q.f2] -side left -anchor nw -padx 3m -pady 2m
    pack [frame $w.q.f3] -side left -anchor nw -padx 3m -pady 2m
    pack [frame $w.q.f4] -side left -anchor nw -padx 3m -pady 2m
    pack [label $w.q.f1.l -text "Sample Rate"]
    foreach e [snack::audio rates] {
	pack [radiobutton $w.q.f1.r$e -text $e -val $e -var ::v(rate)]\
		-anchor w
    }
    pack [label $w.q.f2.l -text "Sample Encoding"]
    foreach e [snack::audio encodings] {
	pack [radiobutton $w.q.f2.r$e -text $e -val $e -var ::v(sfmt)]\
		-anchor w
    }
    pack [label $w.q.f3.l -text Channels]
    pack [radiobutton $w.q.f3.r1 -text Mono -val 1 -var ::v(chan)] -anchor w
    pack [radiobutton $w.q.f3.r2 -text Stereo -val 2 -var ::v(chan)] -anchor w
    pack [radiobutton $w.q.f3.r4 -text 4 -val 4 -var ::v(chan)] -anchor w
    pack [entry $w.q.f3.e -textvariable ::v(chan) -width 3] -anchor w
    pack [label $w.q.f4.l -text "Byte Order"]
    pack [radiobutton $w.q.f4.ri -text "Little Endian\n(Intel)" \
	    -value littleEndian -var ::f(byteOrder)] -anchor w
    pack [radiobutton $w.q.f4.rm -text "Big Endian\n(Motorola)" \
	    -value bigEndian -var ::f(byteOrder)] -anchor w
    pack [label $w.q.f4.l2 -text "\nRead Offset (bytes)"]
    pack [entry $w.q.f4.e -textvar f(skip) -wi 6]
    snack::makeDialogBox $w -title "Interpret Raw File As" -type okcancel \
	-default ok
}

proc Link2File {} {
    global f v

    StopPlay
    if {$v(smpchanged)} {
        if {[DisposalConfirmation]} return
    }
    set v(smpchanged) 0
    if {$v(linkfile)} {
        .of.c delete overwave
        catch {.sect.c delete sect}
        if {$f(sndfile) == ""} {
            snd configure -file _xs[pid].wav
        } else {
            snd configure -file $f(spath)$f(sndfile)
        }
        cbs configure -file ""
    } else {
        if {$f(sndfile) == ""} {
            snd config -load ""
        } else {
            snd config -load $f(spath)$f(sndfile)
        }
        cbs config -load ""
    }
}

proc ConfigOptionsMenu {} {
    global v
    
    if {[snd cget -channels] == 1} {
        snack::menuEntryOff 表示 {表示する波形のチャンネル}
    } else {
        snack::menuEntryOn 表示 {表示する波形のチャンネル}
    }
}

# ラベルを列挙したファイルを読み、
# マウスのあるラベルから右側のE_ラベルに割り当てる
proc AssignLabelSeq {x y} {
    global c v labels

    set labelSeq [ OpenLabelSeq ]
    if {[ llength $labelSeq ] <= 0} { return }

    set v(labchanged) 1
    SetUndo $labels

    if {[string compare [lindex [$c gettags [$c find closest\
        [$c canvasx $x] [$c canvasy $y]]] 2] text] == 0} {

        # 現在見ているラベル番号を得る
        set i [lindex [$c gettags [$c find closest\
                [$c canvasx $x] [$c canvasy $y]]] 0]
        set ls 0
        while {$i < [llength $labels]} {
            if {[string match "E_*" [lindex [lindex $labels $i] 2]]} {
                SetLabelText $i [format "E_%s" [lindex $labelSeq $ls]]
                incr ls
                if {$ls >= [llength $labelSeq]} { break }
            }
            incr i
        }
        Redraw quick
    }
}

# ラベル名を羅列したテキストファイルを読み込んでそのリストを返す
# 羅列の際の区切り文字は、改行やスペース、タブなど
proc OpenLabelSeq {} {
    global f
    set openTypes [ list {{Text Files} {.txt}} {{All Files} {*}} ]
    set fn [tk_getOpenFile -initialdir $f(spath) \
        -initialfile $f(sndfile) -defaultextension "txt" \
        -filetypes $openTypes]
    if [catch {open $fn} in] {
        SetMsg $in
        return {}
    } else {
        set labelSeq {}
        if [catch {set data [read -nonewline $in]}] { return {} }
        regsub -all {[[:space:]]} $data " " data
        foreach line [split $data " "] {
            if {$line != ""} {
                lappend labelSeq $line
            }
        }
        return $labelSeq
    }
}

proc OpenLabelFile {fn} {
    global f v undo

    if [catch {open $fn} in] {
	SetMsg $in
	return {}
    } else {
	if [catch {set labelfile [read $in]}] { return {} }
	set l {}
	set undo {}
	set v(labchanged) 0
	.tb.undo config -state disabled
	close $in
		set f(header) ""
		set getHead 1
		foreach row [split $labelfile \n] {
		    if {$getHead == 1} {
			set f(header) [lappend f(header) $row]
			if [string match # $row] { set getHead 0 }
			continue
		    }
		    set rest ""
		    if {[scan $row {%f %d %s %[^ｧ]} end color label rest] >= 3} {
			lappend l "$end\n$color\n$label\n$rest"
		    }
		}
    }
    return $l
}

proc SaveLabelFile {labels fn} {
    global f v

    if {$fn == "" || [regexp /$ $fn] == 1 || $labels == {}} return
    set f(labfile) [file tail $fn]
    if [string match macintosh $::tcl_platform(platform)] {
	set f(lpath) [file dirname $fn]:
    } else {
	set f(lpath) [file dirname $fn]/
    }
    catch {file copy $fn $fn~}
    if [catch {open $fn w} out] {
	SetMsg $out
        return
    } else {
	set v(labchanged) 0
	fconfigure $out -translation {auto lf}
		if {$f(header) != ""} {
		    puts $out [join $f(header) \n]
		} else {
		    set name [lindex [file split [file rootname $fn]] end]
		    set date [clock format [clock seconds] -format "%a %b %d %H:%M:%S %Y"]
		    puts $out "signal $name"
		    puts $out "type 0\ncolor 121"
		    puts $out "comment created using xs $date"
		    puts $out "font -misc-*-bold-*-*-*-15-*-*-*-*-*-*-*"
		    puts $out "separator ;\nnfields 1\n#"
		}
		foreach row $labels {
		    set rest ""
		    scan $row {%f %d %s %[^ｧ]} end color label rest
		    puts $out [format "    %.6f  %d %s %s" $end $color $label $rest]
		}
	close $out
    }
    SetMsg "Saved: $fn"
    set v(labchanged) 0
}

#
# データ変更を破棄して良いか確認する
# 破棄してOKなら 0、破棄したら駄目なら 1 を返す
#
proc DisposalConfirmation {} {
    return [tk_dialog .dispconfm "確認" \
        "データに変更があります。\n変更内容を破棄して良いですか？" \
        question 1 "はい" "いいえ"]
}

# ファイルを閉じる
proc Close {} {
    global labels f v c power powerDat

    $c focus {}
    if {$v(smpchanged) || $v(labchanged)} {
        if {[DisposalConfirmation]} return
    }
    StopPlay
    set labels {}
    array unset powerDat
    set power(N) 0
    set v(smpchanged) 1
    set v(labchanged) 1
    set v(pwchanged) 1
    set undo {}
    .tb.undo config -state disabled
    set f(labfile) ""
    set f(sndfile) ""
    wm title . "wavDivider:"
    if {$v(linkfile)} {
        catch {file delete -force _xs[pid].wav}
        snd configure -file _xs[pid].wav
    } else {
        snd flush
    }
    Redraw
}

# プログラムを終了させる
proc Exit {} {
    global v

    if {$v(smpchanged) || $v(labchanged)} {
        if {[DisposalConfirmation]} return
    }
    catch {file delete -force _xs[pid].wav}
    exit
}

proc ConfMix {args} {
    global mix

    set n [snd cget -channels]
    for {set i 0} {$i < $n} {incr i} {
	for {set j 0} {$j < $n} {incr j} {
	    set val [expr {0.01 * $mix($i,$j)}]
	    append values "$val "
	}
    }
    eval $mix(f) configure $values
}

proc DoMix {} {
    global v mix

    set start [Marker2Sample m1]
    set end   [Marker2Sample m2]
    if {$start == $end} return
    SetMsg "Mixing channels in range: $start $end"

    ConfMix

    cbs copy snd
    if [catch {snd filter $mix(f) -start $start -end $end \
	    -progress snack::progressCallback}] {
	SetMsg "Mix channels cancelled"
	snd copy cbs
	return
    }

    set v(undoc) "snd swap cbs"
    set v(redoc) "snd swap cbs"
    set v(smpchanged) 1
    .tb.undo config -state normal
    Redraw
}

proc PlayMix {} {
    global mix

    set start [Marker2Sample m1]
    set end   [Marker2Sample m2]
    if {$start == $end} return

    ConfMix

    snd stop
    snd play -filter $mix(f) -start $start -end $end
}

proc MixChan {} {
    global mix

    if {[Marker2Sample m1] == [Marker2Sample m2]} MarkAll
    set w .mix
    catch {destroy $w}
    toplevel $w
    wm title $w {Mix Channels}

    pack [frame $w.f]

    label $w.f.l -text "New channel"
    grid $w.f.l

    set n [snd cget -channels]

    for {set i 0} {$i < $n} {incr i} {
	if {$i == 0} {
	    set label Left
	} elseif {$i == 1} {
	    set label Right
	} else {
	    set label [expr {$i + 1}]
	}
	label $w.f.ly$i -text $label
	grid $w.f.ly$i -row [expr {$i + 1}] -column 0
	label $w.f.lx$i -text "Channel $label"
	grid $w.f.lx$i -row 0 -column [expr {$i + 1}]
	for {set j 0} {$j < $n} {incr j} {
	    if {![info exists mix($i,$j)]} {
		if {$i == $j} {
		    set mix($i,$j) 100
		} else {
		    set mix($i,$j) 0
		}
	    }
	    frame $w.f.f$i-f$j -relief raised -bd 1
	    grid $w.f.f$i-f$j -row [expr {$i + 1}] -column [expr {$j + 1}]
	    pack [scale $w.f.f$i-f$j.s -command "" -orient horizontal \
		    -from -100 -to 100 -showvalue 0 -command ConfMix \
		    -variable mix($i,$j)]
	    pack [frame $w.f.f$i-f$j.f]	  
	    pack [entry $w.f.f$i-f$j.f.e -textvariable mix($i,$j) -width 4] \
		    -side left
	    pack [label $w.f.f$i-f$j.f.l -text %] -side left
	}
    }

    pack [ frame $w.f3] -pady 10
    pack [ button $w.f3.b1 -bitmap snackPlay -command PlayMix] -side left
    pack [ button $w.f3.b2 -bitmap snackStop -command "Stop snd"] -side left
    pack [ button $w.f3.b3 -text OK -width 6 -command "DoMix;destroy $w"] \
	    -side left
    pack [ button $w.f3.b4 -text Cancel -command "destroy $w"] -side left
}

proc SendXScroll {} {
  global c v

  if $v(slink) {
    foreach prg [winfo interps] {
      if [regexp .*xs.* $prg] {
        if {[winfo name .] != $prg} {
          send $prg RecvXScroll [Coord2Time [expr [lindex [.cf.fc.xscroll get] 0] * $v(width)]]
        }
      }
    }
  }
}

proc RecvXScroll {a} {
  global c v

  set f [Time2Coord [expr double($a / $v(width))]]
  eval $c xview moveto $f
}

#---------------------------------------------------
# 拍を画素単位に変換
#
proc beat2pixel {beat} {
  global v

  return [expr $beat * $v(pps) / ($v(bpm) / 60.0) + $v(bpmOffset) * $v(pps)]
}

#---------------------------------------------------
# 拍単位の時間軸用の設定窓
#
proc setBPMWindow {} {
  global bpmWindow v
  if [isExist $bpmWindow] return

  toplevel $bpmWindow
  wm title $bpmWindow "時間軸の設定"
  wm attributes $bpmWindow -topmost 1
  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 $bpmWindow "+$x+$y"
  wm resizable $bpmWindow 0 0

  set fr [frame $bpmWindow.fr]
  radiobutton $fr.rsec -text "秒単位" -variable v(timeUnit) -value "Sec."
  radiobutton $fr.rbpm -text "拍単位" -variable v(timeUnit) -value "Bar"
  pack $fr.rsec $fr.rbpm -side left

  set f [frame $bpmWindow.f]
  label $f.lbpm  -text "テンポ="
  label $f.lbpm2 -text "(BPM)"
  entry $f.ebpm -textvar v(bpmTmp) -wi 10 -validate all -validatecommand {
    if {[string is double %P]} {
      expr {1}
    } else {
      expr {0}
    }
  }
  label $f.loff -text "オフセット="
  label $f.loff2 -text "(秒)"
  entry $f.eoff -textvar v(bpmOffsetTmp) -wi 10 -validate all -validatecommand {
    if {[string is double %P]} {
      expr {1}
    } else {
      expr {0}
    }
  }
  grid $f.lbpm  -sticky w -row 0 -column 0
  grid $f.ebpm  -sticky w -row 0 -column 1
  grid $f.lbpm2 -sticky w -row 0 -column 2
  grid $f.loff  -sticky w -row 1 -column 0
  grid $f.eoff  -sticky w -row 1 -column 1
  grid $f.loff2 -sticky w -row 1 -column 2
  button $bpmWindow.bok -text "OK" -command {
    if {[string is double $v(bpmTmp)]  &&
        [string length $v(bpmTmp)] > 0 && $v(bpmTmp) > 0} {
      set v(bpm) $v(bpmTmp)
    } else {
      set v(bpmTmp) $v(bpm)
    }
    if {[string length $v(bpmOffsetTmp)] <= 0} {
      set v(bpmOffsetTmp) 0
    }
    if {[string is double $v(bpmOffsetTmp)]} {
      set v(bpmOffset) $v(bpmOffsetTmp)
    } else {
      set v(bpmOffsetTmp) $v(bpmOffset)
    }
    Redraw
    destroy $bpmWindow
  }
  button $bpmWindow.bapply -text "Apply" -command {
    if {[string is double $v(bpmTmp)]  &&
        [string length $v(bpmTmp)] > 0 && $v(bpmTmp) > 0} {
      set v(bpm) $v(bpmTmp)
    } else {
      set v(bpmTmp) $v(bpm)
    }
    if {[string length $v(bpmOffsetTmp)] <= 0} {
      set v(bpmOffsetTmp) 0
    }
    if {[string is double $v(bpmOffsetTmp)]} {
      set v(bpmOffset) $v(bpmOffsetTmp)
    } else {
      set v(bpmOffsetTmp) $v(bpmOffset)
    }
    Redraw
  }
  button $bpmWindow.bcancel -text "Cancel" -command {
    set v(bpmTmp) $v(bpm)
    set v(bpmOffsetTmp) $v(bpmOffset)
    destroy $bpmWindow
  }

  pack $fr -side top
  pack $f -side top
  pack $bpmWindow.bcancel $bpmWindow.bapply $bpmWindow.bok -side right
}

proc Redraw {args} {
    # global c labels f v labSuffix
    global c labels f v labSuffix power powerDat

    SetCursor watch
    set length [snd length]
    if {$args != "quick"} {
      $c delete obj
      $c config -bg $v(bg)
      .cf.fyc.yc config -bg $v(bg)
      .of.c config -bg $v(bg)
      if {$length == 0} { set length 1 }
        set v(endsmp) [expr $v(startsmp) + $v(rate) * $v(scrw) / $v(pps)]
      if {$v(endsmp) > $length} {
        set v(endsmp) $length
      }

      if {[expr int(double($length * $v(pps)) / $v(rate))] < $v(scrw)} {
        if [winfo exist .of] { pack forget .of }
        set v(startsmp) 0
        set v(endsmp) $length
      } else {
        Reconf
        pack .of -side top -fill x -before .cf
        if {$::tcl_platform(platform) == "windows"} {
          DrawOverAxis
        }
      }
      .of.xscroll set [expr double($v(startsmp)) / $length] [expr double($v(endsmp)) / $length]

      .cf.fyc.yc delete axis
      if {$v(waveh) > 0} {
        if {$v(linkfile) && $f(sndfile) != ""} {
          snack::deleteInvalidShapeFile [file tail $f(spath)$f(sndfile)]
          $c create waveform 0 0 -sound snd -height $v(waveh) \
            -pixels $v(pps) -tags [list obj wave] \
            -start $v(startsmp) -end $v(endsmp) \
            -channel $v(vchan) -debug $::debug -fill $v(wavcolor) \
            -shapefile [file rootname [file tail $f(spath)$f(sndfile)]].shape\
            -progress snack::progressCallback
      		snack::makeShapeFileDeleteable [file tail $f(spath)$f(sndfile)]
  	    } else {
          $c create waveform 0 0 -sound snd -height $v(waveh) \
            -pixels $v(pps) -tags [list obj wave] \
            -start $v(startsmp) -end $v(endsmp) \
            -channel $v(vchan) -debug $::debug -fill $v(wavcolor)
        }
        $c lower wave
        .cf.fyc.yc create text $v(yaxisw) 2 -text [snd max]\
          -font $v(sfont) -anchor ne -tags axis -fill $v(fg)
        .cf.fyc.yc create text $v(yaxisw) $v(waveh) -text [snd min]\
          -font $v(sfont) -anchor se -tags axis -fill $v(fg)
        .cf.fyc.yc create line 0 [expr $v(waveh)+0] $v(yaxisw) \
          [expr $v(waveh)+0] -tags axis -fill $v(fg)  
      }
      if {$v(topfr) > [expr $v(rate)/2]} {
        set v(topfr) [expr $v(rate)/2]
      }
      # スペクトルを表示する
      if {$v(spegh) > 0} {
        set v(winlen) [expr int($v(rate) / $v(anabw))]
        if {$v(winlen) > $v(fftlen)} {
          set v(winlen) $v(fftlen)
        }
        $c create spectrogram 0 $v(waveh) -sound snd -fftlen $v(fftlen) \
          -winlen $v(winlen) -height $v(spegh) -pixels $v(pps) \
          -preemph $v(preemph) -topfr $v(topfr) -tags [list obj speg] \
          -start $v(startsmp) -end $v(endsmp)\
          -contrast $v(contrast) -brightness $v(brightness)\
          -gridtspacing $v(gridtspacing) \
          -gridfspacing $v(gridfspacing) -channel $v(vchan) \
          -colormap $v($v(cmap)) -gridcol $v(gridcolor) \
          -progress snack::progressCallback -debug $::debug
        $c lower speg
        snack::frequencyAxis .cf.fyc.yc 0 $v(waveh) $v(yaxisw) $v(spegh)\
          -topfr $v(topfr) -tags axis -fill $v(fg)\
          -font $v(sfont)
        .cf.fyc.yc create line 0 [expr $v(spegh) + $v(waveh)+0] \
          $v(yaxisw) [expr $v(spegh) + $v(waveh)+0] -tags axis\
          -fill $v(fg)
      }

      # パワー曲線を描く
      if {$v(powerh) > 0} {
        initProgressWindow
        if {$power(N) <= 0 || $power(pwchanged) != 0} {
          getPower
          set power(pwchanged) 0
          if {$power(N) > 0} {
            ;# パワーの最大値・最小値を求める
            set power(pwMax) $powerDat(0)
            set power(pwMin) $powerDat(0)
            set tmp [expr 30.0 / $power(N)]
            for {set i 1} {$i < $power(N)} {incr i} {
              set p $powerDat($i)
              if {$power(pwMax) < $p} {
                set power(pwMax) $p
              } elseif {$power(pwMin) > $p} {
                set power(pwMin) $p
              }
              updateProgressWindow [expr $i * $tmp]
            }
          }
        }
        updateProgressWindow 30

        if {$power(N) > 0} {
          ;# ppd= 1dBあたりのピクセル数。4は上下各2ピクセルのマージン
          set margin 2
          set ppd [expr ($v(powerh) - $margin * 2) / ($power(pwMax) - $power(pwMin))]
          set pB [expr $v(waveh) + $v(spegh) + $v(powerh)]

          set pwStart [expr int(double($v(startsmp)) / $v(rate) / $power(frameLength))]
          if {$pwStart >= $power(N)} {
            set pwStart [expr $power(N) - 1]
          }
          set pwEnd   [expr int(double($v(endsmp))   / $v(rate) / $power(frameLength))]
          if {$pwEnd >= $power(N)} {
            set pwEnd [expr $power(N) - 1]
          }
          ;# xw .. パワー全体を何ピクセルで表示するか
          ;#set xw [expr $power(N) * $power(frameLength) * $v(pps)]
          set power(coord) {} ;# パワー曲線を引く座標(x,y)列
          set xw   [expr double($v(endsmp) - $v(startsmp)) / $v(rate) * $v(pps)]
          set pwN  [expr $pwEnd - $pwStart]
          set xpp  [expr $xw / $pwN]
          set tmp2 [expr $pB - $margin]
          set tmp3 [expr 70.0 / $power(N)]
          set pwXold 0
          set pwYold $pB
          for {set i 0} {$i <= $pwN} {incr i} {
#            lappend power(coord) \
#              [expr int($xpp * $i)] \
#              [expr int($tmp2 - ($powerDat([expr $i + $pwStart]) - $power(pwMin)) * $ppd)]
            set pwX [expr int($xpp * $i)]
            set pwY [expr int($tmp2 - ($powerDat([expr $i + $pwStart]) - $power(pwMin)) * $ppd)]
            $c create line $pwXold $pwYold $pwX $pwY -tags {obj pw} -fill $v(powcolor)
            set pwXold $pwX
            set pwYold $pwY

            if {[expr $i % 200] == 0} {updateProgressWindow [expr $i * $tmp3 + 30]}
          }
        }

        powerAxis .cf.fyc.yc 0  [expr $v(waveh) + $v(spegh)] \
                             $v(yaxisw) $v(powerh)\
                             -pwMax $power(pwMax) -tags axis -fill $v(fg)\
                             -font $v(sfont) -pwMin $power(pwMin)
        .cf.fyc.yc create line 0 [expr $v(spegh) + $v(waveh)+ + $v(powerh)] \
          $v(yaxisw) [expr $v(spegh) + $v(waveh) + $v(powerh)] -tags axis\
          -fill $v(fg)
        deleteProgressWindow
      }

      ;# pps...縮尺 pixel per second
      ;# rate...サンプリング周波数
      ;# v(width)...波形全体を表示するために必要なピクセル数
      set v(width) [expr int($v(pps) * double($v(endsmp) - $v(startsmp)) / $v(rate))]
      if {$v(width) == 0} { set v(width) 600 } 
      $c create line 0 0 $v(width) 0 -tags obj -fill $v(fg)
      $c create line 0 $v(waveh) $v(width) $v(waveh) -tags obj -fill $v(fg)
      $c create line 0 [expr $v(waveh) + $v(spegh)] \
                     $v(width) [expr $v(waveh) + $v(spegh)] -tags obj -fill $v(fg)
    }

    $c delete tran axis
    set y [expr $v(waveh) + $v(spegh) + $v(powerh)]
    $c create line 0 $y $v(width) $y -tags axis -fill $v(fg)

    if {$v(timeUnit) == "Sec."} {
      ;# 時間軸(単位=秒)
      snack::timeAxis $c 0 $y $v(width) $v(timeh) $v(pps)\
        -tags axis -starttime [expr double($v(startsmp)) / $v(rate)]\
        -fill $v(fg) -font $v(sfont)
      incr y $v(timeh)
      $c create line 0 $y $v(width) $y -tags axis -fill $v(fg)
    } else {
      # 拍単位の時間軸表示
      set b  0               ;# 現在の拍を入れる[単位=拍]
      set bp [beat2pixel $b] ;# 現在の拍を入れる[単位=pixel]
      set hbp  [expr [beat2pixel 0.5]  - [beat2pixel 0]] ;# 8分音符の長さ[単位=pixel]
      set hhbp [expr [beat2pixel 0.25] - [beat2pixel 0]] ;# 16分音符半拍の長さ[単位=pixel]
      set vlbtmShrt [expr $y + $v(timeh) / 4]
      set vlbtm     [expr $y + $v(timeh) / 2]
      while {$bp < $v(width)} {
        if {$b % 4 == 0} {
          $c create line $bp 0 $bp $vlbtm     -tags axis -fill $v(fg)
          $c create text $bp $vlbtm -text [expr $b / 4]  -tags axis -fill $v(fg) \
            -font $v(sfont) -anchor center
        } else {
          $c create line $bp 0 $bp $vlbtm     -tags axis -fill $v(fg)
        }
        if {$hbp >= 25} {
          set bph [expr $bp + $hbp]
          $c create line $bph $y $bph $vlbtmShrt -tags axis -fill blue
        }
        if {$hhbp >= 25} {
          set bphh [expr $bp + $hhbp]
          $c create line $bphh $y $bphh $vlbtmShrt -tags axis -fill #a000a0
          set bphh [expr $bp + $hhbp + $hbp]
          $c create line $bphh $y $bphh $vlbtmShrt -tags axis -fill #a000a0
        }

        incr b
        set bp [beat2pixel $b]
      }
      incr y $v(timeh)
      $c create line 0 $y $v(width) $y -tags axis -fill $v(fg)
    }

    ;# 時間軸ラベル
    .cf.fyc.yc configure -height $y
    .cf.fyc.yc create text 5 [expr $v(waveh) + $v(spegh) + $v(powerh) + 2] -text $v(timeUnit) \
	    -font $v(sfont) -anchor nw -tags axis -fill $v(fg)

    bind .cf.fyc.yc <ButtonRelease-1> { ;# 時間軸切り替え
      if {%y >= [expr $v(waveh) + $v(spegh) + $v(powerh)]} {
        if {$v(timeUnit) == "Bar"} {
          set v(timeUnit) "Sec."
        } else {
          set v(timeUnit) "Bar"
        }
        Redraw
      }
    }
    bind .cf.fyc.yc <ButtonRelease-3> { ;# 時間軸の設定
      setBPMWindow
    }

    if $v(ipa) {
      incr y [DrawLabels $y $labels ipa]
    }
    incr y [DrawLabels $y $labels lab]

    foreach p $v(plugins) {
      incr y [namespace inscope $p Redraw $y]
    }

    set v(toth) $y
    $c configure -height $v(toth) -width $v(width) -scrollregion "0 0 $v(width) $v(toth)"
    .cf.fyc.yc configure -height $v(toth) -scrollregion "0 0 $v(yaxisw) $v(toth)"

# Someday in a perfect universe

#    if {$::tcl_platform(os) == "Linux" || \
#        $::tcl_platform(platform) == "macintosh"} {
#      set maxw [lindex [wm maxsize .] 0]
#      if {$v(width) > $maxw} {
#        if [winfo exist .of] {
#	        . config -width $maxw -height [expr $v(toth) + 130]
#        } else {
#          . config -width $maxw -height [expr $v(toth) + 40]
#        }
#        pack propagate . 0
#      } else {
#        pack propagate . 1
#      }
#    }
    if {$::tcl_platform(platform) == "windows"} {
      ;# koko ディスプレイの幅より窓が横長な場合の処理
      ;# 下記を実行すると、マウスで窓の横幅を変更していた場合も強制的に
      ;# 元の長さに戻されてしまう
      ;# set maxw [lindex [wm maxsize .] 0]
      ;# if {$v(width) > $maxw} {
      ;#   if {[expr int(double($length * $v(pps)) / $v(rate))] >= $v(scrw)} {
      ;#     wm geometry . [expr $maxw - 15]x[expr $v(toth) + 120]
      ;#   } else {
      ;#     wm geometry . [expr $maxw - 15]x[expr $v(toth) + 70]
      ;#   }
      ;# }
    }

    catch {PutMarker m1 [Marker2Time m1] 0 0}
    catch {PutMarker m2 [Marker2Time m2] 0 0}
    SetCursor ""
}

proc DrawLabels {y labels type} {
  global c v f ipa

  if {[llength $labels] == 0} {
  	return 0
  } else {
    # 横線
    $c create line 0                   [expr $y + $v(labelh)]	\
                   [expr $v(width) -1] [expr $y + $v(labelh)] \
                   -tags obj -fill $v(fg)
	  set start 0
	  set end   0
	  set label ""
	  set i 0
	  foreach row $labels {
		      scan $row {%f %d %s} end color label
		      set lx [Time2Coord $end]
		      set start 0
		      scan [lindex $labels [expr $i-1]] {%f} start

      if {$lx >= 0 && $lx <= $v(width)} {
		    if {$v(labalign) == "c"} {
          set tx [Time2Coord [expr ($start+$end)/2]]
		    } elseif {$v(labalign) == "w"} {
          set tx [expr [Time2Coord $start] + 2] 
        } else {
          set tx [Time2Coord $end]
        }
        if {$type == "lab"} {
          $c create text $tx [expr $y+12] -text $label\
            -font $v(font) -anchor $v(labalign)\
            -tags [list $i obj text lab$i tran] -fill $v(fg)
          if $v(emphasizelb) {
            # ラベル境界線を波形やスペクトルの上にも引く
            $c create line $lx 0 $lx [expr $y+$v(labelh)] \
              -tags [list b$i obj bound tran] -fill $v(fg)
          } else {
            # ラベル境界線をラベルペインに引く
            $c create line $lx $y $lx [expr $y+$v(labelh)] \
              -tags [list b$i obj bound tran] -fill $v(fg)
          }
        } else {
          if {$::tcl_platform(platform) == "windows"} {
            $c create text $tx [expr $y+12] \
				    -text $label -font IPAKiel -fill $v(fg)\
				    -anchor $v(labalign) -tags [list obj tran]
		      } else {
            catch {$c create bitmap $tx [expr $y+2] \
              -bitmap @$f(ipapath)/$ipa($label) \
              -anchor n -tags [list obj tran]}
		      }
          if $v(emphasizelb) {
            # ラベル境界線を波形やスペクトルの上にも引く
            $c create line $lx 0 \
                           $lx [expr $y+$v(labelh)] \
                           -tags [list obj tran] -fill $v(fg)
          } else {
            # ラベル境界線をラベルペインに引く
            $c create line $lx [expr $y] \
                           $lx [expr $y+$v(labelh)] \
                           -tags [list obj tran] -fill $v(fg)
		      }
		    }
      }
      incr i
	  }
  }
  return $v(labelh)
}

# パワーパネルの縦軸表示
# snack の unix/snack.tcl の frequencyAxis を改造
proc powerAxis {canvas x y width height args} {
	array set a [list \
		-tags snack_y_axis -font {Helvetica 8} -pwMax 100 \
		-fill black -draw0 0 -pwMin 0]
  if {[string match unix $::tcl_platform(platform)] } {
	 set a(-font) {Helvetica 10}
	}
	array set a $args

	if {$height <= 0} return

  ;# ticklist...目盛りの間隔の候補
	set ticklist [list 1 2 5 10 20 50 100 200 500 1000 2000 5000 \
		10000 20000 50000 100000 200000 500000 1000000]
	set npt 1   ;# npt...目盛りの値の間隔
  ;# dy...目盛りを描画する間隔(y座標)
	set dy [expr {double($height * $npt) / ($a(-pwMax) - $a(-pwMin))}]

	;# puts [font metrics $a(-font) -linespace]
	while {$dy < [font metrics $a(-font) -linespace]} {
	    foreach elem $ticklist {
	      if {$elem <= $npt} {
	        continue
	      }
        set npt $elem
	      break
	    }
	    set dy [expr {double($height * $npt) / ($a(-pwMax) - $a(-pwMin))}]
	}

	if {$npt < 1000} { 
	    set hztext dB
	} else {
	    set hztext kdB
	}

	if $a(-draw0) {
	    set i0 0
	    set j0 0
	} else {
	    set i0 $dy
	    set j0 1
	}

  if {$a(-pwMin) != 0} {
    set j0 [expr int($a(-pwMin) / $npt) + 1]
  }

	for {set i $i0; set j $j0} {$i < $height} {set i [expr {$i+$dy}]; incr j} {
	    set yc [expr {$height + $y - $i}]  ;# 描画するy座標

	    if {$npt < 1000} { 
	      set t [expr {$j * $npt}]
	    } else {
	      set t [expr {$j * $npt / 1000}]
	    }
	    if {$yc > [expr {8 + $y}]} {
	      if {[expr {$yc - [font metrics $a(-font) -ascent]}] > \
	          [expr {$y + [font metrics $a(-font) -linespace]}] ||
	          [font measure $a(-font) $hztext]  < \
	          [expr {$width - 8 - [font measure $a(-font) $t]}]} {
	        $canvas create text [expr {$x +$width - 8}] [expr {$yc-2}]\
	          -text $t -fill $a(-fill)\
	          -font $a(-font) -anchor e -tags $a(-tags)
	      }
	      $canvas create line [expr {$x + $width - 5}] $yc \
	        [expr {$x + $width}]\
	        $yc -tags $a(-tags) -fill $a(-fill)
	    }
	}
	$canvas create text [expr {$x + 2}] [expr {$y + 1}] -text $hztext \
		-font $a(-font) -anchor nw -tags $a(-tags) -fill $a(-fill)

	return $npt
}

proc ScrollCmd {args} {
    global v

    if {[lindex $args 0] == "moveto"} {
      set delta [expr [lindex [.of.xscroll get] 1] - [lindex [.of.xscroll get] 0]]
      set pos [lindex $args 1]
      if {$pos < 0.0} { set pos 0.0 }
      if {$pos > [expr 1.0 - $delta]} { set pos [expr 1.0 - $delta] }
      .of.xscroll set $pos [expr $pos + $delta]
    } elseif {[lindex $args 0] == "scroll" && $v(scroll) == 1} {
      set pos [expr double($v(startsmp)) / [snd length]]
      set delta [expr double($v(endsmp)) / [snd length] - $pos]
      if {[lindex $args 1] > 0} {
        set pos [expr $pos + $delta]
        if {$pos > [expr 1.0 - $delta]} { set pos [expr 1.0 - $delta] }
      }
      if {[lindex $args 1] < 0} {
        set pos [expr $pos - $delta]
        if {$pos < 0.0} { set pos 0.0 }
      }
      .of.xscroll set $pos [expr $pos + $delta]
      set v(scroll) 0
    }
}

proc RePos {args} {
    global v c

    set v(startsmp) [expr int ([lindex [.of.xscroll get] 0] * [snd length])]
    set v(endsmp)   [expr int ([lindex [.of.xscroll get] 1] * [snd length])]
    $c xview moveto 0
    Redraw
}

proc DrawOverAxis {} {
  global v
  
  set totw [winfo width .]
  set scrh [winfo height .of.xscroll]
  set width [expr $totw - 2 * $scrh]
  set length [snd length -unit seconds]
  if {$length > 0} {
    set v(opps) [expr $width/$length]
  } else {
    set v(opps) 400
  }
  .of.c delete overaxis
  snack::timeAxis .of.c $scrh 20 $width 11 $v(opps) -tags overaxis \
      -fill $v(fg)
}

proc OverPlay {x} {
    global v
    
    set start [expr int($v(rate)*(($x - [winfo height .of.xscroll]) * 1000 / $v(opps)))]
    set end   [snd length]
    Stop snd
    if {$start < 0} { set start 0 }
    set v(s0) $start
    set v(s1) $end
    Play snd $start $end
    .of.c create poly -1 -1 -1 -1 -1 -1 -fill red -tags playmark
    after cancel PutPlayMarker
    after 50 PutPlayMarker
}

proc Reconf {} {
  global c v f

  set labSuffix "tmp"
  set dox 0
  set doy 0
  if {[$c xview] == "0 1"} { set dox 1 }
  if {[$c yview] == "0 1"} { set doy 1 }

  if {$dox} {
    pack forget .cf.fc.xscroll
    pack forget .cf.fyc.yc2
  } else {
    pack .cf.fc.xscroll -side bottom -fill x -before $c
    .cf.fyc.yc2 config -height [winfo height .cf.fc.xscroll]
    pack .cf.fyc.yc2 -side bottom -fill x -before .cf.fyc.yc
  }
  if {$doy} {
    pack forget .cf.fc.yscroll
  } else {
    pack .cf.fc.yscroll -side right -fill y -before $c
  }

  set ww [.of.c itemcget overwave -width]
  set v(scrh) [winfo height .of.xscroll]
  set totw [expr [winfo width .] - 2 * $v(scrh)]
  if {$ww != $totw && ![catch {pack info .of}]} {
    .of.c delete overwave
    if {$v(linkfile) && $f(sndfile) != ""} {
      .of.c create waveform $v(scrh) 0 -sound snd -height 20 \
        -width $totw -tags overwave -fill $v(wavcolor) -debug $::debug \
        -shapefile [file rootname [file tail $f(spath)$f(sndfile)]].shape
    } else {
      .of.c create waveform $v(scrh) 0 -sound snd -height 20 \
        -width $totw -tags overwave -fill $v(wavcolor) -debug $::debug
    }
    .of.c create rectangle -1 -1 -1 -1 -tags mark -fill yellow -stipple gray25
  }
  if {[snd length] > 0} DrawOverAxis
#    if {$::tcl_platform(platform) == "unix"} {
#	if {$v(propflag) > 1} { pack propagate . 0 }
#    }
#    if {$dox && $doy} { incr v(propflag) }
}

proc SetMsg {msg args} {
    global v

    if {$args == ""} {
	set v(msg) $msg
	.bf.lab config -state disabled
    } elseif {$args == "mark"} {
	set v(msg) $msg
	set v(currline) -1
	.bf.lab config -state normal
    } else {
	set v(msg) $msg
	set v(currline) $args
	.bf.lab config -state normal
    }
    SetCursor ""
}

proc InputFromMsgLine {key} {
    global v labels
    
    if {$key == "BackSpace"} return
    if {$v(currline) >= 0} {
	set labels [lreplace $labels $v(currline) $v(currline) $v(msg)]
	Redraw quick
    } else {
	if {[scan $v(msg) {From: %s to: %s length: %s sec. ( %f - %f , %f} t0 t1 t2 t3 t4 t5] == 6} {
	    if {$t0 != [lindex $v(fromto) 0]} {
		PutMarker m1 $t0 0 0
	    }
	    if {$t1 != [lindex $v(fromto) 1]} {
		set t2 [expr $t1-$t0]
		PutMarker m2 $t1 0 0
	    }
	    if {$t2 != [lindex $v(fromto) 2]} {
		set t1 [expr $t0+$t2]
		PutMarker m2 $t1 0 0
	    }
	    if {$t3 != [lindex $v(fromto) 3]} {
		set t0 [DTime2Time $t3]
		PutMarker m1 $t0 0 0
	    }
	    if {$t4 != [lindex $v(fromto) 4]} {
		set t1 [expr [DTime2Time $t4]-[DTime2Time $t3]]
		PutMarker m2 [DTime2Time $t4] 0 0
	    }
	    if {$t5 != [lindex $v(fromto) 5]} {
		set t1 [expr [DTime2Time $t3]+[DTime2Time $t5]]
		PutMarker m2 $t1 0 0
	    }
	    set t3 [format "%.3f" [Time2DTime $t0]]
	    set t4 [format "%.3f" [Time2DTime $t1]]
	    set t5 [format "%.3f" [expr $t4 - $t3]]
	    SetMsg [format "From: %9s to: %9s length: %9s sec.\t(%.3f - %.3f, %.3f)"\
		    $t0 $t1 $t2 $t3 $t4 $t5] mark
	    set v(fromto) [list $t0 $t1 $t2 $t3 $t4 $t5]
	}
    }
}

# 再生したい範囲(開始と終了)が指定されている場合のみ再生する
proc PlayBetweenMarks {} {
    global c f v

    set start [Marker2Sample m1]
    set end   [Marker2Sample m2]

    if {$start >= $end} return

    SetMsg "Playing range: $start $end"
    set v(s0) $start
    set v(s1) $end
    Play snd $start $end
    set v(pause) 0
    .of.c create poly -1 -1 -1 -1 -1 -1 -fill red -tags playmark
    $c create poly -1 -1 -1 -1 -1 -1 -fill red -tags playmark
    after 50 PutPlayMarker
}

proc PlayMark {args} {
    global c f v

    Stop snd
    if {[snd length] == 0} return
    set start [Marker2Sample m1]
    set end   [Marker2Sample m2]
    if {$start > [snd length]} return
    if {[llength $args] > 0} {
        set x [Coord2Sample [$c canvasx [lindex $args 0]]]
        if {$x < $start} {
            set end $start
            set start 0
        }
        if {$x > $end} {
            set start $end
            set end [snd length]
        }
    }
    if {$start == $end} {
        set start $end
        set end [snd length]
    }
    SetMsg "Playing range: $start $end"
    set v(s0) $start
    set v(s1) $end
    Play snd $start $end
    set v(pause) 0
    .of.c create poly -1 -1 -1 -1 -1 -1 -fill red -tags playmark
    $c create poly -1 -1 -1 -1 -1 -1 -fill red -tags playmark
    after 50 PutPlayMarker
}

proc PlayAll {} {
    global c v

    Stop snd
    SetMsg "Playing all samples"
    set v(s0) 0
    set v(s1) [snd length]
    Play snd
    set v(pause) 0
    .of.c create poly -1 -1 -1 -1 -1 -1 -fill red -tags playmark
    $c create poly -1 -1 -1 -1 -1 -1 -fill red -tags playmark
    after 50 PutPlayMarker
}

proc Play {s {start 0} {end -1}} {
    global v

    if !$v(remote) {
	$s play -start $start -end $end
    } else {
	set sock [socket $v(ashost) $v(asport)]
	if {$end == -1} {
	    set end [snd length]
	}
	set v(rp_s) $s
	set v(rp_sock) $sock
	set end2 $end
	if {$end2 > [expr $start + 10000]} {
	    set end2 [expr $start + 10000]
	}
	set v(rp_next) $end2
	set v(rp_end) $end
	fconfigure $sock -translation binary -blocking 0
	puts -nonewline $sock play
	flush $sock
	set handle [gets $sock]
	set v(handle) $handle
	puts -nonewline $sock [$s data -fileformat au -start $start -end $end2]
	fileevent $sock writable PlayHandler
    }
}

proc PlayHandler {} {
    global v

    if {$v(rp_next) < $v(rp_end)} {
	set end2 $v(rp_end)
	if {$end2 > [expr $v(rp_next) + 10000]} {
	    set end2 [expr $v(rp_next) + 10000]
	}
	puts -nonewline $v(rp_sock) [$v(rp_s) data -fileformat raw -start $v(rp_next) -end $end2 -byteorder bigEndian]
	set v(rp_next) $end2
    } else {
	close $v(rp_sock)
    }
}

proc Stop {s} {
    global v

    if !$v(remote) {
	$s stop
    } else {
	catch {close $v(rp_sock)}
	catch {set sock [socket $v(ashost) $v(asport)]}
	if ![info exists sock] return
	fconfigure $sock -translation binary
	puts -nonewline $sock stop
	puts $sock $v(handle)
	close $sock
    }
}

proc StopPlay {} {
    global c v

    after cancel PutPlayMarker
    Stop snd
    set v(pause) 0
    set v(s1) 0
    .of.c delete playmark
    $c delete playmark
    if $v(activerec) {
	after cancel UpdateRec
	Redraw
	event generate .cf.fc.c <Configure>
	MarkAll
	set v(activerec) 0
    }
}

proc PausePlay {} {
    global c v

    if $v(activerec) {
	snd pause
	return
    }
    set v(pause) [expr 1 - $v(pause)]
    if $v(pause) {
	after cancel PutPlayMarker
	set v(s0) [expr $v(s0) + int([snack::audio elapsedTime] * $v(rate))]
	Stop snd
    } else {
	after 50 PutPlayMarker
	Play snd $v(s0) $v(s1)
    }
}

proc PutPlayMarker {} {
    global v c

    if $v(pause) return

    set time [expr [snack::audio elapsedTime] + double($v(s0)) / $v(rate)]
    if {$time > [expr double($v(s1)) / $v(rate)] || ![snack::audio active]} {
	.of.c delete playmark
	$c delete playmark
	return
    }
    SetMsg "Playing at [format "%.2f" $time]"
    set ox [expr $v(scrh) + $time * $v(opps) / 1000.0]
    set x [expr ($time - double($v(startsmp)) / $v(rate)) * $v(pps)]
    set y [expr $v(waveh) + $v(spegh) + $v(powerh) + 4]
    .of.c coords playmark $ox 22 [expr $ox-5] 30 [expr $ox+5] 30 
    $c coords playmark $x $y [expr $x-5] [expr $y+10] [expr $x+5] [expr $y+10]
    update idletasks
    after 50 PutPlayMarker
}

proc InfoStr {arg} {
    global f v labels

    set samps [snd length]
    set time  [snd length -unit seconds]
    if {$arg == "path"} {
        set snd "$f(spath)$f(sndfile)"
        set lab "$f(lpath)$f(labfile)"
    } else {
        set snd $f(sndfile)
        set lab $f(labfile)
    }
    # set info [format "Sample file: %s (%s)  %d samples %.2f seconds" $snd $v(smpfmt) $samps $time]
    set info [format "%s (%d samples %.2f seconds)" $snd $samps $time]
    if {$labels != {}} {
        # set info "$info  Label file: $lab  ($v(labfmt))"
        set info "$info, $lab"
    }
    return $info
}

proc xsGetGeometry {} {
    scan [wm geometry .] "%dx%d+%d+%d" w h x y
    if {$::tcl_platform(platform) == "windows"} {
      return +$x+[expr $y+$h+40]
    } else {
      return +$x+[expr $y+$h+68]
    }
}

proc ToggleSpeg {} {
    global v

    if [snack::audio active] return
    if $v(showspeg) {
        set v(spegh) $v(remspegh)
    } else {
        set v(remspegh) $v(spegh)
        set v(spegh) 0
    }
    Redraw
}

proc TogglePower {} {
    global v

    if [snack::audio active] return
    if $v(showpower) {
        set v(powerh) $v(rempowerh)
    } else {
        set v(rempowerh) $v(powerh)
        set v(powerh) 0
    }
    Redraw
}

proc ToggleLB {} {
    global v

    if $v(emphasizelb) {
        set v(emphasizelb) 1
    } else {
        set v(emphasizelb) 0
    }
    Redraw
}

proc MoveBoundary {x} {
    global c labels v

    set coords [$c coords current]
    set x [$c canvasx $x]
    if {$x < 0} { set x 0 }
    set i [string trim [lindex [$c gettags current] 0] b]
    if [string match [$c type current] text] return
    if {$i == "obj" || $i == "mark" || $i == "axis" || $i == ""} {
	return
    }

    set h [expr $i - 1]
    set j [expr $i + 1]

    if {$v(lastmoved) != $i} {
	set v(labchanged) 1
	SetUndo $labels
	set v(lastmoved) $i
    }

    $c raise current
    set px 0
    set nx $v(width)
    set pb [$c find withtag b$h]
    set nb [$c find withtag b$j]
    if {$pb != ""} { set px [lindex [$c coords $pb] 0]}
    if {$nb != ""} { set nx [lindex [$c coords $nb] 0]}

    if {$x <= $px} { set x [expr $px + 1] }
    if {$nx <= $x} { set x [expr $nx - 1] }

    $c coords current $x [lindex $coords 1] $x [lindex $coords 3]
    set rest ""

	    scan [lindex $labels $i] {%f %d %s %[^ｧ]} end color label rest
	    set end [Coord2Time $x]
	    set labels [lreplace $labels $i $i "$end\n$color\n$label\n$rest"]
    SetMsg [Coord2Time $x]
}

proc SetLabelText {i label} {
  global labels v

  set rest ""
  scan [lindex $labels $i] {%f %d %s %[^ｧ]} end color junk rest
  set labels [lreplace $labels $i $i "$end\n$color\n$label\n$rest"]
}

proc Undo {} {
    global c v labels undo

    if {[cbs length] != 0} {
	eval $v(undoc)
        foreach {v(undoc) v(redoc)} [list $v(redoc) $v(undoc)] break
	DrawOverAxis
	Redraw
    } else {
        foreach {labels undo} [list $undo $labels] break
	Redraw quick
    }
    SetMsg ""
}

proc SetUndo {l} {
    global undo

    set undo $l
    .tb.undo config -state normal
}

proc MarkAll {} {
    global v

    PutMarker m1 0 0 0
    PutMarker m2 [Coord2Time $v(width)] 0 0
}

proc ZeroXAdjust {} {
    global v
    
    foreach m {m1 m2} {
	set start [Marker2Sample $m]
	snd sample [expr $start-100] ;# to fill sample buffer with leftmost
	for {set i 0} {$i < 100} {incr i} {
	    set j [expr {$start + $i}]
	    if {$j >= [snd length]} break
	    if {$v(vchan) == 1} {
		set sample [lindex [snd sample $j] 1]
		set psample [lindex [snd sample [expr {$j-1}]] 1]
	    } else {
		set sample [lindex [snd sample $j] 0]
		set psample [lindex [snd sample [expr {$j-1}]] 0]
	    }
	    if {[expr {$sample*$psample}] < 0} break
	    set j [expr {$start - $i}]
	    if {$j < 0} break
	    if {$v(vchan) == 1} {
		set sample [lindex [snd sample $j] 1]
		set psample [lindex [snd sample [expr {$j-1}]] 1]
	    } else {
		set sample [lindex [snd sample $j] 0]
		set psample [lindex [snd sample [expr {$j-1}]] 0]
	    }
	    if {[expr {$sample*$psample}] < 0} break
	}
	if {$i < 100} {
	    PutMarker $m [Sample2Time $j] 0 0
	}

    }
    # Copied from PutMarker
    DrawZoom 1
    DrawSect
    set t1 [Marker2Time m1]
    set t2 [Marker2Time m2]
    set l  [expr $t2 - $t1]
    set tt1 [Time2DTime $t1]
    set tt2 [Time2DTime $t2]
    set ll  [expr $tt2 - $tt1]
    SetMsg [format "From: %9s to: %9s length: %9s sec.\t(%.3f - %.3f, %.3f)"\
	    $t1 $t2 $l $tt1 $tt2 $ll] mark
    set v(fromto) [list $t1 $t2 $l $tt1 $tt2 $ll]
}

proc CutFile {} {
  global v labels saveseq_sw labSuffix

#	    set start [lindex [lindex $labels [expr $n - 1]] 0]
#	    if {$start == ""} { set start 0 }
#	    set stop  [lindex [lindex $labels $n] 0]
#	    Play snd [Time2Sample $start] [Time2Sample $stop]
  set forced 0  ;# 1...強制上書き, 0...上書き確認
  set savenum 0 ;# 保存したファイル数
  set start 0
  set end 0
  set fseq 0
  set dir [tk_chooseDirectory -title "保存フォルダを選択" -initialdir "$v(outDir)" -mustexist 1]
  if {$dir == ""} return
  set v(outDir) $dir
  if {$v(labfmt) != "WAVES"} {
    tk_messageBox -message "error: only WAVES format has be implemented..." -type ok
    return
  }
  set labelSuffix [string trim $labSuffix]
  foreach l $labels {
    set lname [lindex $l 2]
    if {[string equal $lname "S"]} {
      set start [lindex $l 0]
    } elseif {[string match "E_*" $lname]} {
      set writeOrNot 1
      set end [lindex $l 0]
      switch $saveseq_sw {
        2 {
          # ラベルに書かれた文字列をファイル名に使う場合
          regsub {^ *E_} $lname "" tmpstr
          set tmpstr  [string trim $tmpstr]
          if {[string length $tmpstr] <= 0} {
            set ans [tk_dialog .nullStr "エラー" \
              "ラベルからファイル名を生成できませんでした" \
              error 1 "続ける" "中止"]
            switch $ans {
              0 {  ;# 続ける
                set writeOrNot 0
              }
              default {  ;# 中止
                return
              }
            }
          } else {
            set savefname [format "$v(outDir)/%s%s.wav" $tmpstr $labelSuffix]
          }
        }
        1 {
          # ラベルに書かれた通し番号をファイル名に使う場合
          set fseq [string range $lname 2 end]
          if {[string length $fseq] <= 0} {
            set ans [tk_dialog .nullStr "エラー" \
              "ラベルからファイル名を生成できませんでした" \
              error 1 "続ける" "中止"]
            switch $ans {
              0 {  ;# 続ける
                set writeOrNot 0
              }
              default {  ;# 中止
                return
              }
            }
          } else {
            set savefname [format "$v(outDir)/%d%s.wav" $fseq $labelSuffix]
          }
        }
        0 {
          # 保存する順に通し番号を付ける場合
          incr fseq
          set savefname [format "$v(outDir)/cut_%d.wav" $fseq]
        }
      }
      # 保存
      if {$forced == 0  &&  $writeOrNot == 1} {
        if {[file exists $savefname]} {
          set ans [tk_dialog .rewrite "警告" \
            "$savefname が既に存在します。\n上書きしますか？" \
            question 3 \
            "はい" "すべて上書き" "名前を変更して保存" "いいえ" "キャンセル"]
          switch $ans {
            0 { ;# はい
            }
            1 { ;# すべて上書き
              set forced 1
            }
            2 { ;# 名前を変更して保存
              set fn [tk_getSaveFile -initialdir "$v(outDir)" -initialfile $savefname -title "名前を付けて保存" -defaultextension "wav"]
              if {$fn != ""} {
                set savefname $fn
              } else {
                set writeOrNot 0
              }
            }
            3 { ;# いいえ
              set writeOrNot 0
            }
            default {
              SetMsg "保存を中止しました"
              return
            }
          }
        }
      }
      if {$writeOrNot == 1} {
        snd write $savefname -start [Time2Sample $start] \
                             -end   [Time2Sample $end]
        set start $end
        SetMsg [format "saved: %f - %f %s" $start $end $savefname]
        incr savenum
      }
    }
  }
  tk_messageBox -message "$savenum 個のファイルを保存しました" -type ok
}

proc InsertLabelWithLabelNameOnBorder {L R lnameL lnameR} {
    global c v labels

    set v(labchanged) 1
    SetUndo $labels
    InsertLabelEntryWithLabelName $L $lnameL
    InsertLabelEntryWithLabelName $R $lnameR

    $c delete bound text
    Redraw quick
}

proc InsertLabelWithLabelName {x y lname} {
    global c v labels

    set v(labchanged) 1
    SetUndo $labels
    InsertLabelEntryWithLabelName [Coord2Time [$c canvasx $x]] $lname

    $c delete bound text
    Redraw quick
}

proc InsertLabelEntryWithLabelName {t lname} {
    global labels v

    set i 0
    foreach l $labels {
      if {[lindex $l 0] > $t} { break }
      incr i
    }
    # SetMsg [lindex [lindex $labels $i] 1]
    set labels [linsert $labels $i "$t\n121\n$lname"]
}

proc InsertLabel {x y} {
    global c v labels

    set v(labchanged) 1
    SetUndo $labels
    InsertLabelEntry [Coord2Time [$c canvasx $x]]

    $c delete bound text
    Redraw quick
}

proc InsertLabelEntry {t} {
    global labels v

    set i 0
	    foreach l $labels {
		if {[lindex $l 0] > $t} { break }
		incr i
	    }
	    SetMsg [lindex [lindex $labels $i] 1]
	    set labels [linsert $labels $i "$t\n121\nx"]
}

proc DeleteLabel {x y} {
    global c v labels

    set v(labchanged) 1
    SetUndo $labels
    if {[string compare [lindex [$c gettags [$c find closest\
	    [$c canvasx $x] [$c canvasy $y]]] 2] text] == 0} {
	set i [lindex [$c gettags [$c find closest\
		[$c canvasx $x] [$c canvasy $y]]] 0]
	RemoveLabelEntry $i

	$c delete bound text
	Redraw quick
    }
}

proc RemoveLabelEntry {i} {
    global labels v

	    set labels [lreplace $labels $i $i]
}

# if called by clicking on the text of a label, this label will be aligned to 
# the selection
# FIXME: but this isn't foolproofed because if there is another label between 
# the one to change and the selection only the selected label 
# (and with HTK-format the right neighbour) will be changed ...

proc AlignLabel {x y} {
    global c v labels

    set v(labchanged) 1
    SetUndo $labels
    if {[string compare [lindex [$c gettags [$c find closest\
	    [$c canvasx $x] [$c canvasy $y]]] 2] text] == 0} {
	set i [lindex [$c gettags [$c find closest\
		[$c canvasx $x] [$c canvasy $y]]] 0]

	SetUndo $labels
	set start [Marker2Time m1]
	set end   [Marker2Time m2]
	set rest ""

		scan [lindex $labels $i] {%f %d %s %[^ｧ]} junk color label rest
		set labels [lreplace $labels $i $i "$end\n$color\n$label\n$rest"]
		set rest ""
		set j [expr $i-1]
		if {$j >= 0} {
		    scan [lindex $labels $j] {%f %d %s %[^ｧ]} junk color label rest
		    set labels [lreplace $labels $j $j "$start\n$color\n$label\n$rest"]
		}

	$c delete bound text
	Redraw quick
    } else {
	puts "AlignLabel error: x=$x; y=$y"
    } 
}

proc CropLabels {cstart cend} {
    global labels v

    set l {}
	    set flag 0
	    foreach row $labels {
		set rest ""
		scan $row {%f %d %s %[^ｧ]} end color label rest
		if {$cend < $end && $flag} {
		    set end [expr $cend - $cstart]
		    lappend l "$end\n$color\n$label\n$rest"
		    break
		}
		if {$cstart < $end} {
		    set end [expr $end - $cstart]
		    lappend l "$end\n$color\n$label\n$rest"
		    set flag 1
		}
	    }
    return $l
}

# moves the startpoint of the right label to the cursorposition
# 現在地より右側のラベルを現在地に移動させる
proc GetRightLabel {x y} {
    global c labels v

    set t [Coord2Time [$c canvasx $x]]
    set i 0
    set v(labchanged) 1
    SetUndo $labels
    set rest ""
	    foreach l $labels {
		if {([lindex $l 0] > $t)} { break }
		incr i
	    }
	    if {$i == [llength $labels]} return
	    scan [lindex $labels $i] {%f %d %s %[^ｧ]} junk color label rest
	    set labels [lreplace $labels $i $i "$t\n$color\n$label\n$rest"]
	    SetMsg [lindex [lindex $labels $i] 1]
    $c delete bound text
    Redraw quick
}

proc PlayLabel {x y} {
    global c labels v

    set t [Coord2Time [$c canvasx $x]]
    set i 0
    foreach l $labels {
      if {[lindex $l 0] > $t} { break }
      incr i
    }
    PlayNthLab $i
}

proc PlayNthLab {n} {
    global labels v
    
        set start [lindex [lindex $labels [expr $n - 1]] 0]
        if {$start == ""} { set start 0 }
        set stop  [lindex [lindex $labels $n] 0]
        Play snd [Time2Sample $start] [Time2Sample $stop]
}

# ラベルにフォーカスあり→ラベル間を再生、
# ラベルにフォーカスなし→マウスで指定した範囲を再生、
proc PlayComm {W x} {
    global c

    set i [lindex [$c gettags [$W focus]] 0]
    if {$i != ""} {
        # ラベルにフォーカスがある場合は、ラベルの範囲を再生
        PlayNthLab $i
    } else {
        # ラベルにフォーカスが無い場合は、マウスで指定した範囲を再生
        if {[$W type [$W focus]] != "text"} PlayBetweenMarks
    }
}

proc MarkLabel {x y} {
    global c labels v

    set t [Coord2Time [$c canvasx $x]]
    set i 0
    foreach l $labels {
      if {[lindex $l 0] > $t} { break }
      incr i
    }
    MarkNthLab $i
}

proc MarkNthLab {n} {
    global labels v
    
          set start [lindex [lindex $labels [expr $n - 1]] 0]
          if {$start == ""} { set start 0 }
          set stop  [lindex [lindex $labels $n] 0]
    # cause the left marker is always m1 we have to move the marker
    # in the right order
    if {$start > [Marker2Time m2]} {
      PutMarker m2 $stop 0 0
      SendPutMarker m2 [Time2Coord $stop]
      PutMarker m1 $start 0 0
      SendPutMarker m1 [Time2Coord $start]
    } else {
      PutMarker m1 $start 0 0
      SendPutMarker m1 [Time2Coord $start]
      PutMarker m2 $stop 0 0
      SendPutMarker m2 [Time2Coord $stop]
    }
}


proc SetRaw {} {
    global v

    StopPlay
    set v(smpchanged) 1
    snd config -rate $v(rate) -encoding $v(sfmt) -channels $v(chan)
    Redraw
    Reconf
}

proc Time2Sample {t} {
  global v

  expr {int($t*$v(rate))}
}

proc Sample2Time {s} {
  global v

  expr {double($s)/$v(rate)}
}

proc TimeRound {t} {
    global v

	    expr {$t}
}

proc Time2Coord {t} {
  global v

   expr {(($t - (double($v(startsmp))/$v(rate)) )*$v(pps))}
}

proc Time2DTime {t} {
    global v

	    expr {$t}
}

proc DTime2Time {t} {
    global v

	    expr {$t}
}

proc Coord2Time {x} {
    global v

	    expr {double($x)/$v(pps)+double($v(startsmp))/$v(rate)}
}

proc Coord2Sample {x} {
    global v

    expr {int($v(startsmp)+$x*double($v(rate))/$v(pps))}
}

proc BoundaryEnter {x} {
    global c _mb

    set _mb 1
    $c itemconfig current -fill red
    $c configure -cursor sb_h_double_arrow
}

proc BoundaryLeave {x} {
    global c v

    $c itemconfig current -fill $v(fg)
    $c configure -cursor {}
}

proc MarkerEnter {x} {
    global c

    $c itemconfig current -fill red
    $c configure -cursor sb_h_double_arrow
}

proc MarkerLeave {x} {
    global c v

    $c itemconfig current -fill $v(fg)
    $c configure -cursor {}
}

proc PutMarker {m x y f} {
    global c v _mx _mb

    if {$_mx == 0} return
    if {$y > [expr $v(waveh) + $v(spegh) + $v(powerh) + $v(timeh)]} {
	if {$_mb == 1 && $f == 1} {
	    MoveBoundary $x
	}
	return
    }
    if {$f == 1} {
	if {$x < 0 && [lindex [$c xview] 0] > 0} {
	    $c xview scroll -1 unit
	    update
	    SendXScroll
	}
	if {$x >= [winfo width $c]} {
	    $c xview scroll 1 unit
	    update
	    SendXScroll
	}

	set xc [$c canvasx $x]

	if {$xc < 0} { set xc 0 }
	if {$xc > $v(width)} { set xc $v(width) }

	set t [Coord2Time $xc]
    } else {
	set xc [Time2Coord $x]
	set t $x
    }
    if {$t >= [snd length]} {
      set t [expr {[snd length]-1}]
    }
    $c itemconf $m -tags [list mark $t $m]
    $c coords $m $xc 0 $xc $v(toth)

    if {$m == "m1"} {
	set tm2 [Marker2Time m2]
	if {$t > $tm2} {
	    $c itemconf m2 -tags [list mark $tm2 m3]
	    $c itemconf m1 -tags [list mark $t m2]
	    $c itemconf m3 -tags [list mark [Marker2Time m3] m1]
	}
    } else {
	set tm1 [Marker2Time m1]
	if {$t < $tm1} {
	    $c itemconf m1 -tags [list mark $tm1 m3]
	    $c itemconf m2 -tags [list mark $t m1]
	    $c itemconf m3 -tags [list mark [Marker2Time m3] m2]
	}
    }

    if {$v(fillmark)} {
	$c coords mfill [Time2Coord [Marker2Time m1]] 0 \
		        [Time2Coord [Marker2Time m2]] $v(toth)
    }

    set ox1 [expr $v(scrh) + [Time2DTime [Marker2Time m1]] * $v(opps) / 1000.0]
    set ox2 [expr $v(scrh) + [Time2DTime [Marker2Time m2]] * $v(opps) / 1000.0]
    .of.c coords mark $ox1 2 $ox2 30

    if {$f == 1} {
	DrawZoom 1
	DrawSect
	set t1 [Marker2Time m1]
	set t2 [Marker2Time m2]
	set l  [expr $t2 - $t1]
	set tt1 [Time2DTime $t1]
	set tt2 [Time2DTime $t2]
	set ll  [expr $tt2 - $tt1]
	SetMsg [format "From: %9s to: %9s length: %9s sec.\t(%.3f - %.3f, %.3f)"\
		$t1 $t2 $l $tt1 $tt2 $ll] mark
	set v(fromto) [list $t1 $t2 $l $tt1 $tt2 $ll]
    }

    foreach p $v(plugins) {
	namespace inscope $p Putmark $m
    }
    update
}

proc SendPutMarker {m x} {
    global c v

    set xc [$c canvasx $x]
    if {$v(mlink) == 1} {
	foreach prg [winfo interps] {
	    if [regexp .*xs.* $prg] {
		if {[winfo name .] != $prg} {
		    set t [Coord2Time $xc]
		    send $prg PutMarker $m $t 0 0
		}
	    }
	}
    }
}

proc Marker2Sample {m} {
    global c

    Time2Sample [lindex [$c gettags $m] 1]
}

proc Marker2Time {m} {
    global c

    lindex [$c gettags $m] 1
}

proc DrawCrossHairs {} {
    global c v

    if {$v(ch)} {
        $c delete ch1 ch2
        if {$::tcl_platform(platform) == "windows"} {
#	          $c create line 0 0 0 0 -width 2 -stipple gray50 -tags [list ch1]\
#		          -fill $v(gridcolor)
#	          $c create line 0 0 0 0 -width 2 -stipple gray50 -tags [list ch2]\
#		          -fill $v(gridcolor)
            $c create line 0 0 0 0 -width 1 -tags [list ch1]\
                -fill $v(gridcolor)
            $c create line 0 0 0 0 -width 1 -tags [list ch2]\
                -fill $v(gridcolor)
        } else {
            $c create line 0 0 0 0 -width 1 -stipple gray50 -tags [list ch1]\
                -fill $v(gridcolor)
            $c create line 0 0 0 0 -width 1 -stipple gray50 -tags [list ch2]\
                -fill $v(gridcolor)
        }
        $c lower ch1 m1
        $c lower ch2 m1
    } else {
        $c delete ch1 ch2
    }
}

proc PutCrossHairs {x y} {
    global c v

    set xc [$c canvasx $x]
    set yc [$c canvasy $y]
    set f 0.0
    catch { set f [expr $v(topfr) * ($v(spegh) - ($yc - $v(waveh))) / $v(spegh)]}
    if {$f < 0.0} { set f 0.0 }
    if {$f > 0.5*$v(rate)} { set f [expr 0.5*$v(rate)] }

    if {$v(ch)} {
	$c coords ch1 $xc 0 $xc $v(toth)
	$c coords ch2 0 $yc $v(width) $yc
	set s [Coord2Time $xc]
	set t [expr double($xc) / $v(pps)]

	SetMsg "time: $t\tsample: $s\tfrequency: $f"
    } else {
	$c coords ch1 -1 -1 -1 -1
	$c coords ch2 -1 -1 -1 -1
    }
    if [winfo exists .sect] { DrawSectMarks f $f }
}

proc DrawSect {} {
  global c s v

  if [winfo exists .sect] {
    set geom [lindex [split [wm geometry .sect] +] 0]
    set s(sectwinw) [lindex [split $geom x] 0]
    set s(sectwinh) [lindex [split $geom x] 1]
    set s(sectwinx) [lindex [split [wm geometry .sect] +] 1]
    set s(sectwiny) [lindex [split [wm geometry .sect] +] 2]
    set s(sectw) [expr [winfo width .sect.c] - 25]
    set s(secth) [expr [winfo height .sect.c] - 20]
    set s(sectcw) [winfo width .sect.c]
    set s(sectch) [winfo height .sect.c]

    set s(start) [Marker2Sample m1]
    set s(end)   [Marker2Sample m2]
    if {$s(start) == $s(end)} { set s(start) [expr $s(end) - 1]}
    .sect.c delete sect
    set s(top) [expr int(($s(ref) + $s(range)) / 10.0)]
    set s(bot) [expr int($s(ref) / 10.0 )]

    catch {
      if {$s(ostart) != ""} {
        .sect.c create section 25 0 -sound snd -height $s(secth)\
        -width $s(sectw) -maxvalue [expr 10.0*$s(top)] \
        -minvalue [expr 10.0*$s(bot)] \
        -start $s(ostart) -end $s(oend) -tags sect \
        -fftlen $s(fftlen) -analysistype $s(atype) \
        -lpcorder $s(lpcorder) \
        -winlen $s(fftlen) -channel $v(vchan) -fill red \
        -topfr $v(topfr) -windowtype $s(wintype)
      }
      .sect.c create section 25 0 -sound snd -height $s(secth) \
        -width $s(sectw) -maxvalue [expr 10.0*$s(top)] \
        -minval [expr 10.0*$s(bot)] \
        -start $s(start) -end $s(end) -tags sect -fftlen $s(fftlen) \
        -winlen $s(fftlen) -channel $v(vchan) -frame 1 \
        -debug $::debug -fill $v(fg) -analysistype $s(atype) \
        -lpcorder $s(lpcorder) -topfr $v(topfr) -windowtype $s(wintype)
    }
    .sect.c create text -10 -10 -text df: -font $v(sfont) -tags df \
      -fill blue
    .sect.c create text -10 -10 -text "0 db" -font $v(sfont) -tags db \
      -fill red
    set pps [expr int(double($s(sectw))/($v(topfr)/1000.0) + .5)]
    snack::timeAxis .sect.c 25 $s(secth) $s(sectw) 20 $pps \
      -tags sect -fill $v(fg) -font $v(sfont)

    for {set i $s(top)} {$i > $s(bot)} {incr i -1} {
      set lab [expr 10 * $i]
      .sect.c create text 0 \
        [expr ($i - $s(top)) * $s(secth) / ($s(bot) - $s(top))] \
        -text $lab \
        -tags sect -font $v(sfont) -anchor w -fill $v(fg)
    }

    .sect.c create text 2 2 -text dB -font $v(sfont) -tags sect -anchor nw\
      -fill $v(fg)
    .sect.c create text $s(sectw) $s(secth) -text kHz -font $v(sfont)\
      -tags sect -anchor nw -fill $v(fg)
  }
}

proc DrawSectMarks {x y} {
    global s v

    if {[.sect.c find withtag sm] == ""} {
	if {$::tcl_platform(platform) == "windows"} {
#	    .sect.c create line 0 0 0 $s(sectch) -width 2 -stipple gray50 -tags [list sx sm] -fill $v(fg)
#	    .sect.c create line 0 0 $s(sectcw) 0 -width 2 -stipple gray50 -tags [list sy sm] -fill $v(fg)
#	    .sect.c create line 0 0 0 0 -width 2 -stipple gray50 -tags [list relmark] -fill $v(fg)
	    .sect.c create line 0 0 0 $s(sectch) -width 1 -tags [list sx sm] -fill $v(fg)
	    .sect.c create line 0 0 $s(sectcw) 0 -width 1 -tags [list sy sm] -fill $v(fg)
	    .sect.c create line 0 0 0 0 -width 1 -tags [list relmark] -fill $v(fg)
	} else {
	    .sect.c create line 0 0 0 $s(sectch) -width 1 -stipple gray50 -tags [list sx sm] -fill $v(fg)
	    .sect.c create line 0 0 $s(sectcw) 0 -width 1 -stipple gray50 -tags [list sy sm] -fill $v(fg)
	    .sect.c create line 0 0 0 0 -width 1 -stipple gray50 -tags [list relmark relmarkux] -arrow both -fill $v(fg)
	}
    }

    if {$x != "f"} {
	set xc [.sect.c canvasx $x]
	set yc [.sect.c canvasx $y]
    } else {
	set xc [expr 25+int($s(sectw) * $y / $v(topfr))]
	set yc [lindex [.sect.c coords sy] 1]
    }
    .sect.c coords sx $xc 0 $xc $s(sectch)
    .sect.c coords sy 0 $yc $s(sectcw) $yc
    set f [expr int(double($v(topfr)) * ($xc - 25) / $s(sectw) + .5)]
    if {$f < 0} { set f 0 }
    set db [format "%.1f" [expr 10.0 * ($s(bot) - $s(top)) * double($yc) / $s(secth) + 10.0 * $s(top)]]

    if {$s(rx) != -1} {
	set rx [.sect.c canvasx $s(rx)]
	set ry [.sect.c canvasy $s(ry)]
	.sect.c coords relmark $rx $ry $xc $yc
	.sect.c coords df [expr $rx + ($xc-$rx)/2] $ry
	.sect.c coords db $rx [expr $ry + ($yc-$ry)/2]

	set df [expr abs(int($v(topfr) * ($rx - $xc)/ $s(sectw)))]
	.sect.c itemconf df -text "df: $df" 
	set ddb [format "%.1f" [expr $s(range) * ($ry - $yc) / $s(secth)]]
	.sect.c itemconf db -text "db: $ddb" 
    } else {
#	.sect.c coords relmark 0 0 0 0
#	.sect.c coords df -10 -10
#	.sect.c coords db -10 -10
    }

    .sect.f.lab config -text "Frequency: $f Hz, amplitude: $db dB"
}

proc OpenZoomWindow {} {
    global z v

    catch {destroy .zoom}
    catch {destroy .zmenu}
    toplevel .zoom -width $z(zoomwinw) -height $z(zoomwinh)
    wm title .zoom "Zoom view"
    wm geometry .zoom +$z(zoomwinx)+$z(zoomwiny)
    pack propagate .zoom 0

    frame .zoom.f
    label .zoom.f.lab -text "Press right mouse button for menu" -width 1 -relief sunken -bd 1 -anchor w
    pack .zoom.f.lab -side left -expand yes -fill x
    pack [button .zoom.f.xzoomB -text X-zoom -command {DrawZoom 1}] -side left
    pack [button .zoom.f.yizoomB -text "Y-zoom in" -command {DrawZoom 2}] -side left
    pack [button .zoom.f.yozoomB -text "Y-zoom out" -command {DrawZoom .5}] -side left
    pack [button .zoom.f.exitB -text Close -command {destroy .zoom}] -side left
    pack .zoom.f -side bottom -fill x
    pack [canvas .zoom.c -closeenough 5 -bg $v(bg)] -fill both -expand true

    update idletasks
    DrawZoom 1

    menu .zmenu -tearoff false
    .zmenu add command -label "Play Range" -command PlayMark
    .zmenu add command -label "Mark Start" -command {PutZMarker zm1 $x}
    .zmenu add command -label "Mark End" -command {PutZMarker zm2 $x}
    if {[string match macintosh $::tcl_platform(platform)] || \
	    [string match Darwin $::tcl_platform(os)]} {
	bind $c <Control-1> \
		{set x %x; set y %y; catch {tk_popup .zmenu %X %Y 0}}
    } else {
	bind .zoom.c <3> {set x %x; set y %y; catch {tk_popup .zmenu %X %Y 0}}
    }
    bind .zoom <Configure> { DrawZoom 1 }
}

proc DrawZoom {factor} {
    global z v f

    if [winfo exists .zoom] {
	set geom [lindex [split [wm geometry .zoom] +] 0]
	set z(zoomwinw) [lindex [split $geom x] 0]
	set z(zoomwinh) [lindex [split $geom x] 1]
        set z(zoomwinx) [lindex [split [wm geometry .zoom] +] 1]
        set z(zoomwiny) [lindex [split [wm geometry .zoom] +] 2]
	set z(zoomwavw) [winfo width .zoom.c]
	set z(zoomwavh) [winfo height .zoom.c]
	set z(f) [expr $z(f) * $factor]

	set start [Marker2Sample m1]
	set end   [Marker2Sample m2]

	if {$start == $end} { set end [expr $start + 1]}
	set zoompps [expr double($z(zoomwavw)) * $v(rate) / ($end - $start)]

	.zoom.c delete zoomwave zm1 zm2
	if {$v(linkfile) && $f(sndfile) != ""} {
	    .zoom.c create waveform 0 [expr $z(zoomwavh)/2] -sound snd \
		    -height [expr int($z(zoomwavh) * $z(f))] \
		    -start $start -end $end -channel $v(vchan) \
		    -pixels $zoompps -tags zoomwave -anchor w -fill $v(wavcolor) \
        -shapefile [file rootname [file tail $f(spath)$f(sndfile)]].shape
	} else {
	    .zoom.c create waveform 0 [expr $z(zoomwavh)/2] -sound snd \
		    -height [expr int($z(zoomwavh) * $z(f))] \
		    -start $start -end $end	-channel $v(vchan) \
		    -pixels $zoompps -tags zoomwave -anchor w -fill $v(wavcolor)
	}
	.zoom.c create line 1 0 1 $z(zoomwavh) -width 1 -tags zm1 -fill $v(fg)
	.zoom.c create line [expr $z(zoomwavw) - 1] 0 [expr $z(zoomwavw) - 1] $z(zoomwavh) -width 1 -tags zm2 -fill $v(fg)
	.zoom.c bind zm1 <B1-Motion> { PutZMarker zm1 %x }
	.zoom.c bind zm2 <B1-Motion> { PutZMarker zm2 %x }
	.zoom.c bind zm1 <ButtonPress-1> { set _mx 0 }
	.zoom.c bind zm2 <ButtonPress-1> { set _mx 0 }
	.zoom.c bind zm1 <ButtonRelease-1> { set _mx 0 }
	.zoom.c bind zm2 <ButtonRelease-1> { set _mx 0 }
	bind .zoom.c <ButtonPress-1>   { PutZMarker zm1 %x; set _mx 1 }
	bind .zoom.c <ButtonRelease-1> { PutZMarker zm2 %x; set _mx 1}
	set z(zoomt1) [Marker2Time m1]
	set z(zoomt2) [Marker2Time m2]
    }
}

proc PutZMarker {m x} {
    global z _mx

    if {$_mx == 0} return

    set xc [.zoom.c canvasx $x]
    if {$xc < 0} { set xc 0 }
    if {$xc > $z(zoomwavw)} { set xc $z(zoomwavw) }
    .zoom.c coords $m $xc 0 $xc $z(zoomwavh)

    set t [TimeRound [expr $z(zoomt1) + ($z(zoomt2) - $z(zoomt1)) * double($xc) / $z(zoomwavw)]]
    set n [Time2Sample $t]
    set s [snd sample $n]
    if {$m == "zm1"} {
	.zoom.f.lab config -text "Marker 1 at $n ($s)"
	PutMarker m1 $n 0 0
    } else {
	.zoom.f.lab config -text "Marker 2 at $n ($s)"
	PutMarker m2 $n 0 0
    }
}

proc Version {} {
  global v
  tk_messageBox -title "バージョン情報" -message "wavDivider version $v(version)"
}

#
# Miscellaneous subroutines
#

proc Help {url} {
    global v lab_path
    
    if {$::tcl_platform(platform) == "windows"} {
	if {[string match $::tcl_platform(os) "Windows NT"]} {
	    exec $::env(COMSPEC) /c start $url &
	} {
	    exec start $url &
	}
    } else {
	if [catch {exec sh -c "netscape -remote 'openURL($url)' -raise"} res] {
	    if [string match *netscape* $res] {
		exec sh -c "netscape $url" &
	    }
	}
    }
}

proc NewWin {} {
    global f

    if {$::tcl_platform(platform) == "windows"} {
	exec [info nameofexecutable] $f(prog) &
    } else {
	exec $f(prog) -geometry [xsGetGeometry] &
    }
}

proc Reset {} {
    global v f s v_copy f_copy s_copy

    array set v $v_copy
    array set f $f_copy
    array set s $s_copy
}

# 詳細設定、の画面
proc Settings {} {
    global v c f s v_copy f_copy s_copy power power_bk v_bk powerDat

    StopPlay
    set w .dim
    catch {destroy $w}
    toplevel $w
    wm title $w "詳細設定"
    wm resizable $w 0 0
    bind $w <Escape> "destroy $w"

    array set power_bk [array get power] ;# パラメータバックアップ
    array set v_bk     [array get v]     ;# パラメータバックアップ

    set start [Coord2Sample [$c canvasx 0]]
    set end   [Coord2Sample [$c canvasx 200]]
    # set start [Coord2Sample [$c canvasx [expr [winfo width .cf.fc]/2 - 100]]]
    # set end   [Coord2Sample [$c canvasx [expr [winfo width .cf.fc]/2 + 100]]]

    set v_copy [array get v]
    set f_copy [array get f]
    set s_copy [array get s]

    ;# 波形やスペクトルを描画するフレーム
    pack [frame $w.ll] -side left -anchor ne
    pack [canvas $w.ll.c -height [expr $v(waveh)+$v(spegh)+$v(powerh)] -width 200 \
	    -highlightthickness 0]    

    ;# パラメータを変更するフレーム
    pack [frame $w.l] -side left -anchor n -fill y
    pack [label $w.l.l1 -text Appearance:]

#    pack [frame $w.l.f3]
#    pack [label $w.l.f3.l -text "Time scale (pixels/second):" -width 25 -anchor w] -side left
#    pack [entry $w.l.f3.e -textvar v(pps) -wi 6] -side left
#    pack [scale $w.l.f3.s -variable v(pps) -orient horiz -from 1 -to 1000 -command "$w.ll.c itemconf both -width 200 -start $start -pixels " -showvalue no] -side left

#    pack [frame $w.l.f1]
#    pack [label $w.l.f1.l -text "Waveform height:" -width 25 -anchor w] -side left
#    pack [entry $w.l.f1.e -textvar v(waveh) -wi 6] -side left
#    pack [scale $w.l.f1.s -variable v(waveh) -orient horiz -from 0 -to 1000 -showvalue no -command {.dim.ll.c configure -height [expr $v(waveh) + $v(spegh)];.dim.ll.c coords speg 0 $v(waveh);.dim.ll.c itemconf wave -height }] -side left

#    pack [frame $w.l.f2]
#    pack [label $w.l.f2.l -text "Spectrogram height:" -width 25 -anchor w] -side left
#    pack [entry $w.l.f2.e -textvar v(spegh) -wi 6] -side left
#    pack [scale $w.l.f2.s -variable v(spegh) -orient horiz -from 0 -to 1000 -command {.dim.ll.c configure -height [expr $v(waveh) + $v(spegh)];.dim.ll.c itemconf speg -height } -showvalue no] -side left

    pack [frame $w.l.f20]
    label $w.l.f20.l -text "Cut spectrogram at freq:" -width 25 -anchor w
    entry $w.l.f20.e -textvar v(topfr) -wi 6
    scale $w.l.f20.s -variable v(topfr) -orient horiz -from 0 -to [expr $v(rate)/2] -command "DrawSect;$w.ll.c itemconf speg -topfreq " -showvalue no
    pack $w.l.f20.l $w.l.f20.e $w.l.f20.s -side left

    pack [frame $w.l.f30]
    pack [label $w.l.f30.l -text "Brightness" -width 25 -anchor w] -side left
    pack [entry $w.l.f30.e -textvar v(brightness) -wi 6] -side left
    pack [scale $w.l.f30.b -variable v(brightness) -showvalue no \
	    -orient horiz -command "$w.ll.c itemconf speg -brightness " \
	    -from -100 -to 100 -res 0.1]

    pack [frame $w.l.f31]
    pack [label $w.l.f31.l -text "Contrast" -width 25 -anchor w] -side left
    pack [entry $w.l.f31.e -textvar v(contrast) -wi 6] -side left
    pack [scale $w.l.f31.c -variable v(contrast) -showvalue no\
	    -orient horiz -command "$w.ll.c itemconf speg -contrast" \
	    -from -100 -to 100 -res 0.1]

#    pack [frame $w.l.f21]
#    label $w.l.f21.l -text "Scroll area width:" -width 25 -anchor w
#    entry $w.l.f21.e -textvar v(scrw) -wi 6
#    pack $w.l.f21.l $w.l.f21.e -side left

    ;# 前景色設定
    pack [frame $w.l.f41] -anchor w
    label  $w.l.f41.l  -text "前景色:" -width 25 -anchor w
    label  $w.l.f41.l2 -textvar v(fg)  -width 7  -anchor w -bg $v(fg)
    button $w.l.f41.b  -text "色の選択" -command {\
      set ctmp [changeColor $v(fg)]
      if {$ctmp != ""} {
        set v(fg) $ctmp
        .dim.l.f41.l2 configure -bg $v(fg)
        # .dim.ll.c itemconf fg -outline $v(fg) ;# 波形の色を変更する
      }
    }
    pack $w.l.f41.l $w.l.f41.l2 $w.l.f41.b -side left

    ;# 背景色設定
    pack [frame $w.l.f41b] -anchor w
    label  $w.l.f41b.l  -text "背景色:" -width 25 -anchor w
    label  $w.l.f41b.l2 -textvar v(bg)  -width 7  -anchor w -bg $v(bg)
    button $w.l.f41b.b  -text "色の選択" -command {\
      set ctmp [changeColor $v(bg)]
      if {$ctmp != ""} {
        set v(bg) $ctmp
        .dim.l.f41b.l2 configure -bg $v(bg)
        # .dim.ll.c configure -bg $v(bg) ;# 波形の色を変更する
        # $c config -bg $v(bg)
        # .cf.fyc.yc config -bg $v(bg)
        # catch {.zoom.c config -bg $v(bg)}
        # catch {.sect.c config -bg $v(bg)}
      }
    }
    pack $w.l.f41b.l $w.l.f41b.l2 $w.l.f41b.b -side left

    ;# 波形色設定
    pack [frame $w.l.f4w] -anchor w
    label  $w.l.f4w.l  -text "波形の色:" -width 25 -anchor w
    label  $w.l.f4w.l2 -textvar v(wavcolor) -width 7 -anchor w -bg $v(wavcolor)
    button $w.l.f4w.b  -text "色の選択" -command {\
      set ctmp [changeColor $v(wavcolor)]
      if {$ctmp != ""} {
        set v(wavcolor) $ctmp
        .dim.l.f4w.l2 configure -bg $v(wavcolor)
        # .dim.ll.c itemconf wave -fill $v(wavcolor) ;# 波形の色を変更する
      }
    }
    pack $w.l.f4w.l $w.l.f4w.l2 $w.l.f4w.b -side left

    ;# スペクトルに引くグリッド線の間隔
    pack [frame $w.l.f42] -anchor w
    label $w.l.f42.l -text "Grid frequency spacing (Hz):" -width 25 -anchor w
    entry $w.l.f42.e -textvar v(gridfspacing) -wi 6
    pack $w.l.f42.l $w.l.f42.e -side left
    bind $w.l.f42.e <Key-Return> {.dim.ll.c itemconf speg -gridf $v(gridfspacing)}

    ;# スペクトルに引くグリッド線の間隔
    pack [frame $w.l.f43] -anchor w
    label $w.l.f43.l -text "Grid time spacing: (s)" -width 25 -anchor w
    entry $w.l.f43.e -textvar v(gridtspacing) -wi 6
    pack $w.l.f43.l $w.l.f43.e -side left
    bind $w.l.f43.e <Key-Return> {.dim.ll.c itemconf speg -gridt $v(gridtspacing)}

    ;# スペクトルに引くグリッド線の色
    pack [frame $w.l.f44] -anchor w
    label  $w.l.f44.l  -text "グリッド線の色:" -width 25 -anchor w
    label  $w.l.f44.l2 -textvar v(gridcolor)  -width 7  -anchor w -bg $v(gridcolor)
    button $w.l.f44.b  -text "色の選択" -command {\
      set ctmp [changeColor $v(gridcolor)]
      if {$ctmp != ""} {
        set v(gridcolor) $ctmp
        .dim.l.f44.l2 configure -bg $v(gridcolor)
        # DrawCrossHairs
        # .dim.ll.c itemconf speg -gridc $v(gridcolor)
      }
    }
    pack $w.l.f44.l $w.l.f44.l2 $w.l.f44.b -side left

    ;# スペクトルの配色
    pack [frame $w.l.f45] -anchor w
    label $w.l.f45.l -text "Spectrogram color:" -width 25 -anchor w
    tk_optionMenu $w.l.f45.cm v(cmap) grey color1 color2
    $w.l.f45.cm.menu entryconfigure 0 -command {.dim.ll.c itemconf speg -col $v($v(cmap))}
    $w.l.f45.cm.menu entryconfigure 1 -command {.dim.ll.c itemconf speg -col $v($v(cmap))}
    $w.l.f45.cm.menu entryconfigure 2 -command {.dim.ll.c itemconf speg -col $v($v(cmap))}
    pack $w.l.f45.l $w.l.f45.cm -side left

    ;# パワー色設定
    pack [frame $w.l.f4p] -anchor w
    label  $w.l.f4p.l  -text "パワー曲線の色:" -width 25 -anchor w
    label  $w.l.f4p.l2 -textvar v(powcolor) -width 7 -anchor w -bg $v(powcolor)
    button $w.l.f4p.b  -text "色の選択" -command {\
      set ctmp [changeColor $v(powcolor)]
      if {$ctmp != ""} {
        set v(powcolor) $ctmp
        .dim.l.f4p.l2 configure -bg $v(powcolor)
      }
    }
    pack $w.l.f4p.l $w.l.f4p.l2 $w.l.f4p.b -side left

    ;# スペクトルの設定
    pack [frame $w.r] -side left -anchor n -fill both -expand true

    pack [label $w.r.l2 -text "Spectrogram analysis:"]

    pack [frame $w.r.f1]
    label $w.r.f1.l -text "FFT window length (points):" -width 25 -anchor w
    entry $w.r.f1.e -textvar v(fftlen) -wi 6
    label $w.r.f1.ldummy -text "" -wi 6
    pack $w.r.f1.l $w.r.f1.e $w.r.f1.ldummy -side left
    bind $w.r.f1.e <Key-Return> {.dim.ll.c itemconf speg -fftlen $v(fftlen)}

    pack [frame $w.r.f2]
    label $w.r.f2.l -text "Analysis bandwidth (Hz):" -width 25 -anchor w
    entry $w.r.f2.e -textvar v(anabw) -wi 6
    label $w.r.f2.ldummy -text "" -wi 6
    pack $w.r.f2.l $w.r.f2.e $w.r.f2.ldummy -side left
    bind $w.r.f2.e <Key-Return> {.dim.ll.c itemconf speg -winlen [expr int($v(rate) / $v(anabw))]}

    pack [frame $w.r.f3]
    label $w.r.f3.l -text "Pre-emphasis factor:" -width 25 -anchor w
    entry $w.r.f3.e -textvar v(preemph) -wi 6
    label $w.r.f3.ldummy -text "" -wi 6
    pack $w.r.f3.l $w.r.f3.e $w.r.f3.ldummy -side left
    bind $w.r.f3.e <Key-Return> {.dim.ll.c itemconf speg -preem $v(preemph)}

    ;# パワーの設定
    pack [label $w.r.lp -text "パワー抽出用パラメータ:"]

    ;# パワー抽出刻みの設定
    pack [frame $w.r.ffl]
    label $w.r.ffl.lfl -text "パワー抽出間隔" -width 25 -anchor w
    entry $w.r.ffl.efl -textvariable power(frameLength) -wi 6 \
      -validate all -validatecommand {
           if {[string is double %P]} {
             if {[string length %P] > 0 && %P > 0} {
               set tmp [sec2samp $power(uttLengthSec) %P]
               if {$tmp >= 0} {
                 set power(uttLength) $tmp
               }
	     }
             expr {1}
           } else {
             expr {0}
	   }
      }
    label $w.r.ffl.lflu -text "(sec)" -anchor w -wi 6
    pack $w.r.ffl.lfl $w.r.ffl.efl $w.r.ffl.lflu -side left

  ;# プリエンファシスの設定
  pack [frame $w.r.fem]
  label $w.r.fem.lem -text "プリエンファシス" -width 25 -anchor w
  entry $w.r.fem.eem -textvariable power(preemphasis) -wi 6
  label $w.r.fem.ldummy -text "" -wi 6
  pack $w.r.fem.lem $w.r.fem.eem $w.r.fem.ldummy -side left

  ;# 平滑化に使うサンプル数の設定
  pack [frame $w.r.fsm]
  label $w.r.fsm.lsm -text "平均平滑化のサンプル数" -width 25 -anchor w
  entry $w.r.fsm.esm -textvariable power(smLength) -wi 6
  label $w.r.fsm.lsmu -text "(sample)" -anchor w -wi 6
  pack $w.r.fsm.lsm $w.r.fsm.esm $w.r.fsm.lsmu -side left

  ;# 窓の選択
  pack [frame $w.r.fwn]
  label $w.r.fwn.lwn -text "窓の種類" -width 25 -anchor w
  tk_optionMenu $w.r.fwn.mwn power(window) \
    Hamming Hanning Bartlett Blackman Rectangle
  pack $w.r.fwn.lwn $w.r.fwn.mwn -side left

    ;# OK, Apply, キャンセルボタン
    pack [frame $w.r.f] -anchor e -pady 5 -padx 5 -side bottom
    pack [button $w.r.f.okB -text OK -wi 6 -command { \
      set power(pwchanged) 1
      Redraw
      destroy .dim}] -side right
    pack [button $w.r.f.appB -text Apply -wi 6 -command Redraw] -side right
    pack [button $w.r.f.exitB -text Cancel -command { \
      array set power [array get power_bk] ;# パラメータを以前の状態に戻す
      array set v     [array get v_bk]     ;# パラメータを以前の状態に戻す
      Reset
      DrawSect
      Redraw
      destroy .dim}] -side right
    update

    ;# 波形やスペクトルなどを左端に描画する
    if {$v(linkfile) && $f(sndfile) != ""} {
      .dim.ll.c create waveform 0 0 -sound snd -height $v(waveh) -width 200 \
        -pixels $v(pps) -tags [list wave both] -start $start -end $end \
        -channel $v(vchan) -fill $v(wavcolor) -frame yes -debug 0 \
        -shapefile [file rootname [file tail $f(spath)$f(sndfile)]].shape
      .dim.ll.c create rectangle 0 0 200 $v(waveh) -tags [list fg both] -outline $v(fg)
      .dim.ll.c raise fg wave
    } else {
      .dim.ll.c create waveform 0 0 -sound snd -height $v(waveh) -width 200 \
        -pixels $v(pps) -tags [list wave both] -start $start -end $end \
        -channel $v(vchan) -fill $v(wavcolor) -frame yes -debug 0
      .dim.ll.c create rectangle 0 0 200 $v(waveh) -tags [list fg both] -outline $v(fg)
      .dim.ll.c raise fg wave
    }
    if {$v(spegh) > 0} {
      .dim.ll.c create spectrogram 0 $v(waveh) -sound snd -fftlen $v(fftlen)\
        -height $v(spegh) -width 200 -pixels $v(pps) \
        -preemph $v(preemph) -topfr $v(topfr) \
        -start $start -end $end -tags [list speg both] \
        -contrast $v(contrast) \
        -brightness $v(brightness) -gridtspacing $v(gridtspacing) \
        -gridfspacing $v(gridfspacing) -channel $v(vchan) \
        -colormap $v($v(cmap)) -gridcol $v(gridcolor)
    }
    if {$v(powerh) > 0 && $power(N) > 0} {
      set pwStart [expr int($start / double($v(rate)) / $power(frameLength))]
      set pwEnd   [expr int($end   / double($v(rate)) / $power(frameLength))]
      set margin 2
      set ppd [expr ($v(powerh) - $margin * 2) / ($power(pwMax) - $power(pwMin))]
      set pB [expr $v(waveh) + $v(spegh) + $v(powerh)]
      set pwN  [expr $pwEnd - $pwStart]
      set xpp  [expr 200 / $pwN]
      set tmp2 [expr $pB - $margin]
      for {set i 0} {$i <= $pwN} {incr i} {
        set pwX [expr int($xpp * $i)]
        set pwY [expr int($tmp2 - ($powerDat([expr $i + $pwStart]) - $power(pwMin)) * $ppd)]
        if {$i == 0} {
          set pwXold $pwX
          set pwYold $pwY
        }
        .dim.ll.c create line $pwXold $pwYold $pwX $pwY -tags {pw both} -fill $v(powcolor)
        set pwXold $pwX
        set pwYold $pwY
      }
    }
    
    ;#↓色設定窓を閉じた時にこの窓が本体窓の後ろに来ることがあったので無効にした
    ;# grab set $w ;# フォーカスをこの窓のみにする
}

;# 色の選択
proc changeColor {initcolor} {
  return [tk_chooseColor -initialcolor $initcolor -title "色の選択"]
}

proc Plugins {} {
    global v

    set w .plugins
    catch {destroy $w}
    toplevel $w
    wm title $w {Plug-ins}

    pack [ label $w.lPlugins -text "Installed plug-ins:"]
    pack [ frame $w.f] -fill both -expand true
    pack [ scrollbar $w.f.scroll -command "$w.f.list yview"] -side right -fill y
    listbox $w.f.list -yscroll "$w.f.scroll set" -setgrid 1 -height 6 -width 50
    pack $w.f.list -side left -expand true -fill both
    foreach e $v(pluginfiles) {
	$w.f.list insert end $e
    }

    pack [ label $w.lDesc -text Description:]
    pack [ frame $w.f2] -fill x
    pack [ text $w.f2.text -height 4 -wrap word] -fill x -expand true

    pack [ frame $w.f3]
    pack [ button $w.f3.b1 -text Load... -command "PluginsAdd $w"] -side left
    pack [ button $w.f3.b2 -text Unload -command "PluginsRemove $w"] -side left
    pack [ button $w.f3.b3 -text Close -command [list destroy $w]] -side left

    bind $w.f.list <ButtonRelease-1> {.plugins.f2.text delete 0.0 end;.plugins.f2.text insert end [namespace inscope [lindex $v(plugins) [.plugins.f.list curselection]] Describe]}
}

proc PluginsAdd {w} {
    global v

    set types {
	{{xs Plug-in Files} {.plg}}
	{{Tcl Files} {.tcl}}
	{{All Files}    *  }
    }
    set file [tk_getOpenFile -title "Select plug-in" -filetypes $types]
    if {$file == ""} return
    if {[source $file] == "fail"} return
    $w.f.list insert end $file
    set v(pluginfiles) [$w.f.list get 0 end]
}

proc PluginsRemove {w} {
    global v

    set i [$w.f.list curselection]
    namespace inscope [lindex $v(plugins) $i] Unload
    set v(plugins) [lreplace $v(plugins) $i $i]
    catch {$w.f.list delete $i}
    set v(pluginfiles) [$w.f.list get 0 end]
    $w.f2.text delete 0.0 end
}

# 右クリックするとポップアップするメニュー
menu .popmenu -tearoff false
proc PopUpMenu {X Y x y} {
  global v

  .popmenu delete 0 end

  # 波形上で右クリックした場合
  if {$y < [expr $v(waveh) + $v(spegh) + $v(powerh) + $v(timeh)]} {
    .popmenu add command -label "指定範囲を再生" -command [list PlayBetweenMarks]
    .popmenu add command -label "スペクトル表示/非表示の切替" -command {
      if $v(showspeg) {
        set v(showspeg) 0
      } else {
        set v(showspeg) 1
      }
      ToggleSpeg
    }
    .popmenu add command -label "パワー表示/非表示の切替" -command {
      if $v(showpower) {
        set v(showpower) 0
      } else {
        set v(showpower) 1
      }
      TogglePower
    }
    # .popmenu add command -label "全体を再生" -command [list PlayAll]
    # .popmenu add command -label "再生を中止" -command [list StopPlay]
  } else {
  # ラベル上で右クリックした場合
    .popmenu add command -label "ラベル間を再生" -command [list PlayLabel $x $y]
    .popmenu add command -label "ラベルを削除" -command [list DeleteLabel $x $y]
    .popmenu add command -label "ラベル名の列を挿入" -command [list AssignLabelSeq $x $y]
    # .popmenu add command -label "Mark Label" -command [list MarkLabel $x $y]
  }
#  .popmenu add command -label "Save Range" -command SaveMark
#  .popmenu add command -label "Mark Start" -command "PutMarker m1 $x 0 1;SendPutMarker m1 $x"
#  .popmenu add command -label "Mark End" -command "PutMarker m2 $x 0 1;SendPutMarker m2 $x"
#  .popmenu add command -label "Zoom" -command OpenZoomWindow
#  if {$y > [expr $v(waveh) + $v(spegh) + $v(powerh) + $v(timeh)]} {
#	.popmenu add command -label "Insert Label" -command [list InsertLabel $x $y]
#	.popmenu add command -label "Align Label" -command [list AlignLabel $x $y]
# 	.popmenu add command -label "Get Right Label" -command [list GetRightLabel $x $y]
#    }
    catch {tk_popup .popmenu $X $Y 0}
}

proc SaveSettings {} {
    global v f s

    if [catch {open [file join ~ .xsrc] w} out] {
	SetMsg $out
    } else {
	puts $out "set v(s_version) $v(p_version)"
	puts $out "set v(waveh) $v(waveh)"
	puts $out "set v(spegh) $v(spegh)"
	puts $out "set v(powerh) $v(powerh)"
#	puts $out "set v(scrw) $v(scrw)"
	puts $out "set v(pps) $v(pps)"
	puts $out "set v(fftlen) $v(fftlen)"
	puts $out "set v(winlen) $v(winlen)"
	puts $out "set v(anabw) $v(anabw)"
	puts $out "set v(preemph) $v(preemph)"
	puts $out "set v(ipa) $v(ipa)"
	puts $out "set v(autoload) $v(autoload)"
	puts $out "set v(ch) $v(ch)"
	puts $out "set v(slink) $v(slink)"
	puts $out "set v(mlink) $v(mlink)"
	puts $out "set v(pluginfiles) {$v(pluginfiles)}"
#	puts $out "set v(browser) \{$v(browser)\}"
	puts $out "set v(rate) $v(rate)"
	puts $out "set v(sfmt) $v(sfmt)"
	puts $out "set v(chan) $v(chan)"
#	puts $out "set v(offset) $v(offset)"
#	puts $out "set v(zerolabs) $v(zerolabs)"
	puts $out "set v(ipafmt) $v(ipafmt)"
	puts $out "set v(labalign) $v(labalign)"
	puts $out "set v(fg) $v(fg)"
	puts $out "set v(bg) $v(bg)"
	puts $out "set v(wavcolor) $v(wavcolor)"
	puts $out "set v(fillmark) $v(fillmark)"
	puts $out "set v(font) \{$v(font)\}"
	puts $out "set v(sfont) \{$v(sfont)\}"
	puts $out "set v(gridfspacing) $v(gridfspacing)"
	puts $out "set v(gridtspacing) $v(gridtspacing)"
	puts $out "set v(gridcolor) $v(gridcolor)"
	puts $out "set v(remote) \{$v(remote)\}"
	puts $out "set v(ashost) \{$v(ashost)\}"
	puts $out "set v(asport) \{$v(asport)\}"
	puts $out "set v(recording) \{$v(recording)\}"
	puts $out "set v(cmap) \{$v(cmap)\}"
	puts $out "set v(showspeg) \{$v(showspeg)\}"
	puts $out "set v(showpower) \{$v(showpower)\}"
	puts $out "set v(linkfile) \{$v(linkfile)\}"

	puts $out "set f(skip)  $f(skip)"
	puts $out "set f(ipath) $f(ipath)"
	puts $out "set f(ihttp) $f(ihttp)"

	puts $out "set s(fftlen)  $s(fftlen)"
	puts $out "set s(anabw)   $s(anabw)"
	puts $out "set s(wintype) $s(wintype)"
	puts $out "set s(ref)     $s(ref)"
	puts $out "set s(range)   $s(range)"
	puts $out "set s(atype)   $s(atype)"
	puts $out "set s(lpcorder) $s(lpcorder)"
      
	close $out
    }
}

proc SetCursor {flag} {
    foreach widget [winfo children .] {
	$widget config -cursor $flag
    }
    update idletasks
}

# Put custom procedures between the lines below
# Custom procs start here
# Custom procs end here

foreach plug [split $v(pluginfiles)] {
    source $plug
}

DrawCrossHairs
# ToggleRecording
Link2File

if {$tcl_platform(platform) == "windows"} {
    update idletasks
    Redraw
}

proc GetStdin {} {
    global v pipevar

    append pipevar [read -nonewline stdin]
    if [eof stdin] { 
	fileevent stdin readable ""
	if {$pipevar != ""} {
	    snd data $pipevar
	    set v(rate) [snd cget -rate]
	    set v(sfmt) [snd cget -encoding]
	    set v(chan) [snd cget -channels]
	    wm geometry . {}
	    Redraw
	    event generate .cf.fc.c <Configure>
	    MarkAll
	    PlayAll
	}
    }
}

if {$argv == "-"} {
    fconfigure stdin -translation binary -blocking 0
    if {$tcl_version > 8.0} {
      fconfigure stdin -encoding binary
    }
    fileevent stdin readable GetStdin
} elseif [llength $argv] {
    if {[llength $argv] > 1} { set v(autoload) 0 }
    foreach fn $argv {
      OpenFiles [file normalize $fn]
    }
} else {
    #if [string compare macintosh $::tcl_platform(platform)] {
    #  GetOpenFileName
    #}
}

#---------------------------------------------------
# D&Dされたものを処理する
#
proc procDnd {objList} {
  global v t

  if {$v(smpchanged) || $v(labchanged)} {
    if {[DisposalConfirmation]} return
  }

  set wavReadAlready 0   ;# wavをD&Dしたなら1にして複数回実行を監視
  set labReadAlready 0   ;# labをD&Dしたなら1にして複数回実行を監視
  foreach obj $objList {
    set fn [file normalize $obj]
    switch [file extension $fn] {
	    .wav {
        if {$wavReadAlready == 0} {
	        OpenFiles $fn
          set wavReadAlready 1
        }
      }
	    .lab {  
        if {$labReadAlready == 0} {
	        OpenFiles $fn
          set labReadAlready 1
        }
      }
    }
  }
}

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

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

  toplevel $prgWindow
  wm title $prgWindow $title
  wm attributes $prgWindow -toolwindow 1
  wm attributes $prgWindow -topmost 1
  wm resizable $prgWindow 0 0
  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(pregress) 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
}

set prgWindow .progress
set v(progress) 0

