return join(": ", map $_->[0], i_errors());
}
+# this function tries to DWIM for color parameters
+# color objects are used as is
+# simple scalars are simply treated as single parameters to Imager::Color->new
+# hashrefs are treated as named argument lists to Imager::Color->new
+# arrayrefs are treated as list arguments to Imager::Color->new iff any
+# parameter is > 1
+# other arrayrefs are treated as list arguments to Imager::Color::Float
+
+sub _color {
+ my $arg = shift;
+ my $result;
+
+ if (ref $arg) {
+ if (UNIVERSAL::isa($arg, "Imager::Color")
+ || UNIVERSAL::isa($arg, "Imager::Color::Float")) {
+ $result = $arg;
+ }
+ else {
+ if ($arg =~ /^HASH\(/) {
+ $result = Imager::Color->new(%$arg);
+ }
+ elsif ($arg =~ /^ARRAY\(/) {
+ if (grep $_ > 1, @$arg) {
+ $result = Imager::Color->new(@$arg);
+ }
+ else {
+ $result = Imager::Color::Float->new(@$arg);
+ }
+ }
+ else {
+ $Imager::ERRSTR = "Not a color";
+ }
+ }
+ }
+ else {
+ # assume Imager::Color::new knows how to handle it
+ $result = Imager::Color->new($arg);
+ }
+
+ return $result;
+}
+
+
#
# Methods to be called on objects.
#
}
if ($opts{filled}) {
+ my $color = _color($opts{'color'});
+ unless ($color) {
+ $self->{ERRSTR} = $Imager::ERRSTR;
+ return;
+ }
i_box_filled($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},
- $opts{ymax},$opts{color});
+ $opts{ymax}, $color);
}
elsif ($opts{fill}) {
unless (UNIVERSAL::isa($opts{fill}, 'Imager::Fill')) {
$opts{ymax},$opts{fill}{fill});
}
else {
- i_box($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},$opts{ymax},$opts{color});
+ my $color = _color($opts{'color'});
+ unless ($color) {
+ $self->{ERRSTR} = $Imager::ERRSTR;
+ return;
+ }
+ i_box($self->{IMG},$opts{xmin},$opts{ymin},$opts{xmax},$opts{ymax},
+ $color);
}
return $self;
}
$opts{'d2'}, $opts{fill}{fill});
}
else {
+ my $color = _color($opts{'color'});
+ unless ($color) {
+ $self->{ERRSTR} = $Imager::ERRSTR;
+ return;
+ }
if ($opts{d1} == 0 && $opts{d2} == 361 && $opts{aa}) {
i_circle_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{'r'},
- $opts{'color'});
+ $color);
}
else {
- # i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'}, $opts{'d2'},$opts{'color'});
- if ($opts{'d1'} <= $opts{'d2'}) { i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'},$opts{'d2'},$opts{'color'}); }
- else { i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},$opts{'d1'}, 361,$opts{'color'});
- i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'}, 0,$opts{'d2'},$opts{'color'}); }
+ if ($opts{'d1'} <= $opts{'d2'}) {
+ i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
+ $opts{'d1'}, $opts{'d2'}, $color);
+ }
+ else {
+ i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
+ $opts{'d1'}, 361, $color);
+ i_arc($self->{IMG},$opts{'x'},$opts{'y'},$opts{'r'},
+ 0, $opts{'d2'}, $color);
+ }
}
}
unless (exists $opts{x1} and exists $opts{y1}) { $self->{ERRSTR}='missing begining coord'; return undef; }
unless (exists $opts{x2} and exists $opts{y2}) { $self->{ERRSTR}='missing ending coord'; return undef; }
+ my $color = _color($opts{'color'});
+ unless ($color) {
+ $self->{ERRSTR} = $Imager::ERRSTR;
+ return;
+ }
+ $opts{antialias} = $opts{aa} if defined $opts{aa};
if ($opts{antialias}) {
- i_line_aa($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2}, $opts{color});
+ i_line_aa($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2},
+ $color);
} else {
- i_draw($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2}, $opts{color});
+ i_draw($self->{IMG},$opts{x1}, $opts{y1}, $opts{x2}, $opts{y2},
+ $color);
}
return $self;
}
# print Dumper(\@points);
+ my $color = _color($opts{'color'});
+ unless ($color) {
+ $self->{ERRSTR} = $Imager::ERRSTR;
+ return;
+ }
+ $opts{antialias} = $opts{aa} if defined $opts{aa};
if ($opts{antialias}) {
for $pt(@points) {
- if (defined($ls)) { i_line_aa($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$opts{color}); }
+ if (defined($ls)) {
+ i_line_aa($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$color);
+ }
$ls=$pt;
}
} else {
for $pt(@points) {
- if (defined($ls)) { i_draw($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$opts{color}); }
+ if (defined($ls)) {
+ i_draw($self->{IMG},$ls->[0],$ls->[1],$pt->[0],$pt->[1],$color);
+ }
$ls=$pt;
}
}
$opts{'fill'}{'fill'});
}
else {
- i_poly_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{'color'});
+ my $color = _color($opts{'color'});
+ unless ($color) {
+ $self->{ERRSTR} = $Imager::ERRSTR;
+ return;
+ }
+ i_poly_aa($self->{IMG}, $opts{'x'}, $opts{'y'}, $color);
}
return $self;
return;
}
- i_bezier_multi($self->{IMG},$opts{'x'},$opts{'y'},$opts{'color'});
+ my $color = _color($opts{'color'});
+ unless ($color) {
+ $self->{ERRSTR} = $Imager::ERRSTR;
+ return;
+ }
+ i_bezier_multi($self->{IMG},$opts{'x'},$opts{'y'},$color);
return $self;
}
i_flood_cfill($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{fill}{fill});
}
else {
- i_flood_fill($self->{IMG}, $opts{'x'}, $opts{'y'}, $opts{color});
+ my $color = _color($opts{'color'});
+ unless ($color) {
+ $self->{ERRSTR} = $Imager::ERRSTR;
+ return;
+ }
+ i_flood_fill($self->{IMG}, $opts{'x'}, $opts{'y'}, $color);
}
$self;
Line:
$img->line(color=>$green, x1=>10, x2=>100,
- y1=>20, y2=>50, antialias=>1 );
+ y1=>20, y2=>50, aa=>1 );
That draws an antialiased line from (10,100) to (20,50).
+The I<antialias> parameter is still available for backwards compatibility.
+
Polyline:
$img->polyline(points=>[[$x0,$y0],[$x1,$y1],[$x2,$y2]],color=>$red);
- $img->polyline(x=>[$x0,$x1,$x2], y=>[$y0,$y1,$y2], antialias=>1);
+ $img->polyline(x=>[$x0,$x1,$x2], y=>[$y0,$y1,$y2], aa=>1);
Polyline is used to draw multilple lines between a series of points.
The point set can either be specified as an arrayref to an array of
array references (where each such array represents a point). The
other way is to specify two array references.
+The I<antialias> parameter is still available for backwards compatibility.
+
Polygon:
$img->polygon(points=>[[$x0,$y0],[$x1,$y1],[$x2,$y2]],color=>$red);
$img->polygon(x=>[$x0,$x1,$x2], y=>[$y0,$y1,$y2]);
hatched fills, image based fills and fountain fills. See
L<Imager::Fill> for more information.
+The C<color> parameter for any of the drawing methods can be an
+L<Imager::Color> object, a simple scalar that Imager::Color can
+understand, a hashref of parameters that Imager::Color->new
+understands, or an arrayref of red, green, blue values.
+
=head2 Text rendering
Text rendering is described in the Imager::Font manpage.
--- /dev/null
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# Change 1..1 below to 1..last_test_to_print .
+# (It may become useful if the test is moved to ./t subdirectory.)
+use strict;
+my $loaded;
+
+BEGIN { $| = 1; print "1..17\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Imager qw/:all/;
+$loaded = 1;
+print "ok 1\n";
+
+init_log("testout/t21draw.log",1);
+
+my $redobj = NC(255, 0, 0);
+my $red = 'FF0000';
+my $greenobj = NC(0, 255, 0);
+my $green = [ 0, 255, 0 ];
+my $blueobj = NC(0, 0, 255);
+my $blue = { hue=>240, saturation=>1, value=>1 };
+my $white = '#FFFFFF';
+
+my $testnum = 2;
+
+my $img = Imager->new(xsize=>100, ysize=>100);
+
+ok($img->box(color=>$blueobj, xmin=>10, ymin=>10, xmax=>48, ymax=>18),
+ "box with color obj");
+ok($img->box(color=>$blue, xmin=>10, ymin=>20, xmax=>48, ymax=>28),
+ "box with color");
+ok($img->box(color=>$redobj, xmin=>10, ymin=>30, xmax=>28, ymax=>48, filled=>1),
+ "filled box with color obj");
+ok($img->box(color=>$red, xmin=>30, ymin=>30, xmax=>48, ymax=>48, filled=>1),
+ "filled box with color");
+
+ok($img->arc(x=>75, 'y'=>25, r=>24, color=>$redobj),
+ "filled arc with colorobj");
+
+ok($img->arc(x=>75, 'y'=>25, r=>20, color=>$green),
+ "filled arc with colorobj");
+ok($img->arc(x=>75, 'y'=>25, r=>18, color=>$white, d1=>325, d2=>225),
+ "filled arc with color");
+
+ok($img->arc(x=>75, 'y'=>25, r=>18, color=>$blue, d1=>225, d2=>325),
+ "filled arc with color");
+ok($img->arc(x=>75, 'y'=>25, r=>15, color=>$green, aa=>1),
+ "filled arc with color");
+
+ok($img->line(color=>$blueobj, x1=>5, y1=>55, x2=>35, y2=>95),
+ "line with colorobj");
+
+# FIXME - neither the start nor end-point is set for a non-aa line
+#my $c = Imager::i_get_pixel($img->{IMG}, 5, 55);
+#ok(color_cmp($c, $blueobj) == 0, "# TODO start point not set");
+
+ok($img->line(color=>$red, x1=>10, y1=>55, x2=>40, y2=>95, aa=>1),
+ "aa line with color");
+ok($img->line(color=>$green, x1=>15, y1=>55, x2=>45, y2=>95, antialias=>1),
+ "antialias line with color");
+
+ok($img->polyline(points=>[ [ 55, 55 ], [ 90, 60 ], [ 95, 95] ],
+ color=>$redobj),
+ "polyline points with color obj");
+ok($img->polyline(x=>[ 55, 85, 90 ], 'y'=>[60, 65, 95], color=>$green, aa=>1),
+ "polyline xy with color aa");
+ok($img->polyline(x=>[ 55, 80, 85 ], 'y'=>[65, 70, 95], color=>$green,
+ antialias=>1),
+ "polyline xy with color antialias");
+
+ok($img->write(file=>'testout/t21draw.ppm'),
+ "saving output");
+
+malloc_state();
+
+sub ok {
+ my ($ok, $msg) = @_;
+
+ if ($ok) {
+ print "ok ",$testnum++,"\n";
+ }
+ else {
+ print "not ok ",$testnum++," # $msg\n";
+ }
+}
+
+sub color_cmp {
+ my ($l, $r) = @_;
+ my @l = $l->rgba;
+ my @r = $r->rgba;
+ # print "# (",join(",", @l[0..2]),") <=> (",join(",", @r[0..2]),")\n";
+ return $l[0] <=> $r[0]
+ || $l[1] <=> $r[1]
+ || $l[2] <=> $r[2];
+}
projects / imager.git / commitdiff