File Coverage

blib/lib/Game/TextPatterns/Util.pm

Criterion	Covered	Total	%
statement	27	27	100.0
branch	24	24	100.0
condition	12	12	100.0
subroutine	5	5	100.0
pod	2	2	100.0
total	70	70	100.0

# -*- Perl -*-
#
# some utility subs for text patterns

package Game::TextPatterns::Util;
our $VERSION = '1.47';

use strict;
use warnings;
use constant { COL => 0, ROW => 1, };

require Exporter;
our @ISA       = qw(Exporter);
our @EXPORT_OK = qw(adj_4way adj_8way);

# NOTE the adj_* functions for speeds do not check if all points lie
# outside the given 0,0,mc,mr bounding box. this may change if this
# proves problematic in practice
sub adj_4way {
    my ($p, $max_col, $max_row) = @_;
    my @adj;
    push @adj, [ $p->[COL] - 1, $p->[ROW] ] unless $p->[COL] <= 0;
    push @adj, [ $p->[COL] + 1, $p->[ROW] ] unless $p->[COL] >= $max_col;
    push @adj, [ $p->[COL], $p->[ROW] - 1 ] unless $p->[ROW] <= 0;
    push @adj, [ $p->[COL], $p->[ROW] + 1 ] unless $p->[ROW] >= $max_row;
    return @adj;
}

sub adj_8way {
    my ($p, $max_col, $max_row) = @_;
    my @adj;
    push @adj, [ $p->[COL] - 1, $p->[ROW] ] unless $p->[COL] == 0;
    push @adj, [ $p->[COL] + 1, $p->[ROW] ] unless $p->[COL] == $max_col;
    push @adj, [ $p->[COL], $p->[ROW] - 1 ] unless $p->[ROW] == 0;
    push @adj, [ $p->[COL], $p->[ROW] + 1 ] unless $p->[ROW] == $max_row;
    push @adj, [ $p->[COL] - 1, $p->[ROW] - 1 ]
      unless $p->[COL] == 0
      or $p->[ROW] == 0;
    push @adj, [ $p->[COL] - 1, $p->[ROW] + 1 ]
      unless $p->[COL] == 0
      or $p->[ROW] == $max_row;
    push @adj, [ $p->[COL] + 1, $p->[ROW] - 1 ]
      unless $p->[COL] == $max_col
      or $p->[ROW] == 0;
    push @adj, [ $p->[COL] + 1, $p->[ROW] + 1 ]
      unless $p->[COL] == $max_col
      or $p->[ROW] == $max_row;
    return @adj;
}

1;
__END__