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;
|