#!/usr/bin/perl -w

package Tile::Prototile;

use strict;
use Data::Dumper;

# ob das hier so nice ist ist mal ne ganz andere Frage, aber es stammt aus dem alten Programm
use constant FNULL => 0.00000001;
use constant G2R => 0.0174532925199432957692369076848;

# constants used for xfig translation
use constant PKTMASS => 10;
use constant DECOPOINTBORE => 20;
my $xnull = 4500.0;
my $ynull = 6750.0;
# use another fx or fy if another mass was used!
my $fx = 1.0;
my $fy = 1.0;

# array for an animation
my @animation = ("|","/","-","\\");
my $char;

# this could be solved in a better way, so that the programm is not so
# memory dissipative, but it was not wished. Perhaps in a later version!
# To rebalance it, have a look to the list copy list of saat infos
# holds tmp infos
my $copy_point = {
		DEG => undef,
		X1 => undef,
		Y1 => undef
	};

# holds the new saat infos, its needed to replace the old infos!	
my @new_saat_infos;


# this class takes no constructor parameters
sub new
{
  my $classname = shift;  # we know our class name
  my $class = ref($classname) || $classname; # now the constructor can be use as an constructor or an object method
 
   
 # construkt for one prototile
 my $self= {
 	NAME => undef,			# the name of the prototile
	TILES_OF_INFLATION => [], 	# tiles of inflation
	INFLATION_FAKTOR => undef,	# the inflation factor
	DECORATION_POINTS => [], 	# decoration point in black
	DECORATION_LINES => [], 	# decoration lines in black
	DECORATION_POLYPOINTS => [], 	# the polylines define a polygon
	FILL_COLOR => -1337, 		# colorcode
	SAAT_INFOS => [],		# hold saat infos of this tile
	OUTPUT => "",			# hold given filename and or path
	};
		
  
  bless($self,$class);    # bless object
  return $self;           # return this object
}


# does the recursion on this prototile, based on saat informations
sub doRekursion(){
	my $self = shift;
	my $writeToTile;
	
	foreach my $old_saat (@{$self->{SAAT_INFOS}}){
		
		# calculate new points by using inflation factor
		$old_saat->{X1} = ($old_saat->{X1} * $self->{INFLATION_FAKTOR});
		$old_saat->{Y1} = ($old_saat->{Y1} * $self->{INFLATION_FAKTOR});
		
		# process all the inflation tiles
		# do the inflation until no tile of inflation is left any more
		foreach my $infl_tile (@{$self->{TILES_OF_INFLATION}}){
		
		$writeToTile = $infl_tile->{PROTOTILE_NR};
		
		#copy points
		$copy_point->{DEG} = $infl_tile->{ROTATION};
		$copy_point->{X1} = $infl_tile->{XPOS};
		$copy_point->{Y1} = $infl_tile->{YPOS};
		
		#check the rotation properties
		# negative rotation
		if($old_saat->{DEG} < 0){
			$copy_point->{Y1} = -$copy_point->{Y1};
			$copy_point->{DEG} = $old_saat->{DEG} - $copy_point->{DEG};

			# rotation of this tile is smaller zero
			if($infl_tile->{ROTATION} < 0){
				#print("Tile Rotation kleiner 0!\n");
				while($copy_point->{DEG} < (0+FNULL)){
					$copy_point->{DEG} = $copy_point->{DEG} + 360;
				}
			}
			else{
				while($copy_point->{DEG} < (-360 - (FNULL))){
					$copy_point->{DEG} = $copy_point->{DEG} + 360;
				}
			}
		}
		# positive rotation
		else{
			$copy_point->{DEG} = $old_saat->{DEG} + $copy_point->{DEG};
			
			if($infl_tile->{ROTATION} < 0){
				while($copy_point->{DEG} >= (0 - (FNULL))){
					$copy_point->{DEG} = $copy_point->{DEG} - 360;
				}
			}
			else{
				while($copy_point->{DEG} >= (360+FNULL)){
					$copy_point->{DEG} = $copy_point->{DEG} - 360;
				}
			}
		}
		
		#set the new isaat X position
		my $new_x = ($old_saat->{X1} + (cos((G2R * $old_saat->{DEG})) * $copy_point->{X1}) - (sin((G2R * $old_saat->{DEG})) * $copy_point->{Y1}));
		
		#set the new isaat Y position
		my $new_y = ($old_saat->{Y1} + (cos((G2R * $old_saat->{DEG})) * $copy_point->{Y1}) + (sin((G2R * $old_saat->{DEG})) * $copy_point->{X1}));
		
		#write new ipaat !
		#DEBUG 
		#print($writeToTile." ".$copy_point->{DEG}." ".$new_x." ".$new_y."\n");
		
		$self->addNewSaatInfos($copy_point->{DEG},$new_x,$new_y,$writeToTile);
		}
		
	}
	
	#delete old saat infos and place new ones!
	$self->{SAAT_INFOS} = ();
	
	return \@new_saat_infos;
}

