#use Parse::DSLUtils qw(:yapp);
use strict;
use utf8::all; 
my $instruments=join("",<DATA>);
my %DEF = (
  drumon  => "[I:MIDI= drumon]\n"  ,
  drumoff  => "[I:MIDI= drumoff]\n"  ,
  chordoff => "[I:MIDI= gchordoff]\n" ,
  chordon  => "[I:MIDI= gchordon]\n" ,
  transpose => "[I:MIDI= transpose #1]",
  volume    => "[I:MIDI= control 5 #1]\n",
  chordvol  => "[I:MIDI= chordvol #1 MIDI= bassvol #1]",
  mus3 => "X: 1\nT: #1\nM: 3/4\nK: C\nL: 1/4\n|",
  mus4 => "X: 1\nT: #1\nM: 4/4\nK: C\nL: 1/4\n|",
);

my $gchordsre =qr{([bcfghijGHIJz\d()|\-]+)};
my $drumsre =qr{([dz\d()]+)};
my $optbarsre =qr{(?:(\d+)/)?};

my $M=qr{\\}; 
my $yyst;
my $yyFile=preproc({def=>{%DEF}},join("",<>));
%initstate  ABC 
%white   [\ \t]+   
%comments ##.+    

%%
  my $c=0;
  my $chs="";
  my $Met;

REC:ABC{   ### ABC header level
(M:\s*(\d+)\h*\/\h*(\d+).*\n) 
                           { $Met=[$2,$3]; print $1; }

drummode\s+(\w+)\h*=\h*$optbarsre$drumsre\h+(.*)\n 
                           { $DEF{$1} = drummode($2,$3, $4);  }

chordmode\s+(\w+)\h*=\h*$optbarsre$gchordsre\h+(\S+)\h+(\S+)\h*\n
                           { $DEF{$1} = chordmode($2,$3,$4,$5);  }

chordmode\s+(\w+)\h*=\h*$optbarsre$gchordsre\h+(\S+)\h*\n
                           { $DEF{$1} = chordmode($2,$3,$4);  }

chordmode\s+(\w+)\h*=\h*$optbarsre$gchordsre\h*\n
                           { $DEF{$1} = chordmode($2,$3);  }

drummode(.*)               { die("bad drummode '$1'\n")       }
chordmode(.*)              { die("bad chordmode '$1'\n")      }

\\(\w+)\s*[=←]\s*\{(.*?)\}  { $DEF{$1}=$2;                     }
\{(.*?)\}\s*[→]\s*\\(\w+)   { $DEF{$1}=$2; print $2            }
\\(\w+)                     { print($DEF{$1} || err("undef $1"));      }

chords\[(\w+)\]\{          { print($DEF{$1} || err("undef $1")); REC CHORDS;}
chords\{                   {                             REC CHORDS;}

DR:\s*(\w+)\h*\n           { print("V:$1\n"); REC DRVOICE;}
dr:\s*\h*                  {                  REC DRVOICE;}
CH:\s*(\w+)\h*\n           { print("V:$1\n"); REC CHVOICE;}
ch:\s*\h*                  {                  REC CHVOICE;}
                                  ## }}

(.*\n)                     { print $1;                        }
}

REC:DRVOICE{

\n(?=(V|CH|DR|W|X|P|dr|ch):\s*\w+)   { DONE;}

\\(\w+)\s*[=←]\s*\{(.*?)\}  { $DEF{$1}=$2; }
\{(.*?)\}\s*[→]\s*\\(\w+)   { $DEF{$1}=$2; print $2            }
\\(\w+)                     { print($DEF{$1} || err("undef $1"));       }

(X\d*\s*\|\|?\]?\:?)       { print "$DEF{drumoff}$1\n$DEF{drumon}" }

(:?\|\|?\]?\d?:?)               { 
             if($c < $Met->[0]) { print nch("${chs}z".($Met->[0]-$c)."$1\n");}
               else        { print nch("$chs$1\n");}
             $c=0; $chs=""
           } 

\.                         { $c++; $chs .= "z";}

([^\s.:|]+)                { $c++; $chs .= qq{ "$1"z}; }
([:])                      { $chs .= $1;}

\n         { }

}

REC:CHVOICE{

\n(?=(V|CH|DR|W|X|P|dr|ch):\s*\w+)   { DONE;}

\\(\w+)\s*[=←]\s*\{(.*?)\}  { $DEF{$1}=$2; }
\{(.*?)\}\s*[→]\s*\\(\w+)   { $DEF{$1}=$2; print $2            }
\\(\w+)                     { print($DEF{$1} || err("undef $1"));       }

(X\d*\s*\|\|?\]?\:?)        { print "$DEF{chordoff}$1\n$DEF{chordon}" }

(:?\|\|?\]?\d?:?)               { 
             if($c < $Met->[0]) { print nch("${chs}z".($Met->[0]-$c)."$1\n");}
               else      { print nch("$chs$1\n");}
             $c=0; $chs=""
           } 

