#!/usr/bin/perl

###############
## Libraries ##
###############
use FileHandle; use Time::HiRes qw(usleep gettimeofday);use Tk;
$B = eval { require Win32::Sound }; $B or require Gnome::Sound;

####################
## Initialization ##
####################
$F={1,{qw[f 1 S 1 q 1 s 1]},2,{qw[f 1 S 1 q 1]},4,{qw[f 1 S 1]},8,{qw
[S 1]},};sub X{length$_[0]}foreach$b(keys%$F){$p=$F->{$b};map{$F->{$b
*1.5}->{$_}=$F->{$b}->{$_} } (keys%$p); $F->{$b *1.5}->{d}=1} $,='li'
; $;='a.wav'; @i = map { $o = $_; map {$o.$_ }('A'..'G')}(1..5);$si-=
3; $px = { }; for (@i) { $px->{$_} = $si++ ; last if ($_ eq '5E')}map
{$px->{"$_#"}=$px->{$_.'b'}=$px->{$_}} (keys%$px);$E={qw(1A 3- 1B 2%-
1C 2- 1D 1%- 1E 1 3C 1 5A 1 5B 1%+ 5C 2+ 5D 2%+ 5E 3+)};map {$E->{$_.
'#'}=$E->{$_} } ( keys % $E); $G = 4; $ja = 472; $n = 55; $Y= $Z=100;
$I={};$T= $J=3; $j = $U = $v = $W = $z = $oo = 0;$w = { };$V = {};sub
P{my($p, $q, $r, $s) = @_; $st = $I->{$q.$r}; $s/=100;$ha =0;$ck=$st/
11025;$er= $s *11025; map { $X = 327.67* $Y*sin($ha*6.2831853); if($R
>=@$p) {push @$p,$X}else{$p->[$R]+= $X } $R++; $ha += $ck } (1..$er)}

##################
## Command-line ##
##################
my $input = shift||
   '<75>[1]vV+|:{1(1)/1C/DEFG+ABCDEFG+ABCBAAbADCBAA-GF#GrG+E-GrF+'.
   'E-FrF+D-FrE+D-ErE+C-ErD+C-DrD+B-D^+Cr}:||:(.25)2G+CEDCBA-GFED'.
   'CBA-GF*E+EFF#G.E`Dr:|=1vV-|:{2(2)1C/E~CF~CE+CAB-G#+A-FGCr}:||'.
   ':(2)EDCB:|=2vV-|:{3(2)0C/ECFCE+CAB-G#+A-FGCr}:||:(2)GGGG:|=3';

