view release on metacpan or  search on metacpan

lib/Games/Roguelike/Caves.pm  view on Meta::CPAN

package Games::Roguelike::Caves;

#use 5.008000;
use strict;
use warnings;

#require Exporter;

use base 'Exporter';

our @EXPORT = qw(
	generate_cave
	outline_walls
);

our $VERSION = '0.01';

#use cellular automata to carve out a decent cave
#initially contain 45% walls at random
#a tile becomes or remains a wall if the 3x3 region centered on it contains at least 5 walls.
#use 1 to represent wall, 0 is space
sub generate_cave{
    my ($w, $h, $iterations, $percentWalls, $wall, $floor) = @_;
    die 'dimensions?' unless ($w and $h);
    $iterations ||= 12;
    $percentWalls ||= .45;
    $percentWalls /= 100 if $percentWalls>1; # in case it's .45 or something
    $wall = ' ' unless defined $wall;
    $floor = '.' unless defined $floor;
    
    my @terrain = ();
    my @nextStep = ();
    for my $x (0..$w-1){
        for my $y (0..$h-1){
            $terrain[$y][$x] = rand()<$percentWalls ? 1 : 0;
        }
    }
    for (1..$iterations){
        for my $x (0..$w-1){
            for my $y (0..$h-1){
                if ( !$x or !$y or $x==$w-1 or $y==$h-1){
                    #we're at edge: be wall.
                    $nextStep[$y][$x] = 1;
                    next;
                }
                my $c=0;
                #count walls in 3x3 square
                $c += $terrain[$y-1][$x-1];
                $c += $terrain[$y-1][$x];
                $c += $terrain[$y-1][$x+1];
                $c += $terrain[$y]  [$x-1];
                $c += $terrain[$y]  [$x];
                $c += $terrain[$y]  [$x+1];
                $c += $terrain[$y+1][$x-1];
                $c += $terrain[$y+1][$x];
                $c += $terrain[$y+1][$x+1];
                $nextStep[$y][$x] = $c>4 ? 1 : 0;
            }
        }
        #swap arrays using typeglobs
        #(*terrain,*nextStep) = (*nextStep,*terrain)
       my @tmp = @terrain;
       @terrain = @nextStep;
       @nextStep = @tmp;
    }
    #translate to cave wall or floor
    for my $x (0..$w-1){
        for my $y (0..$h-1){
            $terrain[$y][$x] = $terrain[$y][$x] ? $wall : $floor;
            #print STDOUT $terrain[$y][$x];
        }
        #print STDOUT "\n";
    }
    return \@terrain;
}

sub outline_walls{
    my ($terrain, $wall, $floor) = @_;
    my $h = $#$terrain + 1;
    die 'empty map' unless $h;
    my $w = $#{$terrain->[0]} + 1;
    die 'empty row' unless $w;
    $floor = '.' unless defined $floor;
    $wall = ' ' unless defined $wall;
    
    no warnings; #yeah. sometimes this checks tiles outide of $terrain.
    for my $x (0..$w-1){
        for my $y (0..$h-1){
            next if $terrain->[$y][$x] eq $floor; #is floor
            my ($v,$h)=(0,0); #vert/horiz weighting
            $v++ if $terrain->[$y][$x-1] eq $floor;
            $v++ if $terrain->[$y][$x+1] eq $floor;
            $h++ if $terrain->[$y-1][$x] eq $floor;
            $h++ if $terrain->[$y+1][$x] eq $floor;
            if ($h>$v){
                $terrain->[$y][$x] = '-';
            }
            elsif ($v>$h){