# delets the new_saat_info list
sub deleteNewSaat(){
	my $self = shift;
	@new_saat_infos = ();
}

# does the same like the old pat2pkt!
sub translateToVector(){
	my $self = shift;
	
	print("Writing information of ".$self->{NAME}." to Xfig file!\n");
	
	#First process the mass of pkt!
	 $fy = PKTMASS;
	 $fx = $fy * 45;
	 $fy = -$fx;
	
	# check if there is an output file name given
	my $outputhandle = "Tilewizard_Output.fig";
	if($self->{OUTPUT} ne "none" && $self->{OUTPUT} ne "" ){
		$outputhandle = $self->{OUTPUT}.".fig";
	}
	
	# attach information of this tile to xfig file
	unless (open Xfig_dateihandle, ">>".$outputhandle){
		die "Unable to attach information to output file: $!";
	}
	
	# process the saat infos
	foreach(@{$self->{SAAT_INFOS}}){
		
		# translate the deco points
		&doPointTranslation($_,$self);	
		
		# translate the deco lines
		&doLineTranslation($_,$self);
		
		# translate the polypoint to a polygon
		&doPolypointTranslation($_,$self);
	}
	
	#close file handle
	close Xfig_dateihandle;
}


# does the translations on polygons
sub doPolypointTranslation(){
	my ($saat,$self) = @_;
	
	my $polyCnt = 0;
	my $x_1;
	my $y_1;
	my $firstPoint = 1; # dont calculate first point twice! instead of use a flag
	my @firstPointCpy;
	
	# informations of the polygon
	my $nrOfPoints = @{$self->{DECORATION_POLYPOINTS}}+1;
	if($nrOfPoints <= 1){
		# return if there are no polypoints in the list
		return;
	}
	
	my $style_val  = 0.000;
	my $cap_style = 1;
	my $join_style = $cap_style;
	my $areafillColor = 20;
	my $baseFillColor;
	my $penColor;
	my $thickness = 0;
	my $layer = 1;
	
	# drops the gfx-representation of this tile on a layer depth dependig of its name!
	#if($self->{NAME} =~ /([0-9]+)/){
	#$layer = ($1+1);
	#}
	
	if($self->{FILL_COLOR} == -1337){
		$areafillColor = -1;
		$baseFillColor = -1;
		$penColor = 0;
	}
	else{
		$penColor = $self->{FILL_COLOR};
		$baseFillColor = $self->{FILL_COLOR};
	}
	
	#$penColor = 0; #uncomment to set pencolor to black every time DEBUG!
	
	# write the polygon header
	# and here translate it to the xfig format
	print Xfig_dateihandle ("2 3 0 ".$thickness." ".$penColor." ".$baseFillColor." $layer -1  ".$areafillColor." ".$style_val." ".$join_style
	." ".$cap_style."  0  0  0  ".$nrOfPoints." \n	     ");
	
	# process every polyline of this tile
	foreach my $polyline (@{$self->{DECORATION_POLYPOINTS}}){
		
		# just change a temp value but not the original !
		my $tmpX1 = $polyline->{X1};
		my $tmpY1 = $polyline->{Y1};
	
		# swop y coordinate
		if($saat->{DEG} < 0){
			$tmpY1 = -$tmpY1;
		}
		
		# pkt coordinates
		$x_1 = $saat->{X1} + (cos(G2R * $saat->{DEG}) * $tmpX1) - (sin(G2R * $saat->{DEG}) * $tmpY1);
		$y_1 = $saat->{Y1} + (cos(G2R * $saat->{DEG}) * $tmpY1) + (sin(G2R * $saat->{DEG}) * $tmpX1);
		
		
		#DEBUG TO PKT/FILE
		#print("L ".$x_1." ".$y_1." ".$x_2." ".$y_2."\n");
		
		if($polyCnt >= 6){
			print Xfig_dateihandle ("\n");
			$polyCnt = 0;
		}
		
		
		if($polyCnt <= 0){
			print Xfig_dateihandle ("\t");
		}
		print Xfig_dateihandle (&calcXfigPoint($x_1,$fx,$xnull)." ".&calcXfigPoint($y_1,$fy,$ynull)." ");
		
		# copy first point
		if($firstPoint == 1){
			$firstPoint = 0;
			push(@firstPointCpy,&calcXfigPoint($x_1,$fx,$xnull));
			push(@firstPointCpy,&calcXfigPoint($y_1,$fy,$ynull));
		}
		
		$polyCnt++;
	}
	
	# write the end point of the polyline
	if($polyCnt >= 6){
		print Xfig_dateihandle ("\n\t");
		print Xfig_dateihandle (shift(@firstPointCpy)." ".shift(@firstPointCpy)."\n");
	}
	else{
		print Xfig_dateihandle (" ".shift(@firstPointCpy)." ".shift(@firstPointCpy)."\n");
	}
}

