Image-Base-X11-Protocol
view release on metacpan or search on metacpan
lib/Image/Base/X11/Protocol/Drawable.pm view on Meta::CPAN
die "Unknown colour(s): ",join(', ', @failed_colours);
}
}
#------------------------------------------------------------------------------
# clipping to signed 16-bit parameters
use constant _LO => -0x8000; # -32768
use constant _HI => 0x7FFF; # +32767
# $x1,$y1, $x2,$y2 are the endpoints of a line.
# Return new endpoints which are clipped to within -0x8000 to +0x7FFF which is
# signed 16-bits for X protocol.
# If given line is entirely outside the signed 16-bit rectangle then return
# an empty list.
#
sub _line_clip {
my ($x1,$y1, $x2,$y2) = @_;
### _line_clip_16bit(): "$x1,$y1, $x2,$y2"
unless (_line_any_positive($x1,$y1, $x2,$y2)) {
### nothing positive ...
lib/Image/Base/X11/Protocol/Drawable.pm view on Meta::CPAN
my ($x1new,$y1new) = _line_end_clip($x1,$y1, $x2,$y2)
or do {
### x1,y1 end nothing in range ...
return;
};
($x2,$y2) = _line_end_clip($x2,$y2, $x1,$y1)
or return;
return ($x1new,$y1new, $x2,$y2);
}
# $x1,$y1, $x2,$y2 are the endpoints of a line.
# Return new values for the $x2,$y2 end which clips it to within
# LO <= x2 <= HI
# LO <= y2 <= HI
#
# If the line is entirely outside LO to HI then return an empty list.
# If x2,y2 is already within LO to HI then return them unchanged.
#
# x1,y1
# /
# +-------- if x2 outside
t/MyTestImageBase.pm view on Meta::CPAN
my $elem;
foreach $elem (@sizes) {
my ($x1,$y1, $x2,$y2) = @$elem;
{
my $name = "line $x1,$y1 $x2,$y2";
&$image_clear_func();
$image->line ($x1,$y1, $x2,$y2, $white);
my $bad = (
# endpoints
is_pixel ($image, $x1,$y1, $white, $name)
+ is_pixel ($image, $x2,$y2, $white, $name)
# nothing in surrounding rectangle
+ is_rect ($image, $x1-1,$y1-1, $x2+1,$y2+1, $black, $name));
if ($bad) {
dump_image ($image);
}
}
{
my $name = "line $x2,$y2 $x1,$y1, reversal";
&$image_clear_func();
$image->line ($x2,$y2, $x1,$y1, $white);
my $bad = (
# endpoints
is_pixel ($image, $x1,$y1, $white, $name)
+ is_pixel ($image, $x2,$y2, $white, $name)
# nothing in surrounding rectangle
+ is_rect ($image, $x1-1,$y1-1, $x2+1,$y2+1, $black, $name));
if ($bad) {
dump_image ($image);
}
}
}
( run in 0.680 second using v1.01-cache-2.11-cpan-524268b4103 )