#!/usr/bin/perl
##
## Programmer:    Craig Stuart Sapp <craig@ccrma.stanford.edu>
## Creation Date: Thu Jan 19 17:19:49 PST 2012
## Last Modified: Thu Jan 19 17:19:53 PST 2012
## Syntax:        Perl 5
##
## Description:   This program creates a webpage for Haydn quartet keyscapes
##                and will create the necessary images.  The underlying kern
##                files must be in the current directory.
##

use strict;

my $relative = 0; 
if ($ARGV[0] =~ /relative/i) {
   # transpose all movements to C major/minor before plotting
   $relative = 1;
}

my $quartetmax  = 103;  # total number of quartets;
my $numbermax   = 7; # maximum possible quartet movment number
my $movementmax = 7; # maximum possible quartet movment number
my $smallsize = 100; # size of large iamges (x2 pixel width)
my $largesize = 450; # size of large iamges (x2 pixel width)
my $pagetitle = "Haydn String Quartet Keyscapes";

my $command = "thru -v norep | mkeyscape -fbn --trim -s$smallsize | convert - -transparent white";
if ($relative) {
   $command = "thru -v norep | transpose -k c | mkeyscape -fbn --trim -s$smallsize | convert - -transparent white";
}

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

printHeader();
my $i;
for $i (1 .. $quartetmax) { 
   processSonata($i);
}
printFooter();

exit(0);

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



##############################
##
## processSoanta -- create images if they do not already exist, and print
##     table row entry for quartet.
##


sub processSonata {
   my ($number) = @_;
   $number = "0$number" if $number < 10;
   my @movementfiles = getMovementFiles($number);
   printSonataRow($number, @movementfiles);
   my $i;
   my $num2;
   for ($i=0; $i<$numbermax; $i++) {
      $num2 = "${number}n$i";
      @movementfiles = getMovementFiles($num2);
      printSonataRow($num2, @movementfiles);
   }
}



##############################
##
## getMovementFiles -- return a list of movements in the given quartet.
##

sub getMovementFiles {
   my ($number) = @_;

   my $num = $number;
   my $maxx = $movementmax;
   my $i;
   my $ii;
   my @output;
   for ($i=1; $i<=$maxx; $i++) {
      $ii = $i;
      $ii = "0$i" if $ii < 10;
      $output[@output] = "op$num-$ii" if -r "op$num-$ii.krn";
   }
   return @output;
}



##############################
##
## printSonataRow --
##

sub printSonataRow {
   my ($number, @movements) = @_;
   my $num = $number;
   $num = "0$num" if $num < 10;
   return if @movements == 0;
   my $title = getWorkTitle("$movements[0].krn");

   print <<"EOT";

<tr>
   <td>
      <hr noshade> 
      <font size=+1>$title</font><br></td>
</tr>
EOT


   print "<tr><td><table><tr>\n";
   my $i;
   my $movement;
   foreach $movement (@movements) {
      processMovement($number, $movement);
   }
   print "</tr></table></td></tr>\n";
}



##############################
##
## processMovement --
##