##################
## Main Program ##
##################
 $x=55; $D= 2**(1/12); map{$U=$_;$y=$x*(2**$U);for($i=0;$i<7;$i++)
  {$t=[qw(A B C D E F G)]->[$i]; $u = $U.$t; $I->{$u} = $y;last if(
   '5E'eq$u);$I->{"${u}b"}=$y/$D; $I->{"${u}#"} = $y * $D; $y *= ($D
     ** [2,1,2,2,1,2,2]->[$i])}}( 1..5 );W($input,50,20);$cv= tkinit->
     Scrolled ('Canvas', -scrollbars,'se')->form; $cv->configure (-wi,
     850,-he, $ja,-bg, 'white',-confine, 1); S(0,$G-1); update $cv;$B?
    Win32::Sound::Volume(0xffffffff):Gnome::Sound::init('localhost');
   $B? Win32::Sound::Play($;,1):Gnome::Sound::play($;);$nt=$ot=-0.2+
  gettimeofday; $k = 0;while($k<=$V->{V}){$tt=$ot+($k+1)/128;while(
 $nt<$tt){usleep(1/4096);$nt=gettimeofday()}while($ot+($k+1)*1/128
 <=$nt){$nb=$V->{$k++};while(@{$V->{$k}}>0){push@$nb,@{$V->{$k++}}
 }($k%128)or i(12);if($nb){while(@$nb){($nn,$dd)=splice(@$nb,0,2);
  $sd=($nn=~s/([-+])$//)? $1:0; $dd*=8;t($nn, $dd,$sd)} $cv->update
   ;i(18)}}}while(1){$cv->update;usleep 100000}#5/3/2006 - liverpole


##################
## Subroutines ###
##################
sub C { create $cv(@_) } sub i{ $n+=$_[0];if($n+18>=822){$n=55;if
  (++$j>=$G){S($G,$G);$ja+=114;$cv->configure(-scrollregion,[0,0,
  850,$ja]);$cv->yviewMoveto(1-(1/$G));++$G}}}sub S {my ($C,$c)=@
  _; for ($i=$C;$i<=$c;$i++) {$jo=$i*114; map{$xy=35+$jo+6*$_;5eq
  $_ or create$cv($,, 20,$xy, 830, $xy) }(0..10)}}sub R{my($C)=@_
  ;$l=0;$d={};while($C=~s/{(.)([^}]*)}/$2/){my$sm=$1;$d->{$sm}=$2
  }while($C=~/=(.)/){my$sm=$1;$c=$d->{$sm};$C=~s/=\Q$sm\E/$c/}map
  {if (/\|:/) { $c[++$l] = "" } elsif (/:\|/) { $c[$l-1] .= $c[$l
  ]x2; --$l } else { $c[$l] .= $_ } }split(/(\|:|:\|)/,$C); $c[0]
  }sub W{my($a,$b,$c)=@_;$_=R($a);$v=$Z=$b;$U=$W=$c;my$p=[];while
  ($_) { if (s/^\(([.\d]+)\)//){$v=$Z*$1}elsif(s/^<(\d+)>//) { $Y
  =$1} elsif (s/^\[([-\d]+)\]//){$oo=$1}elsif(s/^(\-|\+)//){$T+=(
  $1eq'+')?1:-1}elsif(s/^(\d+)//) { $T = $1 }elsif(s/^(\*|\/)//){
  $v*=($1eq'*')?2:.5}elsif(s/^(\^|_)//){$v*=($1eq'^')?4:.25}elsif
  (s/^!(\d+)!//){$U = $1} elsif (s/^@(.)//) {$w->{$1}||=$R}elsif(
  s/^&(.)//){$R=$w->{$1}}elsif(s/^v//){ ++$z;$R=$S =0; $T = $J;$v
  =$Z;$U=$W}elsif(s/^V(.)//){$S=$1}else{D(\$_,$p)}}sysopen($A,$;,
  O_WRONLY|O_CREAT)or die$!.$/;$N=4*@$p;$H=pack('A4Va4A4VvvVVvv'.
  'a4V','RIFF',$N+36,'WAVE','fmt',16,1,2,11025,44100,4,16,'data',
  $N);syswrite($A,$H,44);for($i=0;$i<@$p;$i++){my$vu=$p->[$i]/($z
  ||1);$da=pack('s',$vu);$O.=$da.$da;if(X$O>4096){syswrite($A,$O,
  X $O); $O =""}($i< @$p) or last } syswrite ($A,$O,X$O);close$A;
}

sub t {
  my ($nn, $nb, $sd) = @_;
  my$pd=$F->{$nb};my$yy=35+$j*114;$yy+=69;$x=$n;$nn=~/(.)(.+)/;$et=$2;
  my$idx=$px->{$1.$et};defined($idx)or return;my$y=$yy-($idx*3);if($et
  =~/[#b]/){$x-=8;if($et=~/#/){C($,,$x-4,$y-1,$x+3,$y-3);C($,,$x-3,$y+
  3,$x+4,$y+1);C($,,$x-3,$y-4,$x,$y+5);C($,,$x,$y-5,$x+3,$y+4)}else{C(
  $,,$x-2, $y-8,$x-2,$y+4);C($,,$x-2,$y+3,$x+3,$y+1);C($,,$x+2,$y+1,$x
  +3,$y-1);C($,,$x+2,$y-1,$x-2,$y-3)}$x+=8}@a=$pd->{'f'}?(-fi,'blue'):
  ();create$cv ('ov',$x-3, $y-3, $x+3, $y+3, @a); $pd->{'d'} and $cv->
  createOval($x+3+3,$y+1,$x+3+6,$y+4,-fi,'black');if($pd->{S}||0){my($
  sx,$sy)=($x,$y);$sd||=0;$g=20;$di=1;if('-'eq$sd||(!$sd&&$idx<$px ->{
  '3C'})){$di=-1;$sx-=2*3;$g=-$g}create$cv($,,$sx+3,$sy,$sx+3,$sy-$g);
  if($pd->{q}||0){$sx+=3;$sy-=$g;$Q=8;$P=4;$P=$di*$P;create$cv($,,$sx,
  $sy,$sx+$Q,$sy+$P);if($pd->{s}||0){$sy+=$P;create$cv($,,$sx,$sy,$sx+
  $Q,$sy+$P)}}} if($_=$E->{$nn}){/(\d)(%?)([-+]?)/;($rp,$eq,$le)=($1,$
  2,$3);$le=('-'eq$le)?-3:3;($eq eq'%')and$y+=$le; while($rp--){create
  $cv($,, $x-7, $y, $x+7, $y);$y += 2 * $le}}
}

###################
## Program notes ##
###################
                    sub
                     D{
                     my(
                     $p,
                     $P)
                     =@_;
                     ($$p
                     =~s/
                     ^( (
                     [A-G]
                     [#b%]?
                     )|[Rr]
                     )(\.|`?
                     )(~?)//x)
                     or die$$p.
                     $/;$M=$1;$
                     dv=$3||0;$
                     sv= $4||0;
                     $dd   =$v;(
                     'R'    eq$M)
                     and      $dd
                     *=2      ;$dv
                     and       $dd
                     *=(       '.'
                     eq$        dv)
                     ?1.5       :.5
                     ; $         tc
                     = $         sv
                     ?0:         $U
                     ;$r         =$
                     dd*        $tc
                    /100        ;$
                    q= $       dd
              -$r;$k=int      (
            128*$R/11025     )
          ;(($V->{V}||0)
          <$k)and$V->{V}
        =$k;$V->{$k}||=[
        ];$L=$T+$oo;$K=$
        L.$M;$S and$K.=
        $S;push@{$V->{
        $k}},"$K",($dd
        /100);P($P,$L,
         $M,$q);P($P
         ,'r','r',$
            r);}