 Do you know where your variables are? PerlMonks

### Sierpinski's Triangle - Tk

by bl0rf (Pilgrim)
 on Mar 16, 2004 at 23:51 UTC ( #337175=CUFP: print w/replies, xml ) Need Help??

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 + \$_ )/2,
( \$pt + \$_ )/2 ) },
sub{ my @pt = (50,400); return(  (\$pt + \$_ )/2,
( \$pt + \$_ )/2 ) },
sub{ my @pt = (750,400); return(  (\$pt + \$_ )/2,
( \$pt + \$_ )/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;
See 70931 for a method by Dr.Mu which is slower but saveable -> it doesn't use rectangles as pixels.

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 + \$_ ) / 2, ( \$pt + \$_ ) / 2 );
},
sub {
my @pt = ( 50, 400 );
return( ( \$pt + \$_ ) / 2, ( \$pt + \$_ ) / 2 );
},
sub {
my @pt = ( 750, 400 );
return( ( \$pt + \$_ ) / 2, ( \$pt + \$_ ) / 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

 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.

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 + \$_ ) / 2, ( \$pt + \$_ ) / 2 );
},
sub {
my @pt = ( 50, 400 );
return( ( \$pt + \$_ ) / 2, ( \$pt + \$_ ) / 2 );
},
sub {
my @pt = ( 750, 400 );
return( ( \$pt + \$_ ) / 2, ( \$pt + \$_ ) / 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__

 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.

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 + \$_ ) / 2, ( \$pt + \$_ ) / 2 );
},
sub {
my @pt = ( 50, 400 );
return( ( \$pt + \$_ ) / 2, ( \$pt + \$_ ) / 2 );
},
sub {
my @pt = ( 750, 400 );
return( ( \$pt + \$_ ) / 2, ( \$pt + \$_ ) / 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); },
});

 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.

Re: Sierpinski's Triangle - Tk
by zentara (Archbishop) 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' );

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

I'm not really a human, but I play one on earth. flash japh
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 ).

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.

Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: CUFP [id://337175]
Approved by Popcorn Dave
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (2)
As of 2022-05-25 04:42 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
Do you prefer to work remotely?

Results (84 votes). Check out past polls.

Notices?