# translates the points to xfig coordinates
sub doPointTranslation(){
	my ($saat,$self) = @_;
	
	my $x_1;
	my $y_1;
	
	# process every point of this tile
	foreach my $point (@{$self->{DECORATION_POINTS}}){
	
		# just change a temp value but not the original !
		my $tmpX1 = $point->{X1};
		my $tmpY1 = $point->{Y1};
		
		# rotation is smaller than 0
		if($saat->{DEG} < 0){
			$tmpY1 = -$tmpY1;
		}
		
		# pkt coordinates
		$x_1 = $saat->{X1} + (cos(G2R * $saat->{DEG}) * $tmpX1) - (sin(G2R * $saat->{DEG}) * $tmpY1);
		$y_1 = $saat->{Y1} + (cos(G2R * $saat->{DEG}) * $tmpY1) + (sin(G2R * $saat->{DEG}) * $tmpX1);
		
		# write to xfig file
		print Xfig_dateihandle ("1 3 0 3 -1 7 0 0 0 0.000 1 0.0000 ");
		print Xfig_dateihandle ((&calcXfigPoint($x_1,$fx,$xnull))." ".(&calcXfigPoint($y_1,$fy,$ynull))." ".DECOPOINTBORE." ".DECOPOINTBORE." ");
		print Xfig_dateihandle ((&calcXfigPoint($x_1,$fx,$xnull))." ".(&calcXfigPoint($y_1,$fy,$ynull))." ");
		print Xfig_dateihandle ((&calcXfigPoint($x_1,$fx,$xnull)+20)." ".(&calcXfigPoint($y_1,$fy,$ynull))."\n");
		
	}
}
	
