File Coverage

blib/lib/AI/Pathfinding/AStar/Rectangle.pm

Criterion	Covered	Total	%
statement	38	68	55.8
branch	0	10	0.0
condition			n/a
subroutine	7	13	53.8
pod	3	6	50.0
total	48	97	49.4

package AI::Pathfinding::AStar::Rectangle;
use strict;
use warnings;

require Exporter;

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use AI::Pathfinding::AStar::Rectangle ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(create_map

) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(
);

our $VERSION = '0.23';

require XSLoader;
XSLoader::load('AI::Pathfinding::AStar::Rectangle', $VERSION);

# Preloaded methods go here.

sub foreach_xy{
    my $self = shift;
    my $sub  = shift;
    no strict 'refs';
    local *a= *{ caller() . '::a' };
    local *b= *{ caller() . '::b' };
    local ($a, $b );
    local $_;
    for $a ( $self->start_x .. $self->last_x ){
	for $b ( $self->start_y .. $self->last_y ){
	    $_ = $self->get_passability( $a, $b );
	    &$sub();
	}
    };
}
sub foreach_xy_set{
    my $self = shift;
    my $sub  = shift;

    no strict 'refs';
    local *a= *{ caller() . '::a' };
    local *b= *{ caller() . '::b' };
    local ($a, $b );
    local $_;
    for $a ( $self->start_x .. $self->last_x ){
	for $b ( $self->start_y .. $self->last_y ){
	    $_ = $self->get_passability( $a, $b );
	    $self->set_passability( $a, $b, (scalar &$sub()) );
	};
    };

}
sub create_map($){
    unshift @_, __PACKAGE__;
    goto &new;
}

1 for ($a, $b); #suppress warnings

sub set_passability_string{
    my $self = shift;
    my $passability = shift;
    die "Bad passabilitity param for set_passability_string" unless $self->width * $self->height == length( $passability );
    $self->foreach_xy_set( sub { substr $passability, 0, 1, '' } );

}
sub get_passability_string{
    my $self = shift;
    my $buf = '';
    $self->foreach_xy( sub { $buf.= chr( $_)} );
    return $buf;
}


sub draw_path{
    my $map  = shift;
    my ($x, $y) = splice @_, 0, 2;
    my $path  = shift;

    my @map;
    $map->foreach_xy( sub {$map[$a][$b]= $_} );

# draw path
    my %vect = (
            #      x  y
            1 => [-1, 1, ],
            2 => [ 0, 1, '.|'],
            3 => [ 1, 1, '|\\'],
            4 => [-1, 0, '|<'],
            6 => [ 1, 0, '|>'],
            7 => [-1,-1, '|\\'],
            8 => [ 0,-1, '\'|'],
            9 => [ 1,-1, '|/']
    );

    my @path = split //, $path;
    print "Steps: ".scalar(@path)."\n";
    for ( @path )
    {
            $map[$x][$y] = '|o';
            $x += $vect{$_}->[0];
            $y -= $vect{$_}->[1];
            $map[$x][$y] = '|o';
    }

    printf "%02d", $_ for 0 .. $map->last_x;
    print "\n";
    for my $y ( 0 .. $map->last_y - 1 )
    {
            for my $x ( 0 .. $map->last_x - 1 )
            {
                    print $map[$x][$y] eq
                    '1' ? "|_" : (
                    $map[$x][$y] eq '0' ? "|#" : (
                    $map[$x][$y] eq '3' ? "|S" : (
                    $map[$x][$y] eq '4' ? "|E" : $map[$x][$y] ) ) );
            }
            print "$y\n";
    }
}

1;
__END__