view release on metacpan or  search on metacpan

lib/Image/BoxModel/Chart.pm  view on Meta::CPAN

				color 	=> $p{grid_color}
			);
		}
	}
	else{
		#unimplemented
		print "horizontal grid unimplemented. sorry.";
	}
}

sub DrawTicks{
	my $image = shift;
	my %p = @_;
	
	if ($p{orientation} =~ /vertical/){	
		foreach (@{$p{array}}){
			
			my $y = where_between (
				pos_min => $image->{$p{box_to_measure_from}}{bottom} - $p{box_border},
				pos_max => $image->{$p{box_to_measure_from}}{top} 	 + $p{box_border},
				val_min => $p{lowest},
				val_max => $p{highest},
				val		=> $_
			);
			
			$image -> DrawRectangle (
				top 	=> $y - ($p{thickness}-1)/2, # see above, DrawGrid
				bottom 	=> $y + ($p{thickness}-1)/2, 
				right 	=> $image -> {$p{box_to_draw_on}}{right},
				left 	=> $image -> {$p{box_to_draw_on}}{left},
				color 	=> 'black' # to be dony by parameter
			);
		}
	}
	else{
		for my $c (0 .. scalar(@{$p{array}})-1){
			my $x = where_between (
				pos_min => $image->{$p{box_to_measure_from}}{left}  + $p{box_border},
				pos_max => $image->{$p{box_to_measure_from}}{right} - $p{box_border},
				val_min => $p{lowest},
				val_max => $p{highest},
				val		=> $c +.5 # middle of the bar / point / whatever is in the middle between 2 borders..
			);
			
			$image -> DrawRectangle (
				left 	=> $x-($p{thickness}-1)/2, # see above, DrawGrid
				right 	=> $x+ ($p{thickness}-1)/2, 
				bottom 	=> $image -> {$p{box_to_draw_on}}{bottom},
				top 	=> $image -> {$p{box_to_draw_on}}{top},
				color 	=> 'black' # to be dony by parameter
			);
		}
	}
}

