7
\$\begingroup\$

I wrote a Perl script that implements the algorithm described in this article to generate terrain height maps. The idea is to raise a random hill \$i\$ of size \$r_i\$ centered at point \$(x_i, y_i)\$, such that the height at point \$(x, y)\$ is

$$ z = r_i^2 - ((x - x_1)^2 + (y - y_1)^2) $$

The resulting terrain is the sum of many such hills, with some normalization and flattening.

The output of this program is a bunch of inserts into the database and a png. The only problem with it is that it has really bad performance.

#!/usr/bin/perl
# mapgen.pl
# Henry J Schmale
# August 16, 2015
# Generates a height map

use strict;
use warnings;
use DBI;
use Image::Magick;
use constant {
    MAX_X   =>  2000,
    MAX_Y   =>  2000,
    MAX_R   =>  1075,
    MIN_R   =>  100,
    NUM_HILLS => 250
};

my @heightmap;

makemap();

sub makemap {
    #init heightmap to 0
    for(my $i = 0 ; $i < MAX_Y; $i++){
        my @arr;
        for(my $j = 0; $j < MAX_X; $j++){
            $arr[$j] = 0;
        }
        $heightmap[$i] = \@arr;
    }

    # Start adding hills
    for(my $i = 0; $i < NUM_HILLS; $i++){
        makehill(int(rand(MAX_X)), int(rand(MAX_Y)), int(rand(MAX_R) + MIN_R));
    }
    # normallize
    my $maxvalue = 0;
    for(my $x = 0; $x < MAX_X; $x++){
        for(my $y = 0; $y < MAX_Y; $y++){
            if($heightmap[$x][$y] > $maxvalue){
                $maxvalue = $heightmap[$x][$y];
            }
        }
    }
    for(my $x = 0; $x < MAX_X; $x++){
        for(my $y = 0; $y < MAX_Y; $y++){
            $heightmap[$x][$y] /= $maxvalue;
        }
    }
    # Flatten
    for(my $x = 0; $x < MAX_X; $x++){
        for(my $y = 0; $y < MAX_Y; $y++){
            $heightmap[$x][$y] *= $heightmap[$x][$y];
            $heightmap[$x][$y] *= $heightmap[$x][$y];
            $heightmap[$x][$y] *= $heightmap[$x][$y];
        }
    }
    # Dump to file
    dumpToImg();
    dumpToDb();
}

sub makehill {
    my ($x1, $y1, $r) = @_;
    my $z;
    for(my $x = $x1 - $r; $x < ($x1 + $r); $x++){
        for(my $y = $y1 - $r; $y < ($y1 + $r); $y++){
            my $dx = $x - $x1;
            my $dy = $y - $y1;
            $z = ($r * $r) - (($dx * $dx) + ($dy * $dy));
            if($z > 0 and $x > 0 and $y > 0){
                $heightmap[$x][$y] += $z;
            }
        }
    }
}

sub dumpToDb {
    my $dbh = DBI->connect("dbi:SQLite:dbname=server.sqlite",'','')
            or die DBI::errstr;
    my $sth = $dbh->prepare("INSERT INTO map_heights(lat_pt, long_pt, z_pt)".
                            "VALUES(?, ?, ?)");
    for(my $x = 0; $x < MAX_X; $x++){
        for(my $y = 0; $y < MAX_Y; $y++){
            $sth->execute($x, $y, $heightmap[$x][$y]);
        }
    }
    $dbh->disconnect();
}

sub dumpToImg {
    my $im = Image::Magick->new;
    my $junk = MAX_X.'x'.MAX_Y;
    print $junk."\n";
    $im->Set(size => $junk);
    $im->ReadImage('canvas:white');
    warn "$im" if "$im";
    for(my $x = 0; $x < MAX_X; $x++){
        for(my $y = 0; $y < MAX_Y; $y++){
            my $z = $heightmap[$x][$y];
            my @pixel = ($z, $z, $z);
            $im->SetPixel(x=>$x, y=>$y, color=>\@pixel);
        }
    }
    my $x = $im->Write('heightmap.png');
    warn "$x" if "$x";
}
\$\endgroup\$
  • \$\begingroup\$ What is your goal for putting the map into a database? Merely to retrieve it again? Or do you plan to run SQL queries to analyze the topology? \$\endgroup\$ – 200_success Aug 17 '15 at 4:34
  • \$\begingroup\$ @200_success Retrieval, and analyzing the topology. \$\endgroup\$ – HSchmale Aug 17 '15 at 4:39
2
\$\begingroup\$

Reducing number of nested loops and using native perl foreach loop which generally perform better would be a good start in optimization,

# ... 
my @heightmap;
my $maxvalue = 0;

# init image
my $im = Image::Magick->new;
my $junk = MAX_X .'x'. MAX_Y;
print $junk, "\n";
$im->Set(size => $junk);
$im->ReadImage('canvas:white');
warn $im if $im;

# init prepared sql insert
my $dbh = DBI->connect("dbi:SQLite:dbname=server.sqlite",'','')
    or die DBI::errstr;
my $sth = $dbh->prepare("INSERT INTO map_heights(lat_pt, long_pt, z_pt) VALUES(?, ?, ?)")
    or die $dbh->errstr;

makemap();

sub makemap {

    # Start adding hills
    for my $i (0 .. NUM_HILLS-1) {
        makehill(int(rand(MAX_X)), int(rand(MAX_Y)), int(rand(MAX_R) + MIN_R));
    }

    for my $x (0 .. MAX_X-1) {
        for my $y (0 .. MAX_Y-1) {
            # init to 0
            $heightmap[$x][$y] //= 0;

            $heightmap[$x][$y] /= $maxvalue;
            $heightmap[$x][$y] **= 8;
            # $heightmap[$x][$y] *= $heightmap[$x][$y];
            # $heightmap[$x][$y] *= $heightmap[$x][$y];
            # $heightmap[$x][$y] *= $heightmap[$x][$y];

            my $z = $heightmap[$x][$y];
            $im->SetPixel(
              x => $x,
              y => $y,
              color => [ ($z) x 3 ],
            );
            $sth->execute($x, $y, $z);
        }
    }
    # Dump to file

    # dumpToImg();
    my $x = $im->Write('heightmap.png');
    warn $x if $x;

    # dumpToDb();
    $dbh->disconnect();
}

sub makehill {
    my ($x1, $y1, $r) = @_;

    for my $x ($x1 - $r .. ($x1 + $r)-1) {
        ($x > 0) or next;

        for my $y ($y1 - $r .. ($y1 + $r)-1) {
            ($y > 0) or next;

            my $dx = $x - $x1;
            my $dy = $y - $y1;
            my $z = ($r * $r) - (($dx * $dx) + ($dy * $dy));
            if ($z > 0) {
                $heightmap[$x][$y] += $z;
                if ($heightmap[$x][$y] > $maxvalue) {
                    $maxvalue = $heightmap[$x][$y];
                }
            }
        }
    }
}
\$\endgroup\$
2
\$\begingroup\$

I see two things right off the bat that may help:

  1. Calculate $maxvalue inside makehill() so you don't have to calculate it after
  2. Do the normalization and flattening in 1 pass. Also, you can do the flattening in a single function call. You're basically raising each value to the 8th power, so use the power function. I don't know perl real well, but it's usually called pow() and takes a value and an exponent.

The other thing that looks problematic is setting each individual pixel through a function call. Is there any way to pass a buffer of memory to ImageMagick? If so, it would probably faster to do that.

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.