# Terrain height map generator

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;
}

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";
}

• 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? – 200_success Aug 17 '15 at 4:34
• @200_success Retrieval, and analyzing the topology. – HSchmale Aug 17 '15 at 4:39

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];
}
}
}
}
}


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.