#!/usr/bin/perl
#
# Programmer:    Craig Stuart Sapp <craig.stanford.edu>
# Creation Date: Tue Sep 24 13:36:16 PDT 2013
# Last Modified: Tue Sep 24 17:45:37 PDT 2013
# Filename:      module2pmx
# Syntax:        perl 5
#
# Description:   Convert a counterpoint interval module into SCORE PMX
# 		 data (to then convert into an EPS or SVG image).  This 
# 		 PERL script can be used in conjunction with output from 
# 		 the cint program.
# Options:
#    -s #	== horizontal spacing between notes (default 10.0).
#    -l #	== distance between start of staff and first note (default 8.0).
#    -r #	== distance between left side of last note and end of staff
#    		   (default 8.0).
#    -scale #	== SVG image scaling factor (default 1.43).
#    -t 	== Display input text string to right of staff.
#
# Example input: "2sx -2 3xs 2 3xx"
#
# Example output:
#	#module chain: 2sx -2 3xs 2 3xx
#	#SVG_SCALE: 1.43
#	8 1 0 0 0 36
#	1 1 8 7 10 1 1 -0.25 0 20
#	1 1 28 8 10 0 1 -0.5
#	1 1 8 6 20 0 1 -0.5
#	1 1 18 5 20 0 1 -0.75
#	1 1 28 6 20 0 1 -0.5
#	5 1 -2 4.25 4.25 8 -0.8 -2
#

use strict;
use Getopt::Long;

my $spacing     = 10.0;  # horizontal spacing between notes on staff
my $lmargin     = 8.0;   # horizontal spacing before first note
my $rmargin     = 8.0;   # horizontal spacing after last note
my $svgscale    = 1.43;  # SVG_SCALE: parameter
my $displaytext = 0;     # display input string on right of staff

Getopt::Long::Configure("bundling");
GetOptions (
   's|spacing=f'	=> \$spacing,
   'l|left-margin=f'	=> \$lmargin,
   'r|right-margin=f'	=> \$rmargin,
   'scale=f'		=> \$svgscale,
   't|text'		=> \$displaytext
);

my $inputstring = $ARGV[0];
my $module = $inputstring;
$module =~ s/[^\dsx\s-]//g;
$module =~ s/_/ /g;
$module =~ s/\s+/ /g;
$module =~ s/^\s+//;
$module =~ s/\s+$//;

my $Offset  = getAveragePitch($module);
my @PitchesT = getTopPitches($module, $Offset);
my @PitchesB = getBottomPitches($module, $Offset);

printPMX();

exit(0);

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

##############################
##
## printPMX --
##

sub printPMX {

   # first print the staff lines (no clef):
   my $stafflength = $lmargin + $rmargin + (@PitchesT - 1) * $spacing;
   $stafflength = limitFraction($stafflength, 3);
   if ($svgscale != 1.0) {
      print "#module chain: $inputstring\n";
      print "#SVG_SCALE: $svgscale\n";
   }
   print "8 1 0 0 0 $stafflength\n";

   printNoteSequences();

   # print input string to the right of the music if the -t option is given:
   my $hpos = $stafflength + $rmargin;
   if ($displaytext) {
      print "\"_00$inputstring\" 1 $hpos 5\n";
   }
}



##############################
##
## limitFraction -- given a floating-point number, set the maximum 
##     number of digits that the fractional part of the number can have.
##

sub limitFraction {
   my ($number, $limit) = @_;
   my $factor = 10.0 ** $limit;
   return int($number * $factor + 0.5) / $factor;
}



##############################
##
## printNoteSequences -- print the top and bottom parts of the 
##      counterpoint pitch module.  Both are displayed on the
##      same staff, with the top part having stems up, and the
##      bottom part having stems down.
##

sub printNoteSequences {
   my $hpos;
   my $vpos;
   my $notehead = 0;
   my $i;
   my $p10 = 0;
   my $p5 = 0;
   my $p8 = 0;

   # first print top notes
   for ($i=0; $i<@PitchesT; $i++) {
      $p10 = 0;
      $p5 = 10;
      $vpos = int($PitchesT[$i]);
      $hpos = $lmargin + $i * $spacing;
      $hpos = limitFraction($hpos, 3);
      if (($i > 0) && ($PitchesT[$i] =~ /s/)) {
         # don't print notes tieing from previous sonority
         next;
      }
      if (abs($PitchesT[$i] - $PitchesB[$i]) == 1) {
         $p10 = 20;
      }
      # deal with cases where the parts are crossed here.
      $p8 = getStemAdjust("up", $vpos);
      if ($PitchesT[$i+1] =~ /s/) {
         # print note as open half notehead
         $notehead = 1;
      } else {
         $notehead = 0;
      }
      print "1 1 $hpos $vpos $p5 $notehead 1 $p8";
      if ($p10) {
         print " 0 $p10";
      }
      print "\n";
   }

   # Then print bottom notes
   for ($i=0; $i<@PitchesB; $i++) {
      $p10 = 0;
      $p5 = 20;
      $vpos = int($PitchesB[$i]);
      $hpos = $lmargin + $i * $spacing;
      $hpos = limitFraction($hpos, 3);
      if (($i > 0) && ($PitchesB[$i] =~ /s/)) {
         # don't print notes tieing from previous sonority
         next;
      }
      if (abs($PitchesT[$i] - $PitchesB[$i]) == 0) {
         $p10 = 10;
      }
      $p8 = getStemAdjust("down", $vpos);
      if ($PitchesB[$i+1] =~ /s/) {
         # print note as open half notehead
         $notehead = 1;
      } else {
         $notehead = 0;
      }
      print "1 1 $hpos $vpos $p5 $notehead 1 $p8";
      if ($p10) {
         print " 0 $p10";
      }
      print "\n";
   }

   # Print leading tie if first note in each voice is sustained
   # from an earlier sonority.
   if ($PitchesT[0] =~ /s/) {
      my $leftpos = $lmargin - 10;
      my $rightpos = $lmargin;
      my $verticalpos;
      if ($PitchesT[0] % 2 == 0) {
         $verticalpos = int($PitchesT[0])+1.6;
      } else {
         $verticalpos = int($PitchesT[0])+0.6;
      }
      print "5 1 $leftpos $verticalpos $verticalpos $rightpos";
      print " 0.75 -2 0 0 0 0 0.5\n";
   }
   if ($PitchesB[0] =~ /s/) {
      my $leftpos = $lmargin - 10;
      my $rightpos = $lmargin;
      my $verticalpos;
      if ($PitchesB[0] % 2 == 0) {
         $verticalpos = int($PitchesB[0])-1.75;
      } else {
         $verticalpos = int($PitchesB[0])-0.75;
      }
      print "5 1 $leftpos $verticalpos $verticalpos $rightpos -0.8 -2\n";
   }
}



