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

#koko, 同じ音高が連続、かつ、後続音が母音で先行母音と同じにならないようにするとか。
#koko, 先行発声が、先行音の固定範囲に達する音は避けるとか。
#koko, エンベロープのp3を小さくできるとか。

#---------------------------------------------------
# 大域変数
#---------------------------------------------------

if {[info exists ::starkit::topdir]} {
  set topdir [file dirname [info nameofexecutable]]
} else {
  set topdir [file dirname $argv0]
}

set v(appname) scat
set v(version) 0.1
set v(delParam) 1       ;# 1=入力された先行発声値とオーバーラップ値を削除して出力する
set v(repetition) 1     ;# 0=同じ音が連続しないようにする
set v(flagN) 0          ;# FormantFilterをOFFにする確率
set v(flagG) 0          ;# 1=gフラグをランダムに変更する
set v(gMin) 0           ;# gフラグの最小値
set v(gMax) 0           ;# gフラグの最大値
set v(candidateChar) "だ,ば,ぱ,ら"
set v(rangeL) 0         ;# プラグインで処理開始する行（[#PREV]の次の[]）
set v(rangeR) 0         ;# プラグインで処理終了する行の次の行（[#NEXT]の位置）

if {$argc > 0} {
  set inFile  [lindex $argv 0]
  set outFile $inFile
} else {
  tk_messageBox -message "usage: $argv0 inUstfile" \
    -title error -icon warning
  exit
}

array unset ustData     ;# 元のustデータを入れる

#---------------------------------------------------
# サブルーチン
#---------------------------------------------------

#--------------------------------------
# ustからデータを読む
#
proc readUst {inFile} {
  global ustData v

  set v(N) 0
  if [catch {open $inFile r} in] {
    tk_messageBox -message "$inFileを読み込めません" \
      -title error -icon warning
    return 1
  }
  array unset ustData
  set ustDataSeq 0
  while {![eof $in]} {
    set l [gets $in]
    set ustData($ustDataSeq) $l
    incr ustDataSeq
  }
  set v(N) [array size ustData]
  return 0
}

