Tryag File Manager
Home
-
Turbo Force
Current Path :
/
home
/
cluster1
/
data
/
bu01
/
1121861
/
html
/
poser
/
Foley programs and data
/
spd24_nahuatl_dat_am
/
Upload File :
New :
File
Dir
/home/cluster1/data/bu01/1121861/html/poser/Foley programs and data/spd24_nahuatl_dat_am/matchAm.perl
#!/usr/bin/perl # test.perl # to practice making windows with Tk use Tk; $espsDir = "/pkg/esps/bin"; $usage = "matchAm.perl file_prefix"; $prefix = $ARGV[0]; $wavDir = "/pkg/ldc/talkbank/nahuatl/DAT/am/wav"; $wavFile = "$wavDir/Am_$prefix.wav"; $logFile = "/pkg/ldc/talkbank/nahuatl/DAT/am/$prefix.list"; $fixIncr = 0.2; $smallButtonFont = "8"; if ( ($ARGV[0] =~ /\./) || (@ARGV != 1) ) { die $usage; } &initFile; &initWordWindow; MainLoop; sub initFile { open (INF, $logFile) or die "can't open $logFile"; while (<INF>) { chomp; @s = split; @t = split(/\t/); $bgn = $s[0]; $end = $s[1]; $id = $t[1]; $word = $t[2]; $dur = $t[3]; $type = $t[4]; $code = $t[5]; if (@t < 6) { if (/ORIG/) { push (@{$tokens{"$id $word"}}, "$bgn\t$end\t$dur\t$type\ttoss"); } else { push (@{$tokens{"$id $word"}}, "$bgn\t$end\t$dur\t$type\tkeep"); } } else { push (@{$tokens{"$id $word"}}, "$bgn\t$end\t$dur\t$type\t$code"); } } close INF; @wordIds = sort keys %tokens; } sub initWordWindow { # window initialization my $wordWindow = MainWindow->new; $wordWindow->title( "Ameyaltepec annotation" ); my $idListFrame = $wordWindow->Frame()->pack(-side => 'left', -anchor => 'w', -ipadx => 110); my $buttonFrame = $wordWindow->Frame()->pack(-side => 'left', -anchor => 'w'); my $tokenFrame = $wordWindow->Frame()->pack(-side => 'bottom', -anchor => 'w'); my $timeButtonFrame = $wordWindow->Frame()->pack(-side => 'top', -anchor => 'w'); $idListFrame->Label(-text => "Word ID List")->pack(-side => 'top', -anchor => 'n' ); $idList = $idListFrame->Scrolled("Listbox", -scrollbars => "e", -selectmode => "single", -exportselection => 0, )->pack( -fill => 'x'); $idList->insert('end', @wordIds); &setWordIdRow; $idList->selectionSet($wordIdRow); $idList->see($wordIdRow); ($wordIdRef) = $idList->get($wordIdRow); $buttonFrame->Button(-text => "keep", -command => [ \&setCode, "KEEP" ] )->pack(-side => 'top', -anchor => 'c', -fill => 'x'); $buttonFrame->Button(-text => "toss", -command => [ \&setCode, "TOSS" ] )->pack(-side => 'top', -anchor => 'c', -fill => 'x'); $buttonFrame->Button(-text => "link", -command => [ \&setCode, "LINK" ] )->pack(-side => 'top', -anchor => 'c', -fill => 'x'); $buttonFrame->Button(-text => "maybe", -command => [ \&setCode, "ALT" ] )->pack(-side => 'top', -anchor => 'c', -fill => 'x'); $buttonFrame->Button(-text => "quit", -command => sub { exit; } )->pack(-side => 'top', -anchor => 'c', -fill => 'x'); $idList->bind( '<ButtonRelease-1>', \&showTokens ); $idList->bind( '<Enter>', $idList->selectionSet($wordIdRow)); $tokenLabel = $timeButtonFrame->Label(-text => "Available tokens" )->pack(-side => 'top', -ipadx => 75, -fill => 'x',); $timeButtonFrame->Button(-text => " + ", -font => $smallButtonFont, -command => [ \&setTime, "beg", $fixIncr ] )->pack(-side => 'left', -anchor => 'w', -fill => 'y'); $timeButtonFrame->Button(-text => " - ", -font => $smallButtonFont, -command => [ \&setTime, "beg", 0 - $fixIncr ] )->pack(-side => 'left', -anchor => 'w', -fill => 'y'); $timeButtonFrame->Button(-text => " + ", -font => $smallButtonFont, -command => [ \&setTime, "end", $fixIncr ] )->pack(-side => 'left', -anchor => 'w', -fill => 'y'); $timeButtonFrame->Button(-text => " - ", -font => $smallButtonFont, -command => [ \&setTime, "end", 0 - $fixIncr ] )->pack(-side => 'left', -anchor => 'w', -fill => 'y'); $timeButtonFrame->Button(-text => "COPY $copyBuffer", -command => \©Token, )->pack(-side => 'left', -anchor => 'w', -fill => 'y'); $timeButtonFrame->Button(-text => "PASTE", -command => \&pasteToken, )->pack(-side => 'left', -anchor => 'w', -fill => 'y'); $tokenList = $tokenFrame->Scrolled("Listbox", -scrollbars => "oe", -exportselection => 0, -selectmode => "single", )->pack(-side => 'top', -ipadx => 75, -fill => 'x',); $tokenList->bind('<ButtonRelease-1>', [ \&touchToken ]); $tokenList->bind('<ButtonRelease-2>', [ sub{&noSound}, Ev('x'), Ev('y') ]); $tokenList->bind('<ButtonRelease-3>', [ sub{&setCode("LINK"); $idList->selectionClear($wordIdRow); $lastId = $idList->index("end"); unless ($wordIdRow == $lastId) { $wordIdRow += 1; } $idList->selectionSet($wordIdRow); $idList->see($wordIdRow); &showTokens; } ]); &updateTokenWindow; } sub showTokens { # event bound to <ButtonRelease-1> for the word ID list. # calls &updateTokenWindow to draw the appropriate list. ($wordIdRow) = $idList->curselection; ($wordIdRef) = $idList->get($wordIdRow); &updateTokenWindow; } sub fixToken { } sub writeFile { # records the contents of the hash in the logFile. # called from &setCode and &setTime #print STDERR "writing word file.\n"; open (OUTF, ">$logFile"); foreach $entry ( sort keys %tokens ) { my @samples = @{$tokens{$entry}}; ($writeId, $writeWord) = split(/\s/, $entry, 2); my $letterCount = 97; foreach $sample (@samples) { ($writeStart, $writeStop, $writeDur, $writeType, $writeCode) = split(/\s+/, $sample); printf OUTF "%9.3f%9.3f\t$writeId\t%-28s\t%9.2f\t$writeType\t$writeCode\n", $writeStart, $writeStop, $writeWord, $writeDur; } } close OUTF; } sub updateTokenWindow { # refreshes the display in the token list. @records = @{$tokens{$wordIdRef}}; @tokenDisplay = (); foreach (@records) { ($bgn, $end, $dur, $type, $code) = split(/\t/); push( @tokenDisplay, sprintf( "%9.3f %9.3f %5.2f $type $code", $bgn, $end, $dur ));C } $word = ( $copyBuffer > 1) ? "words" : "word"; $bufInfo = ( $copyBuffer ) ? "\n$copyBuffer $word to paste" : ""; $tokenList->delete(0, 'end'); $tokenList->insert(0, @tokenDisplay); $tokenLabel->configure(-text => "\n$wordIdRef$bufInfo"); } sub touchToken { # subroutine bound to <ButtonRelease-1> for the token list. # plays the token unless it was the last token played. $tokenRow = $tokenList->curselection; my $entry = $tokenList->get($tokenRow); $entry =~ s/^\s+//; ($start, $stop) = split (/\s+/, $entry ); ## if ($lastStop == $stop) { &setCode("KEEP") } unless (($lastStop == $stop) || ($stop - $start > 30) || ($noPlay)) { system "$espsDir/s16play -s $start -e $stop $wavFile"; } $lastStop = $stop; $noPlay = 0; } sub noSound { # highlites a token without playing the sound # or plays the token that is currently highlited. # bound to a button-2 click. my ($list, $x, $y) = @_; $newTokenRow = $tokenList->index("@ $x,$y"); $tokenList->selectionClear($tokenRow); $tokenRow = $newTokenRow; $tokenList->selectionSet($tokenRow); my $entry = $tokenList->get($tokenRow); $entry =~ s/^\s+//; ($start, $stop) = split (/\s+/, $entry ); unless (($lastStop != $stop) || ($stop - $start > 30)) { system "$espsDir/s16play -s $start -e $stop $wavFile"; } $lastStop = $stop; } sub copyToken { # adds the highlited token to a clipboard. # because sometimes words are stored under # the wrong entry. $copyBuffer++; $clipBoard[$copyBuffer] = $tokenList->get($tokenRow); print STDERR "copying $clipBoard[$copyBuffer].\n"; &setCode("TOSS"); &writeFile; &updateTokenWindow; } sub pasteToken { # pastes a selected token into the current $tokenList # and pops the clipboard. if ($copyBuffer) { (my $nul, $bgn, my $end, my $dur, my $type, my $code) = split(/\s+/,$clipBoard[$copyBuffer]); print "$bgn#$end#$dur#$type#$code\n"; push (@{$tokens{"$wordIdRef"}}, "$bgn\t$end\t$dur\t$type\t$code"); print STDERR "pasting $out.\nfrom $clipBoard[$copyBuffer]\n#$writeStart, $writeStop, $writeDur\n"; $copyBuffer--; pop @clipBoard; &writeFile; &updateTokenWindow; } } sub setCode { # replaces the line-final tag with the value $codeArg my($codeArg) = @_; my $entry = $tokenList->get($tokenRow); $entry =~ s/^\s+//; my @incoming = split(/\s+/, $entry); $incoming[$#incoming] = $codeArg; ${$tokens{$wordIdRef}}[$tokenRow] = join( "\t", @incoming ); &writeFile; &updateTokenWindow; } sub setTime { # adjusts the highlited time stamp. # usage: &setTime({beg|end}, value} my $pos; my $switch; my ($whichSide, $value) = @_; my $entry = $tokenList->get($tokenRow); if ($whichSide =~ /beg/) {$pos = 0; $switch = -1;} elsif ($whichSide =~ /end/) {$pos = 1; $switch = 1;} else {die "invalid value $whichSide for \$whichSide (must be \"beg\" or \"end\"!"} $entry =~ s/^\s+//; my @incoming = split(/\s+/, $entry); $incoming[$pos] += $value; # modifies the time stamp $incoming[2] += ($switch * $value); # modifies the duration field ${$tokens{$wordIdRef}}[$tokenRow] = join( "\t", @incoming ); &writeFile; &updateTokenWindow; } sub setWordIdRow { # finds the last LINK tag (if any exist) and sets $wordIdRow # with the corresponding position in the list. my $count = 0; $wordIdRow = 0; foreach $wordId (@wordIds) { @records = @{$tokens{$wordId}}; foreach $record (@records) { if ($record =~ /LINK/) { $wordIdRow = $count; } } $count++; } }