#!/usr/bin/perl
#
# Programmer:    Craig Stuart Sapp <craig@ccrma.stanford.edu>
# Creation Date: Thu Oct 20 19:36:52 PDT 2005
# Last Modified: Thu Oct 20 19:36:55 PDT 2005
# Filename:      /project/mazurka/website/info/revcond/bin/makemainindex
# Syntax:        perl 5
#
# Description:
#
# Usage:         makemainindex discographyfile titlefile

use strict;

my $discofile = $ARGV[0];
my $titlefile = $ARGV[1];
my $indexdir = $ARGV[2];

my $addr    = "http://mazurka.org.uk";
my $imgaddr = "$addr/images";


my $kernaddr = "http://kern.ccarh.org";
my $mazurkaaddr = "$kernaddr/cgi-bin/ksdata?location=users/craig/classical/chopin/mazurka&format=info&file";
my $midiaddr = "http://kern.ccarh.org/cgi-bin/ksdata?l=users/craig/classical/chopin/mazurka&format=midi&file";
my $pdfaddr = "http://kern.ccarh.org/cgi-bin/ksdata?l=users/craig/classical/chopin/mazurka&format=pdf&file";


my $audioaddr = "http://webzu.sapp.org/cgi-bin/webzualbum?user=craig&action=download";


my %TITLES = getTitles($titlefile);
my %DISCO;
my %PINFO;
getDiscography($discofile);

my $Counter = 0;
my $LabelTable = "";

my %PERFORMANCES = getPerformances($indexdir);



printHeader();

print <<"EOT";
<pre>


</pre>
<h1>Evaluating Reverse Conductings</h1>
EOT

print "<table width=650>\n";

print<<"EOT";

<p>This page links to <i>Mathematica</i> notbooks which evaluate the
tapping trials for various recordings which have also been manually
corrected.  The raw data used in the analyses is available from 
<a href=../revcond>this page</a>.  A slightly more detailed description 
of the plots is available from <a href=../revcond/oldnew>this page</a>
which compares the first two manually tapped and corrected performances.

<p>If you click on a performer name/date, then you will be able to
view the notebook in HTML format. Clicking on the <font size=-3>PDF</font>
label after the performer and date will download a PDF file of the notebook.
Clicking on the <font size=-3>NB</font> will download the original notebook
for the performance.

<p> Clicking on the gray label number will take you to the bottom
of the discography page where individual albums are listed in more detail.
Clicking on the opus/no information will download a scanned score
of that particular mazurka.  Clicking on the "Mazurka in x key" portion
of the title will download a plain MIDI file derived from the score.


<p>
<hr noshade>
<p>

EOT

# printPerformances(%PERFORMANCES);

my $key;
foreach $key (sort keys %TITLES) {
   next if $key !~ /^maz/;
   printDisco($key, $TITLES{$key});
}


print <<"EOT";
</table>
<p><small>($Counter mazurka performances in total.)</small>
<pre>


</pre>
EOT


printFooter();


exit(0);


###########################################################################


##############################
##
## printPerformances --
##

sub printPerformances {
   my %performances = @_;

   my $key;
   print "<ul>";
   foreach $key (keys %performances) {
      print "<li> <A href=$key>$key</a> \n";
   }
   print "</ul>";


}



##############################
##
## getPerformances --
##

sub getPerformances {
   my ($directory) = @_;

   my %output;
   opendir (PDIR, $directory) || die;
   my $file;
   while ($file = readdir(PDIR)) {
      next if !-d "$directory/$file";
      next if $file !~ /^pid/;
      $output{$file} = "x";
   }
   close PDIR;

   return %output;
}




##############################
##
## printAlbumEntry --
##

sub printAlbumEntry {
   my $id;
   my $line;
   my $label;
   my $title;
   my $performer;
   my $pstring;
   my $mstring;
   my $temp;
   my $ttemp;
   my $mazurkas;

   while ($line = <DIFILE>) {
      last if $line =~ /^\@END:\s*ALBUM/;
      if ($line =~ /^\@ID:\s*csscd(\d+)/) {
         $id = $1;
      }
      if ($line =~ /^\@LABEL:\s*(.*)\s*$/) {
         $label = $1;
      }
      if ($line =~ /^\@TITLE:\s*(.*)\s*$/) {
         $title = $1;
      }
      if ($line =~ /^\@PERFORMER:\s*(.*)\s*$/) {
         $temp = $1;
         $temp =~ s/{//g;
         $temp =~ s/}//g;
         $performer .= "\t$temp";
      }
      if ($line =~ /^\@TRACK[^ \t\n]+:\s*mazurka(.*)/) {
         $temp = $1;
         $ttemp = $temp;
         $ttemp =~ s/^0//;
         $mazurkas .= "\t<a class=colon href=\"#$temp\">$ttemp</a>";
      }
   }

$performer =~ s/^\s*//;
$performer =~ s/\s*$//;
if ($performer =~ /\t/) {
   $performer =~ s/\t/; /g;
   $pstring = "performers";
} else {
   $pstring = "performer";
}

$mazurkas =~ s/^\s*//;
$mazurkas =~ s/\s*$//;
if ($mazurkas =~ /\t/) {
   $mazurkas =~ s/\t/, /g;
   $mstring = "mazurkas";
} else {
   $mstring = "mazurka";
}

print <<"EOT";
<tr valign=top><td><a name=id$id><img src=img/id$id.jpg></a></td>
</td><td>
<span class=label>$label</span><br>
$title<br>
<i>$pstring</i> :&nbsp;&nbsp;$performer<br>
<i>$mstring</i> :&nbsp;&nbsp;$mazurkas
</td>
</tr>
EOT

}



