I've had lots of fun making this one, and its pretty cool. It all started three days ago when I took out a book from the library:
M.Field and M.Golubitsky, Symmetry in Chaos, 1992: Oxford Press.
I suggest that you read it, it explains how to use chaos/fractals to create symmetric images ( very beautiful ). After reading the explanation about fractals I decided to finally wrestle with Tk and make a fractal.

#!/usr/bin/perl
## Sierpinski's Triangle ##
use Tk;

$width = 800;
$height = 500;
my $main = MainWindow->new();
my $canvas = $main->Canvas( -width=>$width, -height=>$height, -backgro
+und=>"black");
$canvas->pack( -expand=>1,-fill=>'both' );


# the coderefs take ( x, y )

@iterative_set = (

sub{ my @pt = (400,50); return(  ($pt[0] + $_[0] )/2,
 ( $pt[1] + $_[1] )/2 ) },
sub{ my @pt = (50,400); return(  ($pt[0] + $_[0] )/2,
 ( $pt[1] + $_[1] )/2 ) },
sub{ my @pt = (750,400); return(  ($pt[0] + $_[0] )/2,
 ( $pt[1] + $_[1] )/2 ) },

);


# start coordinates
$x = 40;
$y = 400;
$iter = 0;

# weed out transients
while( $iter++ != 100 )
{

( $x, $y ) = $iterative_set[ int rand 3 ]->( $x, $y );

}


$iter = 0;
while( $iter++ < 10000 )
{

( $x, $y ) = $iterative_set[ int rand 3 ]->( $x, $y );
$canvas->createRectangle(
int $x, int $y, int $x, int $y, -outline=>undef, -fill=>'white' );

}

MainLoop;

[download]
See 70931 for a method by Dr.Mu which is slower but saveable -> it doesn't use rectangles as pixels.

My site

