#! /usr/bin/perl
#
if(grep(/^(\-h|\-\-help)$/, @ARGV))
{
print << "ENDOFHELPTEXT";
Combine the CGN text-grids to a "master" textgrid
and add IDcodes for DBMS. 

Use:
./CombineCGNLabelFiles.pl ... [--root=<dir>] 2> error.txt

Options:

--root=<dir>
  CGN annotation text root directory. 
  Default is "../data/annot/text"

-l
--license
  License text
  
-h
--help
  This help text

Processing:
Files are read from "\$IFADVrootDir/<type>".
The output TextGrids are placed in "\$IFADVrootDir/dbl/"
the filename will be extended with a list
of the types included in that .dbl file

<CHANGED>
E.g., [ort, awd, plk] -> *.ort.awd.plk.dbl

Eg
./CombineCGNLabelFiles.pl ort awd 2> error.txt

Possible types:
ort fon awd plk
Individual tiers get the type of origin attached, if needed.
</CHANGED>

DBMS item ID codes:
Every item in the text-grids is given a unique ID code.
The codes are hierarchically organized. For example, a certain
phoneme, the last consonant, 'r', from 'voor',
has ID code: DVB3F29F1GG4SC1

This is build up like:
<DV><A/B><recording no><speaker><repeat><chunk><word><syllable><part><phoneme>

In the example: DV-B-3-F29F-1-GG-4-S-C-1
DVB:      Dialog Video Camera/Subject B
3:        Recording 3
F29F:     Female, 29yo, ID code F 
1:        First participation of this subject
GG:       Chunk YH,starting with 'A',..,'Z','AA',...
4:        Word number 4
S:        First syllable (counting: S, T, U, ....)
C:        Coda position, can be Onset, Kernel, or Coda
1:        Position of the phoneme in the syllable part
          Ie, the first phoneme of the coda
Note that there are no sub-part separators. The ID codes are build
from <alpha><digit> sequences. Insertions are entered with the
old item sub-code, a hyphen '-', and a new counter code (eg, 'AO-A',
a single chunk added after chunk 'AO', or '6-1', a new word entered
after word '6'). Note that a silent pauze counts as an item. Ranges
are indicated by combining the first and last item with a '+'. Eg,
words 2 to 4 are indicated with:  'DVB3F29F1GG2+4'.

The corresponding codes for the syllable, word and chunk are obtained
by removing the rightmost parts. So this phoneme is found in syllable
DVB3F29F1GG4S of word DVB3F29F1GG4 from chunk DVB3F29F1GG.

These ID codes are unique for each recorded segment. So, the ID codes
of the corresponding items in awd, POS, and lem are ALL the same. 
This allows all the DBMS tables to be easily linked.

ENDOFHELPTEXT
exit;
};
if(grep(/\-?\-l(icense)?/, @ARGV))
{
print << "ENDOFLICENSETEXT";
###############################################################################
#
# Copyright R.J.J.H. van Son © 2007
#
# Author Rob van Son
# Institute of Phonetic Sciences & ACLC
# University of Amsterdam
# Herengracht 338
# NL-1016CG Amsterdam, The Netherlands
# Email: R.J.J.H.vanSon\@uva.nl
# WWW  : http://www.fon.hum.uva.nl/rob/
# mail:  Institute of Phonetic Sciences
#        University of Amsterdam
#        Spuistraat 210-212
#        NL-1012VT Amsterdam
#        The Netherlands
#        tel +31 205252196
#        fax +31 205252197
#
# License for use and disclaimers
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
#
#
#######################################################
ENDOFLICENSETEXT
exit;
};
#
require "SentenceLabel.pl";
require "CGN_phonemes.pl";

my $CGNrootDir = "../";
if(grep(/\-\-root\=/, @ARGV))
{
    my ($Option) = grep(/\-\-root\=/i, @ARGV);
    $Option =~ s/\-\-root\=//isg;
    $CGNrootDir = $Option;
    @ARGV = grep(!/\-\-root\=/i, @ARGV);
};

$CGNrootDir .= "/" unless $CGNrootDir =~ m!/$!;

