package Lilypond;
#use Data::Dumper;

use strict;
use Data::Dumper;

use Exporter 5.57 'import';
our @EXPORT_OK = qw/
 alfaNum numAlfa parse_score_code mk_score mk_midi mk_music
/;

my @num = split(//, "abcdefghjk");
my %num;
for (my $ix = 0; $ix < @num; $ix++) { $num{$num[$ix]} = $ix; }

sub alfaNum($) {
    my $alfa = shift;
    my @alfa = split(//,$alfa);
    my @num  = map { $num{$_} } @alfa;
    join("", @num);
}
sub numAlfa($;$) {
    my $num = shift;
    my $len = shift // length($num);
    my $str = sprintf("%0${len}d", $num);
    my @arr = split(//, $str);
    #print "<$num> <$len> <$str> <", join("> <", @arr), ">\n";
    my @alfa = map { $num[$_] } @arr;
    join("", @alfa);
}

sub parse_score_code($) {
    my $code = shift;
    #code is e.g.
    # '{ Oba Obb } { Via Vib Va } [2 Can Alt Ten Bas ] { Vc Fag BC }'
    # {  ... } => GrandStaff
    # [  ... ] => StaffGroup
    # {p ... } => PianoStaff
    # [n ... ] => ChoirStaff + lyrics, where n = number of verses
    # plus the names of the voices, one per staff
    # tokens have to be separated by whitespace (spaces or tabs)

    my @fld = split(/[ \t]+/, $code);

    my $data = [ ];
    my $current = $data;
    my @prv = ($data);
    my @stop = ("");
    for my $token (@fld) {
	my $stop = $stop[$#stop];
	if ($token =~ m/^[{[]/) {
	    my $nxt = [ ];
	    if      ($token eq "{") {           # GrandStaff
		push @stop, "}";
		push @$nxt, "GrandStaff";
	    } elsif ($token eq "[") {           # StaffGroup
		push @stop, "]";
		push @$nxt, "StaffGroup";
	    } elsif ($token eq "{p") {          # PianoStaff
		push @stop, "}";
		push @$nxt, "PianoStaff";
	    } elsif ($token =~ /^\[(\d+)$/) {   # ChoirStaff
		push @stop, "]";
		push @$nxt, ("ChoirStaff", $1);
	    } else {
		printf(STDERR
		       "unknown token <%s> in code <%s>\n",
		       $token, $code);
		return "";
	    }
	    #print "token <$token> stop <", join("> <", @stop), ">\n";
	    push @$current, $nxt;

	    push @prv, $current;
	    $current = $nxt;
	    #print join(" ", @nxt), "\n";
	} elsif ($token eq $stop) {
	    $current = pop @prv;
	    pop @stop;
	    #print "End token\n";
	} elsif ($token =~ /^[a-zA-Z]+$/) { # a voice name
	    push @$current, $token;
	    #print "voice <$token>\n";
	} else {
	    printf(STDERR
		   "unknown token <%s> in code <%s>\n",
		   $token, $code);
	    return "";
	}
    }

    $data;
}

sub mk_score_run($$$$);
sub mk_score($;$$$) {
    my $data = shift;
    my $num  = shift // 0;
    my $lyr  = shift // {}; # allowed variable names (if set)
    my $mus  = shift // {}; # allowed variable names (if set)

    if (ref($data) ne "ARRAY") { return ""; }
    if (@$data < 1) { return ""; }
    my $CNT = numAlfa($num . "");

    my $score =
"\\score {
  \\header { piece = \\hdr$CNT }
  <<
    \\scorePre
";

    $score .= mk_score_run($data, "    ", $lyr, $mus);

    $score .=
"  >>
  \\layout { }
}
";

    $score;
}
sub mk_score_run($$$$) {
    my $data = shift;
    my $pfx = shift;
    my $lyr  = shift // {}; # allowed variable names (if set)
    my $mus  = shift // {}; # allowed variable names (if set)

    my $score = "";

    my $lyrcnt = scalar keys %$lyr;
    my $muscnt = scalar keys %$mus;

    my $sta = 0;
    my $cnt = 0;
    my $cntlen = 0;
    my $staff = $$data[0];
    if      ($staff eq "GrandStaff") {
	$sta = 1;
    } elsif ($staff eq "StaffGroup") {
	$sta = 1;
    } elsif ($staff eq "PianoStaff") {
	$sta = 1;
    } elsif ($staff eq "ChoirStaff") {
	if (@$data < 3) { return ""; }
	$sta = 2;
	$cnt = $$data[1];
	$cntlen = length($cnt . "");
    } else {
	$staff = "";
    }

    if (@$data < $sta+1) { return ""; }
    my $npfx = $pfx;
    if ($staff eq "PianoStaff") {
	my $name = $$data[$sta];
	$score .= "$pfx\\new $staff \\with \\name$name <<\n";
	$npfx .= "  ";
    } elsif ($staff) {
	$score .= "$pfx\\new $staff\n$pfx<<\n";
	$npfx .= "  ";
    }

    for (my $ix = $sta; $ix < @$data; $ix++) {
	my $nxt = $$data[$ix];
	if (ref($nxt) eq "ARRAY") {
	    my $res = mk_score_run($nxt, $npfx, $lyr, $mus);
	    $score .= $res;
	} else {
	    my $name = $nxt;
	    if ($muscnt < 1 || $$mus{$name} ) {
		$score .= "$npfx\\staff$name\n";
		if ($staff eq "ChoirStaff") {
		    for (my $ix = 0; $ix < $cnt; $ix++) {
			my $CNT = uc(numAlfa($ix, $cntlen));
			if ($lyrcnt < 1 || $$lyr{"$name$CNT"}) {
			    $score .= "$npfx\\lyricsto voice$name \\lyr${name}$CNT\n";
			}
		    }
		}
	    }
	}
    }

    if ($staff) {
	$score .= "$pfx>>\n";
    }

    $score;
}

sub mk_midi($) {
    my $data = shift;

    if (ref($data) ne "ARRAY") { return ""; }
    if (@$data < 1) { return ""; }

    my $midi =
"\\score {
  \\unfoldRepeats
  <<
";

    my $mstaff = mk_midi_run($data);
    if ($mstaff eq "") { return ""; }
    $midi .= $mstaff;

    $midi .=
"  >>
  \\midi { }
}
";
}
sub mk_midi_run($);
sub mk_midi_run($) {
    my $data = shift;
    my $midi = "";

    my $sta = 0;
    my $staff = $$data[0];
    if      ($staff eq "GrandStaff") {
	$sta = 1;
    } elsif ($staff eq "StaffGroup") {
	$sta = 1;
    } elsif ($staff eq "PianoStaff") {
	$sta = 1;
    } elsif ($staff eq "ChoirStaff") {
	if (@$data < 3) { return ""; }
	$sta = 2;
    } else {
    }

    if (@$data < $sta) { return ""; }

    for (my $ix = $sta; $ix < @$data; $ix++) {
	my $nxt = $$data[$ix];
	if (ref($nxt) eq "ARRAY") {
	    my $res = mk_midi_run($nxt);
	    $midi .= $res;
	} else {
	    my $name = $nxt;
	    $midi .= "    \\mstaff$name\n";
	}
    }

    $midi;
}

sub mk_music($);
sub mk_music($) {
    my $data = shift;

    my @empty = ("", "");
    if (ref($data) ne "ARRAY") { return @empty; }
    if (@$data < 2) { return @empty; }

    my $lyr = "";
    my $mus = "";

    my $sta = 0;
    my $cnt = 0;
    my $cntlen = 0;
    my $staff = $$data[0];
    if      ($staff eq "GrandStaff") {
	$sta = 1;
    } elsif ($staff eq "StaffGroup") {
	$sta = 1;
    } elsif ($staff eq "PianoStaff") {
	$sta = 1;
    } elsif ($staff eq "ChoirStaff") {
	if (@$data < 3) { return @empty; }
	$sta = 2;
	$cnt = $$data[1];
	$cntlen = length($cnt . "");
    } else {
	$staff = "";
    }

    for (my $ix = $sta; $ix < @$data; $ix++) {
	my $nxt = $$data[$ix];
	if (ref($nxt) eq "ARRAY") {
	    my @res = mk_music($nxt);
	    $lyr .= $res[0];
	    $mus .= $res[1];
	} else {
	    my $name = $nxt;
	    if ($staff eq "ChoirStaff") {
		for (my $ix = 0; $ix < $cnt; $ix++) {
		    my $CNT = uc(numAlfa($ix, $cntlen));
		    $lyr .= "lyr${name}$CNT = \\lyricmode {\n}\n";
		}
	    }
	    $mus .= "mus$name = \\relative f {\n}\n\n";
	}
    }

    ( $lyr, $mus );
}

1;