File Coverage

blib/lib/Image/Magick/Chart.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

package Image::Magick::Chart;

use strict;
use warnings;

use Carp;

use Image::Magick;

use Moo;

require 5.006002;

our $VERSION = '1.07';

use Types::Standard qw/Any ArrayRef Bool Int Str/;

has antialias =>
(
	default  => sub{return 0},
	is       => 'rw',
	isa      => Bool,
	required => 0,
);

has bar_width =>
(
	default  => sub{return 8},
	is       => 'rw',
	isa      => Int,
	required => 0,
);

has bg_color =>
(
	default  => sub{return 'white'},
	is       => 'rw',
	isa      => Str,
	required => 0,
);

has colorspace =>
(
	default  => sub{return 'RGB'},
	is       => 'rw',
	isa      => Str,
	required => 0,
);

has depth =>
(
	default  => sub{return 8},
	is       => 'rw',
	isa      => Int,
	required => 0,
);

has fg_color =>
(
	default  => sub{return 'black'},
	is       => 'rw',
	isa      => Str,
	required => 0,
);

has font =>
(
	default  => sub{return 'Courier'},
	is       => 'rw',
	isa      => Str,
	required => 0,
);

has frame_color =>
(
	default  => sub{return 'black'},
	is       => 'rw',
	isa      => Str,
	required => 0,
);

has frame_option =>
(
	default  => sub{return 1},
	is       => 'rw',
	isa      => Bool,
	required => 0,
);

has height =>
(
	default  => sub{return 0},
	is       => 'rw',
	isa      => Int,
	required => 0,
);

has image =>
(
	default  => sub{return ''},
	is       => 'rw',
	isa      => Any,
	required => 0,
);

has output_file_name =>
(
	default  => sub{return ''},
	is       => 'rw',
	isa      => Str,
	required => 1,
);

has padding =>
(
	default  => sub{return [30, 30, 30, 30]}, # [12 noon, 3, 6, 9].
	is       => 'rw',
	isa      => ArrayRef,
	required => 0,
);

has pointsize =>
(
	default  => sub{return 14},
	is       => 'rw',
	isa      => Int,
	required => 0,
);

has tick_length =>
(
	default  => sub{return 4},
	is       => 'rw',
	isa      => Int,
	required => 0,
);

has title =>
(
	default  => sub{return ''},
	is       => 'rw',
	isa      => Str,
	required => 0,
);

has width =>
(
	default  => sub{return 0},
	is       => 'rw',
	isa      => Int,
	required => 0,
);

has x_axis_data =>
(
	default  => sub{return []},
	is       => 'rw',
	isa      => ArrayRef,
	required => 1,
);

has x_axis_labels =>
(
	default  => sub{return []},
	is       => 'rw',
	isa      => ArrayRef,
	required => 1,
);

has x_axis_labels_option =>
(
	default  => sub{return 0},
	is       => 'rw',
	isa      => Bool,
	required => 0,
);

has x_axis_ticks_option =>
(
	default  => sub{return 0},
	is       => 'rw',
	isa      => Int, # Sic.
	required => 0,
);

has x_data =>
(
	default  => sub{return []},
	is       => 'rw',
	isa      => ArrayRef,
	required => 0,
);

has x_data_option =>
(
	default  => sub{return 1},
	is       => 'rw',
	isa      => Int,
	required => 0,
);

has x_pixels_per_unit =>
(
	default  => sub{return 3},
	is       => 'rw',
	isa      => Int,
	required => 0,
);

has y_axis_data =>
(
	default  => sub{return []},
	is       => 'rw',
	isa      => ArrayRef,
	required => 1,
);

has y_axis_labels =>
(
	default  => sub{return []},
	is       => 'rw',
	isa      => ArrayRef,
	required => 1,
);

has y_axis_labels_option =>
(
	default  => sub{return 0},
	is       => 'rw',
	isa      => Bool,
	required => 0,
);

has y_axis_labels_x =>
(
	default  => sub{return undef},
	is       => 'rw',
	isa      => Any,
	required => 0,
);

has y_axis_ticks_option =>
(
	default  => sub{return 1},
	is       => 'rw',
	isa      => Int, # Sic.
	required => 0,
);

has y_pixels_per_unit =>
(
	default  => sub{return 20},
	is       => 'rw',
	isa      => Int,
	required => 0,
);

# -----------------------------------------------

