Compare commits

..

4 Commits

  1. 16
      HexGrid.pm
  2. 1
      HexGrid/Path.pm
  3. 12
      HexGrid/Pin.pm
  4. 9
      HexGrid/Region.pm
  5. 12
      HexGrid/Tile.pm
  6. 2
      README.md
  7. 129
      coord_tripler.pl
  8. 68
      grid-tester.pl
  9. 3
      test-regions

@ -211,25 +211,21 @@ sub render($this)
# Continuations to be performed after other renders have finished # Continuations to be performed after other renders have finished
# Registered by subcomponents' render methods # Registered by subcomponents' render methods
my $laters = []; my $layers = {};
foreach my $region (keys %{$this->{regions}}) foreach my $region (keys %{$this->{regions}})
{ {
# $m contains the min/max extents of the region # $m contains the min/max extents of the region
my $m = $this->{regions}{$region}->render($svg, $laters, $this); my $m = $this->{regions}{$region}->render($svg, $this, $layers);
$min_x = $m->{min_x} if $m->{min_x} < $min_x; $min_x = $m->{min_x} if $m->{min_x} < $min_x;
$min_y = $m->{min_y} if $m->{min_y} < $min_y; $min_y = $m->{min_y} if $m->{min_y} < $min_y;
$max_x = $m->{max_x} if $m->{max_x} > $max_x; $max_x = $m->{max_x} if $m->{max_x} > $max_x;
$max_y = $m->{max_y} if $m->{max_y} > $max_y; $max_y = $m->{max_y} if $m->{max_y} > $max_y;
} }
foreach my $path (keys %{$this->paths}) foreach my $tile_callback (@{$layers->{tiles}}) { $tile_callback->(); }
{ foreach my $path (keys %{$this->paths}) { $this->{paths}{$path}->render($this, $svg); }
$this->{paths}{$path}->render($this, $svg); foreach my $pin_callback (@{$layers->{pins}}) { $pin_callback->(); }
} foreach my $popup_callback (@{$layers->{popups}}) { $popup_callback->($svg); }
foreach my $later (@$laters)
{
$later->($svg);
}
# Max and min coordinates are all at the top-left corner of tiles, add one width/height to get full extent # Max and min coordinates are all at the top-left corner of tiles, add one width/height to get full extent
my $width = $max_x - $min_x + $this->tile_width; my $width = $max_x - $min_x + $this->tile_width;
my $height = $max_y - $min_y + $this->tile_height; my $height = $max_y - $min_y + $this->tile_height;

@ -4,6 +4,7 @@ use v5.30;
use Moo; use Moo;
use MooX::Aliases; use MooX::Aliases;
use Carp;
use Data::Dumper; use Data::Dumper;
use feature "signatures"; use feature "signatures";

