#!/usr/bin/perl ## ## Programmer: Craig Stuart Sapp ## Creation Date: Thu Jan 19 17:19:49 PST 2012 ## Last Modified: Fri Jan 27 08:24:22 PST 2012 ## Syntax: Perl 5 ## ## Description: This program creates a webpage for Chopin mazurka 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 $mazurkamax = 68; # total number of mazurkas; my $movementmax = 4; # maximum possible mazurka movment number my $smallsize = 100; # size of large iamges (x2 pixel width) my $thumbsize = 200; my $largesize = 450; # size of large iamges (x2 pixel width) my $pagetitle = "Chopin Mazurka 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 .. $mazurkamax) { processMazurka($i); } printFooter(); exit(0); ########################################################################### ############################## ## ## processMazurka -- create images if they do not already exist, and print ## table row entry for mazurka. ## sub processMazurka { my ($number) = @_; my @movementfiles = getWorkFiles($number); return if @movementfiles <= 0; printMazurkaRow($number, @movementfiles); } ############################## ## ## getWorkFiles -- return a list of movements in the given mazurka. ## sub getWorkFiles { my ($number) = @_; my $num = $number; $num = "0$num" if $num < 10; my $maxx = $movementmax; my $i; my @output; for ($i=1; $i<=$maxx; $i++) { $output[@output] = "mazurka$num-$i" if -r "mazurka$num-$i.krn"; } return @output; } ############################## ## ## printMazurkaRow -- ## sub printMazurkaRow { my ($number, @movements) = @_; my $num = $number; $num = "0$num" if $num < 10; my $title = getWorkTitle("$movements[0].krn"); print <<"EOT";
$title
EOT print "\n"; my $i; my $movement; foreach $movement (@movements) { processMovement($number, $movement); } print "
\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 = $command2; #$tcommand =~ s/-s\s*(\d+)/-s$largesize/; `cat $movement.krn | $tcommand $malt-large.png`; } my $movementtitle; my $movementkey; ($movementtitle, $movementkey) = getPieceTitleAndKey("$movement.krn"); print " \n"; print " \n" if $mnumber == 1; print <<"EOT";
$movementtitle
(score) (kern) (midi)
$movementkey
EOT } ############################## ## ## printHeader ## sub printHeader { my $date = `date`; chomp $date; print <<"EOT"; mkeyscape Bach WTC keyscapes
Humdrum Extras

$pagetitle

This page shows keyscapes for all of Chopin's mazurkas. Click on each keyscape plot to view a larger version. EOT if ($relative) { print<<"EOT";

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). Click here 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. Click here to view the same plots using a color mapping relative to the function of the tonic key of each movement.

EOT } print <<"EOT";

EOT } ############################## ## ## printFooter -- ## sub printFooter { print <<"EOT";




Script used to create this page.
EOT } ############################## ## ## getWorkTitle -- ## sub getWorkTitle { my ($file) = @_; $file =~ /mazurka(\d+)/; my $number = $1; $number =~ s/^0+//; return "Mazurkas, 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 = ) { 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///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/♯/g; $title =~ s/-flat/♭/g; $title =~ s/Op\./op./g; $title =~ s/\s*---\s*/—/g; return $title; } ############################## ## ## getPieceTitleAndKey -- ## sub getPieceTitleAndKey { my ($file) = @_; open (FILE, $file) or die; $file =~ /mazurka\d+-(\d+)/; my $mnumber = $1; $mnumber =~ s/^0+//; my $line; my $title = ""; my $key = ""; my $number = ""; while ($line = ) { 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. $title"; } $title =~ s/\s*---\s*/—/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/♯/g; $key =~ s/-flat/♭/g; } $title = "No. $mnumber $title"; return ($title, $key); }