#!/usr/bin/perl
use XML::DT ;
my $filename = shift;
use strict;
my $M = "\cA";

sub clef{
 my %b=@_;
 if($b{"clef-octave-change"}==-1){ return "$b{sign}-8"}
 if($b{"clef-octave-change"}==1) { return  "$b{sign}+8"}
 if($b{sign} eq "percussion")    { return  "perc"}
 return $b{sign}
}

sub nnl{
 my $a=shift;
 $a =~ s/\s+/ /g;
 $a;
}

sub note{
  my ($st,$t,$a)=@_;
  if($a eq "sharp")         { return "^$st$t" }
  if($a eq "flat")          { return "_$st$t" }
  if($a eq "natural")       { return "=$st$t" }
  if($a eq "double-sharp")  { return "^^$st$t" }
  if($a eq "flat-flat")     { return "__$st$t" }
                            { return  "$st$t" }
}

sub pit{
  my ($st,$o)=@_;
  if ($o == 1 ){ return  "$st,,,"         }
  if ($o == 2 ){ return  "$st,,"         }
  if ($o == 3 ){ return  "$st,"          }
  if ($o == 4 ){ return  "$st"           }
  if ($o == 5 ){ return  lc($st)         }
  if ($o == 6 ){ return  lc($st)."'"     }
  if ($o == 7 ){ return  lc($st)."''"    }
  if ($o == 7 ){ return  lc($st)."'''"   }
  return "???pitch$o???";
}

sub temp{
  my ($o)=@_;
  if ($o eq "32th"   ){ return  "/4"        }
  if ($o eq "16th"   ){ return  "/2"        } ## "/"
  if ($o eq "eighth" ){ return  ""          } ## 1
  if ($o eq "quarter"){ return  "2"         } 
  if ($o eq "half"   ){ return  "4"         }
  if ($o eq "whole"  ){ return  "8"         }
  return "???tempo$o???";
}

sub t2{
  my ($o)=@_;
  if ($o eq "16th"   ){ return  "1/16"       }
  if ($o eq "eighth" ){ return  "1/8"        }
  if ($o eq "quarter"){ return  "1/4"        }
  if ($o eq "half"   ){ return  "1/2"        }
  if ($o eq "whole"  ){ return  "1"          }
  return "???tempo$o???";
}

sub dot{
  my ($o)=@_;
  if ($o eq "/4"){ return "3/8"        }
  if ($o eq "/2"){ return "3/4"        }
  if ($o eq "1" ){ return "3/2"        }
  if ($o eq "2" ){ return "3"          }
  if ($o eq "4" ){ return "6"          }
  return "???dot$o???";
}

sub barline{   ## repdir  number star stop
 my %b=@_;
 if ($b{type} eq "stop" )      { return '"S"' }  #Fix me
 if ($b{number} == 1 )         { return "|1" }
 if ($b{number} > 1 )          { return ":|$b{number}" }
 if ($b{repdir} eq "forward" ) { return "|:" }
 if ($b{repdir} eq "backward" ){ return ":|" }
 if ($b{"bar-style"} eq "light-heavy" && $b{"location"} eq "right") 
                               { return "|]" }
 "||".join("+",%b)."||"
}

sub lyr{      ## Fixme
 my %b=@_;
 $b{text};
}

sub key{
  my ($fifths, $mode)=@_;
  my $m = ($mode eq "minor" ? "m" : "" );
  if($fifths ==  0){return "C$m" }
  if($fifths ==  1){return "G$m" }
  if($fifths ==  2){return "D$m" }
  if($fifths ==  3){return "A$m" }
  if($fifths ==  4){return "E$m" }
  if($fifths ==  5){return "B$m" }
  if($fifths ==  6){return "F#$m" }
  if($fifths ==  7){return "C#$m" }
  if($fifths == -1){return "F$m" }
  if($fifths == -2){return "Bb$m" }
  if($fifths == -3){return "Eb$m" }
  if($fifths == -4){return "Ab$m" }
  if($fifths == -5){return "Db$m" }
  if($fifths == -6){return "Gb$m" }
  if($fifths == -7){return "Cb$m" }
  return "???fifths$fifths???";
}

sub h   { "$M$_[0]: $_[1]$M"; }   ##  A1: ...
sub com { "$M% $_[0]$M"  }        ##  % ... 
sub com2{ "$M%%$_[0] $_[1]$M"  }  ##  %%A1 ...

sub words { qq{"$_[0]"} }         ## Fix me...

