Transcode_Wiki: Ssa2srt

I wrote these two scripts because editing .ssa files in a text editor sucks:

 #!/usr/bin/tclsh
 #
 # Convert .ssa file to a .srt file
 #
 # See the note in the code about special handling when
 # the .srt file will NOT be re-merged.
 #
 set basename [ lindex $argv 0 ]
 set fid [ open $basename.ssa r ]
 set ssa [ read $fid [ file size $basename.ssa ] ]
 set ssa [ split $ssa "\n" ]
 close $fid
 set srt [ open $basename.srt w ]
 set i 1
 #
 foreach line $ssa {
   if {  [ regexp {^Dialogue:\s+Marked} $line ] } {
      set line [ split $line , ]
      set t1 [ join [ split [ lindex $line 1 ] . ] , ]0
      set t2 [ join [ split [ lindex $line 2 ] . ] , ]0
      set txt [ join [ lrange $line 9 end ] , ]
      #
      ## ***************OPTIONAL STEPS***************************
      # Uncomment the next 2 lines if you will NOT be re-merging
      # the .srt file changes back into the .ssa file.
      #regsub -all {\\N} $txt { } txt
      #regexp -nocase {^\{.+\}([^\s\n\t].+)} $txt -> txt
      #
      # If you want to preserve linebreaks, use these instead:
      # (note that this will still prevent re-merging back to ssa)
      #regsub -all {\\N} $txt "\n" txt
      #regexp -nocase {^\{.+\}([^\s\n\t].+)} $txt -> txt
      ## *******************************************************
      #
      puts $srt $i
      puts $srt "$t1 --> $t2"
      puts $srt "$txt\n"
      incr i
   }
 }

 #!/usr/bin/tclsh
 #
 # Merge the text from the .srt file back into the
 # .ssa file.
 #
 set basename [ lindex $argv 0 ]
 set fid [ open $basename.srt r ]
 set srt [ read $fid [ file size $basename.srt ] ]
 set srt [ split $srt "\n" ]
 set srt [ lrange $srt 1 end ]
 close $fid
 set fid [ open $basename.ssa r ]
 set ssa [ read $fid [ file size $basename.ssa ] ]
 set ssa [ split $ssa "\n" ]
 close $fid
 set merged [ open $basename.merged.ssa w ]
 #
 proc getnextsrt { args } {
     if { [ llength $::srt ] < 1 } { exit }
     set newtext [ list ]
     if { [ regexp {^\s*$} [ lindex $::srt 0 ] ] } {
        set ::srt [ lrange $::srt 1 end ]
        if { [ regexp {^\d+$} [ lindex $::srt 0 ] ] } {
           set ::srt [ lrange $::srt 1 end ]
        }
     } elseif { [ regexp {\d\s+-->\s+\d} [ lindex $::srt 0 ] ] } {
        set ::srt [ lrange $::srt 1 end ]
     } else {
        set newtext [ lindex $::srt 0 ]
        set ::srt [ lrange $::srt 1 end ]
     }
     return $newtext
 }
 #
 foreach line $ssa {
   set newtext [ list ]
   if { ! [ regexp {^(Dialogue.+0000\,\,).+} $line -> meat ] } {
      puts $merged $line
   } else {
      while { ! [ string length $newtext ] } {
         set newtext [ getnextsrt ]
      }
      puts $merged "$meat$newtext"
   }
 }