CUFP
BronzeWing
<p>Greetings fellow monks,<br>
I present to you the program that made the fractal on my [184471|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).</p>
<READMORE>
<p><code>#!/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;
</code></p>
<p>For starters, try replacing @Points with one of these sets:<br>
<code>
__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),</code>
</p>
</READMORE>
<p>-BronzeWing</p>