Layer-based rendering

HexGrid.pm

@@ -211,25 +211,21 @@ sub render($this)
 
 	# Continuations to be performed after other renders have finished
 	# Registered by subcomponents' render methods
-	my $laters = [];
+	my $layers = {};
 	foreach my $region (keys %{$this->{regions}})
 	{
 		# $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_y = $m->{min_y} if $m->{min_y} < $min_y;
 		$max_x = $m->{max_x} if $m->{max_x} > $max_x;
 		$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
 	my $width = $max_x - $min_x + $this->tile_width;
 	my $height = $max_y - $min_y + $this->tile_height;

HexGrid/Path.pm

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

HexGrid/Pin.pm

@@ -15,7 +15,7 @@ has popup => (is => 'rw', default => 1, alias => 'use_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 $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_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;
 }
 

HexGrid/Region.pm

@@ -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 $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}})
 		{
 			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_y = $y_translate if $y_translate < $min_y;

HexGrid/Tile.pm

@@ -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
 	(
@@ -112,8 +112,8 @@ sub render($this, $container, $width, $height, $laters = undef)
 	my $hex = $g->polygon(points => hex_path($width, $height),
 		id => "$this->{nw}_$this->{sw}_inner_hex", style => $this->style);
 	# 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})
 	{
@@ -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
 			my $use_element = $g->use(id => "$this->{nw}_$this->{sw}_${image}_use",
 				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 $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;

README.md

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

coord_tripler.pl

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

grid-tester.pl

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

test-regions

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