view release on metacpan or  search on metacpan

t/MyTestImageBase.pm  view on Meta::CPAN

             [3,2, 4,2],    # thin horiz
             [3,2, 13,2],
             [3,3, 4,3],
             [3,3, 13,3],

             [5,2, 5,3],    # thin vert
             [5,2, 5,9],
             [6,2, 6,3],
             [6,2, 6,9],

             [1,1, 2,2],    # 2x2
             [5,6, 7,8],

             [1,1, 18,8],   # big
            );

sub check_xy {
  my ($image, %options) = @_;
  my $big_fetch_expect = $options{'big_fetch_expect'};

  my $big_negative = -2**16 + 2;
  # exercise some negatives
  $image->xy ($big_negative,0, $white);
  $image->xy (0,$big_negative, $white);
  $image->xy ($big_negative,$big_negative, $white);
  is (scalar($image->xy($big_negative,$big_negative)), $big_fetch_expect,
      'xy() negative fetch');
  is (scalar($image->xy(0,$big_negative)), $big_fetch_expect,
      'xy() negative fetch');
  is (scalar($image->xy($big_negative,0)), $big_fetch_expect,
      'xy() negative fetch');

  my $big_positive = 2**16 + 2;
  $image->xy ($big_positive,$big_positive, $white);
  $image->xy (0,$big_positive, $white);
  $image->xy ($big_positive,0, $white);
  is (scalar($image->xy(0,$big_positive)), $big_fetch_expect,
      'xy() big positive fetch');
  is (scalar($image->xy($big_positive,0)), $big_fetch_expect,
      'xy() big positive fetch');
  is (scalar($image->xy($big_positive,$big_positive)), $big_fetch_expect,
      'xy() big positive fetch');
}

sub check_line {
  my ($image, %options) = @_;
  my ($width, $height) = $image->get('-width','-height');
  my $image_clear_func = $options{'image_clear_func'};

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

sub rect_using_Other {
  my ($image, $x1, $y1, $x2, $y2, $colour, $fill) = @_;
  $image->Image_Base_Other_rectangles ($colour, $fill, $x1, $y1, $x2, $y2);
}

sub check_rectangle {
  my ($image, %options) = @_;
  my ($width, $height) = $image->get('-width','-height');
  my $image_clear_func = $options{'image_clear_func'};

  my $method;
  foreach $method ('rectangle',
                   ($image->can('Image_Base_Other_rectangles')
                    ? ('MyTestImageBase::rect_using_Other')
                    : ())) {

    # exercise some negatives
    foreach my $fill (0,1) {
      $image->$method (-100,-100,-10,-10, $white, $fill);
      $image->$method (-100,-100,5,5, $white, $fill);
      $image->$method (5,5,200,200, $white, $fill);
    }


    my $elem;
    foreach $elem (@sizes) {
      my ($x1,$y1, $x2,$y2) = @$elem;

      {
        my $name = "$method unfilled $x1,$y1, $x2,$y2";
        my $fill = undef;
        &$image_clear_func();

        my @args = ($x1,$y1, $x2,$y2, $white, $fill);
        if ($method eq 'Image_Base_Other_rectangles') {
          unshift @args, splice @args, -2, 2;
        }
        $image->$method (@args);

        my $bad
          = (is_rect ($image, $x1,$y1, $x2,$y2, $white_expect, $name)
             # outside
             + is_rect ($image, $x1-1,$y1-1, $x2+1,$y2+1, $black, $name)
             # inside
             + is_rect ($image, $x1+1,$y1+1, $x2-1,$y2-1, $black, $name));
        if ($bad) { dump_image($image); }
      }
      {