sub BUILD
{
	my($self) = @_;

	if ($self -> image)
	{
		($self -> width, $self -> height) = $self -> image -> Get('width', 'height');
	}
	else
	{
		$self -> width(${$self -> padding}[3] + 1 + ($self -> x_pixels_per_unit * ${$self -> x_axis_data}[$#{$self -> x_axis_data}]) + ${$self -> padding}[1]);
		$self -> height(${$self -> padding}[2] + 1 + ($self -> y_pixels_per_unit * ${$self -> y_axis_data}[$#{$self -> y_axis_data}]) + ${$self -> padding}[0]);
		$self -> image(Image::Magick -> new(size => "$self -> width x $self -> height") );

		$self -> image -> Set(antialias => $self -> antialias) && Carp::croak("Can't set antialias: $self -> antialias");
		$self -> image -> Set(colorspace => $self -> colorspace) && Carp::croak("Can't set colorspace: $self -> colorspace");
		$self -> image -> Set(depth => $self -> depth) && Carp::croak("Can't set depth: $self -> depth");
		$self -> image -> Read('xc:' . $self -> bg_color) && Carp::croak("Can't set bg_color color: $self -> bg_color");
	}

}	# End of BUILD.

# -----------------------------------------------

sub draw_frame
{
	my($self)  = @_;
	my($x_max) = $self -> x_pixels_per_unit * ${$self -> x_axis_data}[$#{$self -> x_axis_data}];

	$self -> image -> Draw
	(
		fill      => 'none',
		primitive => 'polyline',
		stroke    => $self -> frame_color,
		points    => sprintf
		(
			"%i,%i %i,%i %i,%i %i,%i %i,%i",
			${$self -> padding}[3], ${$self -> padding}[0],
			${$self -> padding}[3] + $x_max, ${$self -> padding}[0],
			${$self -> padding}[3] + $x_max, ($self -> height - ${$self -> padding}[2] - 1),
			${$self -> padding}[3], ($self -> height - ${$self -> padding}[2] - 1),
			${$self -> padding}[3], ${$self -> padding}[0]
		),
	) && Carp::croak("Can't draw frame");

}	# End of draw_frame.

# -----------------------------------------------

sub draw_horizontal_bars
{
	my($self)           = @_;
	my($half_bar_width) = int($self -> bar_width / 2);
	my($y_zero)         = $self -> height - ${$self -> padding}[2] - 1;

	my($i, $data, @metric, $x_right, $y_top);

	for $i (0 .. $#{$self -> x_data})
	{
		$data    = ${$self -> x_data}[$i];
		$x_right = ${$self -> padding}[3] + ($self -> x_pixels_per_unit * $data);
		$y_top   = $y_zero - ($self -> y_pixels_per_unit * ${$self -> y_axis_data}[$i]);

		$self -> image -> Draw
		(
			fill      => $self -> fg_color,
			primitive => 'polyline',
			method    => 'floodfill',
			stroke    => $self -> fg_color,
			points    => sprintf
			(
				"%i,%i %i,%i %i,%i %i,%i",
				${$self -> padding}[3], $y_top - $half_bar_width,
				$x_right, $y_top - $half_bar_width,
				$x_right, $y_top + $half_bar_width,
				${$self -> padding}[3], $y_top + $half_bar_width,
			),
		) && Carp::croak("Can't draw horizontal bars");

		next if ($self -> x_data_option == 0);

		@metric = $self -> image -> QueryFontMetrics(text => $data);

		$self -> image -> Annotate
		(
		 font        => $self -> font,
		 text        => $data,
		 stroke      => 'black',
		 strokewidth => 1,
		 pointsize   => $self -> pointsize,
		 x           => $x_right + $self -> tick_length,
		 y           => $y_top + int($metric[5] / 2) - 2,
		) && Carp::croak("Can't draw horizontal bars");
	}

}	# End of draw_horizontal_bars.

# -----------------------------------------------

sub draw_title
{
	my($self) = @_;

	$self -> image -> Annotate
	(
	 font        => $self -> font,
	 text        => $self -> title,
	 stroke      => 'black',
	 strokewidth => 1,
	 pointsize   => $self -> pointsize,
	 x           => int( ($self -> width - int(int($self -> pointsize / 2) * length($self -> title) ) ) / 2),
	 y           => int(${$self -> padding}[0] / 2) + 2,
	) && Carp::croak("Can't draw title");

}	# End of draw_title.

# -----------------------------------------------

sub draw_x_axis_labels
{
	my($self)	= @_;
	my($x_zero)	= ${$self -> padding}[3];

	my($i, $text, $x_step, @metric);

	for $i (0 .. $#{$self -> x_axis_labels})
	{
		$text   = ${$self -> x_axis_labels}[$i];
		$x_step = $x_zero + ($self -> x_pixels_per_unit * ${$self -> x_axis_data}[$i]);
		@metric = $self -> image -> QueryFontMetrics(text => $text);

		$self -> image -> Annotate
		(
			font        => $self -> font,
			text        => $text,
			stroke      => $self -> frame_color,
			strokewidth => 1,
			pointsize   => $self -> pointsize,
			x           => $x_step - int($metric[4] / 2) - 1,
			y           => $self -> height - $self -> pointsize,
		) && Carp::croak("Can't draw X-axis labels");
	}

}	# End of draw_x_axis_labels.

# -----------------------------------------------

sub draw_x_axis_ticks
{
	my($self)   = @_;
	my($x_zero) = ${$self -> padding}[3];
	my($y_zero) = $self -> x_axis_ticks_option == 1 ? $self -> height - ${$self -> padding}[2] : ${$self -> padding}[0];
	my($y_one)  = $self -> height - ${$self -> padding}[2] + $self -> tick_length;

	my($x, $x_step);

	for $x (@{$self -> x_axis_data})
	{
		$x_step = $x_zero + ($self -> x_pixels_per_unit * $x);

		$self -> image -> Draw
		(
			primitive => 'line',
			stroke    => $self -> frame_color,
			points    => sprintf
			(
				"%i,%i %i,%i",
				$x_step, $y_zero,
				$x_step, $y_one
			),
		) && Carp::croak("Can't draw X-axis ticks");
	}

}	# End of draw_x_axis_ticks.

# -----------------------------------------------

sub draw_y_axis_labels
{
	my($self)   = @_;
	my($y_zero) = $self -> height - ${$self -> padding}[2] - 1;

	my($y, $offset, @metric);

	for $y (@{$self -> y_axis_labels})
	{
		@metric = $self -> image -> QueryFontMetrics(text => $y);
		$offset	= defined($self -> y_axis_labels_x) ? $self -> y_axis_labels_x : ${$self -> padding}[3] - $self -> pointsize - $metric[4];
		$y_zero -= $self -> y_pixels_per_unit;

		$self -> image -> Annotate
		(
			font        => $self -> font,
			text        => $y,
			stroke      => $self -> frame_color,
			strokewidth => 1,
			pointsize   => $self -> pointsize,
			x           => $offset,
			y           => $y_zero + int($metric[5] / 2) - 2,
		) && Carp::croak("Can't draw Y-axis labels");
	}

}	# End of draw_y_axis_labels.

# -----------------------------------------------

sub draw_y_axis_ticks
{
	my($self)   = @_;
	my($x_max)  = $self -> x_pixels_per_unit * ${$self -> x_axis_data}[$#{$self -> x_axis_data}];
	my($x_zero) = $self -> y_axis_ticks_option == 1 ? ${$self -> padding}[3] : $x_max + ${$self -> padding}[3];
	my($x_one)  = ${$self -> padding}[3] - $self -> tick_length;
	my($y_zero) = $self -> height - ${$self -> padding}[2] - 1;

	my($i);

	# We use _x_data here and not _y_axis_* so that the number
	# of ticks corresponds to the number of data points, and
	# not to the number of y-axis labels. Remember: The user
	# can - and should - have an empty string as the last
	# label on the y-axis, to make the image pretty.

	for $i (0 .. $#{$self -> x_data})
	{
		$y_zero -= $self -> y_pixels_per_unit;

		$self -> image -> Draw
		(
			primitive => 'line',
			stroke    => $self -> frame_color,
			points    => sprintf
			(
				"%i,%i %i,%i",
				$x_zero, $y_zero,
				$x_one, $y_zero
			),
		) && Carp::croak("Can't draw Y-axis ticks");
	}

}	# End of draw_y_axis_ticks.

# -----------------------------------------------

sub write
{
	my($self) = @_;

	$self -> image -> Write($self -> output_file_name) && Carp::croak("Can't write file");

}	# End of write.

# -----------------------------------------------

1;

__END__