Remember that game I have in the back-burner, the one I described as being a cross of ‘X-Com’ meets ‘Dwarf Fortress’?
No? Well, no big surprise. After all, is it way at the back of the back-burner stack. Anyway, as a quick recap: it’s a game about colonial marines blasting aliens in sinister caves to harvest their precious bodily fluids. Or something like that. Important part is: I had some tuits lately, and so I worked a little bit on one of the basics of that game.
Specifically, I checked out how I could dig myself some caves.
I first thought I’d find some dungeon building modules already out there to do the deed, but they are more rare than I expected. And the ones that do exist insist on building rectangular rooms and straight corridors, which is nice if you want the basement of a wizard’s crib, but not so much if you want to recreate the hive of those Starship Troopers’ lovelies.
Without readily available software to do my excavations, I decided to give it a shot myself. To come up with an algorithm to create a decent dungeon or cave system was the hard part. At the end, I went with a very simple recipe that seems to gives fair results:
- Begin with a blank grid.
- Pick a random point on the grid that hasn’t been excavated.
- Excavate a room around that point.
- If the room is not connected with the rest of the system, pick a random point A in that room, and a random point B in the rest of the system, and dig from A toward B until they connect.
- Repeat 2 through 4 until there is enough rooms and tunnels to make you happy.
Nice thing about this method, is that there are no specifics about how to excavate the rooms or dig the tunnels. If you want a classic dungeons, you can go all right angles on both, but if you desire something more organic, you could set them to be a little more erratic.
Having figured out my intended approach, I first implement a generic digging role that takes care of the main building logistic:
package Games::DungeonBuilder::Digger;
use strict;
use Moose::Role;
use Method::Signatures;
use Games::DungeonBuilder::Grid;
no warnings qw/ uninitialized /;
requires 'create_room', 'tunnel';
has grid => (
is => 'ro',
default => sub { Games::DungeonBuilder::Grid->new },
);
has target_density => (
is => 'rw',
default => 0.4,
);
has region => (
is => 'rw',
default => sub {
[ [ 0, 40 ], [ 0, 40 ] ],
},
);
method escavate {
$self->create_room while $self->density < $self->target_density;
}
method density {
my $d = $self->region;
my $density;
for my $x ( $d->[0][0] .. $d->[0][1] ) {
for my $y ( $d->[1][0]..$d->[1][1] ) {
$density++ if $self->grid->{$x}{$y};
}
}
return $density / ($d->[0][1] -$d->[0][0] ) / ($d->[1][1] -$d->[1][0] );
}
method surrounding ( $x, $y ) {
return [$x-1,$y], [$x+1,$y], [$x,$y+1], [$x,$y-1];
}
1;
With all the general excavation process encapsulated in that role, creating the dungeon and cave builders is only a question of implementing different flavors of create_room and tunnel.
package Games::DungeonBuilder::Dungeon;
use strict;
use Moose;
use Method::Signatures;
no warnings;
with 'Games::DungeonBuilder::Digger';
has room_factor => (
is => 'rw',
default => 0.4,
);
method create_room ( $location = undef ) {
unless ( $location ) {
my $d = $self->region;
$location->[0] = $d->[0][0] + int rand( $d->[0][1] - $d->[0][0] );
$location->[1] = $d->[1][0] + int rand( $d->[1][1] - $d->[1][0] );
}
my $width = 1;
$width++ while rand() < $self->room_factor;
my $height = 1;
$height++ while rand() < $self->room_factor;
my @dig;
for my $x ( $location->[0]..$location->[0] + $width ) {
for my $y ( $location->[1]..$location->[1] + $height ) {
push @dig, [ $x, $y ];
}
}
my @system;
for my $x ( keys %{ $self->grid } ) {
for my $y ( keys %{ $self->grid->{$x} } ) {
push @system, [$x,$y];
}
}
my @cave;
my $connected;
while ( my $p = shift @dig ) {
my ( $x, $y ) = @$p;
next if $self->grid->{$x}{$y};
$self->grid->{$x}{$y} = 2;
push @cave, [$x,$y];
$connected ||= grep { $self->grid->{$_->[0]}{$_->[1]} == 1 } $self->surrounding($x,$y);
}
# do they need to be connected?
if ( @system and not $connected ) {
$self->tunnel( $cave[ rand @cave ], $system[ rand @system ] );
}
for my $x ( keys %{ $self->grid } ) {
for my $y ( keys %{ $self->grid->{$x} } ) {
$self->grid->{$x}{$y} = 1 if $self->grid->{$x}{$y} == 2;
}
}
}
method tunnel ( $src, $dst ) {
my $index = rand() < 0.5 ? 0 : 1;
until( $self->grid->{ $src->[0] }{ $src->[1] } == 1 ) {
$index = !$index if $src->[$index] == $dst->[$index];
$src->[$index] += $src->[$index] > $dst->[$index] ? -1 : 1;
$self->grid->{$src->[0]}{$src->[1]} ||= 2;
}
}
__PACKAGE__->meta->make_immutable;
1;
package Games::DungeonBuilder::Cave;
use strict;
use Moose;
use Method::Signatures;
no warnings;
with 'Games::DungeonBuilder::Digger';
has room_factor => (
is => 'rw',
default => 0.4,
);
method create_room ( $location = undef ) {
unless ( $location ) {
my $d = $self->region;
$location->[0] = $d->[0][0] + int rand( $d->[0][1] - $d->[0][0] );
$location->[1] = $d->[1][0] + int rand( $d->[1][1] - $d->[1][0] );
}
my @dig = ( $location );
my @system;
for my $x ( keys %{ $self->grid } ) {
for my $y ( keys %{ $self->grid->{$x} } ) {
push @system, [$x,$y];
}
}
my @cave;
my $connected;
while ( my $p = shift @dig ) {
my ( $x, $y ) = @$p;
next if $self->grid->{$x}{$y};
$self->grid->{$x}{$y} = 2;
push @cave, [$x,$y];
$connected ||= grep { $self->grid->{$_->[0]}{$_->[1]} == 1 } $self->surrounding($x,$y);
push @dig, grep { rand() < $self->room_factor } $self->surrounding( $x, $y );
}
# do they need to be connected?
if ( @system and not $connected ) {
$self->tunnel( $cave[ rand @cave ], $system[ rand @system ] );
}
for my $x ( keys %{ $self->grid } ) {
for my $y ( keys %{ $self->grid->{$x} } ) {
$self->grid->{$x}{$y} = 1 if $self->grid->{$x}{$y} == 2;
}
}
}
method tunnel( $src, $dst ) {
until( $self->grid->{ $src->[0] }{ $src->[1] } == 1 ) {
my $index = rand() < 0.5;
$src->[$index] += $src->[$index] > $dst->[$index] ? -1 : 1;
$self->grid->{$src->[0]}{$src->[1]} ||= 2;
}
}
__PACKAGE__->meta->make_immutable;
1;
Oh yes, and there is the map itself, which class is for the time being… rather simple:
package Games::DungeonBuilder::Grid;
use strict;
no warnings;
use List::MoreUtils qw/ minmax /;
use Moose;
use Method::Signatures;
no warnings;
method to_string {
my $output;
my ( $minx, $maxx ) = minmax keys %$self;
my ( $miny, $maxy ) = minmax map { keys %$_ } values %$self;
for my $y ( $miny-1..$maxy+1 ) {
for my $x ( $minx-1..$maxx+1 ) {
$output .= $self->{$x}{$y} ? ' ' : '#';
}
$output .= "\n";
}
return $output;
}
__PACKAGE__->meta->make_immutable;
1;
It’s not very nice to just use the underlying hash of the Moose class like that, granted. But for the moment, it’s good enough.
And that’s all I need. Using that code, I can create different flavors of maps. Or even better, use different diggers and assign them them different parts of a single map. For example, want a classic dungeon to open to darker caves? No problem, the script
#!/usr/bin/perl
use strict;
use Games::DungeonBuilder::Cave;
use Games::DungeonBuilder::Dungeon;
my $grid = Games::DungeonBuilder::Grid->new;
Games::DungeonBuilder::Dungeon->new(
target_density => 0.3,
room_factor => 8/10,
region => [ [ 0, 50],[0, 50] ],
grid => $grid,
)->escavate;
Games::DungeonBuilder::Cave->new(
target_density => 0.3,
region => [ [ 0, 50],[51, 100] ],
grid => $grid,
)->escavate;
print $grid->to_string;
will generate an output looking like this
############################################################ ############################################################ #### ############## ##################################### ####### ############## ##################################### ####### ############## ##################################### ####### ############## ##################################### ####### ############# ##################################### ######## ############# ##################################### ######## #################################### ######## ######## ######## # ######## ############### ######## ######## # ######## ############### ######## ######## # ######## ############# ############ ######## # ######## ############# ############ ######## # ###### ######## ## #### ######################## ##### ###### ######## ## #### ############################### ###### ######## ## #### ############################### ###### ######## ## #### ############################### ###### ######## ## #### ################# ############ ###### ######## ## ####################### ############ ###### ######## ## ####################### ########## # ######## ## ####################### ########## # ######## #### ######################### ########## # ######## #### ######################### ########## # ######## #### ######################### ########### # ######## #### ######################### ########### # ######## #### ######### ###### ########### # ####### ### ######### ###### ########### # ####### ### ######### ###### ############# ###### ####### ### ########## ###### ####### ############# ######### ###### ####### ################### ######### ###### ####### ################### ######### ###### ####### ################### ######### ###### ####### ##################### ######### ###### ####### ##################### ######### ###### ############################### ######### ###### ############################### ######### ###### ############################### ############## ######### ############## ######### #################### ############## ######### #################### ############## ######### ####### ###### ############## ################## ################# ################## ###### ################# ############ #### ###### ################# ############ #### ########## ##################### ############ #### ####### ##################### ############ #### ##### ## ##################### ############ #### # # ##################### ############ ## ## ########################## ############ ###### #### ########################## ############ ###### #### ########################## ######################### #### # ###################### ######################### ### ##### #################### ############ ########## ### ######### ################### ############ ### #### #### ########## ################### ############ # #### ########## ################### ########## # ######## ########## ############### ############### ### ############## ############### ############## #### ################### ############### ############## ## ################### ############# ############### ### # ########### ####### ########### ############ ### ## ######### ######### ########## ############ ## #### ########### # ################ ############### ##### ############ ################ ############# ######## ######## ### ################# ########## ########## ####### # ################# ########## # ########## ######### ## # ################## ########## # ########### ########## # #################### ####### ########### ########## ################## ###### # ############ ########## # ################## ##### ## ############ ##### ################## ###### # ################# ## ################## ###### # # ############ ###### # ################ ######### # ## ####### ######## # # ################# ######## ####### ######## # ################# ######## ### #### ######## #### ############### ######### ######## # ######## # # ############### ## ## ######## ########## # ############### ## ## ####### ############ ############### ### # ###### ############# # ############ ##### ###### ## # ################ ############ #### ## ######### ############### ################ ### ## ######## # ################################ ## ## ##### # ################################ ### ########### ### # # ################################ ############## # ### # ############################### ############## ## ### ############################## ########### ## #### ############### ############ ########### # # ################### ######### ########### # ###### ######### ######## ########### # ##### # ####### ### ######## ########### ## # #### ########### ######### ################# # #### ######### ################## # # # ## # ### # ########### ################# # # # ####### ############ ################## ## ####### ############### ################# ######################## ############### ## ######################## ############### # # ### ######################### ############### ## ## ######################### ################### ## ##### ######################### ###################### #################################### ############################################################
The code, as usual, is available on GitHub (and should eventually make it to CPAN, once some documentation is injected into the mix).
4 Comments. Leave new
You wouldn’t have a C# version by any chance..?
I’m afraid not. But the underlying code is nothing too daunting, it should be relatively easy for you to port it into C# (or any other language).
Then I’ll begin learning Perl right away. Thanks anyway!
This had to be the most devious way to get someone to learn Perl ever. But hey, if it works… ;-)
Seriously, though, enjoy the ride! And if you need help, see if there is a Perl Monger group in your city — we’re usually a helpful bunch.