# translates the deco lines to xfig coordinates
sub doLineTranslation(){
	my ($saat,$self) = @_;

	my $x_1;
	my $x_2;
	my $y_1;
	my $y_2;
	
	# process every decoline of this tile
	foreach my $line (@{$self->{DECORATION_LINES}}){
		#&playAnimation();
		# eigentlich muss nur die y coordinate neu gesetzt werden, in eine tmp variable
		# just change a temp value but not the original !
		my $tmpX1 = $line->{X1};
		my $tmpY1 = $line->{Y1};
		my $tmpX2 = $line->{X2};
		my $tmpY2 = $line->{Y2};
		
		# invert coordinate
		if($saat->{DEG} < 0){
			$tmpY1 = -$tmpY1;
			$tmpY2 = -$tmpY2;
		}
		
		# pkt coordinates
		$x_1 = $saat->{X1} + (cos(G2R * $saat->{DEG}) * $tmpX1) - (sin(G2R * $saat->{DEG}) * $tmpY1);
		$y_1 = $saat->{Y1} + (cos(G2R * $saat->{DEG}) * $tmpY1) + (sin(G2R * $saat->{DEG}) * $tmpX1);
		$x_2 = $saat->{X1} + (cos(G2R * $saat->{DEG}) * $tmpX2) - (sin(G2R * $saat->{DEG}) * $tmpY2);
		$y_2 = $saat->{Y1} + (cos(G2R * $saat->{DEG}) * $tmpY2) + (sin(G2R * $saat->{DEG}) * $tmpX2);
		
		#DEBUG TO PKT/FILE
		#print("L ".$x_1." ".$y_1." ".$x_2." ".$y_2."\n");
		
		#and here translate it to the xfig format
		print Xfig_dateihandle ("2 1 0 1 -1 7 0 0 -1 0.000 1 1 -1 0 0 2 \n	     ");
		
		print Xfig_dateihandle (&calcXfigPoint($x_1,$fx,$xnull)." ");
		print Xfig_dateihandle (&calcXfigPoint($y_1,$fy,$ynull)." ");
		print Xfig_dateihandle (&calcXfigPoint($x_2,$fx,$xnull)." ");
		print Xfig_dateihandle (&calcXfigPoint($y_2,$fy,$ynull)."\n");
	}
}
	
# display an animation
sub playAnimation(){
	my $self = shift;
	
	 $char = shift(@animation);
	 print STDERR ($char."\r");
	 push(@animation,$char);
}


# calculates a point to xfig coordinates
sub calcXfigPoint(){
	my ($koordinate, $factor, $pointNull, $self) = @_;
	return int($pointNull + ($koordinate * $factor));
}

# add new saat information to this object
sub addNewSaatInfos(){
	my $self = shift;
	my ($deg, $x1, $y1, $proto) = @_;
	
	my $saat_struct = {
		PROTOTILE_NR => $proto,
		DEG => $deg,
		X1 => $x1,
		Y1 => $y1
	};

	# add deco line to deco line list
	push(@new_saat_infos, $saat_struct);
}


# add only a saat info
sub addSaatInfo(){
	my $self = shift;
	my ($deg, $x1, $y1) = @_;

	my $saat_struct = {
		DEG => $deg,
		X1 => $x1,
		Y1 => $y1
	};

	# add deco line to deco line list
	push(@{$self->{SAAT_INFOS}}, $saat_struct);
}

# adds a new deco line
sub addNewDecoLine(){
	my $self = shift;
	my ($x1, $y1, $x2, $y2) = @_;

	my $line = {
		X1 => $x1,
		Y1 => $y1,
		X2 => $x2,
		Y2 => $y2
	};

	# add deco line to deco line list
	push(@{$self->{DECORATION_LINES}}, $line);
}

# adds a new poly point
sub addNewPolyPoint(){
	my $self = shift;
	my ($x,$y) = @_;

	my $point = {
		X1 => $x,
		Y1 => $y
	};

	# add poly point to poly point list
	push(@{$self->{DECORATION_POLYPOINTS}}, $point);
}

# adds a new deco point
sub addNewDecoPoint(){
	my $self = shift;
	my ($x,$y) = @_;

	my $point = {
		X1 => $x,
		Y1 => $y
	};

	# add deco point to deco point list
	push(@{$self->{DECORATION_POINTS}}, $point);
}

