I didn't look at all the code, but I made it pass use strict by using a dispatch table that holds references to the subroutines to call. I tried to keep my change as minimal as possible.
use warnings;
use strict;
use Tk;
use Tk::BrowseEntry;
use Tk::Optionmenu;
use Tk::Dialog;
# references
srand (time);
my $max_x = 500;
my $max_y = 500;
my $subname;
my %subs = (
s_fern => \&s_fern,
sier_gasket => \&sier_gasket,
sier_carpet => \&sier_carpet
);
my $main = new MainWindow(-title => 'Fractal Generator', -height => $m
+ax_y + 25, -width => $max_x );
my $canvas = $main->Canvas(-height => $max_y, -width => $max_x, -backg
+round=>'black' )->pack(-side =>'bottom');
my $frame = $main->Frame(-height => 1, -width => 500)->pack(-side =>'t
+op');
my $frac_type;
my $interations = $main->Optionmenu(
-options => ["Spleenwort Fern","Sierpinski's Gasket","Sierpinski's
+ Carpet"],
-variable => \$frac_type,
)->pack(-side=> "left",);
my $int_num;
$interations = $main->Optionmenu(
-options => [qw/5000 10000 20000 30000 40000 50000 75000 100000/],
-variable => \$int_num,
)->pack(-side=> "left",);
my $colour;
my $randflag;
my @colourarray = ("grey","red", "orange", "yellow", "green", "blue",
+"violet", "purple", "random");
my $colourlist = $main->Optionmenu(
-options => \@colourarray,
-command => sub { $randflag = 0;
if ($colour eq "random") {$randflag = 1}},
-variable => \$colour,
)->pack(-side=> "left",);
$main->Button( -text => " Exit ", -command => \&exit )->pack(-side =>"
+right");
$main->Button(-text => 'Create', -command=>
sub{
$canvas->delete ("all");
create($canvas);
})->pack(-side => 'right',-padx => 25);
#$main->waitVisibility;
MainLoop;
# SUB LAND
sub create {
my( $canvas) = @_;
my $count = 1;
my $x;
my $y;
my $scaleby = 1;
my $makexpos = $max_x;
my $makeypos = $max_y;
my $xlinevalue = 1;
my $ylinevalue = 1;
if ($int_num >= 30000) {
my $dialog = $main->Dialog(-bitmap => 'question', -title => 'C
+onfirm Iterations',-text => "$int_num Iterations may take a while to
+complete. Would you like to continue?",-default_button => 'Yes', -but
+tons => [qw/Yes No/]);
my $answer = $dialog->Show;
if ($answer eq "No") {
return;
}
}
$main->Busy(-recurse => 1);
if ($frac_type eq "Spleenwort Fern") {
$x = 1;
$y = 1;
$subname = "s_fern";
$scaleby = 10; # reduce it by 10 times
$makexpos = 2; # shift the image to middle of canvas
}elsif($frac_type eq "Sierpinski's Gasket"){
$x = 40;
$y = 400;
$subname = "sier_gasket";
}elsif($frac_type eq "Sierpinski's Carpet"){
$x = 40;
$y = 400;
$subname = "sier_carpet";
}
create_dot($canvas, $x, $y, $count, $scaleby, $makexpos, $makeypos
+, $xlinevalue, $ylinevalue);
}
sub create_dot {
my( $canvas, $x, $y, $count,$scaleby, $makexpos, $makeypos, $xline
+value, $ylinevalue) = @_;
$count ++;
if ($count > $int_num){
$main->Unbusy;
if ($randflag == 1) {
$colour = "random";
}
return;
}
($x, $y) = $subs{$subname}->($x , $y );
my $newx = ($x * ($max_x/$scaleby)) + ($max_x/$makexpos);
my $newy = ($y * ($max_y/$scaleby)) + ($max_y/$makeypos);
if ($randflag == 1) {
my $currentcolour = int rand (7);
$colour = $colourarray[$currentcolour];
}
$canvas->createLine($newx,$newy ,($newx + $xlinevalue),($newy + $y
+linevalue),-fill=> $colour);
create_dot($canvas, $x, $y, $count, $scaleby, $makexpos, $makeypos
+, $xlinevalue, $ylinevalue);
}
sub s_fern {
my( $x, $y) = @_;
my $x1;
my $y1;
my $c;
my ($v1, $v2, $v3, $v4, $v5, $v6);
$c = int(rand(100));
if ($c < 85) {
$v1 = 0.85, $v2 = 0.04, $v3 = 0;
$v4 = -0.04, $v5 = 0.85, $v6 = 1.60;
}elsif ($c < 91){
$v1 = 0.20, $v2 = -0.26, $v3 = 0;
$v4 = 0.23, $v5 = 0.22, $v6 = 1.60;
}elsif ($c < 98){
$v1 = -0.15, $v2 = 0.28, $v3 = 0;
$v4 = 0.26, $v5 = 0.24, $v6 = 0.44;
}else{
$v1 = 0, $v2 = 0, $v3 = 0;
$v4 = 0, $v5 = 0.16, $v6 = 0;
}
$x1 = $v1 * $x + $v2 * $y + $v3;
$y1 = $v4 * $x + $v5 * $y + $v6;
return $x1, $y1;
}
sub sier_gasket {
my( $x, $y) = @_;
my $x1;
my $y1;
my $c = 0;
my @iterative_set = (
sub{ my @pt = (0,0); return( ($pt[0] + $_[0] )/2,
( $pt[1] + $_[1] )/2 ) },
sub{ my @pt = (1,0); return( ($pt[0] + $_[0] )/2,
( $pt[1] + $_[1] )/2 ) },
sub{ my @pt = (.5,1); return( ($pt[0] + $_[0] )/2,
( $pt[1] + $_[1] )/2 ) },
);
# weed out transients
while( $c++ != 100 )
{
( $x1, $y1 ) = $iterative_set[ int rand 3 ]->( $x, $y );
return $x1, $y1;
}
}
sub sier_carpet {
my( $x, $y) = @_;
my $x1;
my $y1;
my $c = 0;
my @iterative_set = (
sub{ my @pt = (0,0); return( ($pt[0] + $_[0] )/3,
( $pt[1] + $_[1] )/3 ) },
sub{ my @pt = (2,0); return( ($pt[0] + $_[0] )/3,
( $pt[1] + $_[1] )/3 ) },
sub{ my @pt = (2,2); return( ($pt[0] + $_[0] )/3,
( $pt[1] + $_[1] )/3 ) },
sub{ my @pt = (0,2); return( ($pt[0] + $_[0] )/3,
( $pt[1] + $_[1] )/3 ) },
sub{ my @pt = (1,0); return( ($pt[0] + $_[0] )/3,
( $pt[1] + $_[1] )/3 ) },
sub{ my @pt = (1,2); return( ($pt[0] + $_[0] )/3,
( $pt[1] + $_[1] )/3 ) },
sub{ my @pt = (2,1); return( ($pt[0] + $_[0] )/3,
( $pt[1] + $_[1] )/3 ) },
sub{ my @pt = (0,1); return( ($pt[0] + $_[0] )/3,
( $pt[1] + $_[1] )/3 ) },
);
# weed out transients
while( $c++ != 100 )
{
( $x1, $y1 ) = $iterative_set[ int rand 8 ]->( $x, $y );
return $x1, $y1;
}
}
# References
#
# Sierpinski fractal algorithms copied from
# http://www.perlmonks.com/?node_id=337175
#
# Other fractal algorithms and all values copied from
# http://www.cs.wisc.edu/~richm/cs302s00/applets/
He who asks will be a fool for five minutes, but he who doesn't ask will
remain a fool for life.
Chady | http://chady.net/