danwizard208
/
wiki-map
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

.

Browse Source
main
Daniel Asher Resnick 5 months ago
parent 5c2c1c5afc
commit 147c2cb6cb
1 changed files with 97 additions and 15 deletions
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Show Stats Download Patch File Download Diff File
  1. 112
      coord_tripler.pl

112
coord_tripler.pl
Unescape View File

@ -9,8 +9,15 @@ no warnings "experimental::signatures";
my $coords_regex = qr/^\s*(-?\d+)\s*,\s*(-?\d+)\s*$/; my $coords_regex = qr/^\s*(-?\d+)\s*,\s*(-?\d+)\s*$/;
my %regions_to_tiles; my %regions;
my %tiles_to_regions; my %tile_to_regions;
my %bounds =
(
nw_min => "Inf",
nw_max => "-Inf",
sw_min => "Inf",
sw_max => "-Inf"
);
my $input_file = shift; my $input_file = shift;
open (my $input_fh, $input_file); open (my $input_fh, $input_file);
@ -18,29 +25,104 @@ open (my $input_fh, $input_file);
my $output_file = shift // "$input_file.out"; my $output_file = shift // "$input_file.out";
open (my $output_fh, ">$output_file"); open (my $output_fh, ">$output_file");
$regions{holes}{bg} = '#000000';
while (my $line = <$input_fh>) while (my $line = <$input_fh>)
{ {
my @fields = split '; ', $line; my @fields = split '; ', $line;
print $output_fh (shift @fields) . "; "; #region name my $region = (shift @fields); #region name
print $output_fh (shift @fields) . "; "; #background colour $regions{$region}{bg} = (shift @fields); #background colour
my @expanded_tile_specs = (); expand_coords(\%regions, \%tile_to_regions, $region, \%bounds, @fields);
foreach my $coords (@fields) }
fill_holes(\%regions, \%tile_to_regions, \%bounds);
foreach my $region (keys %regions)
{
say $output_fh ("$region; $regions{$region}{bg}; " . make_output_region_line(\%regions, $region));
}
sub expand_coords($regions_hashref, $tile_to_region_hashref, $region, $bounds, @coord_list)
{
foreach my $coords (@coord_list)
{ {
do { carp "Skipping bad spec: $coords"; next; } unless $coords =~ $coords_regex; do { carp "Skipping bad spec: $coords"; next; } unless $coords =~ $coords_regex;
my $nw_base = $1 * 3; my $nw_base = $1 * 3;
my $sw_base = $2 * 3; my $sw_base = $2 * 3;
my @new = ("$nw_base,$sw_base"); push @{$regions_hashref->{$region}{tiles}{$nw_base}}, $sw_base;
push @new, ($nw_base+1) . "," . ($sw_base); push @{$regions_hashref->{$region}{tiles}{$nw_base+1}}, $sw_base;
push @new, ($nw_base-1) . "," . ($sw_base); push @{$regions_hashref->{$region}{tiles}{$nw_base-1}}, $sw_base;
push @new, ($nw_base) . "," . ($sw_base+1); push @{$regions_hashref->{$region}{tiles}{$nw_base}}, $sw_base+1;
push @new, ($nw_base) . "," . ($sw_base-1); push @{$regions_hashref->{$region}{tiles}{$nw_base}}, $sw_base-1;
push @new, ($nw_base+1) . "," . ($sw_base-1); push @{$regions_hashref->{$region}{tiles}{$nw_base+1}}, $sw_base-1;
push @new, ($nw_base-1) . "," . ($sw_base+1); push @{$regions_hashref->{$region}{tiles}{$nw_base-1}}, $sw_base+1;
$tile_to_region_hashref->{$nw_base}{$sw_base} = $region;
$tile_to_region_hashref->{$nw_base+1}{$sw_base} = $region;
$tile_to_region_hashref->{$nw_base-1}{$sw_base} = $region;
$tile_to_region_hashref->{$nw_base}{$sw_base+1} = $region;
$tile_to_region_hashref->{$nw_base}{$sw_base-1} = $region;
$tile_to_region_hashref->{$nw_base+1}{$sw_base-1} = $region;
$tile_to_region_hashref->{$nw_base-1}{$sw_base+1} = $region;
$bounds{nw_min} = $nw_base - 1 if $bounds{nw_min} > $nw_base - 1;
$bounds{nw_max} = $nw_base + 1 if $bounds{nw_max} < $nw_base + 1;
$bounds{sw_min} = $sw_base - 1 if $bounds{sw_min} > $sw_base - 1;
$bounds{sw_max} = $sw_base + 1 if $bounds{sw_max} < $sw_base + 1;
}
}
sub fill_holes($regions_hashref, $tile_to_region_hashref, $bounds)
{
for(my $nw = $bounds->{nw_min}; $nw <= $bounds->{nw_max}; $nw++)
{
for(my $sw = $bounds->{sw_min}; $sw <= $bounds->{sw_max}; $sw++)
{
if($nw % 3 != 0 && $nw % 3 == $sw % 3)
{
my %neighbouring_regions;
$neighbouring_regions{$tile_to_region_hashref->{$nw+1}{$sw}}++ if exists $tile_to_region_hashref->{$nw+1}{$sw};
$neighbouring_regions{$tile_to_region_hashref->{$nw-1}{$sw}}++ if exists $tile_to_region_hashref->{$nw-1}{$sw};
$neighbouring_regions{$tile_to_region_hashref->{$nw}{$sw+1}}++ if exists $tile_to_region_hashref->{$nw}{$sw+1};
$neighbouring_regions{$tile_to_region_hashref->{$nw}{$sw-1}}++ if exists $tile_to_region_hashref->{$nw}{$sw-1};
$neighbouring_regions{$tile_to_region_hashref->{$nw+1}{$sw-1}}++ if exists $tile_to_region_hashref->{$nw+1}{$sw-1};
$neighbouring_regions{$tile_to_region_hashref->{$nw-1}{$sw+1}}++ if exists $tile_to_region_hashref->{$nw-1}{$sw+1};
my $total_neighbours = 0;
map {$total_neighbours += $_} (values %neighbouring_regions);
next if $total_neighbours < 6; # Must be surrounded to be filled
# Each neighbouring region will always provide 2,4 or 6 neighbouring tiles
my $found_region;
foreach my $region (keys %neighbouring_regions)
{
if($neighbouring_regions{$region} > 3) # == 4 or 6
{
$found_region = $region;
}
}
if(!$found_region) # Neighboured by 3 regions each providing 2 tiles
{
$found_region = (keys %neighbouring_regions)[int(rand(3))];
}
push @{$regions_hashref->{$found_region}{tiles}{$nw}}, $sw;
$tile_to_region_hashref->{$nw}{$sw} = $found_region;
}
}
}
}
push @expanded_tile_specs, (join "; ", @new); sub make_output_region_line($regions_hashref, $region)
{
my $line = "";
foreach my $nw (keys %{$regions_hashref->{$region}{tiles}})
{
foreach my $sw (@{$regions_hashref->{$region}{tiles}{$nw}})
{
$line .= "$nw,$sw; ";
}
} }
say $output_fh (join "; ", @expanded_tile_specs); chop($line);
chop($line);
return $line;
} }
close $input_fh; close $input_fh;

Write Preview
Loading…
Cancel
Save