### Linear Fractal Generator

by BronzeWing (Monk)
 on Jan 17, 2003 at 21:31 UTC ( #227805=CUFP: print w/replies, xml ) Need Help??

Greetings fellow monks,
I present to you the program that made the fractal on my home node. It was inspired by the C Curve xscreensaver written by Rick Campbell. Right now it's set to generate the same fractal as on my home node, but you can change it around by messing with @Lines and @Points under Settings. \$Epsilon is the minimum width/height a line must be to get processed in the next iteration (otherwise, it'd be wasting processing power on lines too small to see, which would be pointless).

#!/usr/bin/perl use warnings; use strict; use Tk; ############ # Settings # ############ my \$Epsilon = 6; my \$Delay = .5; my @Lines = ([100, 240, 540, 240]); my @Points = map \$_/100, ( ( 0, 0), ( 10, 20), ( 90, -20), (100, 0), ); # The expression that generates @Colors looks pretty ugly, but # it's actually the shortest method I could think of for generating # a rainbow in RGB. my @Colors = map sprintf('#%02x%02x%02x', @\$_), map [ \$_<=256 ? 255 : \$_<512 ? 512 - \$_ : \$_<768 ? 0 : \$_<1024 ? 0 : \$_<1280 ? \$_ - 1024 : 255, \$_<256 ? \$_ : \$_<512 ? 255 : \$_<=768 ? 255 : \$_<1024 ? 1024 - \$_ : \$_<1280 ? 0 : 0, \$_<256 ? 0 : \$_<512 ? 0 : \$_<768 ? \$_ - 512 : \$_<1024 ? 255 : \$_<=1280 ? 255 : 1536 - \$_, ], (0..1536); ########### # Widgets # ########### my \$Main = new Tk::MainWindow; \$Main->Label('-textvariable'=>\(my \$Status="Initializing..."))->pack; my \$Canvas = \$Main->Canvas( '-width'=>640, '-height'=>480, '-background'=>'black' )->pack; my @LineItems = map \$Canvas->createLine(@\$_,'-fill'=>'white'), @Lines; ############# # Main Loop # ############# while (++our \$i) { \$Status = "Iteration \$i..."; my \$LinesAffected = 0; my \$Color = 0; my \$ColorIncrement = (@Colors / @Lines) / (@Points/2 - 1); for (my \$Line=0;\$Line<=@Lines-1;\$Line++) { my @Line = @{\$Lines[\$Line]}; \$Canvas->Exists ? \$Canvas->delete(\$LineItems[\$Line]) : exit; my \$Size1 = abs(\$Line[2]-\$Line[0]); my \$Size2 = abs(\$Line[3]-\$Line[1]); if (\$Size1>\$Epsilon or \$Size2>\$Epsilon) { \$LinesAffected++; my @NewLines; my @NewItems; for (my \$Point=0;\$Point<\$#Points-1;\$Point+=2) { my (\$X1, \$Y1, \$X2, \$Y2) = @Line; push @NewLines, my \$NewLine = [ \$X1+(\$X2-\$X1)*\$Points[\$Point+0] + (\$Y2-\$Y1)*\$Points[\$Point+1], \$Y1+(\$Y2-\$Y1)*\$Points[\$Point+0] - (\$X2-\$X1)*\$Points[\$Point+1], \$X1+(\$X2-\$X1)*\$Points[\$Point+2] + (\$Y2-\$Y1)*\$Points[\$Point+3], \$Y1+(\$Y2-\$Y1)*\$Points[\$Point+2] - (\$X2-\$X1)*\$Points[\$Point+3] ]; push @NewItems, \$Canvas->Exists ? \$Canvas->createLine( @\$NewLine, '-fill' => \$Colors[\$Color] ) : exit; \$Color += \$ColorIncrement; } splice(@Lines,\$Line,1,@NewLines); splice(@LineItems,\$Line,1,@NewItems); \$Line += \$#NewLines; } else { \$LineItems[\$Line] = \$Canvas->Exists ? \$Canvas->createLine( @Line, '-fill' => \$Colors[\$Color] ) : exit; \$Color += \$ColorIncrement * (@Points/2 - 1); } \$Main->Exists ? \$Main->update : exit; } \$Main->Exists ? \$Main->update : exit; last unless \$LinesAffected; select(undef,undef,undef,\$Delay); # (A cute idiom for hires sleep) } \$Status = "Done."; MainLoop;

