#use Parse::DSLUtils qw(:yapp);
use strict;
use utf8::all; 
my $instruments=join("",<DATA>);
my %DEF = ( 
  drumoff   => "%%MIDI drumoff\n"  ,
  chordoff  => "%%MIDI gchordoff\n" ,
  chordon   => "%%MIDI gchordon\n" ,
  transpose => "%%MIDI transpose #1",
  volume    => "%%MIDI control 5 #1",
  chordvol  => "%%MIDI chordvol #1\n%%MIDI bassvol #1",
);
my $gchordsre =qr{([bcfghijGHIJz\d()]+)};
my $drumsre   =qr{([dz\d()]+)};
my $optbarsre =qr{(?:(\d+)/)?};

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

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


REC:ABC{   ### ABC header level
(M:\s*(\d+).*\n)           { $M=$2; print $1;                 }

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

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

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

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($1));      }

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

CH:\s*(\w+)                { print("V:$1"); REC CHVOICE;}
                                  ## }}

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

REC:CHVOICE{

(\nV:\s*\w+)               { print $1;   DONE;}
CH:\s*(\w+)                { print("V:$1");}

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

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

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

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

}

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($1));       }


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

(:?\|\|?\]?\d?:?)               { 
             if($c < $M) { print nch("${chs}z".($M-$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 => "§",param=>"C",def=>{});
 if(ref($_[0]) eq "HASH") {%opt = (%opt , %{shift(@_)}) } ;
 my ($a)=@_;
 my %DEF=(%{$opt{def}});
 my $c=0;
 my $M=$opt{dolar};
 while(
      $a =~ s{$M\binclude\(\s*(\S+?)\s*\)}{
              open(my $F,"<:utf8","$1") or die("#Cant open $1\n");
              my $c=join("",<$F>);
              close $F;
              $c =~  s/\h*(\r\n|\n\r|\n|\r)/\n/g;   ## remove sp before \n
              $c =~  s/^(\xFF\xFE|\xFE\xFF|\xEF\xBB\xBF|\x{FEFF})//;  # BOM!
              $c;}ge
   or $a =~ s{$M(\w+)\s*[=←]\s*\{(.*?)\}}{
              $DEF{"$1"}=qq{$2};"" }ge
   or $a =~ s{$M(\w+)\s*[=←]\s*\((.*?)\)}{
              $DEF{"$1"}=qq{$2};"" }ge
   or $a =~ s{$M(\w+)\((.*?)\)\s*[=←]\s*\{(.*?)\}}{
              my($x1,$x2,$x3)=($1,$2,$3);
              $DEF{"$x1"}= ($x3 =~ s!\b$x2\b!#1!gr) ; "" }ge
   or $a =~ s{\{(.*?)\}\s*[→]\s*$M(\w+)}{
              $DEF{"$2"}=qq{$1}; "$1" }ge
   or $a =~ s{$M(\w+)\((.*?)\)}{
              my($x1,$x2)=($1,$2);
              $DEF{$x1}=~ s!#1!$x2!gr }ge
   or $a =~ s{$M(\w+)}{ $DEF{"$1"} || "\cA$1";       }ge
 ){ err("Infinite loop") if($c++ > 10)}
 $a=~ s/\cA/$M/g;
 ##print Dumper(\%DEF);
 $a;
}

sub err   { die("% Error '$_[0]' \n") }
sub instruC{ "%%MIDI chordprog $_[0]\n"}
sub instruB{ "%%MIDI bassprog $_[0]\n"}
sub gchord{ "%%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  { "%%MIDI drum $_[0] $_[1]\n%%MIDI drumon\n"}

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

sub chordmode{ my ($bars,$gchords,$instru,$bass)=@_;
  $bass=$instru if(not defined($bass));
  my $r="";
  $r.="%%MIDI gchordbars $bars\n" if($bars =~ /\S/);
  $r.="%%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