@ -15,7 +15,7 @@ has popup => (is => 'rw', default => 1, alias => 'use_popup');
has popup_class => (is => 'rw', default => 'pin-popup'); has popup_class => (is => 'rw', default => 'pin-popup');
sub render($this, $pin_container, $x, $y, $w, $h, $laters = undef) sub render($this, $pin_container, $x, $y, $w, $h, $clip_path, $layers)
{ {
my $group = $pin_container->g(); my $group = $pin_container->g();
my $element = $group->use(href => "#$this->{icon}_symbol", my $element = $group->use(href => "#$this->{icon}_symbol",
@ -26,12 +26,10 @@ sub render($this, $pin_container, $x, $y, $w, $h, $laters = undef)
my $center_x = $x + $w/2; my $center_x = $x + $w/2;
my $center_y = $y + $h/2; my $center_y = $y + $h/2;
if(defined $laters) push @{$layers->{popups}}, sub ($popup_container) { $this->render_popup($popup_container,
{ $pin_container->{transform}, $center_x, $center_y); }
push @$laters, sub ($popup_container) { $this->render_popup($popup_container, if $this->popup;
$pin_container->{transform}, $center_x, $center_y); } $group->{"clip-path"} = "url(#$clip_path->{id})";
if $this->popup;
}
return $group; return $group;
} }

@ -46,7 +46,7 @@ sub iter_tile($this, $code)
} }
} }
sub render($this, $svg, $laters, $grid) sub render($this, $svg, $grid, $layers)
{ {
my ($min_x,$min_y,$max_x,$max_y) = qw(Inf Inf -Inf -Inf); my ($min_x,$min_y,$max_x,$max_y) = qw(Inf Inf -Inf -Inf);
my $g = $svg->g(id => HexGrid::to_id("$this->{name}$this->{id_suffix}")); my $g = $svg->g(id => HexGrid::to_id("$this->{name}$this->{id_suffix}"));
@ -55,8 +55,11 @@ sub render($this, $svg, $laters, $grid)
foreach my $sw (keys %{$this->{tiles}{$nw}}) foreach my $sw (keys %{$this->{tiles}{$nw}})
{ {
my ($x_translate, $y_translate) = $grid->translate_coords($nw, $sw); my ($x_translate, $y_translate) = $grid->translate_coords($nw, $sw);
my $tile_group = $this->{tiles}{$nw}{$sw}->render($g, $grid->tile_width, $grid->tile_height, $laters); push @{$layers->{tiles}}, sub
$tile_group->{transform} = "translate($x_translate, $y_translate)"; {
my $tile_group = $this->{tiles}{$nw}{$sw}->render($g, $grid->tile_width, $grid->tile_height, $layers);
$tile_group->{transform} = "translate($x_translate, $y_translate)";
};
$min_x = $x_translate if $x_translate < $min_x; $min_x = $x_translate if $x_translate < $min_x;
$min_y = $y_translate if $y_translate < $min_y; $min_y = $y_translate if $y_translate < $min_y;

@ -103,7 +103,7 @@ sub _do_pin($this, $pin, $dock = undef)
} }
} }
sub render($this, $container, $width, $height, $laters = undef) sub render($this, $container, $width, $height, $layers)
{ {
my $g = $container->g my $g = $container->g
( (
@ -112,8 +112,8 @@ sub render($this, $container, $width, $height, $laters = undef)
my $hex = $g->polygon(points => hex_path($width, $height), my $hex = $g->polygon(points => hex_path($width, $height),
id => "$this->{nw}_$this->{sw}_inner_hex", style => $this->style); id => "$this->{nw}_$this->{sw}_inner_hex", style => $this->style);
# Have tile contents clip to the hexagon # Have tile contents clip to the hexagon
my $clipPath = $g->clipPath(id => "$this->{nw}_$this->{sw}_clip"); my $clip_path = $g->clipPath(id => "$this->{nw}_$this->{sw}_clip");
$clipPath->use(href => "#$hex->{id}"); $clip_path->use(href => "#$hex->{id}");
if($this->{colour}) if($this->{colour})
{ {
@ -128,7 +128,7 @@ sub render($this, $container, $width, $height, $laters = undef)
# The actual image is defined at the HexGrid level, here we reference it # The actual image is defined at the HexGrid level, here we reference it
my $use_element = $g->use(id => "$this->{nw}_$this->{sw}_${image}_use", my $use_element = $g->use(id => "$this->{nw}_$this->{sw}_${image}_use",
href => "#${image}_symbol", width => $width, height => $height, href => "#${image}_symbol", width => $width, height => $height,
"clip-path" => "url(#$clipPath->{id})"); "clip-path" => "url(#$clip_path->{id})");
} }
} }
@ -152,8 +152,8 @@ sub render($this, $container, $width, $height, $laters = undef)
my $y = $height * $docks{$key}->{y}; my $y = $height * $docks{$key}->{y};
my $h = $height * $docks{$key}->{h}; my $h = $height * $docks{$key}->{h};
my $pin_element = $this->{pins}{$key}->render($g, $x, $y, $w, $h, $laters); push @{$layers->{pins}},
$pin_element->{"clip-path"} = "url(#$clipPath->{id})"; sub { $this->{pins}{$key}->render($g, $x, $y, $w, $h, $clip_path, $layers); };
} }
} }
return $g; return $g;

@ -28,7 +28,7 @@ Examples of the four combinations:
2 is intended to make a map for the main page, and for each Region, Subregion and Location page. 2 is intended to make a map for the main page, and for each Region, Subregion and Location page.
3 is intended to be linked to and <s>has</s>will have click-toggleable popups. 3 is intended to be linked to and has click-toggleable popups.
4 is an artifact of the above 3 and doesn't have intended use. 4 is an artifact of the above 3 and doesn't have intended use.

@ -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…
Cancel
Save