File Coverage

blib/lib/Image/BoxModel/Lowlevel.pm

Criterion	Covered	Total	%
statement	12	138	8.7
branch	0	88	0.0
condition	0	64	0.0
subroutine	4	13	30.7
pod	8	9	88.8
total	24	312	7.6

package Image::BoxModel::Lowlevel;

use warnings;
use strict;

use POSIX;	#for ceil() in ::Box
use Carp;

=head1 NAME

Image::BoxModel::Lowlevel - Lowlevel functions for Image::BoxModel

=head1 SYNOPSIS

  For an example and general information see Image::BoxModel.pm

=head1 DESCRIPTION

Image::BoxModel::Lowlevel implements some basic functionality.

It does so by using the methods from Image::BoxModel::Backend::[LIBRARY]

There are more backends planned and more functionality for each backend.
(backends, patches, wishes are very welcome - in this order ;-)

Image::BoxModel::Lowlevel can be used directly, which is considered painful sometimes.
You need to specify the size of a box before you can put text on it, for example, while 'Annotate' (inherited from ::Text) easily inserts a box and puts text on it.
On the other hand,  ::Lowlevel gives you full control.

=head2 Methods:

=cut

#########################
#Get width & height of a Box
#########################

=head3 GetBoxSize

 ($width, $height) = $image -> GetBoxSize (box => "name_of_your_box");

=cut

sub GetBoxSize{
	my $image = shift;
	my %p = @_;

	if ((exists $p{box} && defined $p{box}) && (exists $image->{$p{box}}{width})){
		return $image->{$p{box}}{width}, $image->{$p{box}}{height};
	}
	else{
		return "Box '$p{box}' is not (correctly, at least) defined";
	}
}



#########################
# Add a new box and resize another one (the "free"-box unless resize => box-to-resize is set)
#########################

=head3 Box

If you don't specify 'resize => $name_of_box_to_be_resized', the standard-box 'free' is chosen.

 $image -> Box (
	position 		=>[left|right|top|bottom],
	width			=> $x,
	height 			=> $y,
	name 			=> $name_of_new_box,

	# You can either specify a background color, then the box will be filled with that color
	background  	=> [color]

	# or you can define a border color and a background color, then you will get a nice rectangle with border.
	# if you omit border_thickness it defaults to 1
	background 		=> [color],
	border_color	=> [color],
	border_thickness =>[color]
 );

=cut