For starters, try replacing @Points with one of these sets:

__END__ ( 0, 0), ( 50, 29), ( 50, -29), (100, 0), ( 0, 0), ( 50, 0), ( 50, 50), ( 50, 0), (100, 0), ( 0, 0), ( 30, 0), ( 50, 30), ( 70, 0), (100, 0),

-BronzeWing

Replies are listed 'Best First'.
Re: Linear Fractal Generator
by Aristotle (Chancellor) on Jan 25, 2003 at 20:34 UTC
Beautiful (just like the original). :) I had a few idle moments, so I sat down and cleaned it up a bit. It started out mainly as a cleanup of the rainbow palette generation (which is now in RAINBOW_PAL and calc_gradient()), but grew to a complete reorganization. It does not, I'm afraid, have the neat update-as-you-calculate effect anymore, but the upside is faster runtime - and it is pretty easy to port to a different windowing system, a console-only version that outputs a PNG via GD or any number of other output possibilities by just changing init_and_make_updater() as well as done().
#!/usr/bin/perl -w use strict; use Tk; ###### SETTINGS ###### use constant EPSILON => 6; use constant SET_NR => 0; use constant INITIAL_LINE => ([100, 240, 540, 240]); use constant POINT_SET => ( [ [ 0, 0], [ 10, 20], [ 90, -20], [100, 0], ], [ [ 0, 0], [ 50, 29], [ 50, -29], [100, 0], ], [ [ 0, 0], [ 50, 0], [ 50, 50], [ 50, 0], [100, 0], ], [ [ 0, 0], [ 30, 0], [ 50, 30], [ 70, 0], [100, 0], ], ); use constant RAINBOW_PAL => ( R => [255 => 255 => 0 => 0 => 255 => 255], G => [ 0 => 255 => 255 => 255 => 0 => 0], B => [ 0 => 0 => 255 => 255 => 255 => 0], ); ###### FUNCTIONS ###### use constant X => 0; use constant Y => 1; use constant PALETTE_GRANULARITY => 255; sub calc_gradient { my %par = @_; my @pal; for(0 .. \$#{\$par{R}}-1) { my \$rlum = \$par{R}[\$_]; my \$glum = \$par{G}[\$_]; my \$blum = \$par{B}[\$_]; my \$rinc = (\$par{R}[\$_ + 1] - \$par{R}[\$_]) / PALETTE_GRANULARI +TY; my \$ginc = (\$par{G}[\$_ + 1] - \$par{G}[\$_]) / PALETTE_GRANULARI +TY; my \$binc = (\$par{B}[\$_ + 1] - \$par{B}[\$_]) / PALETTE_GRANULARI +TY; push @pal, map sprintf('#%02x%02x%02x', \$rlum + \$rinc * \$_, \$glum + \$ginc * \$_, \$blum + \$binc * \$_, ), 0 .. PALETTE_GRANULARITY; } return \@pal; } my @pt = map [ map \$_/100, @\$_], @{(POINT_SET)[SET_NR]}; sub iterate_lines { map { my (\$X1, \$Y1, \$X2, \$Y2) = @\$_; (abs(\$Y2 - \$Y1)>EPSILON or abs(\$X2 - \$X1)>EPSILON) ? map [ \$X1+(\$X2-\$X1)*\$pt[\$_][X] +(\$Y2-\$Y1)*\$pt[\$_][Y], \$Y1+(\$Y2-\$Y1)*\$pt[\$_][X] -(\$X2-\$X1)*\$pt[\$_][Y], \$X1+(\$X2-\$X1)*\$pt[\$_+1][X] +(\$Y2-\$Y1)*\$pt[\$_+1][Y], \$Y1+(\$Y2-\$Y1)*\$pt[\$_+1][X] -(\$X2-\$X1)*\$pt[\$_+1][Y], ], 0 .. \$#pt - 1 : \$_; } @_ } sub init_and_make_updater { my @pal = @{+shift}; my \$window = Tk::MainWindow->new; my \$label = ""; \$window->Label(-textvariable => \\$label)->pack; my \$canvas = \$window->Canvas( -width => 640, -height => 480, -background => 'black', )->pack; my \$lines; return sub { (\$label, \$lines) = @_; if(defined \$lines) { my \$inc = @pal / @\$lines; my \$idx = -\$inc; \$canvas->delete('all'); \$canvas->createLine(@\$_, -fill => \$pal[\$idx += \$inc]) for +@\$lines; } \$window->update; } } sub done { MainLoop; } ###### MAIN PROGRAM ###### my \$update = init_and_make_updater(calc_gradient(RAINBOW_PAL)); \$update->("Initializing..."); my @lines = INITIAL_LINE; my \$lines_previously = 0; my \$iter = 0; until(\$lines_previously == @lines) { \$lines_previously = @lines; \$iter++; @lines = iterate_lines @lines; \$update->("Iteration \$iter...", \@lines); } \$update->("Done."); done(\@lines);