sub processMovement {
   my ($number, $movement) = @_;
   $movement =~ /-(\d+)$/;
   my $mnumber = $1;
   my $malt = $movement;
   $malt .= "-rel" if $relative;

   if (!-r "$malt.png") {
      `cat $movement.krn | $command $malt.png`;
   }
   if (!-r "$malt-large.png") {
      my $tcommand = $command;
      $tcommand =~ s/-s\s*(\d+)/-s$largesize/;
      `cat $movement.krn | $tcommand $malt-large.png`;
   }
   my $movementtitle;
   my $movementkey;
   ($movementtitle, $movementkey) = getMovementTitleAndKey("$movement.krn");

   print "   <td valign=top>\n";
   print "      <a name=op$number> </a>\n" if $mnumber == 1;
print <<"EOT";
      <table><tr><td><a href=$malt-large.png><img border=0 src=$malt.png></a></td></tr>
         <tr><td><center>$movementtitle<br> 
     <!-- (<a href=http://kern.ccarh.org/ksdata?file=$movement.krn&l=haydn/quartet&format=pdf>score</a>)
-->
     (<a href=http://kern.ccarh.org/ksdata?file=$movement.krn&l=haydn/quartet&format=kern>kern</a>) 
      (<a href=http://kern.ccarh.org/ksdata?file=$movement.krn&l=haydn/quartet&format=midi>midi</a>)
    <br>
    $movementkey

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

EOT

}



##############################
##
## printHeader
##

sub printHeader {
   my $date = `date`;
   chomp $date;

print <<"EOT";
<!---------------------------------------------------------------------------->
<html>
<head>
<title> Haydn string quartet keyscapes</title>
<meta name="Document-Owner" content="Craig Sapp (craig\@ccrma.stanford.edu)"> 
<meta name="Author" content="Craig Stuart Sapp (craig\@ccrma.stanford.edu)">
<meta name="Creation-Date" content=" Thu Jan 19 16:46:07 PST 2012 ">
<meta name="Revision-Date" content=" $date ">
<style type="text/css">
<!-- 
.commandname { font-weight: bold; text-decoration: none; 
            font-size: 125%; color: #000000}
.indexitem { text-decoration: none; }
a {text-decoration:none}
-->
</style>
</head>
</head>
<!---------------------------------------------------------------------------->
<!body topmargin="15" leftmargin="5" alink="#ff8080" bgcolor="#e2dfc7" link="#dd0000" marginheight="5" marginwidth="5" text="#321e04" vlink="#118dcc">    
<body topmargin="15" leftmargin="5" alink="#bb9966" bgcolor="#e2dfc7" link="#bb9966" marginheight="5" marginwidth="5" text="#321e04" vlink="#bb9966">
<center>
<table width=750>
<tr><td>

<table width=750><tr><td>

<center>
<table width=750>
<tr valign=top><td>


<a href=http://extras.humdrum.org><img src=../../../img/humdrumextras.gif alt="Humdrum Extras" border=0></a>
</td><td><h1>$pagetitle</h1></td></table>
</center>
<p>

This page shows <a href=../>keyscapes</a> for most of <a
href=http://kern.ccarh.org/browse?l=haydn/quartet>Haydn's string
quartets</a>.   Click on each keyscape plot to view a larger version.

EOT

if ($relative) {
   print<<"EOT";

<p>
The following keyscapes are colored relative to the tonic key of the movement:
green = tonic, light blue = dominant, yellow = subdominant, purple =
submediant (or relative minor for a major tonic), red = median (or relative
major for a minor tonic), dark blue = supertonic (or dominant of the
dominant), sea green = Neapolitan and subtonic = orange (or subdominant of the
subdominant). <a href=index.html>Click here</a> to view keyscapes colored
without transposing to C.


EOT


} else {

print <<"EOT";

Below is the key to color mapping for the plots.  Major keys are the
brighter row in the legend, and minor keys are the darker row.  <a
href=index-rel.html>Click here</a> to view the same plots using 
a color mapping relative to the function of the tonic key of 
each movement.

<p>
<center>
<img border=0 src=../default-colormap.png>
</center>
<p>

EOT

}

print <<"EOT";

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

<center>
<table width=700>

EOT

}



##############################
##
## printFooter --
##

sub printFooter {

print <<"EOT";

</table>

<pre>




</pre>
<a href=script.txt>Script</a> used to create this page.
</td></tr>
</table>
</center>

</body>
</html>

EOT

}



##############################
##
## getWorkTitle --
##

sub getWorkTitle {
   my ($file) = @_;
   open (FILE, $file) or die "Cannot open $file for reading";
   my $line;
   my $opus;
   my $sct;
   my $number;
   my $title = "";
   while ($line = <FILE>) {
      if ($line =~ /^!!!OTL[^:]*:\s*(.*)\s*$/) {
         $title = $1;
      }
      if ($line =~ /^!!!OPS[^:]*:\s*(.*)\s*$/) {
         $opus = $1;
      }
      if ($line =~ /^!!!ONM[^:]*:\s*(.*)\s*$/) {
         $number = $1;
      }
      if ($line =~ /^!!!SCT[^:]*:\s*(.*)\s*$/) {
         $sct = $1;
      }
   }
   close FILE;

   $title =~ s/,\s*mvmt\.\s*\d+\s*//;
   if ($opus !~ /^\s*$/) {
      $title .= ", $opus";
      $number =~ s/\s*No\.\s*//i;
      if ($number !~ /^\s*$/) {
         $title .= "/$number";
      }
   }
   if ($sct !~ /^\s*$/) {
      $title .= ", $sct";
   }
   $title =~ s/-sharp/&#x266f/g;
   $title =~ s/-flat/&#x266d/g;
   $title =~ s/Op\./op./g;
   $title =~ s/No\./no./;
   $title =~ s/,\s*No\.\s*/\//;
   $title =~ s/\s*---\s*/&mdash;/g;
   $title =~ s/Major/major/g;
   $title =~ s/Minor/minor/g;

   return $title;
}



##############################
##
## getMovementTitleAndKey --
##

sub getMovementTitleAndKey {
   my ($file) = @_;
   open (FILE, $file) or die;
   my $line;

   my $title = "";
   my $key = "";
   my $number = "";
   while ($line = <FILE>) {
      if (($title =~ /^\s*$/) && ($line =~ /^!!!OMD[^:]*:\s*(.*)\s*$/)) {
         $title = $1;
      }
      if (($key =~ /^\s*$/) && ($line =~ /^\*([a-g][-#]?):/i)) {
         $key = $1;
      }
      if ($line =~ /^!!!OMV[^:]*:\s*(.*)\s*$/) {
         $number = $1;
      }
   }
   close FILE;
   $number =~ s/^\s*mvmt\.\s*//i;
   $number =~ s/^\s*no\.\s*//i;

   if ($number !~ /^\s*$/) {
      $title = "$number.&nbsp;$title";
   }
   $title =~ s/\s*---\s*/&mdash;/g;

   my $mode = "major";
   $mode = "minor" if $key =~ /[a-g]/;
   if ($key !~ /^\s*$/) { 
      $key =~ tr/[a-g]/[A-G]/;
      $key =~ s/-/-flat/;
      $key =~ s/#/-sharp/;
      $key = "$key $mode";
      $key =~ s/-sharp/&#x266f/g;
      $key =~ s/-flat/&#x266d/g;
   }

   return ($title, $key);
}