sub Box{
	my $image = shift;
	my %p = @_;	#%p holds the _p_arameters
	my $resize = $p{resize} || 'free';

	#~ print "Name: $resize, Wert: ", $image->{$resize},"\n";
	croak __PACKAGE__,"::Box: You tried to put a box on '$resize' which does not exists. Die." unless exists $image ->{ $resize};

	croak __PACKAGE__,"::Box: Mandatory parameter name missing. Die." unless $p{name};
	return "$p{name} already exists. No box added" if (exists $image->{$p{name}});
	croak __PACKAGE__,"::Box: Mandatory parameter position missing. Die." unless $p{position};

	#return if width or height is not specified.
	#(height wenn adding at top or bottom, width wen adding at left or right side.)
	if ($p{position} eq "top" or $p{position} eq "bottom"){

		return "Box: Please specify height > 0. No box added\n"
			unless (exists $p{height} and $p{height} > 0);

		return "Box: Not enough free space on $resize for $p{name}. No box added\n (requested space: $p{height}, available: $image->{$resize}{height})\n"
			if ($p{height} > $image->{$resize}{height});
	}
	elsif ($p{position} eq "left" or $p{position} eq "right"){

		return "Box: Please specify width > 0. No box added\n"
			unless (exists $p{width} and $p{width} and $p{width} > 0);

		return "Box: Not enough free space on $resize for $p{name}. No box added\n (requested space: $p{width}, available: $image->{$resize}{width})\n"
			if ($p{width} > $image->{$resize}{width});
	}

	$image -> print_message ("Add Box \"$p{name}\" with ", __PACKAGE__,"\n");


	$image->{$p{name}}={	#First we make the new box as big as the field which will be resized..
		top		=> $image->{$resize}{top},
		bottom	=> $image->{$resize}{bottom},
		left	=> $image->{$resize}{left} ,
		right	=> $image->{$resize}{right},
	};

	#.. then we overwrite as needed.

	$p{width}  = ceil ($p{width})  if exists $p{width};
	$p{height} = ceil ($p{height}) if exists $p{height};

	if ($p{position} eq "top"){
		$image->{$p{name}}{bottom} 	= $image->{$resize}{top} + $p{height};

		#The top margin of the resized field is set to the bottom of the new box.
		$image->{$resize}{top} 		= $image->{$p{name}}{bottom}+1;
	}
	elsif ($p{position} eq "bottom"){
		$image->{$p{name}}{top} 	= $image->{$resize}{bottom} - $p{height};
		$image->{$resize}{bottom} 	= $image->{$p{name}}{top}-1;
	}
	elsif ($p{position} eq "left"){
		$image->{$p{name}}{right} 	= $image->{$resize}{left} + $p{width};
		$image->{$resize}{left} 	= $image->{$p{name}}{right}+1;
	}
	elsif ($p{position} eq "right"){
		$image->{$p{name}}{left} 	= $image->{$resize}{right} - $p{width};
		$image->{$resize}{right} 	= $image->{$p{name}}{left}-1;
	}
	else {
		return "Image::BoxModel::Lowlevel::Box: Position $p{position} unknown. No box added";

	}

	# if border_color and background are defined, draw a rectangle with border and fill it.
	if (exists $p{border_color} and defined $p{border_color}
		and
		exists $p{background}   and defined $p{background}
		){

			$p{border_thickness} = 1 unless (exists $p{border_thickness} and defined $p{border_thickness} and $p{border_thickness} > 1);

			$image -> DrawRectangle(
				left 			=> $image->{$p{name}}{left},
				right 			=> $image->{$p{name}}{right},
				top 			=> $image->{$p{name}}{top},
				bottom 			=> $image->{$p{name}}{bottom},
				fill_color 		=> $p{background},
				border_color	=> $p{border_color},
				border_thickness => $p{border_thickness}
			);
	}
	# if there is only background, just fill the box with the color
	elsif (exists $p{background} and defined $p{background}){
		$image-> DrawRectangle(
			left 	=> $image->{$p{name}}{left},
			right 	=> $image->{$p{name}}{right},
			top 	=> $image->{$p{name}}{top},
			bottom 	=> $image->{$p{name}}{bottom},
			color 	=> $p{background}
		);
	}

	$image->{$p{name}}{width} 	= $image->{$p{name}}{right}  - $image->{$p{name}}{left};
	$image->{$p{name}}{height} 	= $image->{$p{name}}{bottom} - $image->{$p{name}}{top};

	$image->{$resize}{height} 	= $image->{$resize}{bottom}  - $image->{$resize}{top};	#calculate these values for later use.. laziness
	$image->{$resize}{width} 	= $image->{$resize}{right}   - $image->{$resize}{left};

	return;
}

#########################
# Add Floating Box. These boxes can reside anywhere and can overlap. Poor error-checking!
#########################

=head3 FloatBox

To position a free-floating box wherever you want. There is virtually no error-checking, so perhaps better keep your hands off. ;-)

 $image -> FloatBox(
	top 	=> $top,
	bottom	=> $bottom,
	right	=> $right,
	left	=> $top,
	name	=> "whatever_you_call_it",
	background =>[color]
 );

=cut

sub FloatBox{
	my $image = shift;
	my %p =@_;
	return "$p{name} already exists. No FloatBox added" if (exists $image->{$p{name}});
	foreach ("top", "bottom", "left", "right"){
		return __PACKAGE__,"::FloatBox: argument $_ missing. No FloatBox added" unless (exists $p{$_});
		$image->{$p{name}}{$_} = $p{$_};
	}

	$image -> print_message ("Add FloatBox \"$p{name}\" with ", __PACKAGE__,"\n");

	#shift right <-> left if left is more right than right ;-)
	($image->{$p{name}}{right}, $image->{$p{name}}{left})   = ($image->{$p{name}}{left}, $image->{$p{name}}{right})
		if ($image->{$p{name}}{left} > $image->{$p{name}}{right});
	#same for bottom and top
	($image->{$p{name}}{top}  , $image->{$p{name}}{bottom}) = ($image->{$p{name}}{bottom}  , $image->{$p{name}}{top})
		if ($image->{$p{name}}{bottom} < $image->{$p{name}}{top});

	$image->{$p{name}}{$_} = int ($image->{$p{name}}{$_}) foreach ('top', 'left');		#only allow integer values
	$image->{$p{name}}{$_} = ceil ($image->{$p{name}}{$_}) foreach ('right', 'bottom');

	my $top 	= $image->{$p{name}}{top};
	my $bottom 	= $image->{$p{name}}{bottom};
	my $left 	= $image->{$p{name}}{left};
	my $right 	= $image->{$p{name}}{right};
	if ((exists $p{background}) && (defined $p{background})){
		$image	-> DrawRectangle(
			left => $left,
			right => $right,
			top => $top,
			bottom => $bottom,
			color => $p{background}
		);
	}

	$image->{$p{name}}{width}  = $image->{$p{name}}{right} - $image->{$p{name}}{left};
	$image->{$p{name}}{height} = $image->{$p{name}}{bottom} - $image->{$p{name}}{top};

	return
}