my %handler=(
#    '-outputenc' => 'ISO-8859-1',
    '-default'   => sub{toxml },
     -type =>{time      =>"MAP",
              metronome =>"MAP",
              key       =>"MAP",
              lyric     =>"MAP",
              clef      =>"MAP" },
     'accidental'  => sub{ father->{acid} = $c; "" }, #
#     'alter' => sub{ }, # 26 ;
     'attributes' => sub{ $c }, # 1 ;
     'barline' => sub{ barline(%v); }, # 3 ; attributes: location
     'bar-style' => sub{ father->{$q}=$c;"" }, # 3 ;
     'beam' => sub{ "" }, # 78 ; attributes: number
     'beat-type' => sub{$c }, # 1 ;
     'beat-unit' => sub{$c }, # 1 ;
     'beats' => sub{$c }, # 1 ;
     'clef' => sub{h("K"," clef=".clef(%$c)) }, # 1 ;
     'clef-octave-change' => sub{$c }, # 1 ;
     'creator' => sub{ h("C", "$v{type} $c") }, # 1 ; attrigutes: type
     'direction' => sub{ $c }, # jj? 1 ;
     'direction-type' => sub{ $c }, # jj? 1 ;
     'divisions' => sub{ com($c) }, # 1 ;
     'dot' => sub{ father->{t}=dot(father->{t}); "" },
     'duration' => sub{ "" }, # 40 ;
     'encoding' => sub{ "" }, # 1 ;
#     'encoding-date' => sub{ }, # 1 ;
#     'encoding-description' => sub{ }, # 1 ;
     'ending' => sub{ father->{number} = $v{number};
                      father->{type} = $v{type}; "" }, # 1 ;
     'fifths' => sub{"" }, # 1 ;
     'identification' => sub{ $c }, # 1 ;
     'key' => sub{h("K", key($c->{fifths}.$M, $c->{mode})) }, # 1 ;
#     'line' => sub{ }, # 1 ;
     'lyric'  => sub{ father->{lyr}=lyr(%v,%$c); ""}, # JJsimp copyrights
     'measure' => sub{ 
          nnl($c)." | % $v{number}$M " .
          ($v{cardlyr} 
          ? h("w",join(" ",@{$v{lyr}}))
          : ""
          ) ;
      },
     'metronome' => sub{ h("Q", t2($c->{"beat-unit"})."=". $c->{"per-minute"}) }, # 1 ;
#     'miscellaneous' => sub{ }, # 1 ;
#     'miscellaneous-field' => sub{ }, # 2 ; attributes: name
     'mode' => sub{ $c }, # 1 ;
     'movement-title' => sub{ h("T", $c) }, # 1 ;
     'notations' => sub{"" }, # 40 ;
     'note' => sub{ 
         father->{cardlyr}++ if $v{lyr};
         push(@{father->{lyr}},$v{lyr});
         nnl($c). note($v{pitch},$v{t},$v{acid}) }, # 40 ;
     'octave' => sub{ father->{o}= 0+$c ; "" }, # 40 ;
     'part' => sub{h("V",$v{id}).$c }, # 1 ; attributes: id
     'part-list' => sub{ "" }, # JJsimpl 1 ;
#     'part-name' => sub{ }, # 1 ;
     'per-minute' => sub{$c }, # 1 ;
     'pitch' => sub{ father->{$q}=pit($v{st},$v{o}); "" }, # 40 ;
     'print' => sub{ ""}, # JJsimp 1 ; attributes: new-system
     'repeat' => sub{ father->{repdir}=$v{direction};"" }, # 3 ; attributes: direction
     'rest'  => sub{ father->{pitch} = "z"; "" }, #
     'rights'  => sub{ com2("abc-copyright",$c)}, # JJsimp copyrights
#     'score-part' => sub{ }, # 1 ; attributes: id
     'score-partwise' => sub{"X:1$M". nnl($c)}, # 1 ;
     'sign' => sub{$c }, # 1 ;
#     'software' => sub{ }, # 1 ;
     'sound' => sub{"" }, # jjsimpl 1 ; attributes: tempo
     'stem' => sub{ ""  }, # JJsimp
     'step' => sub{  father->{st}= $c ; ""  }, # 40 ;
     'syllabic' => sub{$c }, # 1 ;
     'text' => sub{$c }, # 1 ;
     'time' => sub{ h("M", "$c->{beats}/$c->{'beat-type'}") }, # 1 ;
     'type' => sub{ father->{t}= temp($c) ; "" }, # 40 ;
     'voice' => sub{ $c == 1 ? "" : toxml }, # 1 ;
     'words' => sub{ words($c,%v) }, # 1 ;
     'work' => sub{ $c }, # 1 ;
     'work-title' => sub{ h("T", $c) }, # 1 ;

      -end => sub { $c =~ s/(\s*$M)+/\n/g; $c },
);
print dt($filename,%handler);

__END__

<score-partwise>
    <work>
        <work-title>abcm2ps version 3 features</work-title>
    </work>
    <identification>