##############################
##
## getStemAdjust -- Return the stem length adjustment causes by notes being
##     too high or too low.
##

sub getStemAdjust {
   my ($direction, $vpos)  = @_;

   if ($direction =~ /down/i) {
      $vpos = 14 - $vpos;
   }
   $vpos = int($vpos); 

   if ($vpos < 0) {
      return -$vpos;
   } elsif ($vpos < 7) {
      return 0;
   } elsif ($vpos == 7) {
      return -0.25;
   } elsif ($vpos == 8) {
      return -0.5;
   } elsif ($vpos == 9) {
      return -0.75;
   } elsif ($vpos >= 10) {
      return -1;
   }

   return 0;
}



##############################
##
## getTopPitches --  Return the melodic line of the top pitches in the
##     module, with an offset subtracted from each pitch
##

sub getTopPitches {
   my ($module, $offset) = @_;
   my @list = split(/\s+/, $module);
   my @output;
   my $pitchT = 0;
   my $pitchB = 0;
   my $melB = 0;
   my $harm;
   my $i;
   my $attackstate;
   for ($i=0; $i<@list; $i+=2) {
      $pitchB = $pitchB + $melB;
      $harm = int(abs($list[$i])) - 1;
      $harm = -$harm if $list[$i] < 0;
      $pitchT = $pitchB + $harm;
      $list[$i] =~ /[sx]([sx])/;
      $attackstate = $1;
      $output[@output] = $pitchT - $offset + 7;
      $output[$#output] .= $attackstate;
      $melB = int(abs($list[$i+1])-1);
      $melB = -$melB if int($list[$i+1]) < 0;
   }
   return @output;
}



##############################
##
## getBottomPitches --  Return the melodic line of the bottom pitches in the
##     module, with an offset subtracted from each pitch
##

sub getBottomPitches {
   my ($module, $offset) = @_;
   my @list = split(/\s+/, $module);
   my @output;
   my $pitchT = 0;
   my $pitchB = 0;
   my $melB = 0;
   my $harm;
   my $i;
   my $attackstate;
   for ($i=0; $i<@list; $i+=2) {
      $pitchB = $pitchB + $melB;
      $harm = int(abs($list[$i])) - 1;
      $harm = -$harm if $list[$i] < 0;
      $pitchT = $pitchB + $harm;
      $list[$i] =~ /([sx])[sx]/;
      $attackstate = $1;
      $output[@output] = $pitchB - $offset + 7;
      $output[$#output] .= $attackstate;
      $melB = int(abs($list[$i+1])-1);
      $melB = -$melB if int($list[$i+1]) < 0;
   }
   return @output;
}



##############################
##
## getAveragePitch -- Return the diatonic average pitch (rounded to
##    then nearest diatonic pitch.  The returned average assigned
##    the first note of the bottom part an arbitrary pitch height of 0.
##

sub getAveragePitch {
   my ($module) = @_;
   my @pitches = getPitches($module);
   my $sum = 0;
   my $i;
   for ($i=0; $i<@pitches; $i++) {
      $sum += $pitches[$i];
   }
   if ($sum >= 0) {
      return int(($sum/@pitches)+0.5);
   } else {
      return int(($sum/@pitches)-0.5);
   }
}



##############################
##
## getPitches -- Extract pitches from a counterpoint interval module
##     chain, where the first note of the bottom part will be assigned
##     diatonic pitch "0".
##

sub getPitches {
   my ($module) = @_;
   my @list = split(/\s+/, $module);
   my @output;
   my $pitchT = 0;
   my $pitchB = 0;
   my $melB = 0;
   my $harm;
   my $i;
   for ($i=0; $i<@list; $i+=2) {
      $pitchB = $pitchB + $melB;
      $harm = int(abs($list[$i])) - 1;
      $harm = -$harm if $list[$i] < 0;
      $pitchT = $pitchB + $harm;
      $output[@output] = $pitchB;
      $output[@output] = $pitchT;
      $melB = int(abs($list[$i+1])-1);
      $melB = -$melB if int($list[$i+1]) < 0;
   }
   return @output;
}