Beefy Boxes and Bandwidth Generously Provided by pair Networks
go ahead... be a heretic
 
PerlMonks  

Re: A program that really makes waves

by teamster_jr (Curate)
on May 04, 2006 at 10:01 UTC ( #547378=note: print w/ replies, xml ) Need Help??


in reply to A program that really makes waves

++liverpole, That's absolutely awesome.
there's some stuff in there that i shall definitely steal use for some stuff i've been thinking about doing (especially as it generates stuff that's missing from my previous obfu :) ).
you can make it work on 'nix systems either by doing
 # `cat $; > /dev/snd`
(not the safest thing to do! - i've played around with this idea in the past)
or more realistically by using Gnome::Sound rather than Win32::Sound thusly:

# # May 3rd, 2006 -- by liverpole # ############### ## Libraries ## ############### use FileHandle;use Gnome::Sound;Gnome::Sound::init('localhost');use Tk +; use Time::HiRes qw(usleep gettimeofday); #################### ## 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={ q +w ( 1A 3- 1B 2%- 1C 2- 1D 1%- 1E 1 3C 1 5A 1 5B 1%+ 5C 2+ 5D 2%+ 5E 3+)};m +ap{ $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.283185 +3); 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; Gnome::Sound::play($;);$nt=$ot=gettimeofday-.2;$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){ pu +sh@$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;sleep 5; exit + } ################## ## 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);}
al
Update: fixed bad code upload


Comment on Re: A program that really makes waves
Select or Download Code

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://547378]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others romping around the Monastery: (4)
As of 2014-08-30 13:47 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The best computer themed movie is:











    Results (293 votes), past polls