The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w

# Copyright 2011, 2012, 2013 Kevin Ryde

# This file is part of Math-PlanePath.
#
# Math-PlanePath is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by the Free
# Software Foundation; either version 3, or (at your option) any later
# version.
#
# Math-PlanePath is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Math-PlanePath.  If not, see <http://www.gnu.org/licenses/>.

use 5.004;
use strict;
use Test;

use lib 't';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings(); }

use Math::PlanePath::PixelRings;

my $test_count = (tests => 2)[1];
plan tests => $test_count;

if (! eval 'use Image::Base 1.09; 1') { # version 1.09 for ellipse fixes
  MyTestHelpers::diag ('skip due to Image::Base 1.09 not available -- ',$@);
  foreach (1 .. $test_count) {
    skip ('due to no Image::Base 1.09', 1, 1);
  }
  exit 0;
}

# uncomment this to run the ### lines
#use Smart::Comments;

sub dump_coords {
  my ($href) = @_;
  my $x_min = 0;
  my $y_min = 0;
  foreach my $key (keys %$href) {
    my ($x,$y) = split /,/, $key;
    if ($x < $x_min) { $x_min = $x; }
    if ($y < $y_min) { $y_min = $y; }
  }
  my @rows;
  foreach my $key (keys %$href) {
    my ($x,$y) = split /,/, $key;
    $rows[$y-$y_min]->[$x-$x_min] = '*';
  }
  foreach my $row (reverse @rows) {
    my $str = '';
    if ($row) {
      foreach my $char (@$row) {
        if ($char) {
          $str .= " $char";
        } else {
          $str .= "  ";
        }
      }
    }
    MyTestHelpers::diag ($str);
  }
}

my %image_coords;
my $offset = 100;
{
  package MyImage;
  use vars '@ISA';
  @ISA = ('Image::Base');
  sub new {
    my $class = shift;
    return bless {@_}, $class;
  }
  sub xy {
    my ($self, $x, $y, $colour) = @_;
    $x -= $offset;
    $y -= $offset;
    ### image_coords: "$x,$y"
    $image_coords{"$x,$y"} = 1;
  }
}

#------------------------------------------------------------------------------
# _cumul_extend()

{
  my $path = Math::PlanePath::PixelRings->new;
  my $image = MyImage->new;
  my $good = 1;
  my $limit = 500;
  foreach my $r (1 .. $limit) {
    %image_coords = ();
    $image->ellipse (-$r+$offset,-$r+$offset, $r+$offset,$r+$offset, 'white');
    my $image_count = scalar(@{[keys %image_coords]});

    Math::PlanePath::PixelRings::_cumul_extend($path);
    my $got = $path->{'cumul'}->[$r+1];
    my $want = $path->{'cumul'}->[$r] + $image_count;
    if ($got != $want) {
      $good = 0;
      MyTestHelpers::diag ("_cumul_extend() r=$r wrong: want=$want got=$got");
    }
  }
  ok ($good, 1, "_cumul_extend() to $limit");
}

#------------------------------------------------------------------------------
# coords

{
  my $path = Math::PlanePath::PixelRings->new;
  my $image = MyImage->new;

  my $n = 1;
  my $good = 1;
  my $limit = 100;
  foreach my $r (0 .. $limit) {
    %image_coords = ();
    $image->ellipse (-$r+$offset,-$r+$offset, $r+$offset,$r+$offset, 'white');
    my $image_count = scalar(@{[keys %image_coords]});

    ### $image_count
    ### from n: $n
    my %path_coords;
    while ($image_count--) {
      my ($x,$y) = $path->n_to_xy($n++);

      # perl 5.6.0 through 5.6.2 ends up giving "-0" when stringizing (as of
      # the code in PixelRings version 19), avoid that so the hash keys
      # compare with "eq" successfully
      $x = "$x";
      $y = "$y";
      if ($x eq '-0') { $x = '0'; }
      if ($y eq '-0') { $y = '0'; }

      ### path_coords: "$x,$y"
      $path_coords{"$x,$y"} = 1;
    }

    ### %image_coords
    ### %path_coords
    if (! eq_hash (\%path_coords, \%image_coords)) {
      MyTestHelpers::diag ("Wrong coords at r=$r");
      MyTestHelpers::diag ("image: ", join(',', sort keys %image_coords));
      MyTestHelpers::diag ("path:  ", join(',', sort keys %path_coords));
      dump_coords (\%image_coords);
      dump_coords (\%path_coords);
      $good = 0;
    }
  }
  ok ($good, 1, 'n_to_xy() compared to image->ellipse()');
}


sub eq_hash {
  my ($x, $y) = @_;
  foreach my $key (keys %$x) {
    if (! exists $y->{$key}) {
      return 0;
    }
  }
  foreach my $key (keys %$y) {
    if (! exists $x->{$key}) {
      return 0;
    }
  }
  return 1;
}

exit 0;