#!/usr/bin/perl -w

use strict;

my @num = ();
my @ltr = ();
my @voice = (
	   [ "Dido"          , "Di", "di" ],
	   [ "Belinda"       , "Be", "be" ],
	   [ "Second woman"  , "Wo", "wo" ],
	   [ "Sorceress"     , "So", "so" ],
	   [ "First witch"   , "FW", "fw" ],
	   [ "Second witch"  , "SW", "sw" ],
	   [ "Spirit"        , "sp", "sp" ],
	   [ "Æneas"         , "Æn", "ae" ],
	   [ "Sailor"        , "Sa", "sa" ],
	   [ "Soprano"       , "S" , "cs" ],
	   [ "Alto"          , "A" , "ca" ],
	   [ "Tenor"         , "T" , "ct" ],
	   [ "Bass"          , "B" , "cb" ],
	   [ "Violin I"      , "V1", "va" ],
	   [ "Violin II"     , "V2", "vb" ],
	   [ "Viola"         , "Va", "vc" ],
	   [ "Basso Continue", "BC", "vd" ],
	   );
my %index = ();
my $fh = *STDOUT;
my $tag;
my $midi = 1;

sub init {
  my $ix;
  my $id;

  push @num, "00";		# just to make AA begein at ltr[1]
  push @ltr, "--";

  for ($ix = 1, $id = "AA"; $ix < 40; $ix++, $id++) {
    if ($ix < 10) { push @num, "0$ix"; }
    else          { push @num, $ix; }
    push @ltr, $id;
  }
  for ($ix = 0; $ix < @voice; $ix++) {
    $index{$voice[$ix][2]} = $ix;
  }
  #print "@num\n";
  #print "@ltr\n";
  #my @l = sort(keys(%index));
  #print "@l\n";
}

sub mkhdr {
  print $fh "\\version \"2.4.2\"\n";
  if ($tag eq "all") {
    print $fh "\\include \"header.ly\"\n";
    print $fh "%\\include \"a3p.ly\"\n";
  } else {
    print $fh "\\include \"a4p.ly\"\n";
  }
  if ($tag eq "act") {
    print $fh "#(set-global-staff-size 13)\n";
  }
  print $fh "\\include \"global.ly\"\n";
  print $fh "\n";
}

sub newfile {
  my $file = shift;
  if (defined($file)) {
    open($fh, ">", $file) or die("$file");
    &mkhdr();
  }
}

sub mkstaff {
  my $voice = shift;
  my $sta = shift;
  my $end = shift;
  my $voice2 = shift;
  my $lyr = shift;
  my $size = shift;

  my $long = $voice[$voice][0];
  my $shrt = $voice[$voice][1];
  my $id   = $voice[$voice][2];

  my $part = $ltr[$sta];
  my $ix;

  print $fh "       ";
  print $fh "\\keepWithTag #'$tag " if ($tag);
  print $fh "\\new Staff ";
  if ($size) {
    print $fh " \\with {\n";
    print $fh "	 fontSize = \#$size\n";
    print $fh "	 \\override StaffSymbol \#'staff-space = \#(magstep $size)\n";
    print $fh "       } "
  }
  if ($voice2) {
    print $fh "<< \\context Voice = v$id$part {\n";
  } else {
    print $fh "\\context Voice = v$id$part {\n";
  }

  if ($tag eq "all") {
    print $fh "	 \\set Staff.instrument = \\markup { \"$long\" }\n";
  } else {
    print $fh "	 \\set Staff.instrument = \\markup { \"$shrt\" }\n";
  }
  print $fh "	 \\set Staff.instr      = \\markup { \"$shrt\" }\n";
  print $fh "	 \\set Staff.minimumVerticalExtent = \#'(-0 . 0)\n" if ($size < 0);
  print $fh "	 { \\clef$id";
  for ($ix = $sta; $ix < $end; $ix++) {
    print $fh " \\Key$ltr[$ix] \\$id$ltr[$ix]";
  }
  print $fh " }\n";
  if ($voice2) {
    print $fh "       } \\\\ \\new Voice $voice2 >>\n";
  } else {
    print $fh "       }\n";
  }
  if ($lyr) {
    print $fh "       \\new Lyrics ";
    if ($size) {
      print $fh "\\with { fontSize = \#$size } ";
    }
    print $fh "\\lyricsto v$id$part {";
    for ($ix = $sta; $ix < $end; $ix++) {
      print $fh " \\l$id$ltr[$ix]";
    }
    print $fh " }\n";
  }
  print $fh "\n";
}