##############################
##
## getDiscography --
##

sub getDiscography {
   my ($file) = @_;

   my $performer;
 
   open (DFILE, $file) || die;
   my $line;
   while ($line = <DFILE>) {
      next if $line !~ /^\@START:/i;
      storeDisk();
   }
}



##############################
##
## storeDisk --
##   Assumes only one version of each mazurka is in album.
##

sub storeDisk {
   my $line;
   my $performer;
   my $pdate;

   my %trackmaz;
   my %tracktime;
   my %trackdate;
   my %trackperformer;
   my %trackid;
   my $label;

   my $id;
   my $track;
   my $diskid;
   while ($line = <DFILE>) {
      last if $line =~ /^\@END:/i;

      if ($line =~ /^\@ID:\s*(pid[^ \t\n]+)/) {
         $diskid = $1;
      }

      if ($line =~ /^\@LABEL:\s*(.*)/) {
         $label = $1;
      }

      if ($line =~ /^\@PERFORMER:.*\{(.*)\}/) {
         $performer = $1;
         # print "PERFORMER = $performer <br>";
      }

      if ($line =~ /^\@PDATE:.*(\d\d\d\d)/) {
         $pdate = $1;
         # print "PDATE = $pdate <br>";
      }

      if ($line =~ /^\@TRACK([^ \t\n]+):\s*(.*)/) {
         $track = $1;
         $id = $2;
         $id =~ s/\s+//g;
         $trackmaz{$track} = $id;
         $trackperformer{$track} = $performer;
         if ($trackdate{$track} =~ /^\s*$/) {
            $trackdate{$track} = $pdate;
         }
         $trackid{$track} = "$diskid-$track";
      }

      if ($line =~ /^\@TIME([^ \t\n]+):\s*(.*)/) {
         $track = $1;
         $id = $2;
         $id =~ s/\s+//g;
         $tracktime{$track} = $id;
         $trackperformer{$track} = $performer;
      }

      if ($line =~ /^\@PDATE([^ \t\n]+):\s*(.*)/) {
         $track = $1;
         $id = $2;
         $id =~ s/\s+//g;
         $id =~ /(\d\d\d\d)/;
         $id = $1;
         $trackdate{$track} = $id;
         $trackperformer{$track} = $performer;
      }

   }

   # store the individual mazurka data entries
   my $key;
   my $datastring;
   my $tvalue;
   foreach $key (sort keys %trackmaz) {
      $datastring = $trackperformer{$key};
      $datastring .= " ($trackdate{$key})";
      $datastring .= " [$tracktime{$key}]";
      $datastring .= " id=$trackid{$key}";
      $datastring .= " label={{$label}}";

      
      $tvalue = $trackid{$key};
      $tvalue =~ s/-2\./b-/;
      $tvalue =~ s/-3\./c-/;
      $tvalue =~ s/-4\./d-/;
      $tvalue =~ s/-5\./e-/;
      $tvalue =~ s/-6\./f-/;
      $tvalue =~ s/-7\./g-/;
      $tvalue =~ s/-8\./h-/;
      $tvalue =~ s/-9\./i-/;
      $tvalue =~ s/-10\./j-/;
      $tvalue =~ s/-11\./k-/;
      $tvalue =~ s/-12\./l-/;
      $tvalue =~ s/-13\./m-/;
      $tvalue =~ s/-14\./n-/;
      $tvalue =~ s/-15\./o-/;
      $tvalue =~ s/-16\./p-/;
      $tvalue =~ s/-17\./q-/;
      $tvalue =~ s/-18\./r-/;
      $tvalue =~ s/-19\./s-/;
      $tvalue =~ s/-20\./t-/;
      $tvalue =~ s/-21\./u-/;
      $tvalue =~ s/-22\./v-/;
      $tvalue =~ s/-23\./w-/;
      $tvalue =~ s/-24\./x-/;
      $tvalue =~ s/-25\./y-/;
      $tvalue =~ s/-26\./z-/;
      # print "PID = $tvalue :: $trackmaz{$key}\n <br>";

      $datastring .= " pidvalue=!!$tvalue!!";
      $DISCO{$trackmaz{$key}} .= "\@$datastring";

      #print "$trackmaz{$key} = $datastring<br>";

      $PINFO{"$tvalue"} = $trackmaz{$key};
   }

}




