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 => $max_y + 25, -width => $max_x );
my $canvas = $main->Canvas(-height => $max_y, -width => $max_x, -background=>'black' )->pack(-side =>'bottom');


my $frame = $main->Frame(-height => 1, -width => 500)->pack(-side =>'top');

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 => 'Confirm Iterations',-text => "$int_num Iterations may take a while to complete. Would you like to continue?",-default_button => 'Yes', -buttons => [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, $xlinevalue, $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 + $ylinevalue),-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/