# add a new tile of inflation
sub addNewTileOfInflation(){
	my $self = shift;
	my ($x1, $y1, $x2, $y2) = @_;

	my $line = {
		PROTOTILE_NR => $x1,
		ROTATION => $y1,
		XPOS => $x2,
		YPOS => $y2
	};

	# add new tile of Inflation to List
	push(@{$self->{TILES_OF_INFLATION}}, $line);
}

# sets the fill color of this tile
sub fillColor(){
	my $self = shift;
	my ($colorCode) = @_;
	
	# do if parameters are given
	if (@_) { 
		$self->{FILL_COLOR} = $colorCode;
	}
	
	#return name
	return $self->{FILL_COLOR};
}

# set and get name of this tile
sub name(){
	my $self = shift;
	my ($protoName) = @_;
	
	# do if parameters are given
	if (@_) { 
		$self->{NAME} = $protoName;
	}
	
	#return name
	return $self->{NAME};
}

# print a formatet object info
sub printObjectInfos(){
	my $self = shift;
	
	print("\n\n################################[Prototile: ".$self->{NAME}." ]###########################################\n");
	print("#\n");
	
	# print all the tiles
	print("# Tiles of inflation:               Amount: ".@{$self->{TILES_OF_INFLATION}}."\n");
	&printInflList($self->{TILES_OF_INFLATION});
	
	# print all the decolines
	print("# Decoration-lines:                 Amount: ".@{$self->{DECORATION_LINES}}."\n");
	&printDecoList($self->{DECORATION_LINES});
	
	# print all the polypoints
	print("# Polygon-points:                   Amount: ".@{$self->{DECORATION_POLYPOINTS}}."\n");
	&printPolyPoints($self->{DECORATION_POLYPOINTS});
	
	# print all decopoints
	print("# Decoration-points:                Amount: ".@{$self->{DECORATION_POINTS}}."\n");
	&printDecoPoints($self->{DECORATION_POINTS});
	
	#print the fill color of this tile if a fill color is given
	if($self->{FILL_COLOR}){
		print("# Fill-color:  ".$self->{FILL_COLOR}."\n");
	}
	
	#print saat infos
	if($self->{SAAT_INFOS}){
	print("# Saat-infos:                       Amount: ".@{$self->{SAAT_INFOS}}."\n");
	&printSaatList($self->{SAAT_INFOS});
	}
	else{
		print ("\/!\\ MISSING SAAT INFORMATION FOR THIS TILE \/!\\\n");
	}
	
	print("#\n");
	print("#############################################################################################\n");
	print("\n\n");

}


# here different prints to visualize and style the different lists
# it could be done in a way wich uses smaller code, but so it is more readable
sub printSaatList(){
	my ($list) = @_;
	
	foreach(@{$list}){
		print("#     DEG: ".$_->{DEG}."     Xpos: ".$_->{X1}."     Ypos: ".$_->{Y1}."\n");
	}
	print("#\n");	
}



sub printInflList(){
	my ($list) = @_;
	
	foreach(@{$list}){
		printf("#     PrototileNr.: %3d   Rotation: %25s%5s(%s, %s)\n",$_->{PROTOTILE_NR},$_->{ROTATION}," ",$_->{XPOS},$_->{YPOS});
	}
	print("#\n");	
}

#
# ueberfluessig man kann auch printDecoPoints dafuer benutzen erstmal drinn lassen
# 
sub printPolyPoints(){
	my ($list) = @_;
	
	foreach(@{$list}){
		printf("#%5s(%s, %s)\n"," ",$_->{X1},$_->{Y1});
	}
	print("#\n");	
}

sub printDecoPoints(){
	my ($list) = @_;
	
	foreach(@{$list}){
		printf("#%5s(%s, %s)\n"," ",$_->{X1},$_->{Y1});
	}
	print("#\n");	
}

sub printDecoList(){
	my ($list) = @_;
	
	foreach(@{$list}){
		printf("#%5s(%s, %s) (%s, %s)\n"," ",$_->{X1},$_->{Y1},$_->{X2},$_->{Y2});
	}
	print("#\n");	
}
1;