Compare commits
4 Commits
6acfb81512
...
8c2d5fc6c2
| Author | SHA1 | Date |
|---|---|---|
 Daniel Asher Resnick
|
8c2d5fc6c2 | 4 months ago |
|
Daniel Asher Resnick
|
ae1987022e | 5 months ago |
|
Daniel Asher Resnick
|
147c2cb6cb | 5 months ago |
|
Daniel Asher Resnick
|
5c2c1c5afc | 5 months ago |
@ -0,0 +1,129 @@ |
||||
use v5.36; |
||||
use rlib '.'; |
||||
|
||||
use Carp; |
||||
use Data::Dumper; |
||||
|
||||
use feature "signatures"; |
||||
no warnings "experimental::signatures"; |
||||
|
||||
my $coords_regex = qr/^\s*(-?\d+)\s*,\s*(-?\d+)\s*$/; |
||||
|
||||
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); |
||||
|
||||
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; |
||||
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; |
||||
|
||||
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}; |
||||
|
||||
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; "; |
||||
} |
||||
} |
||||
chop($line); |
||||
chop($line); |
||||
return $line; |
||||
} |
||||
|
||||
close $input_fh; |
||||
close $output_fh; |
||||
@ -0,0 +1,68 @@ |
||||
use v5.36; |
||||
use rlib '.'; |
||||
|
||||
use HexGrid; |
||||
use HexGrid::Pin; |
||||
|
||||
use Carp; |
||||
use Data::Dumper; |
||||
|
||||
use feature "signatures"; |
||||
no warnings "experimental::signatures"; |
||||
|
||||
my $coords_regex = qr/^\s*(-?\d+)\s*,\s*(-?\d+)\s*$/; |
||||
|
||||
my $grid = HexGrid->new(defaults => { |
||||
style => { 'stroke-width' => 1, stroke => 'black' }, |
||||
show_coords => 1}); |
||||
|
||||
my $test_file = shift; |
||||
open (my $test_fh, $test_file); |
||||
|
||||
while (my $line = <$test_fh>) |
||||
{ |
||||
my @fields = split '; ', $line; |
||||
my $region = $grid->make_region(shift @fields); |
||||
$region->{defaults}{colour} = shift @fields; |
||||
foreach my $coords (@fields) |
||||
{ |
||||
do { carp "Skipping bad spec: $coords"; next; } unless $coords =~ $coords_regex; |
||||
$region->make_tile_at($1,$2); |
||||
} |
||||
} |
||||
|
||||
# say $grid->render; |
||||
say wrap_in_html($grid); |
||||
close $test_fh; |
||||
|
||||
sub wrap_in_html($grid) |
||||
{ |
||||
my $html_builder = "<!DOCTYPE html>"; |
||||
$html_builder .= "\n<html>\n<body>"; |
||||
$html_builder .= "\n" . <<EOS; |
||||
<script> |
||||
function clickPin(pinId, containerId) { |
||||
let popup = document.getElementById(pinId + '-popup'); |
||||
popup.style.visibility = popup.style.visibility == 'visible' ? 'hidden' : 'visible'; |
||||
} |
||||
</script> |
||||
EOS |
||||
if(1) |
||||
{ |
||||
$html_builder .= <<EOS; |
||||
<script> |
||||
function toggleCoords(show) { |
||||
for (var elem of document.getElementsByClassName('coords')) { |
||||
elem.style.visibility = show ? 'visible' : 'hidden'; |
||||
} |
||||
} |
||||
</script> |
||||
<label for="show-coords-checkbox">Show coordinates</label> |
||||
<input type="checkbox" checked id="show-coords-checkbox" onclick="toggleCoords(event.srcElement.checked)" /> |
||||
EOS |
||||
} |
||||
$html_builder .= "\n" . $grid->render; |
||||
$html_builder .= "\n</body>\n</html>"; |
||||
return $html_builder; |
||||
} |
||||
|
||||
@ -0,0 +1,3 @@ |
||||
Minev; #2F7621; 0,1; 0,2; 1,1; 2,0; 0,3; 1,2; 2,1; 1,3; 2,2; 3,1; 1,4; 2,3; 3,2; 2,4; 3,3; 4,2; 3,4; 4,3; 5,2; 4,4; 5,3; 5,4; 6,3; 5,5; 6,5 |
||||
Buslish; #E7F79C; 0,5; 1,5; 0,6; 2,5; 1,6; 0,7; -1,8; 2,5; 3,5; 2,6; 1,7; 0,8; 4,5; 3,6; 1,8; 0,9; 4,6; 3,7; 2,8; 1,9; 4,7; 3,8; 2,9; 3,9 |
||||
Midhills; #E7CE5A; 5,6; 4,8; 5,7; 6,6 |
||||
Loading…
Reference in new issue