=head3 GetTextSize

Get the boundig size of (rotated) text. Very useful to find out how big boxes need to be.
 ($width, $height) = $image -> GetTextSize(
	text 		=> "Your Text",
	textsize 	=> [number],
	rotate 		=> [in degrees, may be negative as well]
 );

=cut

sub GetTextSize{
	my $image = shift;
	my %p = (
		rotate 	=> 0,
		@_
	);

	$p{font} = default_font() unless (exists $p{font} and $p{font} and -f $p{font});

	#die if the mandatory parameters are missing
	my $warning;
	foreach ("text", "textsize"){
		$warning .= "Mandatory parameter \"$_\" missing. " unless (exists $p{$_});
	}
	die __PACKAGE__,"::GetTextSize: ".$warning . "dying." if ($warning);

	#get x&y of all corners:
	#@corner[0-3]{x|y}
	my @corner = $image->TextSize(text => $p{text}, font => $p{font}, textsize => $p{textsize});

	#rotate all 4 corners
	if ($p{rotate}){
		for (my $i = 0; $i < scalar(@corner); $i++){
			($corner[$i]{x}, $corner[$i]{y}) =  $image -> rotation ($corner[$i]{x}, $corner[$i]{y}, 0, 0, $p{rotate});
		}
	}

	my %most =(
		left 	=> 0,
		right 	=> 0,
		top 	=> 0,
		bottom 	=>0
	);

	#find the left-, right-, top- and bottommost values.
	foreach (@corner){
		$most{left}  	= $_->{x} if ($_->{x} < $most{left});
		$most{right} 	= $_->{x} if ($_->{x} > $most{right});
		$most{top}   	= $_->{y} if ($_->{y} < $most{top});
		$most{bottom} 	= $_->{y} if ($_->{y} > $most{bottom});
	}
	return (ceil($most{right}- $most{left})), (ceil($most{bottom}-$most{top}));	#return width and height
	#ceil to ensure that the a the text will surely and safely fit.. There were strange errors in ::Backend::GD with values equaling while being inequal at the same time! I don't unterstand this.
}

=head3 BoxSplit

 $image -> BoxSplit (
	box => "name_of_parent",
	orientation=> "[vertical|horizontal]",
	number => $number_of_little_boxes),
 );

Splits a box into "number" small boxes. This can be useful if you want to have spreadsheet-style segmentation.

Naming of little boxes: parent_[number, counting from 0]

In bitmap-land we only have integer-size-boxes. Therefore some boxes may be 1 pixel taller than others..

Example:

If the parent is "myBox", then the babies are named myBox_0, myBox_1, ...myBox_2635 (if you are crazy enough to have 2635 babies)

=cut

sub BoxSplit{
	my $image = shift;
	my %p = @_;

	my $parent_size;	#because ::Box ignores the not used given dimension, we just set this to with or height of parent and feed it twice..
	my $position;
	if ($p{orientation} eq "vertical"){
		$parent_size 	= $image -> {$p{box}}{height};
		$position 		= "top";
	}
	elsif ($p{orientation} eq "horizontal"){
		$parent_size 	= $image -> {$p{box}}{width};
		$position 		= "left";
	}
	else{
		die __PACKAGE__,": Wrong value of mandatory parameter 'orientation': $p{orientation}, should be [vertical|horizontal]. Die.";
	}

	foreach (0.. $p{number}-1){	#baby-box No. 1 holds number 0..
		my $baby_size = sprintf("%.0f", ($parent_size / ($p{number} - $_)));
		#~ print "baby-size: $baby_size\t baby-name: $p{box}_$_\n";

		$parent_size   -= $baby_size;

		$image -> Box (
			resize 		=> $p{box},
			position 	=> $position,
			width		=> $baby_size-1,
			height 		=> $baby_size-1,
			name		=> "$p{box}_$_",
			background  => $p{background_colors}[$_],

			border_color	=> $p{border_color},
			border_thickness => $p{border_thickness}
		);
	}
	return;	#nothing at the moment
}

#########################
# Add text to a box
#########################

=head3 Text

For easy use: Better use 'Annotate' (inherited from ::Text) instead of 'Text'. Annotate reserves a box automatically while Text does not.

But of course, if you need / want full control, use 'Text'.

