package Imager::Plot::DataSet;
use strict;
use Imager;
use Imager::Plot::Util;
#
# Style string is in the form of one or more
# [rgbckmyo][o-](number)?
#
# examples:
#
# rc is a red circle
#
{
my %colors = (
r=>"red",
g=>"green",
b=>"blue",
c=>"cyan",
k=>"black",
m=>"magenta",
y=>"yellow",
o=>"orange",
);
my %styles = ("-","line",
o=>"circle",
);
sub style_from_string {
my $string = shift;
my %style;
while(s/^([rgbckmyo][ox-])(\d+)?$\s*//) {
my $key = $styles{$2};
my $color = $colors{$1};
my $width = defined $3 ? $colors{$3} : 1;
$style{$key} = {
color=>$color,
width=>$width
};
}
return \%style;
}
}
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = {};
bless ($self, $class);
my %opts = @_;
if ($opts{Y}) {
$self->{Y} = [@{$opts{Y}}];
if ($opts{X}) {
$self->{X} = [@{$opts{X}}];
} else {
@{$self->{X}} = 1..@{$opts{Y}};
}
}
if ($opts{XY}) {
my $nx = $#{$self->{Y}} = $#{$self->{X}} = $#{$opts{XY}};
($self->{X}[$_], $self->{Y}[$_]) = @{$opts{XY}->[$_]} for 0..$nx;
}
if ($opts{Z}) {
$self->{Z} = [@{$opts{Z}}];
}
$self->{Xmin} = (defined $opts{Xmin}) ? $opts{Xmin} : undef;
$self->{Ymin} = (defined $opts{Ymin}) ? $opts{Ymin} : undef;
$self->{Xmax} = (defined $opts{Xmax}) ? $opts{Xmax} : undef;
$self->{Ymax} = (defined $opts{Ymax}) ? $opts{Ymax} : undef;
$self->{'style'} = $opts{style} ||
($opts{string} ?
style_from_string($opts{string}) :
{ line=>{ color => Imager::Color->new("#0000FF"), antialias=>1 } }
);
my $l = $self->{'style'}->{'line'};
$l->{'width'} = 1 if defined $l and !exists $l->{'width'};
$self->{name} = $opts{name} if exists $opts{name};
return $self;
}
sub data_bbox {
my $self = shift;
my @X = minmax(@{$self->{X}});
my @Y = minmax(@{$self->{Y}});
$X[0] = $self->{Xmin} if(defined $self->{Xmin});
$Y[0] = $self->{Ymin} if(defined $self->{Ymin});
$X[1] = $self->{Xmax} if(defined $self->{Xmax});
$Y[1] = $self->{Ymax} if(defined $self->{Ymax});
return (@X, @Y);
}
sub Draw {
my $self = shift;
my %opts = @_;
my $img = $opts{Image};
my %style = %{$self->{'style'}};
my @x = $opts{Xmapper}->(@{$self->{X}});
my @y = $opts{Ymapper}->(@{$self->{Y}});
my @ox = @{$self->{X}};
my @oy = @{$self->{Y}};
if ($style{line}) {
$img->polyline(x=>\@x,
y=>\@y,
color=>$style{line}->{color},
antialias=>$style{line}->{antialias});
if($style{line}->{'width'} > 1) {
my $width = $style{line}->{width} - 1;
my $pw = 0;
while($width) {
my $w = ($width & 1) ? ++$pw : -$pw;
my @yd = map { $_ + $w } @y;
$img->polyline(
x => \@x,
y => \@yd,
color => $style{line}->{color},
antialias => $style{line}->{antialias}
);
$width--;
}
}
}
if ($style{area}) {
# bottom right
push( @x, $x[scalar(@x)-1] );
push( @y, $opts{y2} );
# bottom left
push( @x, $x[0] );
push( @y, $opts{y2} );
$img->polygon(x=>\@x,
y=>\@y,
color=>$style{area}->{color},
antialias=>$style{area}->{antialias});
}
if ($style{marker}) {
die "symbol must be circle for now!\n" unless $style{marker}->{symbol} eq "circle";
my $l = $#x;
my $size = $style{marker}->{size} || 1.5;
for(0..$l) {
Imager::i_circle_aa($img->{IMG}, 0.5+$x[$_], 0.5+$y[$_], $size, $style{marker}->{color});
# Non AA version
# $img->circle(x => $x[$_],
# y => $y[$_],
# color => $style{marker}->{color},
# r => 3);
}
}
if ($style{code}) {
# Work defered to a coderef:
# calling order is:
# ($DataSet, $xr, $yr, $Xmapper, $Ymapper, $img)
my $opts = $style{code}->{opts};
$style{code}->{ref}->($self, \@x, \@y, $opts{Xmapper}, $opts{Ymapper}, $img, $opts);
}
}
1;
__END__
put docs here!