#! /usr/local/bin/perl -w
use strict;
use GD;
# -----------------------------------------------------------
use constant PI => 3.14159265359;
# -----------------------------------------------------------
# turtle as in LOGO's turtle
# Usage: $turtle = turtle();
#        $turtle->($turn_right_x_degree, $forward_x_points);
#        $xy = $turtle->();
sub turtle {
	my ($h, $xy) = (0, [[0],[0]]); 	# h = heading (0 - north, 90 - east, etc)
	return sub { 
		$h = $h + (shift || 0);	# accumulative turns in degree
		my $d = shift || 0;	# distance
		$xy->[0][scalar(@{$xy->[0]})] = $d*sin(PI*$h/180) + $xy->[0][$#{@{$xy->[0]}}]; 
		$xy->[1][scalar(@{$xy->[1]})] = $d*cos(PI*$h/180) + $xy->[1][$#{@{$xy->[1]}}]; 
		return $xy;
	};
}
# -----------------------------------------------------------
# Koch Snowflake
sub koch {
	my ($turtle, $d, $level) = @_ ;
	if ($level==0) {$turtle->(0,$d); return 1;} 
	$turtle->(  0,0); koch($turtle,$d/3,$level-1);
	$turtle->(-60,0); koch($turtle,$d/3,$level-1);
	$turtle->(120,0); koch($turtle,$d/3,$level-1);
	$turtle->(-60,0); koch($turtle,$d/3,$level-1);
}
# -----------------------------------------------------------
my $turtle = turtle();
map {$turtle->(120, 0); koch($turtle, 170, 4);} 0..2;
# -----------------------------------------------------------
plotxy($turtle->(), 'koch.jpg');
# -----------------------------------------------------------


# -----------------------------------------------------------
# Minkowski Island
sub minkowski {
	my ($turtle, $d, $level) = @_ ;
	if ($level==0) {$turtle->(0,$d); return 1;} 
	minkowski($turtle,$d/4,$level-1);
	$turtle->(-90,0); minkowski($turtle,$d/4,$level-1);
	$turtle->( 90,0); minkowski($turtle,$d/4,$level-1);
	$turtle->( 90,0); minkowski($turtle,$d/4,$level-1);
	minkowski($turtle,$d/4,$level-1);
	$turtle->(-90,0); minkowski($turtle,$d/4,$level-1);
	$turtle->(-90,0); minkowski($turtle,$d/4,$level-1);
	$turtle->( 90,0); minkowski($turtle,$d/4,$level-1);
}
# -----------------------------------------------------------
$turtle = turtle();
map {$turtle->(90,0); minkowski($turtle, 150, 3);} 0..3;
# -----------------------------------------------------------
plotxy($turtle->(), 'minkowski.jpg');
# -----------------------------------------------------------


# -----------------------------------------------------------
# Dragon Curve
sub dragon1 {
	my ($turtle, $d, $level) = @_ ;
	if ($level==0) {$turtle->(0,$d); return 1;} 
	dragon($turtle,$d*0.707,$level-1);
	$turtle->(-90,0); dragon1($turtle,$d*0.707,$level-1);
}
sub dragon {
	my ($turtle, $d, $level) = @_ ;
	if ($level==0) {$turtle->(0,$d); return 1;} 
	dragon($turtle,$d*0.707,$level-1);
	$turtle->(90,0); dragon1($turtle,$d*0.707,$level-1);
}
# -----------------------------------------------------------
$turtle = turtle();
dragon($turtle, 150, 12);
# -----------------------------------------------------------
plotxy($turtle->(), 'dragon.jpg');
# -----------------------------------------------------------


# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 
# Sub for Plotting
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 
sub min {(sort {$a<=>$b} @_ )[0];}
# ----------------------------------------------------------------
sub max {(sort {$a<=>$b} @_ )[-1];}
# ----------------------------------------------------------------
sub plotxy {
	my $xy = shift;
	my $file = shift;
	my $scale = shift || 1;
	# -------------------------------------------------------
	my @x = @{$xy->[0]};
	my @y = @{$xy->[1]};
	my $x_min = min(@x);
	my $y_min = min(@y);
	map {$x[$_]=$scale*($x[$_]-$x_min)} 0..$#x;
	map {$y[$_]=$scale*($y[$_]-$y_min)} 0..$#y;
	my $x_width = max(@x) - 0;
	my $y_width = max(@y) - 0;
	# -------------------------------------------------------
	my $image = new GD::Image($x_width,$y_width);
	my $white = $image->colorAllocate(255,255,255);
	my $black = $image->colorAllocate(0,0,0);   
	$image->transparent($white);
	$image->interlaced('true'); 
	$image->line($x[$_-1],$y[$_-1],$x[$_],$y[$_],$black) for 1..$#x;
	$image = $image->copyFlipVertical() ;
	open(IMG, ">$file");
	binmode IMG;
	print IMG $image->jpeg;
}