File Coverage

blib/lib/Games/Terrain/DiamondSquare.pm

Criterion	Covered	Total	%
statement	61	64	95.3
branch	7	12	58.3
condition	5	8	62.5
subroutine	13	13	100.0
pod	1	4	25.0
total	87	101	86.1

package Games::Terrain::DiamondSquare;
{
  $Games::Terrain::DiamondSquare::VERSION = '0.02';
}

## ABSTRACT: Random terrain generation via the Diamond Square algorithm

use strict;
use warnings;
use List::Util 'sum';
use POSIX 'floor';
use base 'Exporter';
our @EXPORT_OK = 'create_terrain';

my ( $FULL_SIZE, $ROUGHNESS );
use constant NW => 0;
use constant NE => 1;
use constant SW => 2;
use constant SE => 3;

sub create_terrain {
    my ( $height, $width, $roughness ) = @_;
    $roughness ||= .5;

    # seed the four corners of the grid with random color values
    my @corners = map {rand} 1 .. 4;

    $ROUGHNESS = $roughness;
    $FULL_SIZE = $height + $width;
    my @points;
    subdivide( \@points, 0, 0, $height, $width, \@corners );
    return \@points;
}

sub subdivide {
    my ( $points, $x, $y, $height, $width, $corners ) = @_;

    if ( $height > 1 || $width > 1 ) {
        my $new_height  = floor( $height / 2 );
        my $new_width = floor( $width / 2 );

        my $middle
          = sum(@$corners) / 4 + displace( $new_height + $new_width );
        my $edge_1 = ( $corners->[NW] + $corners->[NE] ) / 2;
        my $edge_2 = ( $corners->[NE] + $corners->[SW] ) / 2;
        my $edge_3 = ( $corners->[SW] + $corners->[SE] ) / 2;
        my $edge_4 = ( $corners->[SE] + $corners->[NW] ) / 2;

        $_ = constrain($_)
          foreach $middle, $edge_1, $edge_2, $edge_3, $edge_4;

        # do it again for each of the four new grids.
        subdivide(
            $points, $x, $y, $new_height, $new_width,
            [ $corners->[NW], $edge_1, $middle, $edge_4 ]
        );
        subdivide(
            $points, $x + $new_height, $y, $height - $new_height, $new_width,
            [ $edge_1, $corners->[NE], $edge_2, $middle ]
        );
        subdivide(
            $points, $x + $new_height, $y + $new_width, $height - $new_height,
            $width - $new_width,
            [ $middle, $edge_2, $corners->[SW], $edge_3 ]
        );
        subdivide(
            $points, $x, $y + $new_width, $new_height, $width - $new_width,
            [ $edge_4, $middle, $edge_3, $corners->[SE] ]
        );
    }
    else # this is the "base case," where each grid piece is less than the size of a pixel.
    {

 # the corners of the grid piece will be averaged and drawn as a single pixel.
        my $c = sum(@$corners) / 4;

        $points->[$x][$y] = $c;
        if ( $height == 2 ) {
            $points->[ $x + 1 ][$y] = $c;
        }
        if ( $width == 2 ) {
            $points->[$x][ $y + 1 ] = $c;
        }
        if ( $height == 2 and $width == 2 ) {
            $points->[ $x + 1 ][ $y + 1 ] = $c;
        }
    }
    return;
}

sub constrain {
    my $num = shift;
    return
        $num < 0 ? 0
      : $num > 1 ? 1
      :            $num;
}

sub displace {
    my $curr_size = shift;

    my $max = $curr_size / $FULL_SIZE * $ROUGHNESS;
    return ( rand() - 0.5 ) * $max;
}

1;

__END__