view release on metacpan or  search on metacpan

t/92_paths.t  view on Meta::CPAN

                if( $o = $p1_tile->{nb}{$d[1]}{od}{$d[0]} ) {
                    $o = $o->{'open'} if ref $o;
                    return 1 if $o;
                }
            }
        }
    }

    return 0; # FAIL!
}
# }}}

warn "\n";
PAIR: for my $pair (sort { (rand)<=>(rand) } @pairs) {
    my @path = $queue->_locations_in_path(@$pair);

    my $ok = 1;
    PATH: for my $i (0 .. $#path-1) {
        my ($p1, $p2) = @path[$i, $i+1];

        if( &distance($p1, $p2) > 1.4142135623731 ) {
            warn " while plotting (@{$pair->[0]})->(@{$pair->[1]}), |(@$p1)->(@$p2)| is too long\n";
            ok( 0 );
            $ok = 0;

            our $fail ++;
            die "that's too many failures to bother continuing" if $fail > 15;
            last PATH;
        }
    }

    ok( $ok );

    $ok = 1;
    OPEN_DIRECTION: for my $i (0 .. $#path-1) {
        my ($p1, $p2) = @path[$i, $i+1];

        if( "@$p1" =~ m/\./ or "@$p2" =~ m/\./ ) {
            die "\n path has floating point tile numbers \n" . Dumper(\@path) . "\n\n";
        }

        unless( &is_actually_open($p1, $p2) ) {
            warn " while plotting (@{$pair->[0]})->(@{$pair->[1]}), (@$p1)->(@$p2) seems to go through a wall\n";
            ok( 0 );
            $ok = 0;

            our $fail ++;
            die "that's too many failures to bother continuing" if $fail > 15;
            last OPEN_DIRECTION;
        }
    }

    ok( $ok );

    my @lhs1 = @{$pair->[0]};
    my @rhs1 = @{$pair->[1]};
    my @lhs2 = @{$path[0]};
    my @rhs2 = @{$path[$#path]};

    ENDPOINTS: if( "@lhs1" ne "@lhs2" or "@rhs1" ne "@rhs2" ) {
        warn " pair (@lhs1)->(@rhs1) != path endpoints (@lhs2)->(@rhs2)\n";
        ok( 0 );

        our $fail ++;
        die "that's too many failures to bother continuing" if $fail > 15;

    } else {
        ok(1)
    }
}