sub mkpart {
  my $file = shift;
  my $voices = shift;
  my $big = shift;
  my $sta = shift;
  my $end = shift;

  my @sel;
  my $ix;
  my $defsize = 0;
  my $psize = 0;

  if ($big >= 0) {
    $defsize = -3;
    $psize = 1;
    $psize = 0.5 if ($tag eq "ca");
    $psize = 0.5 if ($tag eq "ct");
    $psize = 0.5 if ($tag eq "cb");
    $psize = 0.5 if ($tag eq "voice");
  }

  print $fh "  << \\ss\n";

  @sel = grep { $index{"di"} <= $_ && $_ <= $index{"sa"} } @$voices;
  if (@sel) {
    my $num = @sel;
    print $fh "    \\new ChoirStaff <<\n" if ($num > 1);
    while (defined($ix = shift @sel)) {
      &mkstaff( $ix, $sta, $end, "", 1, ($tag eq "voice" || $ix == $big)? $psize: $defsize);
    }
    print $fh "    >>\n" if ($num > 1);
  }

  @sel = grep { $index{"cs"} <= $_ && $_ <= $index{"cb"} } @$voices;
  if (@sel) {
    my $num = @sel;
    print $fh "    \\new ChoirStaff <<\n" if ($num > 1);
    while (defined($ix = shift @sel)) {
      my $voice2 = "";
      if ($ix == $index{"cs"} && 2 <= $sta && $sta <= 7 && 7 <= $end ) {
	$voice2 = '{ s1*28 | s2.*67 | s1*14 | s2.*13 | s1*24 s2. | \cssAG }';
      }
      &mkstaff( $ix, $sta, $end, $voice2, 1, ($tag eq "voice" || $ix == $big)? $psize: $defsize);
    }
    print $fh "    >>\n" if ($num > 1);
  }

  @sel = grep { $index{"va"} <= $_ && $_ <= $index{"vb"} } @$voices;
  if (@sel) {
    my $num = @sel;
    print $fh "    \\new GrandStaff <<\n" if ($num > 1);
    while (defined($ix = shift @sel)) {
      &mkstaff( $ix, $sta, $end, "", 0, (!($tag eq "voice") && $ix == $big)? $psize: $defsize);
    }
    print $fh "    >>\n" if ($num > 1);
  }

  $ix = $index{"vc"};
  @sel = grep { $_ == $ix } @$voices;
  if (@sel) {
    &mkstaff( 15, $sta, $end, "", 0, (!($tag eq "voice") && $ix == $big)? $psize: $defsize);
  }
  $ix = $index{"vd"};
  @sel = grep { $_ == $ix } @$voices;
  if (@sel) {
    &mkstaff( 16, $sta, $end, "", 0, (!($tag eq "voice") && $ix == $big)? $psize: $defsize);
    print $fh "    \\context FiguredBass {";
    for ($ix = $sta; $ix < $end; $ix++) {
      if ($tag eq "cb") {
	if ($ix == 17) {
	  print $fh " s4.*17";
	} elsif ($ix == 33) {
	  print $fh " s1*30";
	} else {
	  print $fh "  \\fb$ltr[$ix]";
	}
      } else {
	print $fh "  \\fb$ltr[$ix]";
      }
    }
    print $fh " }\n";
  }

  print $fh "  >>\n";
}

sub run {
  my $file = shift;
  my $voices = shift;
  my $big = shift;
  my $sta = shift;
  my $end = shift;

  &newfile($file);
  my $ix;
  for ($ix = $sta; $ix < $end; $ix++) {
    print $fh "\\include \"Music.$num[$ix].ly\"\n";
  }
  print $fh "\\score {\n";
  print $fh "  \\header { piece = \\piece$ltr[$sta] }\n" if ($tag eq "all");

  &mkpart($file, $voices, $big, $sta, $end);

  print $fh "  \\layout {\n";
  if (@$voices > 1) {
    print $fh "    \\context { \\RemoveEmptyStaffContext }\n";
  }
  print $fh "  }\n";

  print $fh "  \\midi {  }\n" if ($midi);
  print $fh "}\n";
}

sub mkfiles {
  my $r = shift;
  my @file = @$r;

  my $voices = shift;
  my $big = shift;
  my @pieces = @_;

  if (@file == 0) {   &mkhdr(); }
  while (@pieces > 1) {
    &run( shift @file, $voices, $big, @pieces);
    shift @pieces;
  }
}

my @file;
my @sel;
my @pieces;

&init();

$tag = "all";
@file = ("all.ly");
@sel = (0..16);
@pieces = ( 1, 2, 14, 23, 29, 35, 40 );
&mkfiles( \@file, \@sel, -1, @pieces );

$tag = "act";
$midi = 1;
@file = qw( act0.ly act1.ly act2a.ly act2b.ly act3a.ly act3b.ly );
&mkfiles( \@file, \@sel, -1, @pieces );
$midi = 0;

$tag = "part";
my $ix;
for ($ix = 0; $ix < @voice; $ix++) {
  @file = ( "P" . $voice[$ix][2] . ".ly");
  @sel = ($ix);
  &mkfiles( \@file, \@sel, -1, @pieces );
}

$tag = "voice";
@sel = (0..$index{"cb"}, $index{"vd"});
@file = qw( actHU0.ly actHU1.ly actHU2a.ly actHU2b.ly actHU3a.ly actHU3b.ly );
&mkfiles( \@file, \@sel, $index{"vd"}, @pieces );

$tag = "cs";
@file = qw( actS0.ly actS1.ly actS2a.ly actS2b.ly actS3a.ly actS3b.ly );
&mkfiles( \@file, \@sel, $index{"cs"}, @pieces );
$tag = "ca";
@file = qw( actA0.ly actA1.ly actA2a.ly actA2b.ly actA3a.ly actA3b.ly );
&mkfiles( \@file, \@sel, $index{"ca"}, @pieces );
$tag = "ct";
@file = qw( actT0.ly actT1.ly actT2a.ly actT2b.ly actT3a.ly actT3b.ly );
&mkfiles( \@file, \@sel, $index{"ct"}, @pieces );
$tag = "cb";
@file = qw( actB0.ly actB1.ly actB2a.ly actB2b.ly actB3a.ly actB3b.ly );
# &mkfiles( \@file, \@sel, $index{"cb"}, @pieces );

$tag = "choir";
@sel = ($index{"cs"} .. $index{"cb"});
@file = qw( actC0.ly actC1.ly actC2a.ly actC2b.ly actC3a.ly actC3b.ly );
&mkfiles( \@file, \@sel, -1, @pieces );

__END__