#--------------------------------------
# [#PREV]の次の位置、[#NEXT]の前の位置を得る
#
proc getRangeLR {} {
  global ustData v

  set v(rangeL) 0
  set v(rangeR) 0

  # rangeLを求める
  set i 0
  while {$i < $v(N)} {
    if [regexp {^\[#[0-9]+\]} $ustData($i)] {
      set v(rangeL) $i
      break
    }
    incr i
  }
  # rangeRを求める
  while {$i < $v(N)} {
    if [regexp {^\[#NEXT\]} $ustData($i)] {
      set v(rangeR) $i
      break
    }
    incr i
  }
  return 0
}


#--------------------------------------
# 各音符のLyricをランダムな文字に書き換える
#
proc changeLyric {} {
  global ustData v

  set newLyric ""
  set oldLyric ""
  for {set i [expr $v(rangeL) +1]} {$i < $v(rangeR)} {incr i} {
    if [regexp {^Lyric=} $ustData($i)] {
      set l [split $ustData($i) "="]
      if {[lindex $l 1] != "R"} {
        set newLyric [lindex $v(lyricList) [expr int(rand() * $v(lyricListN))]]
        while {$v(repetition) == 0 && $newLyric == $oldLyric && $v(lyricListN) > 1} {
          set newLyric [lindex $v(lyricList) [expr int(rand() * $v(lyricListN))]]
        }
        set ustData($i) "Lyric=$newLyric"
        set oldLyric $newLyric
      }
    }
  }
  return 0
}

#--------------------------------------
# 各音高にランダムに文字を割り当ててLyricを置き換える
#
proc changeLyric2 {} {
  global ustData v

  # 各音高に文字を割り当てる（なお、UTAUのNoteNumの範囲は24から107）
  array unset wariate
  for {set i 0} {$i < 128} {incr i} {
    set wariate($i) [lindex $v(lyricList) [expr int(rand() * $v(lyricListN))]]
  }

  # 各音符の音高(NoteNum)を得る
  array unset noteNum
  set seq 0
  for {set i [expr $v(rangeL) +1]} {$i < $v(rangeR)} {incr i} {
    if [regexp {^NoteNum=} $ustData($i)] {
      set l [split $ustData($i) "="]
      set noteNum($seq) [lindex $l 1]
      incr seq
    }
  }

  # 各音符のLyricを対応する文字に書き換える
  set seq 0
  for {set i [expr $v(rangeL) +1]} {$i < $v(rangeR)} {incr i} {
    if [regexp {^Lyric=} $ustData($i)] {
      set l [split $ustData($i) "="]
      if {[lindex $l 1] != "R"} {
        set newLyric $wariate($noteNum($seq))
        set ustData($i) "Lyric=$newLyric"
        set oldLyric $newLyric
      }
      incr seq
    }
  }
  return 0
}

#--------------------------------------
# 各音符のgフラグをランダムに入れ替える
#
proc changeFlagG {} {
  global ustData v

  if {$v(flagG) == 0} {return 0}

  set changed 0
  set i [expr $v(rangeL) +1]
  while {$i < $v(rangeR)} {
    # g値を求める
    set gnew [expr int(rand() * ($v(gMax) - $v(gMin)) + $v(gMin))]

    if [regexp {^\[#[0-9]+\]} $ustData($i)] {
      # もし一つ前の音符にFlagsの指定がなかったなら
      if {$changed == 0} {
        # Flagsのエントリを挿入する
        for {set j [expr $v(N) - 1]} {$j >= $i} {incr j -1} {
          set k [expr $j + 1]
          set ustData($k) $ustData($j)
        }
        set ustData($i) "Flags=g$gnew"
        incr v(N)
        incr v(rangeR)
        incr i
      }
      set changed 0

    } elseif [regexp {^Flags=} $ustData($i)] {
      regsub {g(\+|\-|)[0-9]+} $ustData($i) "" ustData($i)   ;# gフラグを消す
      set ustData($i) "$ustData($i)g$gnew"
      set changed 1
    }
    incr i
  }
  return 0
}

#--------------------------------------
# 各音符のN FlagのON/OFFをランダムに入れ替える
#
proc changeFlagN {} {
  global ustData v

  if {$v(flagN) <= 0} {return 0}

  set changed 0
  set i [expr $v(rangeL) +1]
  while {$i < $v(rangeR)} {
    # formant filterのON/OFFを決める値を求める
    set flagN [expr rand() * 100]

    if [regexp {^\[#[0-9]+\]} $ustData($i)] {
      # もし一つ前の音符にFlagsの指定がなかったなら
      if {$changed == 0} {
        # formant filterを無効にするか
        if {$flagN < $v(flagN)} {
          # Flagsのエントリを挿入する
          for {set j [expr $v(N) - 1]} {$j >= $i} {incr j -1} {
            set k [expr $j + 1]
            set ustData($k) $ustData($j)
          }
          set ustData($i) "Flags=N"
          incr v(N)
          incr v(rangeR)
          incr i
        }
      }
      set changed 0

    } elseif [regexp {^Flags=} $ustData($i)] {
      regsub {N} $ustData($i) "" ustData($i)   ;# Nフラグを消す
      # formant filterを無効にするか
      if {$flagN < $v(flagN)} {
        set ustData($i) "$ustData($i)N"
      }
      set changed 1
    }
    incr i
  }
  return 0
}

#--------------------------------------
# 発話テキストをファイルに書き込む。正常終了なら0を返す。
#
proc writeUst {outFile} {
  global ustData v

  if [catch {open $outFile w} out] {
    tk_messageBox -message "$outFileに書き込めません" \
      -title error -icon warning
    return 1
  }
  for {set i 0} {$i < $v(N)} {incr i} {
    if {$v(delParam) != 0 && [regexp {^(PreUtterance|VoiceOverlap)=} $ustData($i)]} {
    } else {
      puts $out $ustData($i)
    }
  }
  close $out
  return 0
}

#--------------------------------------
# 実行
#
proc doChange {mode} {
  global inFile outFile v

  if [readUst $inFile]   exit
  if [getRangeLR]        exit

  set v(lyricList)  [split $v(candidateChar) ","]
  set v(lyricListN) [llength $v(lyricList)]

  switch $mode {
    1 { if [changeLyric]  exit }
    2 { if [changeLyric2] exit }
  }

  if [changeFlagN] exit
  if [changeFlagG] exit
  if [writeUst $outFile] exit
  exit
}

#---------------------------------------------------
# widget
#---------------------------------------------------

labelframe .fs -relief groove -padx 5 -pady 5 -labelanchor n -text "設定"
label .fs.lCC -text "使用する文字(カンマ刻みで指定)"
entry .fs.eCC -textvar v(candidateChar) -width 60
checkbutton .fs.cDelParam -text "元の先行発声とオーバーラップを削除する" -variable v(delParam)
checkbutton .fs.cRepetition -text "同じ音が連続してもよい(実行その１向けの設定項目)" -variable v(repetition)
#label .fs.lNF -text "(現状では無効)formant filterをランダムにOFFにする確率(0-100。0なら変更せず)"
#entry .fs.eNF -textvar v(flagN)
checkbutton .fs.cFlagG -text "gフラグをランダムに変更する" -variable v(flagG)
label .fs.lGMin -text "gフラグの最小値"
entry .fs.eGMin -textvar v(gMin)
label .fs.lGMax -text "gフラグの最大値"
entry .fs.eGMax -textvar v(gMax)
grid .fs.lCC -row 0 -column 0 -sticky e -pady 5
grid .fs.eCC -row 0 -column 1 -columnspan 3 -sticky ew -pady 5
grid .fs.cDelParam   -row 1 -column 0 -columnspan 4 -sticky w -pady 5
grid .fs.cRepetition -row 2 -column 0 -columnspan 4 -sticky w -pady 5
grid .fs.cFlagG -row 3 -column 0 -columnspan 4 -sticky w -pady 5
grid .fs.lGMin  -row 4 -column 0 -sticky e -pady 5
grid .fs.eGMin  -row 4 -column 1 -sticky ew -pady 5
grid .fs.lGMax  -row 4 -column 2 -sticky e -pady 5
grid .fs.eGMax  -row 4 -column 3 -sticky ew -pady 5

labelframe .fb -relief groove -padx 5 -pady 5 -labelanchor n -text "実行"
button .fb.bDoChange  -text "実行１（各音符に文字候補をランダムに代入）" -command {doChange 1}
button .fb.bDoChange2 -text "実行２（各音高に文字候補をランダムに割り当てる）" -command {doChange 2}
button .fb.bCancel    -text "キャンセル" -command exit
pack .fb.bDoChange .fb.bDoChange2 .fb.bCancel -side left

grid .fs -row 0 -column 0 -sticky ew -pady 5 -padx 3
grid .fb -row 1 -column 0 -sticky ew -pady 5 -padx 3

wm title . "$v(appname) $v(version)"
