#!/usr/bin/perl
##
## Programmer:    Craig Stuart Sapp <craig@ccrma.stanford.edu>
## Creation Date: Thu Jan 19 17:19:49 PST 2012
## Last Modified: Tue Mar  5 18:54:12 PST 2019
## Syntax:        Perl 5
##
## Description:   This program creates a webpage for Chopin prelude 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 $preludemax = 29;  # total number of preludes;
my $movementmax = 25; # maximum possible prelude movement number
my $smallsize = 100; # size of large images (x2 pixel width)
my $thumbsize = 200; 
my $largesize = 400; # size of large images (x2 pixel width)
my $pagetitle = "Chopin Prelude Keyscapes";

my $command = "thrux -v norep | mkeyscape -fbn --trim -s$largesize | ";
$command .=   " convert - -transparent white -resize $thumbsize ";

my $command2 = "thrux -v norep | mkeyscape -fbn --trim -s$largesize | ";
$command2 .=   " convert - -transparent white";

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

   $command2  = "thrux -v norep | transpose -k c | ";
   $command2 .= " mkeyscape -fbn --trim -s$largesize | ";
   $command2 .= " convert - -transparent white ";
}

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

printHeader();
my $i;
for $i (1 .. $preludemax) { 
   print STDERR "Processing prelude $i\n";
   processPrelude($i);
}
printFooter();

exit(0);

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



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


sub processPrelude {
   my ($number) = @_;
   my @movementfiles = getWorkFiles($number);
   return if @movementfiles <= 0;
   printPreludeRow($number, @movementfiles);
}



##############################
##
## getWorkFiles -- return a list of movements in the given prelude.
##

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

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



##############################
##
## printPreludeRow --
##

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

   print <<"EOT";

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

   my $i;
   my $movement;
   foreach $movement (@movements) {
      processMovement($number, $movement);
   }
}



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

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

   if (!-r "$malt.png") {
      print STDERR "XXX\tcat $movement.krn | $command $malt.png\n";
      `cat $movement.krn | $command $malt.png`;
   }
   if (!-r "$malt-large.png") {
      my $tcommand = $command2;
      #$tcommand =~ s/-s\s*(\d+)/-s$largesize/;
      `cat $movement.krn | $tcommand $malt-large.png`;
      print STDERR "XXX\t cat $movement.krn | $tcommand $malt-large.png\n";
   }
   my $movementtitle;
   my $movementkey;
   ($movementtitle, $movementkey) = getPieceTitleAndKey("$movement.krn");

   print "   <span>\n";
   print "      <a name=prelude$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=chopin/prelude&format=pdf>score</a>) 
     (<a href=http://kern.ccarh.org/ksdata?file=$movement.krn&l=chopin/prelude&format=kern>kern</a>) 
      (<a href=http://kern.ccarh.org/ksdata?file=$movement.krn&l=chopin/prelude&format=midi>midi</a>)
    <br>
    $movementkey

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

EOT

}



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

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

print <<"EOT";
<!---------------------------------------------------------------------------->
<html>
<head>
<title> mkeyscape Chopin Prelude 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=615>
<tr><td>

<center>
<table width=615>
<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 all of <a
href=http://kern.ccarh.org/browse?l=chopin/preludes>Chopin's 
preludes</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";

<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) = @_;
   $file =~ /prelude(\d+)/;
   my $number = $1;
   $number =~ s/^0+//;
   return "Preludes, op. $number";
}

sub getWorkTitle2 {
   my ($file) = @_;
   open (FILE, $file) or die "Cannot open $file for reading.";
   my $line;
   my $knum;
   my $opus;
   my $number;
   my $value;
   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*$/) {
         $value = $1;
         if ($knum =~ /^\s*$/) {
            $knum = $value;
         } else {
            $knum .= "/$value";
         }
      }
   }
   close FILE;

   $knum =~ s/<sup>/<sup><small>/g;
   $knum =~ s/<\/sup>/<\/small><\/sup>/g;
   $title =~ s/,\s*mvmt\.\s*\d+\s*//;
   if ($opus !~ /^\s*$/) {
      $title .= ", $opus";
      $number =~ s/\s*No\.\s*//i;
      if ($number !~ /^\s*$/) {
         $title .= "/$number";
      }
   }
   if ($knum !~ /^\s*$/) {
      $title .= ", $knum";
   }
   $title =~ s/-sharp/&#x266f/g;
   $title =~ s/-flat/&#x266d/g;
   $title =~ s/Op\./op./g;
   $title =~ s/\s*---\s*/&mdash;/g;

   return $title;
}



##############################
##
## getPieceTitleAndKey --
##

sub getPieceTitleAndKey {
   my ($file) = @_;
   open (FILE, $file) or die;
   $file =~ /prelude\d+-(\d+)/;
   my $mnumber = $1;
   $mnumber =~ s/^0+//;
   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;
   }
   $title = "No. $mnumber $title";

   return ($title, $key);
}