Replies are listed 'Best First'.
Sierpinski's Triangle - Wx (dirty)
by PodMaster (Abbot) on Mar 17, 2004 at 12:32 UTC
    Here it is in Wx, real dirty (currently wxWidgets doesn't have a nice canvas library) . Someone should try an OpenGL approach :) 
    use strict;
use Wx qw( :everything );
use Wx::Event 'EVT_PAINT';

use vars::i qw( $width 4 );
use vars::i qw( $height 4 );

use vars::i '@iterative_set' => 
(

    sub {
        my @pt = ( 400, 50 );
        return( ( $pt[0] + $_[0] ) / 2, ( $pt[1] + $_[1] ) / 2 );
    },
    sub {
        my @pt = ( 50, 400 );
        return( ( $pt[0] + $_[0] ) / 2, ( $pt[1] + $_[1] ) / 2 );
    },
    sub {
        my @pt = ( 750, 400 );
        return( ( $pt[0] + $_[0] ) / 2, ( $pt[1] + $_[1] ) / 2 );
    },

);



## cause I don't wanna subclass anything just yet
*Wx::App::OnInit = sub { 
Wx::InitAllImageHandlers();
    my $frame = Wx::Frame::->new(undef, -1, 'And Justice For All');
    $frame->Show(1);
    EVT_PAINT( $frame, sub {
        my($s,$e)=@_;
        my $dc = Wx::PaintDC->new($s); # must create, to stop crap
        $dc->SetBackgroundMode( wxTRANSPARENT );
        $dc->SetTextForeground( Wx::Colour->newRGB(169,169,69));

            # start coordinates
            my $x    = 40;
            my $y    = 400;
            my $iter = 0;

            # weed out transients
            while( $iter++ != 100 ) {

                ( $x, $y ) = $iterative_set[ int rand 3 ]->( $x, $y );

            }

            $iter = 0;
            while( $iter++ < 10000 ) {

                ( $x, $y ) = $iterative_set[ int rand 3 ]->( $x, $y );
                $dc->DrawRectangle( int $x, int $y, $width,$height);

            }



        return 0;
    });
    return 1;
};

Wx::App->new->MainLoop; # we're off'n'runnin'now

    [download]

    MJD says "you can't just make shit up and expect the computer to know what you mean, retardo!"
    I run a Win32 PPM repository for perl 5.6.x and 5.8.x -- I take requests (README).
    ** The third rule of perl club is a statement of fact: pod is sexy.

[reply]
[d/l]
Sierpinski's Triangle - Prima
by PodMaster (Abbot) on Mar 17, 2004 at 12:47 UTC 
    #!/usr/bin/perl   
#Prima.sierpinski.pl
#based on examples/f_fill and http://perlmonks.com/index.pl?node_id=33
+7175
use strict;

use vars::i qw( $width 4 );
use vars::i qw( $height 4 );
use vars::i '@iterative_set' => 
(

    sub {
        my @pt = ( 400, 50 );
        return( ( $pt[0] + $_[0] ) / 2, ( $pt[1] + $_[1] ) / 2 );
    },
    sub {
        my @pt = ( 50, 400 );
        return( ( $pt[0] + $_[0] ) / 2, ( $pt[1] + $_[1] ) / 2 );
    },
    sub {
        my @pt = ( 750, 400 );
        return( ( $pt[0] + $_[0] ) / 2, ( $pt[1] + $_[1] ) / 2 );
    },

);



use Prima;
use Prima::Classes;

$::application = Prima::Application->  create;



my $w = Prima::Window-> create(
   onDestroy=> sub {$::application-> close;},
   size   => [ 444, 444],
   centered => 1,
   buffered => 1,
   palette => [ cl::Black, cl::White ],
   onPaint => sub {
     my ( $self, $canvas) = @_;
     $canvas-> color( cl::Back);
            # start coordinates
            my $x    = 40;
            my $y    = 400;
            my $iter = 0;

            # weed out transients
            while( $iter++ != 100 ) {

                ( $x, $y ) = $iterative_set[ int rand 3 ]->( $x, $y );

            }

            $iter = 0;
            while( $iter++ < 10000 ) {

                ( $x, $y ) = $iterative_set[ int rand 3 ]->( $x, $y );
                $canvas->rectangle ( $x, $y, $x+$width, $y+$height );

            }

  },
);

run Prima;

__END__

    [download]

    MJD says "you can't just make shit up and expect the computer to know what you mean, retardo!"
    I run a Win32 PPM repository for perl 5.6.x and 5.8.x -- I take requests (README).
    ** The third rule of perl club is a statement of fact: pod is sexy.

[reply]
[d/l]
Sierpinski's Triangle - SDL
by PodMaster (Abbot) on Mar 17, 2004 at 13:11 UTC
    :D 
    #based on perl -MSDL::Tutorial::Drawing 
use strict;
use warnings;

use SDL::App;
use SDL::Rect;
use SDL::Color;

use vars::i '@iterative_set' => 
(

    sub {
        my @pt = ( 400, 50 );
        return( ( $pt[0] + $_[0] ) / 2, ( $pt[1] + $_[1] ) / 2 );
    },
    sub {
        my @pt = ( 50, 400 );
        return( ( $pt[0] + $_[0] ) / 2, ( $pt[1] + $_[1] ) / 2 );
    },
    sub {
        my @pt = ( 750, 400 );
        return( ( $pt[0] + $_[0] ) / 2, ( $pt[1] + $_[1] ) / 2 );
    },

);


# change these values as necessary
my $title                      = 'My SDL Rectangle-Drawing App';
my ($width, $height, $depth)   = ( 740,   640, 16   );
my ($red, $green, $blue)       = ( 0x00, 0x00, 0xff );
my ($rect_width, $rect_height) = ( 1,   1 );
my ($rect_x,     $rect_y)      = ( 270,   190       );

my $app = SDL::App->new(
    -width  => $width,
    -height => $height,
    -depth  => $depth,
);

my $color = SDL::Color->new(
    -r => $red,
    -g => $green,
    -b => $blue,
);
{
    # start coordinates
    my $x    = 40;
    my $y    = 400;
    my $iter = 0;
    
    # weed out transients
    while( $iter++ != 100 ) {
    
        ( $x, $y ) = $iterative_set[ int rand 3 ]->( $x, $y );
    
    }
    
    $iter = 0;
    while( $iter++ < 10000 ) {
        ( $x, $y ) = $iterative_set[ int rand 3 ]->( $x, $y );
        
        my $rect = SDL::Rect->new(
            -height => $rect_height,
            -width  => $rect_width,
            -x      => $x,
            -y      => $y,
        );
        $app->fill( $rect, $color );
        $app->update( $rect );
    
    }
}




# your code here; remove the next line

use SDL::Constants 'SDL_QUIT';
$app->loop({
SDL_QUIT() => sub { exit(0); },
});

    [download]

    MJD says "you can't just make shit up and expect the computer to know what you mean, retardo!"
    I run a Win32 PPM repository for perl 5.6.x and 5.8.x -- I take requests (README).
    ** The third rule of perl club is a statement of fact: pod is sexy.

[reply]
[d/l]
Re: Sierpinski's Triangle - Tk
by zentara (Cardinal) on Mar 17, 2004 at 17:00 UTC
    UPDATED MAR 18,2004

    Ok I asked on comp.lang.perl.tk and found out how to get the postscript to output. Your code is creating "invisble rectangles". So to get ps output, make these changes" 

    
$canvas->createRectangle(
int $x, int $y, int $x, int $y,
                         -outline=>undef,
                         -fill=>'white' );

#to (or any variation), you need an outline color and size

$canvas->createRectangle(
int $x, int $y, int $x+1, int $y+1,
                         -outline=>'lightgreen',
                         -fill=>'white' );

    [download]

    <END UPDATE>

    You should be able to save the Tk Canvas to a postscript file, then you can convert it to any format you want. It should look something like this, but after a quick try, I don't have it quite right. 

    $main->Button(
    -text    => "Save",
    -command => sub {
         my @capture=();
         my ($x0,$y0,$x1,$y1)=$canvas->bbox('all');
         @capture=('-x'=>$x0,'-y'=>$y0,-height=>$y1-$y0,-width=>$x1-$x
+0);
         $canvas -> postscript(-colormode=>'gray',
                   -file=>$0.'.ps',@capture);
                }
    )->pack;



MainLoop;

    [download]
    I'm not really a human, but I play one on earth. flash japh
[reply]
[d/l]
[select]
Re: Sierpinski's Triangle - Tk
by bl0rf (Pilgrim) on Mar 17, 2004 at 18:05 UTC
    Wow!
    I must commend PodMaster on his formidable graphics programming skills. The alternate imaging techniques seem very long winded and I think that I'll stick with Perl Tk for my imaging needs ( this is the first time I've used Tk ).

    My site
[reply]
Re: Sierpinski's Triangle - Tk
by CloneArmyCommander (Friar) on Mar 19, 2004 at 20:49 UTC
    Just out of curiosity, is this anything like in the Jurassic Park books where after so many chapters it has the pages where the fractal becomes more developed to explain Ian Malcolm's chaos theories? It sounds very interesting.
[reply]

Back to Cool Uses for Perl