File Coverage

blib/lib/Games/RolePlay/MapGen/Generator/SparseAndLoops.pm

Criterion	Covered	Total	%
statement	64	64	100.0
branch	21	24	87.5
condition	5	6	83.3
subroutine	9	9	100.0
pod	0	3	0.0
total	99	106	93.4

# vi:tw=0 syntax=perl:

package Games::RolePlay::MapGen::Generator::SparseAndLoops;

use common::sense;
use Carp;
use parent 'Games::RolePlay::MapGen::Generator::Perfect';
use Games::RolePlay::MapGen::Tools qw( choice roll );

1;

sub _dirsum       { my $c = 0; for (qw(n s e w)) { $c ++ if $_[0]->{od}{$_} } $c };
sub _endian_tiles { return grep { &_dirsum($_) == 1 } map(@$_, @{ $_[0] }) }

# remove_deadends {{{
sub remove_deadends {
    my $this = shift;
    my $opts = shift;
    my $map  = shift;

    my @dirs = (qw(n s e w));

    for my $tile ( &_endian_tiles( $map ) ) {
        if( &roll(1, 100) <= $opts->{remove_deadend_percent} ) {

            DO_THIS_TILE_ALSO:
            my @togo = grep { !$tile->{od}{$_} } @dirs;
            my $dir  = &choice(@togo);

            TRY_THIS_DIR_INSTEAD:
            if( my $nex = $tile->{nb}{$dir} ) {

                $tile->{od}{$dir} = $nex->{od}{$Games::RolePlay::MapGen::opp{$dir}} = 1;

                if( $nex->{type} ) {
                    # Excellent, we're done with this tile.

                } else {
                    # Alrightsir, mark nex as a corridor and we'll have to keep going.

                    $tile = $nex;
                    $tile->{type} = 'corridor';

                    if( &roll(1, 100) > $opts->{same_way_percent} ) {
                        @togo = grep { !$tile->{od}{$_} and !$tile->{_bud}{$dir} } @dirs;
                        $dir  = &choice(@togo);
                    }

                    goto DO_THIS_TILE_ALSO;
                }

            } else {
                $tile->{_bud}{$dir} = 1;
                @togo = grep { !$tile->{od}{$_} and !$tile->{_bud}{$_} } @dirs;
                $dir  = &choice(@togo);

                die "FATAL: couldn't figure out how to un-dead this end..." unless $dir;

                goto TRY_THIS_DIR_INSTEAD;
            }
        }
    }
}
# }}}
# sparsify {{{
sub sparsify {
    my $this = shift;
    my $opts = shift;
    my $map  = shift;

    my $sparseness = $opts->{sparseness};

    SPARSIFY:
    for my $tile ( &_endian_tiles( $map ) ) {
        my($dir)= grep { $tile->{od}{$_} } (qw(n s e w)); # grep returns the resulting list size unless you evaluate in list context
        my $nex = ($tile->{od}{n} ? $map->[$tile->{y}-1][$tile->{x}] :
                   $tile->{od}{s} ? $map->[$tile->{y}+1][$tile->{x}] :
                   $tile->{od}{e} ? $map->[$tile->{y}][$tile->{x}+1] :
                                    $map->[$tile->{y}][$tile->{x}-1] );

        $opts->{t_cb}->() if exists $opts->{t_cb};

        $tile->{od} = {n=>0, s=>0, e=>0, w=>0};
        delete $tile->{type};

        die "incomplete open direction found during sparseness calculation" unless defined $nex;

        $nex->{od}{$Games::RolePlay::MapGen::opp{$dir}} = 0;
    }

    goto SPARSIFY if --$sparseness > 0;
}
# }}}
# genmap {{{
sub genmap {
    my $this = shift;
    my $opts = $this->gen_opts;
    my ($map, $groups) = $this->SUPER::genmap(@_);

    $this->sparsify( $opts, $map );
    $this->remove_deadends( $opts, $map );

    return ($map, $groups);
}
# }}}

__END__