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;

# Name:
#	Image::Magick::Slice.
#
# Documentation:
#	POD-style documentation is at the end. Extract it with pod2html.*.
#
# Reference:
#	Object Oriented Perl
#	Damian Conway
#	Manning
#	1-884777-79-1
#	P 114
#
# Note:
#	o Tab = 4 spaces || die.
#
# Author:
#	Ron Savage
#	Home page: http://savage.net.au/index.html
#
# Licence:
#	Australian copyright (c) 2005 Ron Savage.
#
#	All Programs of mine are 'OSI Certified Open Source Software';
#	you can redistribute them and/or modify them under the terms of
#	The Artistic License, a copy of which is available at:
#	http://www.opensource.org/licenses/index.html

use strict;
use warnings;

use Carp;
use Image::Magick;

require 5.005_62;

require Exporter;

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use Image::Magick::Chart ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(

) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(

);
our $VERSION = '1.06';

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

# Preloaded methods go here.

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

# Encapsulated class data.

{
	my(%_attr_data) =
	(
	 _antialias            => 0, # 0 => No antialias; 1 => Antialias.
	 _bar_width            => 8, # Pixels.
	 _bg_color             => 'white',
	 _colorspace           => 'RGB',
	 _depth                => 8, # Bits per channel.
	 _fg_color             => 'black',
	 _font                 => 'Courier',
	 _frame_color          => 'black',
	 _frame_option         => 1, # 0 => None; 1 => Draw it.
	 _height               => 0,
	 _image                => '', # To specify the padding in pixels around the frame
	 _output_file_name     => '', # I use CSS-style for the 4 sides of the image:
	 _padding              => [30, 30, 30, 30], # [12 noon, 3, 6, 9].
	 _pointsize            => 14, # Points.
	 _tick_length          => 4,  # Pixels.
	 _title                => '',
	 _width                => 0,
	 _x_axis_data          => [],
	 _x_axis_labels        => [],
	 _x_axis_labels_option => 1, # 0 => None; 1 => Draw them.
	 _x_axis_ticks_option  => 2, # 0 => None; 1 => Below x-axis; 2 => Across frame.
	 _x_data               => [],
	 _x_data_option        => 1,
	 _x_pixels_per_unit    => 3, # Horizontal width of each data unit.
	 _y_axis_data          => [],
	 _y_axis_labels        => [],
	 _y_axis_labels_option => 1,     # 0 => None; 1 => Draw them.
	 _y_axis_labels_x      => undef, # undef => Ignore; Other => Use.
	 _y_axis_ticks_option  => 1,     # 0 => None; 1 => Left of y-axis; 2 => Across frame.
	 _y_pixels_per_unit    => 20,
	);

	sub _default_for
	{
		my($self, $attr_name) = @_;

		$_attr_data{$attr_name};
	}

	sub _standard_keys
	{
		keys %_attr_data;
	}

}	# End of encapsulated class data.

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

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 new
{
	my($class, %arg) = @_;
	my($self)        = bless({}, $class);

	for my $attr_name ($self -> _standard_keys() )
	{
		my($arg_name) = $attr_name =~ /^_(.*)/;

		if (exists($arg{$arg_name}) )
		{
			$$self{$attr_name} = $arg{$arg_name};
		}
		else
		{
			$$self{$attr_name} = $self -> _default_for($attr_name);
		}
	}

	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'}");
	}

	return $self;

}	# End of new.

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

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

	$$self{'_image'} -> Write($$self{'_output_file_name'}) && Carp::croak("Can't write file");

}	# End of write.

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

1;

__END__