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