##############################
##
## getTitles --
##

sub getTitles {
   my ($titlefile) = @_;
   my %output;

   open (TFILE, $titlefile) || die;

   my $line;
   my $key;
   my $value;
   while ($line = <TFILE>) {
      if ($line =~ /([^ \t]+)\t(.*)/) {
         $key   = $1;
         $value = $2;
         $output{$key} = $value;
      }
   }

   return %output;
}



##############################
##
## printHeader --
##

sub printHeader {

print <<"EOT";
<html>
<head>
<title> </title>
<style>
<!--
.title { text-decoration: none; color: #880000 }
.colon { text-decoration: none; color: #000000 }
.label { text-decoration: none; color: #aaaaaa }
-->
</style>
</head>
<body bgcolor=#ffffff>

<center>
<table width=760 cellpadding=0 cellspacing=0 border=0>
<tr valign=top>
<td>
   <a href=http://www.charm.rhul.ac.uk><img alt="" border=0 src=$imgaddr/logo.gif></a>
</td>
<td>
   <a href=$addr><img alt="" border=0 src=$imgaddr/banner.gif></a>
</td>
</tr>
</table>
</center>


</td></tr></table></center>

<center>
<table bgcolor=#ffffff width=650 cellpadding=0 cellspacing=0 border=0>
<tr><td>

EOT

}



##############################
##
## printFooter --
##
  	
sub printFooter {

print <<"EOT";


</td>
</tr>
</table>


</center>

<pre>




</pre>




</body>
</html>


EOT

}




##############################
##
## printDisco --
##

sub printDisco {
   my ($mazno, $title) = @_;
   my $mazid = $mazno;
   $mazid =~ s/^mazurka//;
   $mazid =~ s/\.krn$//;
   $mazno =~ s/\..*//;
   $title =~ /(.*),\s*(Op.*)/;

   my $keytitle = $1;
   my $opustitle = $2;

   $keytitle =~ s/^\s*//;
   $keytitle =~ s/\s*$//;
   $keytitle =~ s/\s+/\&nbsp;/g;

   $keytitle =~ s/-flat/<img border=0 src=$imgaddr\/flat.png>/g;
   $keytitle =~ s/-sharp/<img border=0 src=$imgaddr\/sharp.png>/g;
   $keytitle =~ s/Major/major/g;
   $keytitle =~ s/Minor/minor/g;
   if ($keytitle !~ /border/) {
      $keytitle =~ s/major/&nbsp;&nbsp;major/;
      $keytitle =~ s/minor/&nbsp;&nbsp;minor/;
   }

   $opustitle =~ s/^\s*//;
   $opustitle =~ s/\s*$//;
   $opustitle =~ s/\s+/\&nbsp;/g;

   $keytitle  = "<a class=colon href=$midiaddr=$mazno.krn>$keytitle</a>";
   $opustitle = "<a class=colon href=$pdfaddr=$mazno.krn>$opustitle</a>";

   print "<tr valign=top><td><a name=\"$mazid\"></a>$keytitle</td><td width=0></td><td>$opustitle</td><td width=1></td>";
   print "<td>";

   print "<table width=350 cellpadding=0 cellspacing=0>";
   my @data = split(/\@/, $DISCO{$mazno});
   @data = sort @data;
   my $i;
   my $duration;
   my $min;
   my $sec;
   my $colon;
   my $id;
   my $iid;
   my $iidd;
   my $linkstring;
   my $disk;
   my $sid;
   my $track;
   my $performanceid;
   my $label;
   for ($i=0; $i<@data; $i++) {
      next if $data[$i] =~ /^\s*$/;
      $data[$i] =~ s/\[(\d+:\d\d)\]//;
      $duration = $1;
      $data[$i] =~ s/\(\)//g;
      $duration =~ /(\d+):(\d+)/;
      $min = $1;
      $sec = $2;

      if ($data[$i] =~ s/pidvalue=\!\!(.*)\!\!//) {
         $performanceid = $1;
      } else {
         $performanceid = "";
      }

      $data[$i] =~ s/id=(pid\d+-[^ \t\n]+)//;
      $id = $1;
      $id =~ /^pid(\d+)/;
      $sid = $1;
      $disk = 1;
      $track = 0;
      if ($id =~ /(pid\d+)-(\d+)\.(\d+)/) {
         $track = $3;
         $iid = $1;
         $disk = $2;
         $colon = "<a class=colon href=$audioaddr&id=$iid&track=$track&disk=$disk>:</a>";
      } elsif ($id =~ /(pid\d+)-(\d+)/) {
         $track = $2;
         $iid = $1;
         $colon = "<a class=colon href=$audioaddr&id=$iid&track=$track>:</a>";
      }
      $duration = "$min";
      $duration .= "$colon";
      $duration .= "$sec";


      $data[$i] =~ s/label={{(.*)}}//;
      $label = $1;


      $label =~ s/\s*$//;
      $label =~ s/\(\d\d\d\d\)$//;
      $label =~ s/Sony Classical/Sony/g;
      $label =~ s/BMG Classics/BMG/g;
      $label = "<small>$label</small>";
      
      $data[$i] =~ s/^\s*//;
      $data[$i] =~ s/\s*$//;
      $data[$i] =~ s/\s+/\&nbsp;/g;

      my $performer = $data[$i];
      $performer =~ s/\(/<small>(/g;
      $performer =~ s/\)/)<\/small>/g;
      if (-r "$performanceid/$performanceid.pdf") {
         my $temp = $performer;
         $performer = "<table width=100% cellpadding=0 cellspacing=0><tr><td>";
         $performer .= "<a href=$performanceid>$temp</a>";
         $performer .= "</td><td align=right>";
         $performer .= "<font size=-3><a href=$performanceid/$performanceid.pdf>";
         $performer .= "PDF</a>";
         if (-r "$performanceid/$performanceid.nb") {
            $performer .= ":<a href=$performanceid/$performanceid.nb>NB</a>";
         }
         $performer .= "</font>";
         $performer .= "</td></tr></table>";
         $Counter++;
      } 

      print "<tr align=left valign=top><td align=right width=10>$duration</td><td width=10>";
      print "<td width=140 align=left>$performer</td>";
      print "<td width=120 valign=baseline align=right><a href=../../info/discography/#pid$sid class=label>$label</a></td>";
      print "</tr>";
      $linkstring = "$id.mp4";
      $linkstring =~ s/^pid//;
      if ($disk == 2) {
         $linkstring =~ s/-/b-/;
      } elsif ($disk == 3) {
         $linkstring =~ s/-/c-/;
      } elsif ($disk == 4) {
         $linkstring =~ s/-/d-/;
      } elsif ($disk == 5) {
         $linkstring =~ s/-/e-/;
      } elsif ($disk == 6) {
         $linkstring =~ s/-/f-/;
      } elsif ($disk == 7) {
         $linkstring =~ s/-/g-/;
      } elsif ($disk == 8) {
         $linkstring =~ s/-/h-/;
      } elsif ($disk == 9) {
         $linkstring =~ s/-/i-/;
      } elsif ($disk == 10) {
         $linkstring =~ s/-/j-/;
      } elsif ($disk == 11) {
         $linkstring =~ s/-/k-/;
      } elsif ($disk == 12) {
         $linkstring =~ s/-/l-/;
      } elsif ($disk == 13) {
         $linkstring =~ s/-/m-/;
      } elsif ($disk == 14) {
         $linkstring =~ s/-/n-/;
      } elsif ($disk == 15) {
         $linkstring =~ s/-/o-/;
      } elsif ($disk == 16) {
         $linkstring =~ s/-/p-/;
      } elsif ($disk == 17) {
         $linkstring =~ s/-/q-/;
      } elsif ($disk == 18) {
         $linkstring =~ s/-/r-/;
      } elsif ($disk == 19) {
         $linkstring =~ s/-/s-/;
      } elsif ($disk == 20) {
         $linkstring =~ s/-/t-/;
      } elsif ($disk == 21) {
         $linkstring =~ s/-/u-/;
      } elsif ($disk == 22) {
         $linkstring =~ s/-/v-/;
      } elsif ($disk == 23) {
         $linkstring =~ s/-/w-/;
      } elsif ($disk == 24) {
         $linkstring =~ s/-/x-/;
      } elsif ($disk == 25) {
         $linkstring =~ s/-/y-/;
      } elsif ($disk == 26) {
         $linkstring =~ s/-/z-/;
      }
      if ($disk > 1) {
         $linkstring =~ s/([a-z])-\d+\./$1-/;
      }


   }
   print "\n</table>\n";

   print "</td>";
   print "</tr>\n";
}