Daniel Asher Resnick 6 months ago
parent 5c2c1c5afc
commit 147c2cb6cb
  1. 112
      coord_tripler.pl

@ -9,8 +9,15 @@ no warnings "experimental::signatures";
my $coords_regex = qr/^\s*(-?\d+)\s*,\s*(-?\d+)\s*$/;
my %regions_to_tiles;
my %tiles_to_regions;
my %regions;
my %tile_to_regions;
my %bounds =
(
nw_min => "Inf",
nw_max => "-Inf",
sw_min => "Inf",
sw_max => "-Inf"
);
my $input_file = shift;
open (my $input_fh, $input_file);
@ -18,29 +25,104 @@ open (my $input_fh, $input_file);
my $output_file = shift // "$input_file.out";
open (my $output_fh, ">$output_file");
$regions{holes}{bg} = '#000000';
while (my $line = <$input_fh>)
{
my @fields = split '; ', $line;
print $output_fh (shift @fields) . "; "; #region name
print $output_fh (shift @fields) . "; "; #background colour
my @expanded_tile_specs = ();
foreach my $coords (@fields)
my $region = (shift @fields); #region name
$regions{$region}{bg} = (shift @fields); #background colour
expand_coords(\%regions, \%tile_to_regions, $region, \%bounds, @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;
my $nw_base = $1 * 3;
my $sw_base = $2 * 3;
my @new = ("$nw_base,$sw_base");
push @new, ($nw_base+1) . "," . ($sw_base);
push @new, ($nw_base-1) . "," . ($sw_base);
push @new, ($nw_base) . "," . ($sw_base+1);
push @new, ($nw_base) . "," . ($sw_base-1);
push @new, ($nw_base+1) . "," . ($sw_base-1);
push @new, ($nw_base-1) . "," . ($sw_base+1);
push @{$regions_hashref->{$region}{tiles}{$nw_base}}, $sw_base;
push @{$regions_hashref->{$region}{tiles}{$nw_base+1}}, $sw_base;
push @{$regions_hashref->{$region}{tiles}{$nw_base-1}}, $sw_base;
push @{$regions_hashref->{$region}{tiles}{$nw_base}}, $sw_base+1;
push @{$regions_hashref->{$region}{tiles}{$nw_base}}, $sw_base-1;
push @{$regions_hashref->{$region}{tiles}{$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};
push @expanded_tile_specs, (join "; ", @new);
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;
}
}
}
}
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;

Loading…
Cancel
Save