Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

teamster_jr's scratchpad

by teamster_jr (Curate)
on Jun 03, 2004 at 20:05 UTC ( #360451=scratchpad: print w/ replies, xml ) Need Help??

Bear.pl - a tidied up version of my bear is driving obfu for wazoox to test:
use strict; use warnings; use GD; my $i = new GD::Image( 153, 153, ); $i->colorAllocate( 200, 200, 200 ); sub l { my $p = new GD::Polygon; my $x=shift; my $y=shift; $p->addPt( ( $x += shift ), ( $y += shift ) ) while $#_; $i->filledPolygon( $p, shift ); } sub d { l @_, 0, 0, 20, -10, 20, 10, -20, 10, $i->colorAllocate( 153, 15 +3, 153, ); l @_, 20, 10, 20, -10, 0, 20, -20, 10, $i->colorAllocate( 20, 0, + 0 ); } sub a { d @_; l @_, 0, 0, 0, 20, 20, 10, 0, -20, $i->colorAllocate( 20, 153, 153 +, ); } a("73","73"); a("43","88"); a("13","103"); a("13","73"); a("13","43"); a("13","13"); a("43","28"); a("73","43"); a("103","58"); d("73","73"); open FH, ">o.png"; binmode FH; print FH $i->png


Sizer.pl - a script to condense obfuscations to fit into a mail signature
usage: sizer.pl <script name> <char count 1|0> <whitespace removal 1|0> <width>
($f,$s,$t,$l)=@ARGV;open(FH,$f);while(<FH>){chop;s#^\s?(.*)\s?#$1# if! +$t ;last if/^exit;$/|/^##$/;$b=$a.=$_ if!(/^#/|/#-$/)}$l||=72;print++$c== +5& !$s?"\e[31m$&$/":$&.$/while$b=~s#^.{$l}##;printf"%s\n%s %s\n%s %s".$/, +$s ?$b:(($c>3?"\e[31m":"")."$b\e[m\n",$t=length($b),$l-$t,$c+1,$b=length$ +a)


Firework.pm A set of Object Classes for drawing an xterm firework display:
test.pl
#!/usr/bin/perl use Firework; # add_rocket(initial_x, initial_y, v_x, v_y, start_time, color); my $display=new Firework; $display->add_rocket(0,25,18,18); $display->add_rocket(25,25,18,18,7); $display->add_wheel(19,22,3); $display->add_wheel(60,22,8); $display->start_display;

Firework.pm
package Firework; use Firework::Rockets; use Firework::Catherine; use strict; sub new { my $display={fireworks=>[],Time=>0}; bless$display; return$display; } sub add_rocket { my ($display,@args)=@_; my $firework=Firework::Rockets->new(@_); push@{$display->{fireworks}},$firework; } sub add_wheel { my($display,@args)=@_; my $wheel=Firework::Catherine->new(@_); push@{$display->{fireworks}},$wheel; } sub start_display { my $display=shift; my $live_fireworks=1; $|=1; while($live_fireworks){ $live_fireworks=0; print "\ec"; $display->{Time}+=1; foreach my $firework (@{$display->{fireworks}}){ if(!$firework->{dead}){ $live_fireworks++; if($firework->{exploded}){ $firework->post_explode; } else { if($firework->should_explode ){ $firework->explode; } else { if($display->{Time}>$firework->{start}){ $firework->draw; $firework->{timer}+=.1; } } } } } select undef,undef,undef,0.1 } } # and some defaults; sub draw { my $firework=shift; if($firework->y_t > 0 && $firework->y_t < 25 && $firework->x_t > 0 & +& $firewor k->x_t < 80){ printf"\e[%d;%dH\e[1;%dm.\e[m\e[H",$firework->y_t, $firework->x_t, $firework->{colour}; } } sub x_t { my $firework=shift; return $firework->{i_x}+$firework->{v_x}*$firework->{timer}; } sub y_t { my $firework=shift; # s=ut+1/2*a*t^2 return $firework->{i_y} - $firework->{timer}* ($firework->{v_y}-5*$firework->{timer}); } sub v_y_t { my $firework=shift; return $firework->{v_y}-10*$firework->{timer} } sub explode { my $firework=shift; $firework->{dead}=1; } sub should_explode { return 0; } 1;
Firework/Rockets.pm
package Firework::Rockets; use Firework; our @ISA=qw{ Firework }; sub new { my($self,$display,$i_x,$i_y,$v_x,$v_y,$start,$colour)=@_; my $firework={ i_x=>$i_x, i_y=>$i_y, v_x=>$v_x, v_y=>$v_y, start=>$start, display=>$display, colour=>$colour||31+rand(6) }; bless $firework,$self; return $firework; } sub explode { my $firework=shift; $firework->{exploded}=1; for my $z (1..4){ $firework->{parts}{$z}=bless{ i_x=>$firework->x_t, i_y=>$firework->y_t, v_x=>$z%2?5:-5, v_y=>$z>2?5:-5, colour=>$firework->{colour} }; } } sub should_explode { my $self=shift; return ($self->v_y_t < 0); } sub post_explode { my $firework=shift; foreach my $part_count (keys %{$firework->{parts}}){ my $part=$firework->{parts}{$part_count}; if($part->y_t > 22 || $part->x_t > 75 || $part->x_t < 0){ delete $firework->{parts}{$part_count} } else { $part->draw; $part->{timer}+=.1; } } $firework->{dead}=1 if(!scalar keys %{$firework->{parts}}); } 1;
Firework/Catherine.pm
A lot less tidy than others!
package Firework::Catherine; use Firework; our @ISA=qw{ Firework }; sub new { my($self,$display,$x,$y,$start)=@_; my $firework={ pos=>[[-1,-1],[-1,0],[-1,1],[0,1],[1,1],[1,0],[1,-1],[0,-1]], x=>$x, y=>$y, start=>$start, display=>$display }; bless $firework,$self; return $firework; } sub draw { my $wheel=shift; if($wheel->{x}<40){ push@{$wheel->{pos}},shift@{$wheel->{pos}}; } else { unshift@{$wheel->{pos}},pop@{$wheel->{pos}}; } for(0..2){ printf"\e[%d;%dH\e[1;%dm.\e[m\e[H",$wheel->{y}+$wheel->{pos}[$_][0], $wheel->{x}+$wheel->{pos}[$_][1],31+rand(6); if($wheel->{pos}[$_][1]==-1 && $wheel->{pos}[$_][0]==1 && $wheel->{tim +er}%2){ $wheel->{display}->add_rocket($wheel->{x},$wheel->{y},$wheel->{x}>40?- +18:18,15+r and(6)); } } } sub should_explode { my $wheel=shift; $wheel->{dead}=1 if($wheel->{timer}>6); return 0; } 1;

Log In?
Username:
Password:

What's my password?
Create A New User
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others browsing the Monastery: (13)
As of 2014-07-28 13:55 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (200 votes), past polls