Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
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[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;
See 70931 for a method by Dr.Mu which is slower but saveable -> it doesn't use rectangles as pixels.

Comment on Sierpinski's Triangle - Tk
Download Code
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

    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[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__

    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[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); }, });

    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.

Log In?
Username:
Password:

What's my password?
Create A New User
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 making s'mores by the fire in the courtyard of the Monastery: (13)
As of 2014-07-31 14:07 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (249 votes), past polls