\.                         { $c++; $chs .= "z";}

(%.*\n)                    { print $1}
([^\s.:|]+)                { $c++; $chs .= qq{ "$1"z}; }
([:])                      { $chs .= $1;}

\n         { }

}

REC:CHORDS{   ### {{

\}\h*\n    { print $chs; DONE;  }
\}         { print $chs; DONE;  }

\\(\w+)\s*[=←]\s*\{(.*?)\}  { $DEF{$1}=$2; }
\{(.*?)\}\s*[→]\s*\\(\w+)   { $DEF{$1}=$2; print $2            }
\\(\w+)                     { print($DEF{$1} || err("undef $1"));       }


\.                         { $c++; $chs .= "z";}

(X\d*\s*\|\|?\]?\:?)       { print "$DEF{chordoff}$1\n$DEF{chordon}" }

(:?\|\|?\]?\d?:?)               { 
             if($c < $Met->[0]) { print nch("${chs}z".($Met->[0]-$c)."$1\n");}
               else      { print nch("$chs$1\n");}
             $c=0; $chs=""
           } 

([^\s.:|]+)                 { $c++; $chs .= qq{ "$1"z}; }
###([:])                    { $chs .= $1;}

\n         { }

}

%%

sub preproc{
 my %opt =(dolar => qr"\\",dolar2=>'\\',argsep=>';',param=>"C",def=>{},sig=>{});
 if(ref($_[0]) eq "HASH") {%opt = (%opt , %{shift(@_)}) } ;
 my ($a)=@_;
## my %SIG=(%{$opt{sig}});
 my %DEF=(%{$opt{def}});
 my $c=0;
 my $M=$opt{dolar};
 my $M1=$opt{dolar2}; 
 while( 0
   or $a =~ s{$M\binclude\(\s*(\S+?)\s*\)}{                    #\include(file)
              open(my $F,"<:utf8","$1") or die("#Cant open $1\n");
              my $co=join("",<$F>);
              close $F;
              $co =~  s/\h*(\r\n|\n\r|\n|\r)/\n/g;   ## remove sp before \n
              $co =~  s/^(\xFF\xFE|\xFE\xFF|\xEF\xBB\xBF|\x{FEFF})//;  # BOM!
              $co;}ge
#   or $a =~ s{$M(\w+)\s*[=←]\s*\{\{(.*?)\}\}}{                #\a={{perl}}
#              my($x1,$x2)=($1,$2);
#              $DEF{$x1}=sub{$x2};"" }sge
   or $a =~ s{$M(\w+)\s*[=←]\s*\{(.*?)\}}{                     #\a={var}
              $DEF{"$1"}=qq{$2};"" }sge
   or $a =~ s{$M(\w+)\s*[=←]\s*\((.*?)\)}{                     #\a=(var)
              $DEF{"$1"}=qq{$2};"" }ge
   or $a =~ s{$M(\w+)\((.*?)\)\s*[=←]\s*\{(.*?)\}}{            #\a(v)={f(v)}
              my($x1,$x2,$x3)=($1,$2,$3);
              my @args=split(/$opt{argsep}/,$x2);
              for(1..@args){$x3 =~ s!\b$args[$_-1]\b!#$_!g } 
              $DEF{"$x1"}= $x3 ;
              "" }sge
   or $a =~ s{\{(.*?)\}\s*[→]\s*$M(\w+)}{                      #{var}→\a
              $DEF{"$2"}=qq{$1}; "$1" }sge
   or $a =~ s{$M(.*?)\((.*?)\)}{                               #\a(v) FIXME
              my($x1,$x2)=($1,$2);
              my $x3=$DEF{$x1};
              my @args=split(/$opt{argsep}/,$x2);
              for(1..@args){$x3 =~ s!#$_\b!$args[$_-1]!g } 
              $x3  }sge
   or $a =~ s{$M(\w+)}{ $DEF{"$1"} || "\cA$1"; }ge             #\a
 ){ err("Infinite loop") if($c++ > 100)}
 $a=~ s/\cA/$M1/g;
 ##print Dumper(\%DEF);
 $a;
}


sub err   { die("% Error '$_[0]'($yyst)\n") }
sub instruC{ "[I:MIDI= chordprog $_[0]]\n"}
sub instruB{ "[I:MIDI= bassprog $_[0]]\n"}
sub gchord{ "[I:MIDI= gchord    $_[0]]\n"}
sub nch   { return ($_[0] =~ s/zz(\d*)/"z".(($1||1)+1)/ger) }
sub sinstruC{my $pat=shift;
  $pat=~s/-/.*\\b/g;
  my ($i,$j) = ($instruments =~ m!(\d+)=($pat.*)!g);
  instruC($i,$j) }
sub sinstruB{my $pat=shift;
  $pat=~s/-/.*\\b/g;
  my ($i,$j) = ($instruments =~ m!(\d+)=($pat.*)!g);
  instruB($i,$j) }
sub drum  { "[I:MIDI= drum $_[0] $_[1] MIDI= drumon]\n"}

sub drummode{ my ($bars,$drum,$c)=@_;
  my $r="";
  $r.= "[I:MIDI= drumbars $bars]\n" if($bars =~ /\S/);
  $r.= "[I:MIDI= drum $drum $c MIDI= drumon]\n"; # FIXME
  return $r;
}

sub chordmode{ my ($bars, $gchords, $instru, $bass)=@_;
  $instru =~ s/^\h*(.*?)\h*$/$1/ if defined($instru);
  $bass   =~ s/^\h*(.*?)\h*$/$1/ if defined($bass);
  $instru =0       if(not defined($instru));
  $bass   =$instru if(not defined($bass));
  my $n_bars = ($gchords =~ tr{|}{|});
  $bars=$n_bars+1 if $n_bars+1 > $bars;
#  print "Debug: bars=$n_bars\n";
  $gchords =~ s/[\h|-]//g;
  my $r="";
  $r.="[I:MIDI= gchordbars $bars]\n" if($bars =~ /\S/);
  $r.="[I:MIDI= gchordbars 1]\n" if($bars !~ /\S/);
  $r.= gchord($gchords)       if($gchords =~ /\S/);
  $r.= instruC($instru)       if($instru =~ /^\s*\d+\s*$/);
  $r.= sinstruC($1)           if($instru =~ /^\s*([a-zA-Z].*\S)\s*$/);
  $r.= instruB($bass)         if($bass =~ /^\s*\d+\s*$/);
  $r.= sinstruB($1)           if($bass =~ /^\s*([a-zA-Z].*\S)\s*$/);
  return $r
}

lex();

__DATA__

0=piano
1=bright acoustic piano 
2=electric grand piano
3=honky-tonk piano 
4=electric piano 1 
5=electric piano 2 
6=harpsichord 
7=clavi 
8=celesta 
9=glockenspiel 
10=music box 
11=vibraphone 
12=marimba 
13=xylophone 
14=tubular bells 
15=dulcimer 
16=drawbar organ 
17=percussive organ 
18=rock organ 
19=organ // church organ 
20=reed organ 
21=accordion 
22=harmonica 
23=tango accordion 
24=guitar (nylon) 
25=guitar (steel) 
26=electric guitar (jazz) 
27=electric guitar (clean) 
28=electric guitar (muted) 
29=overdriven guitar 
30=distortion guitar 
31=guitar harmonics 
32=acoustic bass 
33=electric bass (finger) 
34=electric bass (pick) 
35=fretless bass 
36=slap bass 1 
37=slap bass 2 
38=synth bass 1 
39=synth bass 2 
40=violin 
41=viola
42=cello 
43=contrabass 
44=tremolo strings 
45=pizzicato strings 
46=orchestral harp 
47=timpani 
48=string ensemble 1 
49=string ensemble 2 
50=synthstrings 1 
51=synthstrings 2 
52=choir aahs 
53=voice oohs 
54=synth voice 
55=orchestra hit 
56=trumpet 
57=trombone 
58=tuba 
59=muted trumpet 
60=french horn 
61=brass section 
62=synthbrass 1 
63=synthbrass 2 
64=soprano sax
65=alto sax 
66=tenor sax 
67=baritone sax 
68=oboe 
69=english horn
70=bassoon 
71=clarinet 
72=piccolo
73=flute 
74=recorder 
75=pan flute
76=blown bottle
77=shakuhachi 
78=whistle 
79=ocarina 
80=lead 1 (square) 
81=lead 2 (sawtooth)
82=lead 3 (calliope) 
83=lead 4 (chiff) 
84=lead 5 (charang) 
85=lead 6 (voice) 
86=lead 7 (fifths) 
87=lead 8 (bass + lead)
88=pad 1 (new age)
89=pad 2 (warm) 
90=pad 3 (polysynth)
91=pad 4 (choir) 
92=pad 5 (bowed) 
93=pad 6 (metallic) 
94=pad 7 (halo) 
95=pad 8 (sweep) 
96=fx 1 (rain) 
97=fx 2 (soundtrack) 
98=fx 3 (crystal) 
99=fx 4 (atmosphere) 
100=fx 5 (brightness) 
101=fx 6 (goblins) 
102=fx 7 (echoes) 
103=fx 8 (sci-fi) 
104=sitar 
105=banjo 
106=shamisen 
107=koto 
108=kalimba 
109=bag pipe 
110=fiddle 
111=shanai 
112=tinkle bell 
113=agogo 
114=steel drums 
115=woodblock 
116=taiko drum 
117=melodic tom 
118=synth drum 
119=reverse cymbal 
120=guitar fret noise 
121=breath noise 
122=seashore 
123=bird tweet 
124=telephone ring 
125=helicopter 
126=applause 
127=gunshot