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.763 second using v1.01-cache-2.11-cpan-524268b4103 )