foreach my $Recording (@ARGV)
{
    # Get ORT and AWD files
    my @OrtFiles = glob("${CGNrootDir}ort/$Recording*.TierName");
    my @AwdFiles = glob("${CGNrootDir}awd/$Recording*.TierName");
    my $OutFile = "${CGNrootDir}dbl/$Recording.ort.awd.dbl";

next unless @OrtFiles && @AwdFiles;
next if -s $OutFile;

    my $OrtAwdLabel = new SentenceLabel;
    # This gives off a warning if the file is corrupt!
    $OrtAwdLabel->ReadLabelFile($OrtFiles[-1]);
    # Ort label
    my @NewOrtTierList = @{$OrtAwdLabel->{TIERORDER}};
    foreach my $Tier (@NewOrtTierList)
    {
        my $newTierName = $Tier =~ /dialoogcode / ? "${'}fctraw" : "${Tier}ort";
        
        # Create the new tier
        $OrtAwdLabel->copyTier($newTierName, $Tier);
        $OrtAwdLabel->removeTier($Tier);
        
        # Change the name in the @NewOrtTierList
        $Tier = $newTierName;

        # Clean up items: Merge empty items
        $OrtAwdLabel->presetItem ($newTierName);
        while($OrtAwdLabel->nextItem ($newTierName) > -1)
        {
            # Make sane intervals
            if($OrtAwdLabel->nextStart($newTierName) > 0 &&
                abs($OrtAwdLabel->currentEnd($newTierName) - $OrtAwdLabel->nextStart($newTierName))
                > 2* $Resolution)
            {
                $OrtAwdLabel->currentEnd($newTierName, $OrtAwdLabel->nextStart($newTierName));
            };

            # Always look back
            if($OrtAwdLabel->currentItem ($newTierName) > 0 &&
                  $OrtAwdLabel->currentValue ($newTierName) =~ /^(sil|sp|\s*)$/i
                && $OrtAwdLabel->readPreviousValue ($newTierName) =~ /^(sil|sp|\s*)$/)
            {
                $OrtAwdLabel->previousItem ($newTierName);
                $OrtAwdLabel->removeItem ($newTierName);
                
            };
            if($OrtAwdLabel->currentValue ($newTierName) =~ /^(sil|sp|\s*)$/i)
            {
                $OrtAwdLabel->currentValue ($newTierName, "sil");
            };
            
        };
        # Add ID codes
        my $FixedID = $newTierName;
        $FixedID =~ s/[a-z]+\s*$//g;
        my $counter = A;
        $OrtAwdLabel->presetItem ($newTierName);
        while($OrtAwdLabel->nextItem ($newTierName) > -1)
        {
            $OrtAwdLabel->currentIDcode($newTierName, "$FixedID$counter");
            if($OrtAwdLabel->currentValue ($newTierName) =~ /^\s*(sil|sp|\s*)$/i)
            {
                $OrtAwdLabel->currentValue ($newTierName, "sil");
            };

            # Next chunk
            ++$counter;
        };
    };    

    
    # This gives off a warning if the file is corrupt!
    $OrtAwdLabel->ReadLabelFile($AwdFiles[-1]);

    # Awd label
    my @NewAwdTierList = @{$OrtAwdLabel->{TIERORDER}};
    my $Resolution = 0.001;

    foreach my $Tier (@NewAwdTierList)
    {
        # Skip Ort tiers
        next if grep(/^$Tier$/, @NewOrtTierList);
        
        # Create a new Tier name
        my $newTierName = $Tier;
        $newTierName .= "awd" unless($Tier =~ /\-$/);
        $newTierName =~ s/\-\-/seg/g;
        $newTierName =~ s/\-/fon/g;
                        
        # Create the new tier
        $OrtAwdLabel->copyTier($newTierName, $Tier);
        $OrtAwdLabel->removeTier($Tier);
        
        # Change the name in the @NewOrtTierList
        $Tier = $newTierName;
        
        # Clean up items: Merge empty items
        $OrtAwdLabel->presetItem ($Tier);
        while($OrtAwdLabel->nextItem ($Tier) > -1)
        {
            # Make sane intervals
            if($OrtAwdLabel->nextStart($Tier) > 0 &&
                abs($OrtAwdLabel->currentEnd($Tier) - $OrtAwdLabel->nextStart($Tier))
                > 2* $Resolution)
            {
                $OrtAwdLabel->currentEnd($Tier, $OrtAwdLabel->nextStart($Tier));
            };

            # Always look back
            if($OrtAwdLabel->currentItem ($Tier) > 0 &&
                  $OrtAwdLabel->currentValue ($Tier) =~ /^(sil|sp|\s*)$/i
                && $OrtAwdLabel->readPreviousValue ($Tier) =~ /^(sil|sp|\s*)$/)
            {
                $OrtAwdLabel->previousItem ($Tier);
                $OrtAwdLabel->removeItem ($Tier);
                
            };
            if($OrtAwdLabel->currentValue ($Tier) =~ /^(sil|sp|\s*)$/i)
            {
                $OrtAwdLabel->currentValue ($Tier, "sil");
            };
            
        };
        
        # Add ID codes
        my $ortTierName = "${Tier}ort";
        # Segments have words as their parents
        $ortTierName =~ s/segort$/fon/g;
        # Words have the ort chunks as their parents
        $ortTierName =~ s/(awd|fon)ort$/ort/g;
        my $StartCount = $ortTierName=~ /ort$/ ? 0 : "S0";
        $OrtAwdLabel->firstItem ($ortTierName);
        $OrtAwdLabel->firstItem ($Tier);

        # For each word
        while($OrtAwdLabel->currentItem ($Tier) > -1)
        {
            my $wordstart = $OrtAwdLabel->currentStart($Tier);
            my $wordend = $OrtAwdLabel->currentEnd($Tier);
            
            my $PrevID = $OrtAwdLabel->readPreviousIDcode($Tier);
            # DVA3M64E1OP4 -> (DV A 3 M 64 E 1 OP)(4)
            $PrevID =~ /^(DV[AB]\d+[MFC]+\d+[A-Z]+\d+[A-Z]+)(\d+)(S?\d*)/i;
            my $PrevPrefix = $1;
            my $PrevCount = $2;
            if($3)
            {
                $PrevPrefix .= $PrevCount;
                $PrevCount = $3;
            };
            
            # Position Ort chunks to END after the start of the word
            while($OrtAwdLabel->currentItem ($ortTierName) > -1 &&
                  ($OrtAwdLabel->currentEnd($ortTierName) < $wordstart - $Resolution))
            {
                $OrtAwdLabel->nextItem ($ortTierName);
            };
            
            # Curious case, if current word ends after the NEXT chunk
            while($OrtAwdLabel->nextEnd($ortTierName) > 0
                  && $wordend > $OrtAwdLabel->nextEnd($ortTierName) - $Resolution)
            {
                last if $OrtAwdLabel->nextItem ($ortTierName) < 0;
            };

            # Is most of the word inside the ort chunk?
            my $chunkstart = $OrtAwdLabel->currentStart($ortTierName);
            my $chunkend = $OrtAwdLabel->currentEnd($ortTierName);
            my $RelStart = $wordstart - $chunkstart;
            my $RelEnd = $chunkend - $wordend;
            
            # Determin ID codes
            my $OrtPrefix = $OrtAwdLabel->currentIDcode($ortTierName);
            my $PreviousOrtPrefix = $OrtAwdLabel->readPreviousIDcode($ortTierName);

            my $CurrentPrefix = $PrevPrefix;
            my $CurrentCount = $PrevCount;
            # All of it is inside
            if($RelStart + $Resolution >= 0 && $RelEnd + $Resolution >= 0)
            {
                if($PrevPrefix ne $OrtPrefix)
                {
                    $CurrentPrefix = $OrtPrefix;
                    $CurrentCount = $StartCount;                    
                };
                ++$CurrentCount;
            }
            # Complete overlap
            elsif($RelStart < $Resolution && $RelEnd < $Resolution)
            {
                if($PrevPrefix ne $OrtPrefix)
                {
                    $CurrentPrefix = $OrtPrefix;
                    $CurrentCount = $StartCount;                    
                };
                ++$CurrentCount;
            }
            # Overlap on start of chunk: First word
            elsif($RelStart < $Resolution)
            {
                # Most of the word inside the new chunk
                my $CurrentChunkValue = $OrtAwdLabel->currentValue ($ortTierName);
                my $CurrentWordValue = $OrtAwdLabel->currentValue ($Tier);
                
                # Chunk and word are silence
                if($CurrentChunkValue =~ /^\s*(sil)?\s*$/ && $CurrentWordValue =~ /^\s*(sil)?\s*$/)
                {
                    $CurrentPrefix = $OrtPrefix;
                    $CurrentCount = $StartCount;                    
                    ++$CurrentCount;
                }
                # Most of the word in new chunk
                elsif($chunkstart - $wordstart < $wordend - $chunkstart
                   || ($CurrentChunkValue =~ 
                        /^\s*$CurrentWordValue/))
                {
                    $CurrentPrefix = $OrtPrefix;
                    $CurrentCount = $StartCount;                    
                    ++$CurrentCount;
                }
                # Less than half of the word, use previous chunk
                else
                {
                    ++$CurrentCount;
                };
            }
            # Overlap on end of chunk: Last word
            elsif($RelEnd < $Resolution)
            {
                # Most of the word inside previous chunk
                my $CurrentChunkValue = $OrtAwdLabel->currentValue ($ortTierName);
                my $CurrentWordValue = $OrtAwdLabel->currentValue ($Tier);
                
                # Chunk and word are silence
                if($CurrentChunkValue =~ /^\s*(sil)?\s*$/ && $CurrentWordValue =~ /^\s*(sil)?\s*$/)
                {
                    $CurrentPrefix = $OrtPrefix;
                    $CurrentCount = $StartCount;                    
                    ++$CurrentCount;
                }
                # But check the content
                elsif($wordend - $chunkend < $chunkend - $wordstart
                   || ($CurrentChunkValue =~ /${CurrentWordValue}[\.\?\!\s]*$/))
                {
                    if($PrevPrefix ne $OrtPrefix)
                    {
                        $CurrentPrefix = $OrtPrefix;
                        $CurrentCount = $StartCount;                    
                    };
                    ++$CurrentCount;
                }
                # Less than half of the word
                else # You should be in the next chunk
                {
                    if($OrtAwdLabel->nextItem ($ortTierName) < 0)
                    {
                        print STDERR "$ortTierName, ERROR: Incorrect chunk position\n";
                    };
                    $PrevPrefix = $OrtPrefix;
                    $OrtPrefix = $OrtAwdLabel->currentIDcode($ortTierName);
                    $CurrentPrefix = $OrtPrefix;
                    $CurrentCount = $StartCount;
                    ++$CurrentCount;
                };
            }
            # How to get here?
            else
            {
                    print STDERR "ERROR: NO ID\n";
                    
                    $CurrentPrefix = "--A";
                    $CurrentCount = $StartCount;                    
            };
            $OrtAwdLabel->currentIDcode($Tier, "$CurrentPrefix$CurrentCount");

            $OrtAwdLabel->nextItem ($Tier);
        };
        
        
        
    };
    
    # Correct the FCTRAW tier to include all missing chunks
    my $currentOrtTier;
    foreach my $Tier (@NewAwdTierList)
    {
        # Skip other tiers
        next if $Tier !~ /fctraw$/;
	
	    # Get tier name
	    $currentOrtTier = $Tier;
	    $currentOrtTier =~ s/fctraw$/ort/g;

	    # Copy the ort tier into a fct tier,
	    # and then replace and normalize the values
	    if($OrtAwdLabel->existsTier($currentOrtTier))
	    {
            my $newFctTier = $Tier;
            $newFctTier =~ s/fctraw$/fct/g;
		    $OrtAwdLabel->copyTier($newFctTier, $currentOrtTier);
            push(@NewAwdTierList, $newFctTier);
            
		    my $BeyondItems = 0;
		    $OrtAwdLabel->firstItem ($Tier);
		    $OrtAwdLabel->presetItem ($newFctTier);
            while($OrtAwdLabel->nextItem ($newFctTier) > -1)
            {
                # The new fct tier
		my $newValue = $OrtAwdLabel->currentValue ($newFctTier);
		my $newStart = $OrtAwdLabel->currentStart ($newFctTier);
		my $newEnd = $OrtAwdLabel->currentEnd ($newFctTier);
		my $newID = $OrtAwdLabel->currentIDcode ($newFctTier);

                # The raw fct tier
		my $rawValue = $OrtAwdLabel->currentValue ($Tier);
                #$rawValue = "NULL" if $rawValue =~ /^\s*(sil|ggg|xxx)\s*$/;
                $rawValue = "NULL" if $rawValue =~ /^\s*(sil|xxx)\.?\s*$/i;
		my $rawStart = $OrtAwdLabel->currentStart ($Tier);
		my $rawEnd = $OrtAwdLabel->currentEnd ($Tier);
		my $rawID = $OrtAwdLabel->currentIDcode ($Tier);
		
                # Not in correct chunk: Search for chunk
                while($rawStart < $newEnd && $rawEnd < $newStart 
                      && !$BeyondItems)
                {
			        $BeyondItems = ($OrtAwdLabel->nextItem ($Tier) > -1) 
				        ? 0 : 1;
			        $rawValue = $OrtAwdLabel->currentValue ($Tier);
                    $rawValue = "NULL" if $rawValue =~ /^\s*(sil|ggg|xxx)\s*$/;
			        $rawStart = $OrtAwdLabel->currentStart ($Tier);
			        $rawEnd = $OrtAwdLabel->currentEnd ($Tier);
			        $rawID = $OrtAwdLabel->currentIDcode ($Tier);
                };
                last if $BeyondItems;
                
                # Non-verbal ignored
			    if($newValue =~ /^\s*(sil|ggg|xxx)\s*$/)
			    {
				    $newValue = $OrtAwdLabel->currentValue ($newFctTier, "NULL");
			    }
                elsif(abs($rawStart - $newStart) < 0.005 
                        && abs($rawEnd - $newEnd) < 0.005)
                {
                    # All ok, next
                    $newValue = $OrtAwdLabel->currentValue ($newFctTier, $rawValue);
                }
                elsif($newStart < $rawStart && $newEnd > $rawEnd 
                      && !$BeyondItems)
                {
                    # All ok, next
                    $newValue = $OrtAwdLabel->currentValue ($newFctTier, $rawValue);
                }
                elsif($newStart > $rawStart && $newEnd < $rawEnd 
                      && !$BeyondItems)
                {
                    # All ok, next
                    $newValue = $OrtAwdLabel->currentValue ($newFctTier, $rawValue);
                }
                elsif($newStart < $rawStart && $newEnd > $rawStart 
                      && !$BeyondItems)
                {
                    # Overlap, Ok? next
                    if($newEnd - $rawStart > $rawStart - $newStart)
                    {
                        $newValue = $OrtAwdLabel->currentValue ($newFctTier, $rawValue);
                    }
                    else
                    {
                        $newValue = $OrtAwdLabel->currentValue ($newFctTier, "UNLABELED");  
                    };  
                }
                elsif($newStart < $rawEnd && $newEnd > $rawEnd 
                      && !$BeyondItems)
                {
                    # Overlap, Ok? next
                    if($rawEnd - $newStart > $newEnd - $rawEnd)
                    {
                        $newValue = $OrtAwdLabel->currentValue ($newFctTier, $rawValue);
                    }
                    else
                    {
                        $newValue = $OrtAwdLabel->currentValue ($newFctTier, "UNLABELED");  
                    };  
                }
                else
                {
                    # Try to find a better fit
                    # Not in correct chunk: Search for chunk
                    while($rawStart < $newEnd && !$BeyondItems)
                    {
			            $BeyondItems = ($OrtAwdLabel->nextItem ($Tier) > -1) 
				        ? 0 : 1;
			            $rawValue = $OrtAwdLabel->currentValue ($Tier);
                        $rawValue = "NULL" if $rawValue =~ /^\s*(sil|ggg|xxx)\s*$/;
			            $rawStart = $OrtAwdLabel->currentStart ($Tier);
			            $rawEnd = $OrtAwdLabel->currentEnd ($Tier);
			            $rawID = $OrtAwdLabel->currentIDcode ($Tier);
                        
                        if($rawStart < $newEnd && !$BeyondItems)
                        {
                            $newValue = $OrtAwdLabel->currentValue ($newFctTier, $rawValue);
                            last;
                        };
                    };
                    if($rawStart < $newEnd && !$BeyondItems)
                    {
                        $newValue = $OrtAwdLabel->currentValue ($newFctTier, $rawValue);
                    }
                    else
                    {
                        $newValue = $OrtAwdLabel->currentValue ($newFctTier, "UNLABELED");  
                    };
                };
		    };
        };
    };
    @NewAwdTierList = grep(!/fctraw/, @NewAwdTierList);
    
    # Update seg item ID codes
    foreach my $Tier (@NewAwdTierList)
    {
        # Skip non-segment tiers
        next if $Tier !~ /seg$/;
        
        $OrtAwdLabel->presetItem ($Tier);
        my $SyllableState = "sil";
        my $SyllableCounter = "S";
        my $SegmentCounter = 1;
        while($OrtAwdLabel->nextItem ($Tier) > -1)
        {
            my $PreviousValue = $OrtAwdLabel->readPreviousValue($Tier);
            my $CurrentValue = $OrtAwdLabel->currentValue($Tier);
            my $NextValue = $OrtAwdLabel->readNextValue($Tier);
            
            # Skip silence
            if($CurrentValue =~ /^\s*(sil)?\s*$/)
            {
                my $CurrentIDcode = $OrtAwdLabel->currentIDcode($Tier);
                $CurrentIDcode =~ s/S\d*$/SK1/g;
                $OrtAwdLabel->currentIDcode($Tier, $CurrentIDcode);
                            
                next;
            };
            
            my $PreviousIDcode = $OrtAwdLabel->readPreviousIDcode($Tier);
            my $CurrentIDcode = $OrtAwdLabel->currentIDcode($Tier);
            my $NextIDcode = $OrtAwdLabel->readNextIDcode($Tier);
            my $PreviousWordcode = $PreviousIDcode;
            my $CurrentWordcode = $CurrentIDcode;
            my $NextWordcode = $NextIDcode;
            $PreviousWordcode =~ s/[CKOS-Z]+\d+$//g;
            $CurrentWordcode =~ s/[CKOS-Z]+\d+$//g;
            $NextWordcode =~ s/[CKOS-Z]+\d+$//g;
            
            # New word
            if($PreviousWordcode ne $CurrentWordcode)
            {
                if($CurrentValue =~ /^\s*(sil)?\s*$/)
                {   $SyllableState = "K";}
                elsif(isVowel($CurrentValue))
                {   $SyllableState = "K";}
                else
                {   $SyllableState = "O";
                };
                $SyllableCounter = "S";
                $SegmentCounter = 1;
            }
            # Silence, just in case
            elsif($CurrentValue =~ /^\s*(sil)?\s*$/)
            {
                $SyllableState = "K";
                $SyllableCounter = "S";
                $SegmentCounter = 1;
            }
            # Syllable kernel
            elsif(isVowel($CurrentValue))
            {
                # New syllable
                ++$SyllableCounter if $SyllableState =~ /(K|C)/;
                $SyllableState = "K";
                $SegmentCounter = 1;
            }
            # Coda or (new) onset
            else
            {
                # Handle the 'st' and 'tst' word end problems
                if($SyllableState =~ /(K|C)/)
                {
                    # New syllable and new onset
                    # Harmonicity reversed
                    # The current phoneme has a higher harmonicity
                    # Next phoneme in same word has higher harmonicity
                    # Note that most problems occur due to /t/ and /s/
                    if($NextWordcode eq $CurrentWordcode &&
                            sameOffset($CurrentValue, $NextValue))
                    {
                        ++$SegmentCounter;
                        $SegmentCounter = 1 if $SyllableState =~ /[K]/;
                        $SyllableState = "C";
                    }
                    elsif($NextWordcode eq $CurrentWordcode &&
                            sameOnset($CurrentValue, $NextValue))
                    {
                        $SyllableState = "O";
                        $SegmentCounter = 1;
                        ++$SyllableCounter;
                        # st correction, always that one!
                        if($PreviousValue eq "s" && $CurrentValue eq "t")
                        {
                            $OrtAwdLabel->previousItem($Tier);
                            my $currentID = $OrtAwdLabel->currentIDcode($Tier);
                            if($currentID =~ /([S-Z]+)C(\d+)$/)
                            {
                                my $IDprefix = $`;
                                my $currentSyllableCount = $SyllableCounter;
                                my $currentSyllableState = $SyllableState;
                                my $currentSegmentCount = $SegmentCounter;
                                $currentID = "$IDprefix${currentSyllableCount}$currentSyllableState$currentSegmentCount";
                                $OrtAwdLabel->currentIDcode($Tier, $currentID);
                                ++$SegmentCounter;
                            };
                            $OrtAwdLabel->nextItem($Tier);
                        };
                    }
                    # Start coda
                    elsif($SyllableState =~ /(K)/)
                    {
                        $SyllableState = "C";
                        $SegmentCounter = 1;
                    }
                    # Just extend the coda
                    else
                    {
                        ++$SegmentCounter;
                    };
                }
                elsif($NextWordcode ne $CurrentWordcode && $SyllableState == "O")
                {
                    # You should'nt be in the Onset state, change previous phonemes
                    if($OrtAwdLabel->currentValue($Tier) =~ /[st]/)
                    {
                        $SyllableCounter = chr(ord($SyllableCounter)-1) 
                                unless $SyllableCounter =~ /S$/;

                        # Remember position
                        $OrtAwdLabel->storeItem($Tier);
                        while($OrtAwdLabel->readPreviousIDcode($Tier) =~ /[S-Z]O\d+$/
                                && $OrtAwdLabel->currentIDcode($Tier) =~ /^$CurrentWordcode/)
                        {
                            last if $OrtAwdLabel->previousItem($Tier) < 0;
                            my $currentID = $OrtAwdLabel->currentIDcode($Tier);
                            $currentID =~ /([S-Z]+)O(\d+)$/;
                            my $IDprefix = $`;
                            my $currentSyllableCount = $1;
                            $currentSyllableCount = chr(ord($currentSyllableCount)-1)
                                    unless $currentSyllableCount =~ /S$/;
                            my $currentSegmentCount = $2;
                            $currentID = "$IDprefix${currentSyllableCount}C$currentSegmentCount";
                            $OrtAwdLabel->currentIDcode($Tier, $currentID);
                        };
                        # Go back
                        $OrtAwdLabel->restoreItem($Tier);
                    }
                    ++$SegmentCounter;
                    $SyllableState = "C";
                }
                # Just onset
                else
                {
                    ++$SegmentCounter;
                };
            };
            
            $OrtAwdLabel->currentIDcode($Tier, 
                            "$CurrentWordcode$SyllableCounter$SyllableState$SegmentCounter");
        };
    };
        
    # Create ackawd tiers
    foreach my $Tier (@NewOrtTierList)
    {
        next unless $Tier =~ /ort$/;
        my $Subject = $Tier;
        $Subject =~ s/ort$//g;
        
        my $ackTier = $Tier;
        $ackTier =~ s/ort$/ackawd/g;
        
        my $awdTier = $Tier;
        $awdTier =~ s/ort$/awd/g;
        
        
        # Create the new tier
        $OrtAwdLabel->copyTier($ackTier, $Tier);
        push(@NewAwdTierList, $ackTier);
        
        # Step through tiers
        $OrtAwdLabel->presetItem($ackTier);
        $OrtAwdLabel->firstItem($awdTier);
        while($OrtAwdLabel->nextItem($ackTier) > -1)
        {
            my $currentAckStart = $OrtAwdLabel->currentStart($ackTier);
            my $currentAckEnd = $OrtAwdLabel->currentEnd($ackTier);
            my $currentAckID = $OrtAwdLabel->currentIDcode($ackTier);
            # Step to the start of the chunk
            while($OrtAwdLabel->currentEnd($awdTier) < $currentAckStart)
            {
                last if $OrtAwdLabel->nextItem($awdTier) < 0;
            };
            # Step to the last word in the chunk
            while($OrtAwdLabel->readNextIDcode($awdTier) =~ /^${currentAckID}\d+/)
            {
                last if $OrtAwdLabel->nextItem($awdTier) < 0;
            };
            
            # Overstepped, go back
            unless($OrtAwdLabel->currentIDcode($awdTier) =~ /^${currentAckID}\d+/
                && $OrtAwdLabel->readNextIDcode($awdTier) !~ /^${currentAckID}\d+/)
            {
                if($OrtAwdLabel->readNextIDcode($awdTier) =~ /^${currentAckID}\d+/)
                {
                    last if $OrtAwdLabel->nextItem($awdTier) < 0;
                };
                if($OrtAwdLabel->currentIDcode($awdTier) !~ /^${currentAckID}\d+/
                    && $OrtAwdLabel->readPreviousIDcode($awdTier) =~ /^${currentAckID}\d+/)
                {
                    last if $OrtAwdLabel->previousItem($awdTier) < 0;
                    
                };
            };
            
            # Double check the IDs, and then align the end of the chunk
            if($OrtAwdLabel->currentIDcode($awdTier) =~ /^${currentAckID}\d+/
                && $OrtAwdLabel->readNextIDcode($awdTier) !~ /^${currentAckID}\d+/)
            {
                my $newEnd = $OrtAwdLabel->currentEnd($awdTier);
                # Do not overstep the next item
                $newEnd = $OrtAwdLabel->nextEnd($ackTier)
                    if($newEnd > $OrtAwdLabel->nextEnd($ackTier)
                        && $OrtAwdLabel->nextEnd($ackTier) > 0);
                $OrtAwdLabel->currentEnd($ackTier, $newEnd);
                last if $OrtAwdLabel->nextItem($ackTier) < 0;
                $OrtAwdLabel->currentStart($ackTier, $newEnd);
                last if $OrtAwdLabel->previousItem($ackTier) <0;
                
                # If the last word is a silence, break the chunk
                if($OrtAwdLabel->currentStart($ackTier) < 
                    $OrtAwdLabel->currentStart($awdTier) &&
                    $OrtAwdLabel->currentValue($awdTier) =~ /^\s*(sil)?\s*$/i)
                {
                    $OrtAwdLabel->splitTier($ackTier, 2);
                    $OrtAwdLabel->currentEnd($ackTier, $OrtAwdLabel->currentStart($awdTier));
                    last if $OrtAwdLabel->nextItem($ackTier) < 0;
                    $OrtAwdLabel->currentStart($ackTier, $OrtAwdLabel->currentStart($awdTier));
                    
                    # Update value of new chunk item
                    $OrtAwdLabel->currentValue($ackTier, $OrtAwdLabel->currentValue($awdTier));
                    # Udate ID of new chunk item
                    my $currentID = $OrtAwdLabel->currentIDcode($ackTier)."-A";
                    $OrtAwdLabel->currentIDcode($ackTier, ${currentID});
                    $OrtAwdLabel->currentIDcode($awdTier, "${currentID}1");
                    # The other tiers
                    $OrtAwdLabel->currentItem("${Subject}fon", $OrtAwdLabel->currentItem($awdTier));
                    $OrtAwdLabel->currentIDcode("${Subject}fon", $OrtAwdLabel->currentIDcode($awdTier));
                    # Segments are more difficult
                    my $segItem = $OrtAwdLabel->EndAlignedinTier($awdTier, "${Subject}seg");
                    $OrtAwdLabel->currentItem("${Subject}seg", $segItem);
                    if($OrtAwdLabel->currentValue("${Subject}seg") =~ /^\s*(sil)?\s*$/i)
                    {
                        $OrtAwdLabel->currentIDcode("${Subject}seg", 
                                ($OrtAwdLabel->currentIDcode($awdTier))."SK1");
                    };
                };
            }
            elsif($OrtAwdLabel->nextEnd($ackTier) > 0)
            {
                print STDERR "${currentAckID}: $currentAckStart - $currentAckEnd Incorrect word ID\n";
            };
            
        };
        
    };
    
    # Write resulting file
    $OrtAwdLabel->FoldedIDcodes(@NewAwdTierList);
    $OrtAwdLabel->print("$OutFile", reverse(@NewAwdTierList));

};

