#!/opt/local/bin/tclsh
# The above line calls up the tcl shell.  If tclsh has a different
# path on the system that you're using, edit this line.  You can
# find out the path by typing "which tclsh".
# 
# script xlabel2TextGrid.tcl
# 
# Syntax:  
#    xlabel2TextGrid.tcl tonesfile(s)
#
# Arguments:
#    tonesfile(s)  the pathname(s) to the xlabel tones file(s) 
#
# Results:
#    reads in xlabels from the tones file(s) and associated
#    breaks, foot, syll, and misc files, to create TextGrid
#    file(s) for a C-ToBI transcription

##################################################################
#
# proc subtr_time  
#     This is the procedure that builds the parts of the TextGrid
#     file for the different tiers
#
# Arguments:
#    infile      pathname to the input label file name
#    outfile     the output TextGrid file name
#    tierType    the type of the tier, whether interval or point
#    endtime     the ending time for the wav file
#
# Results:
#    the contents of infile are copied to outfile, except that
#    all of the lines with labels have the start time subtracted
#    from the original label time.
#
# This next line defines the procedure name and arguments.  The 
# following ? some lines (up to the start of the script proper) is 
# the body of the procedure.
proc build_tier {infile outfile tierType endtime} {
    # Open a channel to the input label file, and set the variable
    # "labFile" to that channel.
    set labFile [open $infile "r"]
    # Read in the data from the file into the "labels" variable.
    set labels [read $labFile]
    # Split the "labels" variable into a list of lines in the 
    # "linelist" variable.
    set linelist [split $labels "\n"]
    # Clean up by closing input label file.
    close $labFile

    # Find the line with the hash mark that demarcates the 
    # beginning of the labels proper
    set hashmark [lsearch $linelist "\#"]
    # Delete the lines up until there
    set linelist [lreplace $linelist 0 $hashmark]

    # Check to see what type of tier this is and proceed accordingly
    if {[string match "TextTier"} {
        # If it is a TextTier, the number of points equals the 
        # number of labels, which is the same as the length of
        # the labels list minus 1 (for the last line being blank)
        set nPoints [expr [llength $linelist] - 1]
        # Now write out the header information for the tier
           #   that it is a tier of type "TextTier"
        puts $tgFile {"TextTier"}
           #   that the tier name is the infile variable extension
        set tierName [exec basename $infile
        puts $tgFile $tierName
           #   that it starts at 0 and ends at $endtime
        puts $tgFile 0
        puts $tgFile $endtime
           #   that it has nlabels points in it
        puts $tgFile $nPoints

        # Loop through the labels in the list
        for {set pos 0} {$pos < $nPoint} {incr pos} {
        # Get and write out the time for the point
            set line [lindex $linelist $pos]
	    regexp {([0-9]+\.[0-9]+)} $line labtime
	    puts $tgFile $labtime
        # Get the label part of the line and write it out
            regsub {( )+([0-9]+\.[0-9]+)( )+[0-9]+( )+} $line "" labText
            puts $tgFile "\"$labText\""
	}

     if {[string match "Interval"} {
        # If it is an Interval tier, the number of intervals equals 
        # number of labels, which is the same as the length of
        # the labels list minus 1 (for the last line being blank)
        # but we have to invent a beginning time for the first one
        set nIntervals [expr [llength $linelist] - 1]
        # Now write out the header information for the tier
           #   that it is a tier of type "Interval"
        puts $tgFile {"Interval"}
           #   that the tier name is the infile variable extension
        set tierName [exec basename $infile]
        puts $tgFile $tierName
           #   that it starts at 0 and ends at $endtime
        puts $tgFile 0
        puts $tgFile $endtime
           #   that it has nlabels intervals in it
        puts $tgFile $nIntervals

        # Generate start time for the first interval and write it out
        set line [lindex $linelist 0]
        regexp {([0-9]+\.[0-9]+)} $line labtime
        set labtime1 [expr $labtime / 2]
        puts $tgFile $labtime1
        puts $tgFile $labtime
        regsub {( )+([0-9]+\.[0-9]+)( )+[0-9]+( )+} $line "" labText
        puts $tgFile "\"$labText\""
        # Loop through the rest of the labels in the list
        for {set pos 1} {$pos < $nPoint} {incr pos} {
        # Write out the last interval ending time as this interval's
        # beginning time
            puts $tgFile $labtime
        # Get and write out the time for the ending time
            set line [lindex $linelist $pos]
	    regexp {([0-9]+\.[0-9]+)} $line labtime
	    puts $tgFile $labtime
        # Get the label part of the line and write it out
            regsub {( )+([0-9]+\.[0-9]+)( )+[0-9]+( )+} $line "" labText
            puts $tgFile "\"$labText\""
	}
}



#######  The main body of the script starts here  ######
#
# First check to see whether there fewer than the required number 
# of arguments (need at least one), and if there are too few,
# use the error command to print an error message to the screen 
# exit the script.  
if {$argc < 1} {
    error "too few arguments"
# " need at least one tones file name"
}

# Loop through the tones file names that are specified as 
# the arguments
for {set i 0} {$i < $argc} {incr i} {
    # Read the next tones file name from the arguments list, 
    # and set the variable "file" to the result.
    set tonespath [lindex $argv $i]

    # Check to see if that file exists, and if it doesn't
    # exit the program.  (Note: later on, we can make this
    # less brittle, so that it goes to the next file instead
    # of exiting, but for now this will do.)
    if {![file isfile $tonespath]} {
        error "$tonespath doesn't exist"
    }

    # Create path name for the breaks file
    regsub {\.tones} $tonespath ".breaks" breakspath
    # Check to see if that file exists, and if it doesn't
    # exit the program.  
    if {![file isfile $breakspath]} {
        error "$breakspath doesn't exist"
    }

    # Do the same for the foot file
    regsub {\.tones} $tonespath ".foot" footpath
    if {![file isfile $footpath]} {
        error "$footpath doesn't exist"
    }

    # Do the same for the syll file
    regsub {\.tones} $tonespath ".syll" syllpath
    if {![file isfile $syllpath]} {
        error "$syllpath doesn't exist"
    }

    # Do the same for the misc file
    regsub {\.tones} $tonespath ".misc" miscpath
    if {![file isfile $miscpath]} {
        error "$miscpath doesn't exist"
    }

    # Do the same for the wav file
    regsub {\.tones} $tonespath ".wav" miscpath
    if {![file isfile $wavpath]} {
        error "$wavpath doesn't exist"
    }

    # Send a call to praat to get the ending time of the 
    # wav file (note that this requires the get_end.praat file
    # to be in your bin directory.  If it is not, put it there.
    regexp {([0-9\.]+)} [exec praat ~/get_end.praat $wavpath] end

    # Open a channel to the TextGrid file
    set tgFile [open $textgridpath "w+"]

    # Write out the header information at the top of the file
    #  that this is a short format TextFile
    puts $tgFile {File type = "ooTextFile short"} 
    #  that it is of a TextGrid object
    puts $tgFile {"TextGrid"}
    puts $tgFile "\n"
    #  that the xmin time is 0
    puts $tgFile 0
    #  that the xmax time is $end
    puts $tgFile $end
    #  that tiers exist in the file
    puts $tgFile {<exists>}
    #  that there are six tiers in the file
    puts $tgFile "6"

    # Call the procedure build_tier for the tones tier
    build_tier $tonespath $tgFile "TextTier" $end
    # Do the same for the breaks tier
    build_tier $breakspath $tgFile "TextTier" $end
    # and for the foot tier
    build_tier $footpath $tgFile "Interval" $end
    # and for the syll tier
    build_tier $syllpath $tgFile "Interval" $end

    # Take care of the words tier, which will be empty for now
    puts $tgFile {"Interval"}
    puts $tgFile {"words"}
    puts $tgFile 0
    puts $tgFile $end
    puts $tgFile 0
    # Call the procedure build_tier for the misc tier
    build_tier $miscpath $tgFile "Interval" $end
}