Put (rotated, antialized) text on a box. Takes a bunch of parameters, of which "text" and "textsize" are mandatory.

 $image -> Text(
	text 		=> $text,
	textsize 	=> [number],
	color		=> "black",
	font 		=> [font-file]
	rotate		=> [in degrees, may be negative as well],
	box 		=> "free",
	align 		=> [Left|Center|Right]",		#align is how multiline-text is aligned
	position 	=> [Center				#position is how text will be positioned inside its box
					NorthWest|
					North|
					NorthEast|
					West|
					SoutEast|
					South|
					SouthWest|
					West
				   ],
	background	=> [color]				#rather for debugging
 );

=cut

sub Text{
	my $image = shift;
	my %p = (
		color	=>"black",
		rotate	=>0,
		box		=> "free",
		rotate 	=> 0,
		align 	=> "Center",
		position=> "Center",
		@_
	);

	$p{font} = default_font() unless (exists $p{font} and $p{font} and -f $p{font});

	my $warning;
	foreach ("text", "textsize"){
		$warning .= "Mandatory parameter \"$_\" missing. " unless (exists $p{$_});
	}
	$warning .= "align = $p{align} is invalid. Valid are Right / Left / Center. " unless ($p{align} =~ /left/i or $p{align} =~ /right/i or $p{align} =~ /center/i);

	#if the box does not exist (Box couldn't / didn't want to make it due to missing parameters), we can't add text.
	#(It's better if we don't want to..)
	$warning .= "Box '$p{box}' does not exist. " unless (exists $image->{$p{box}});

	return "Text: ".$warning . "No Text added.\n" if ($warning);

	#center of box = left + (right-left) /2
	#later we will rotate the text around the center of the box.
	$p{x_box_center} = $image->{$p{box}}{left} + ($image->{$p{box}}{right} - $image->{$p{box}}{left}) / 2;
	$p{y_box_center} = $image->{$p{box}}{top} + ($image->{$p{box}}{bottom} - $image->{$p{box}}{top}) / 2;

	#DrawText lives in ::Backend::[your_library], because it has to do much library-specific calculations

	my $w = $image -> DrawText(%p);
	$warning .= $w if $w;

	$image -> print_message ("Add Text to Box \"$p{box}\" with ",__PACKAGE__,"\n");
	return $warning || return;	#to avoid "uninitialized value in calling line when using -w"
}

=head3 Save

 $image -> Save($filename);

Save the image to file. There is no error-checking at the moment. You need to know yourself if your chosen library supports the desired file-type.

=head3 DrawRectangle

Rectangle without border:

 $image -> DrawRectangle (top => $top, bottom => $bottom, right => $right, left => $left, color => "color");

Rectangle with border:

 $image -> DrawRectangle (top => $top, bottom => $bottom, right => $right, left => $left, fill_color => "color", border_color => "color");

Draws a rectangle with the given sides. There are no rotated rectangles at the moment.


=cut

#There is no Save, DrawRectangle.. here really, because they're in ::Backend::[library]

=head2 Internal methods:

(documentation for myself rather than the user)

=head3 rotation

To rotate a given point by any point. It takes the angle in degrees, which is very comfortable to me.
If you want to rotate something, feel free to use it. :-)

 ($x, $y) = $image -> rotation($x, $y, $x_center, $y_center, $angle);

=cut

sub rotation{
	my $image = shift;
	my ($x, $y, $x_center, $y_center, $angle) = @_;
	#~ print "X: $x Y: $y x-center: $x_center y-center: $y_center angle: $angle\n";

	return ($x, $y) if ($angle == 0); # if angle == 0 then return immediately. 1st because there's nothing to do, 2nd to prevent from division by 0

	$angle = $image->{PI} / (360 / $angle) * 2;

	my $sin = sin ($angle);
	my $cos = cos ($angle);

	my $x1=$x;
	my $y1=$y;

	$x = ($x1 * $cos) - ($y1 * $sin) - ($x_center * $cos) + ($y_center * $sin) + $x_center;
	$y = ($x1 * $sin) + ($y1 * $cos) - ($x_center * $sin) - ($y_center * $cos) + $y_center;

	return $x, $y;
}

=head3 print_message

Checks if verbose is on and then prints messages.
 $image -> print_message("Text");

=cut

sub print_message{
	my $image = shift;
	print @_ if $image->{verbose};
}

sub default_font{
	my $package = __PACKAGE__;		# Gives Image::BoxModel::Lowlevel
	$package =~ s/::/\//g;			# 		Image/BoxModel/Lowlevel
									# Make default font: (path-to-lib)/Image/BoxModel/Backend/FreeSans.ttf
	(my $default_font = $INC{"$package.pm"}) =~ s/Lowlevel\.pm/Backend\/FreeSans.ttf/;
	if (-f $default_font){
		return $default_font;
	}
	else{
		die "Can't find default font. Please file bug report.";
	}
}


1;
__END__