Makeshifts last the longest.

i edited BronzeWing's code and made it faster so it still has a cool update effect(as long as line 72 is not commeted). it's faster than Aristotle's code when line 72 is commeted out and almost as fast when its not commeted out
#!/usr/bin/perl -w use strict; use Tk; ############ # Settings # ############ my \$Epsilon = 8; my @Lines = ([200, 300, 600, 300]); my @Points = map \$_/90, ( #my design best with 90 for @Points (-20,20), (20,10), (90,-10), (120,20), #original design best with 96 for @Points #( 0, 0), #( 10, 20), #( 90, -20), #(100, 0), ); #you can put your own colors here sub randomc { my \$i = rand(2); if (\$i>=0 && \$i<1) {return '#b10000';} if (\$i>=1 && \$i<2) {return '#b15128';} } ########### # Widgets # ########### my \$Main = new Tk::MainWindow; \$Main->Label('-textvariable'=>\(my \$Status="Initializing..."))->pack; my \$Canvas = \$Main->Canvas( '-width'=>900, '-height'=>700, '-background'=>'#000000' )->pack; my @LineItems = @Lines; ############# # Main Loop # ############# \$Main->update; while (++our \$i<10) { # change 10 if u need more \$Status = "Iteration \$i..."; for (my \$Line=0;\$Line<=@Lines-1;\$Line++) { my @Line = @{\$Lines[\$Line]}; if (abs(\$Line[2]-\$Line[0])>\$Epsilon or abs(\$Line[3]-\$Line[1])> +\$Epsilon) { my @NewLines; my @NewItems; for (my \$Point=0;\$Point<\$#Points-1;\$Point+=2) { my (\$X1, \$Y1, \$X2, \$Y2) = @Line; push @NewLines, my \$NewLine = [ \$Line[0]+(\$Line[2]-\$Line[0])*\$Points[\$Point+0] + (\$Line[3]-\$Line[1])*\$Points[\$Point+1], \$Line[1]+(\$Line[3]-\$Line[1])*\$Points[\$Point+0] - (\$Line[2]-\$Line[0])*\$Points[\$Point+1], \$Line[0]+(\$Line[2]-\$Line[0])*\$Points[\$Point+2] + (\$Line[3]-\$Line[1])*\$Points[\$Point+3], \$Line[1]+(\$Line[3]-\$Line[1])*\$Points[\$Point+2] - (\$Line[2]-\$Line[0])*\$Points[\$Point+3] ]; push @NewItems, \$Canvas->createLine(@\$NewLine, '-fill' + => randomc()); } splice(@Lines,\$Line,1,@NewLines); #\$Line += \$#NewLines;#good for some fractals not for others wi +thout commet you need more iterations and update effect isnt as good } \$Main->Exists ? \$Main->update : exit; #with this line commeted + out its like Aristotle's Code } \$Main->Exists ? \$Main->update : exit; last unless 2; } \$Status = "Done."; MainLoop;

Create A New User
Node Status?
node history
Node Type: CUFP [id://227805]
Approved by gjb
Front-paged by Mr. Muskrat
help
Chatterbox?
 [planetscape]: boo marto faints

How do I use this? | Other CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (8)
As of 2018-04-27 09:42 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
My travels bear the most uncanny semblance to ...

Results (97 votes). Check out past polls.

Notices?