=head3 Legend

 $image -> Legend(
	#mandatory:
	font 			=> (path to font file),
	name 			=> (name of box in which the legend lives)
	values_annotations => (name of your datasets)
	
	#optional (dafaults preset):
	textsize 		=> [number],
	rotate 			=> [number], 
	colors 			=> (color names of datasets), 	#nice: 'colors => DefaultColors()' sets default colors
	position 		=> ['right'|'left],
	orientation 	=> 'vertical',					#horizontal is unimplemented so far
	resize 			=> (name of box to be resized),
	background 		=> (color),
	
	padding_left 	=> [number],
	padding_right 	=> [number],
	padding_top 	=> [number],
	padding_bottom 	=> [number],
	
	spacing_left 	=> [number],
	spacing_top 	=> [number],
	spacing_right 	=> [number],
	spacing_bottom 	=> [number],
	
	border 			=> [number],
	border_color 	=> (color),
 );

Draw Legend. 

=cut

sub Legend{
	my $image = shift;
	my %p = (
		textsize 		=> 12,
		rotate 			=> 0, 
		colors 			=> DefaultColors(),
		position 		=> 'right',
		orientation 	=> 'vertical',
		resize 			=> 'free',
		background 		=> $image->{background},
		
		padding_left 	=> 10,
		padding_right 	=> 10,
		padding_top 	=> 10,
		padding_bottom 	=> 10,
		
		spacing_left 	=> 10,
		spacing_top 	=> 10,
		spacing_right 	=> 10,
		spacing_bottom 	=> 10,
		
		border 			=> 1,
		border_color	=> 'black',
		
		@_
	);
	
	if (exists $p{values_annotations} and $p{values_annotations}){
		$p{values_ref} = $p{values_annotations};
	}
	else{
		croak __PACKAGE__, ": Mandatory parameter 'values_annotations' missing";
	}
	
	croak __PACKAGE__, ": Mandatory parameter 'name' missing" unless (exists $p{name} and $p{name});
	
	my $square_size = int ($p{textsize} * .8);	#to be done by some intelligently set parameters later on..

	my ($w, $h) = $image -> ArrayBox (resize => $p{name},
		name 		=> "$p{name}_text",
		background 	=> $p{background},
		position 	=> $p{position},
		orientation => $p{orientation},
		values_ref 	=> $p{values_ref},
		textsize 	=> $p{textsize},
		rotate 		=> $p{rotate},
		font 		=> $p{font},
		no_box 		=> 1
	);
	
	#~ print "Width: $w, height: $h\n";
	
	#idea: have a big box into which the smaller boxes for legend etc go.
	
	$image -> Box (
		name 		=> "$p{name}",
		width 		=> $p{padding_left} + $p{border} + $p{spacing_left} + $square_size + $p{spacing_left} + $w + $p{spacing_right} + $p{border} + $p{padding_right}+6,
		height 		=> $p{padding_top} + $p{border} + $p{spacing_top} + $h + $p{spacing_bottom} + $p{border} + $p{padding_bottom}+4,
		position 	=> $p{position},
		resize 		=> $p{resize},
	);
	
	#~ print "Top: $image->{$p{name}}{top}, bottom: $image->{$p{name}}{bottom}\n";
	
	foreach ('left', 'right', 'top', 'bottom'){	#padding: 4 little (big) boxes outside the border, one at each corner
		$image -> Box (
			resize 	=> "$p{name}",
			width 	=> $p{"padding_$_"},
			height 	=> $p{"padding_$_"},
			name 	=> "$p{name}_padding_$_",
			position=> "$_",
		);
	}
	
	foreach ('left', 'right', 'top', 'bottom'){	#spacing: 4 little (big) boxes inside the border, one at each corner
		$image -> Box (
			resize 	=> "$p{name}",
			width 	=> $p{"spacing_$_"} + $p{border},	#to reserve space for the border as well..
			height 	=> $p{"spacing_$_"} + $p{border},
			name 	=> "$p{name}_spacing_$_",
			position=> "$_",
		);
	}
	
	$image -> ArrayBox (		#reserve space for the text
		resize 		=> $p{name},
		name 		=> "$p{name}_text",
		background 	=> $p{background},
		position 	=> 'right',	# Text is *always" right of little squares, wherever the legend is put.
		orientation => $p{orientation},
		values_ref 	=> $p{values_ref},
		textsize 	=> $p{textsize},
		rotate 		=> $p{rotate},
		font 		=> $p{font},
	);
	
	$image -> Box(			#some spacing between text & squares
		resize 		=> $p{name},
		name		=> "$p{name}_spacing_text_squares",
		width 		=> $p{spacing_left},
		position 	=> 'right'
	);
	
	$image -> Box(				#box for squares
		resize 		=> $p{name},
		name		=> "$p{name}_squares",
		width 		=> $square_size,
		height 		=> $square_size,
		position 	=> $p{position},
	);
	
	
	$image -> DrawRectangle(		#a rectangle as border of the legend
		top 		=> $image ->{"$p{name}_spacing_top"}{top},
		bottom 		=> $image->{"$p{name}_spacing_top"}{top}+ $p{border} * 2 + $h+ $p{spacing_top} + $p{spacing_bottom}, # Calculate space needed. 
		left 		=> $image->{"$p{name}_spacing_left"}{left}, 
		right 		=> $image->{"$p{name}_spacing_right"}{right},  
		fill_color 	=> $p{background}, 
		border_color=> $p{border_color},
		border_thickness => $p{border}
	)if ($p{border});
	
	#~ print $image->{"$p{name}_spacing_top"}{top}, "\t", $p{border} * 2 ,"\t", $h, "\t", $p{spacing_top} ,"\t", $p{spacing_bottom},"\n";
	#~ print $image->{"$p{name}_spacing_top"}{top}+ $p{border} * 2 + $h+ $p{spacing_top} + $p{spacing_bottom}, "\n";
	
	
	
	
	#~ print  $image->{"$p{name}_spacing_top"}{top}+ $p{border} * 2 + $p{spacing_top} + $h + $p{spacing_bottom};
	
	foreach (0.. scalar(@{$p{values_ref}})-1){
		#~ #print @{$p{colors}}[$_], "\t", @{$p{values_ref}}[$_], "\n";
		
		my ($width, $height) = $image -> GetTextSize(
			text 		=> @{$p{values_ref}}[$_],
			textsize 	=> $p{textsize},
			rotate	 	=> $p{rotate},
			font 		=> $p{font}
		);
		
		#there will be a distinction between vertically and horizontally drawn legends as soon as this is implemented
		
		my $e = $image -> Annotate(
			resize 		=>"$p{name}_text",
			text 		=> @{$p{values_ref}}[$_], 
			textsize 	=> $p{textsize},
			rotate 		=> $p{rotate},
			align 		=> 'left', 
			text_position=> 'west',
			font 		=> $p{font},
			
		);
	
		
		my $center_of_minibox = ($image->{$e}{top} + $image->{$e}{bottom}) / 2;
		
		$image -> DrawRectangle(
			top 		=> $center_of_minibox - $square_size / 2, 
			bottom 		=> $center_of_minibox + $square_size / 2, 
			#~ #top 	=> $image->{$e}{top},
			#~ #bottom 	=> $image->{$e}{bottom},
			left 		=> $image->{"$p{name}_squares"}{left}, 
			right		=> $image->{"$p{name}_squares"}{right},  
			fill_color 	=> @{$p{colors}}[$_], 
			border_color=> 'black'
		);
	}
}

sub where_between{#calculates where on a picture a value has to be painted between two points
	my %p = @_;
	
	foreach ('pos_min', 'pos_max', 'val_min', 'val_max', 'val'){
		Carp::croak ("where_between: missing parameter $_") unless (exists $p{$_});
	}
	
	my $position =  (
		$p{pos_min} 					#minimum position 
		+
		($p{pos_max} - $p{pos_min})		#distance between max & min
		*
		
		($p{val} - $p{val_min})			#difference between value and minimum value (numbers, not position!)
		/ 
		($p{val_max} - $p{val_min})		#difference between max & minimum
		#3 lines above result in a factor between 0 an 1, 0 if val = min, 1 if val = max, .5 if val in the middle between the both.
		
		#the distance between max & min (which are pixels or whatsoever) are multiplied by the factor (0-1).
		#this way, the distance between min and position are calculated
		
		#if max < min the result of max-min is negative so that a negative number is added to min. and everybody is happy without any if().
	);
	
	return $position;
}


sub DefaultColors{
	my $image = shift;
	return ['red', 'orange', 'yellow', 'LightGreen', 'green', 'blue', 'DarkBlue', 'DarkRed'];
}