.

HexGrid.pm

@@ -16,6 +16,8 @@ use Data::Dumper;
 use feature "signatures";
 no warnings "experimental::signatures";
 
+my $DEBUG = 0;
+
 has regions => (is => 'rw', default => sub { {} });
 has images => (is => 'rw', default => sub{ {} });
 
@@ -26,6 +28,7 @@ has defaults => (is => 'rw', default => sub { {} });
 has make_popups => (is => 'rw', default => 1, alias => 'popups');
 has popup_class => (is => 'rw', default => 'pin-popup');
 has hidden_popups => (is => 'rw', default => 1, alias => 'popups_are_hidden');
+has embed_images => (is => 'rw', default => 1);
 
 sub tile_width($this) { 2 * $this->{sideLength} }
 sub tile_height($this) { sqrt(3) * $this->{sideLength} }
@@ -48,7 +51,8 @@ sub add_image($this, $name, $source)
 		source => $source,
 		id => "${name}_img",
 		width => 1,
-		height => 1
+		height => 1,
+		fetch => $this->embed_images
 	);
 }
 
@@ -60,6 +64,74 @@ sub get_tile_at($this, $nw, $sw)
 	}
 	croak "No tile at $nw,$sw";
 }
+sub get_tile_and_region_at($this, $nw, $sw)
+{
+	foreach my $region (values $this->{regions}->%*)
+	{
+		return ($region->{tiles}{$nw}{$sw}, $region) if exists $region->{tiles}{$nw}{$sw};
+	}
+	croak "No tile at $nw,$sw";
+}
+
+# Clones settings
+# Regions (and by extension tiles) are tied to $this
+# Images are not imported
+sub subgrid_for_regions($this, @region_names)
+{
+	my $subgrid = HexGrid->new
+	(
+		sideLength => $this->{sideLength},
+		width => $this->{width},
+		height => $this->{height},
+		defaults => merge($this->{defaults}, {}),
+		make_popups => $this->{make_popups},
+		popup_class => $this->{popup_class},
+		hidden_popups => $this->{hidden_popups},
+		embed_images => $this->{embed_images}
+	);
+	$subgrid->add_region($this->{regions}{$_}) for @region_names;
+	say STDERR Dumper($subgrid) if $DEBUG;
+	return $subgrid;
+}
+
+sub subgrid_for_tiles($this, @coords_list)
+{
+	my $subgrid = HexGrid->new
+	(
+		sideLength => $this->{sideLength},
+		width => $this->{width},
+		height => $this->{height},
+		defaults => $this->{defaults},
+		make_popups => $this->{make_popups},
+		popup_class => $this->{popup_class},
+		hidden_popups => $this->{hidden_popups},
+		embed_images => $this->{embed_images}
+	);
+	foreach my $coords (@coords_list)
+	{
+		my ($tile, $region) = $this->get_tile_and_region_at($coords->{nw}, $coords->{sw});
+		unless(exists $subgrid->{regions}{$region->{name}})
+		{
+			my $clone = $region->clone;
+			$subgrid->add_region($clone);
+		}
+		$subgrid->{regions}{$region->{name}}->add_tile($tile);
+	}
+	return $subgrid;
+}
+
+sub iter_region($this, $code)
+{
+	foreach my $region (values %{$this->{regions}})
+	{
+		$code->($region);
+	}
+}
+
+sub iter_tile($this, $code)
+{
+	$this->iter_region(sub($region) { $region->iter_tile($code) });
+}
 
 sub render($this)
 {
@@ -116,4 +188,5 @@ sub translate_coords($this, $nw, $sw)
 
 sub to_id($string) { $string =~ s/\W/-/g && return $string; }
 
+sub DEBUG { $DEBUG = 1; }
 1;

HexGrid/Image.pm

@@ -4,10 +4,15 @@ use v5.30;
 
 use Moo;
 use MooX::Aliases;
+use LWP::UserAgent;
+use MIME::Base64;
 
 use feature "signatures";
 no warnings "experimental::signatures";
 
+my $DEBUG = 0;
+
+my $USER_AGENT;
 
 has source => (is => 'rw', required => 1, alias => [qw(src url source_url)]);
 has fetch => (is => 'rw', default => 0);
@@ -15,13 +20,34 @@ has id => (is => 'rw', required => 1);
 has width => (is => 'rw', required => 1);
 has height => (is => 'rw', required => 1);
 
+has _cached_data => (is => 'rw', default => undef);
+
 sub render($this, $container)
 {
-	# hard coded into external URL mode
-	my $image_element = $container->image(id => $this->{id}, href => $this->{source});
+	say STDERR $this->{_cached_data} if $DEBUG;
+	my $image_element = $container->image(id => $this->{id});
+	my $href = $this->{source};
+	if ($this->{fetch})
+	{
+		$this->_fetch_base64 unless defined($this->{_cached_data});
+		$href = $this->{_cached_data};
+	}
+	$image_element->{href} = $href;
 	$image_element->{width} = $this->{width} if defined($this->{width});
 	$image_element->{height} = $this->{height} if defined($this->{height});
 	return $image_element;
 }
 
+sub _fetch_base64($this)
+{
+	$USER_AGENT // ($USER_AGENT = LWP::UserAgent->new(timeout => 10));
+	say STDERR "Fetching $this->{source}";
+	my $response = $USER_AGENT->get($this->{source});
+	my $content_type = $response->headers->content_type;
+	my $encoded_content = encode_base64($response->content);
+	$this->{_cached_data} = "data:$content_type;base64, $encoded_content";
+	return $this->{_cached_data};
+}
+
+sub DEBUG { $DEBUG = 1; }
 1;

HexGrid/Pin.pm

@@ -16,9 +16,10 @@ has popup_class => (is => 'rw', default => 'pin-popup');
 
 sub render($this, $pin_container, $x, $y, $w, $h, $laters = undef)
 {
-	my $element = $pin_container->image(href => $this->{icon},
+	my $group = $pin_container->g();
+	my $element = $group->use(href => "#$this->{icon}_symbol",
 		x => $x, y => $y, width => $w, height => $h);
-	$element->{id} = "$this->{id}-img";
+	$element->{id} = "$this->{id}-use";
 	$element->{onclick} = "clickPin('$this->{id}', '$pin_container->{id}');";
 	my $center_x = $x + $w/2;
 	my $center_y = $y + $h/2;
@@ -28,7 +29,7 @@ sub render($this, $pin_container, $x, $y, $w, $h, $laters = undef)
 		push @$laters, sub ($popup_container) { $this->render_popup($popup_container,
 				$pin_container->{transform}, $center_x, $center_y); };
 	}
-	return $element;
+	return $group;
 }
 
 sub render_popup($this, $popup_container, $transform, $x_shift, $y_shift)

HexGrid/Region.pm

@@ -17,6 +17,16 @@ has name => (is => 'rw', required => 1);
 has defaults => (is => 'rw', default => sub { {} });
 has id_suffix => (is => 'rw', default => '_region');
 
+sub clone($this)
+{
+	return HexGrid::Region->new
+	(
+		name => $this->{name},
+		defaults => merge($this->{defaults},{}),
+		id_suffix => $this->{id_suffix}
+	);
+}
+
 sub add_tile($this, $tile) { $this->{tiles}{$tile->{nw}}{$tile->{sw}} = $tile; }
 sub make_tile_at($this, $nw, $sw, %tile_settings)
 {
@@ -32,6 +42,17 @@ sub make_subregion($this, $name, %defaults)
 	$this->add_subregion(HexGrid::Region->new(name => $name, defaults => $tile_defaults));
 }
 
+sub iter_tile($this, $code)
+{
+	foreach my $nw (keys %{$this->{tiles}})
+	{
+		foreach my $sw (keys %{$this->{tiles}{$nw}})
+		{
+			$code->($this->{tiles}{$nw}{$sw});
+		}
+	}
+}
+
 sub render($this, $svg, $laters, $grid)
 {
 	my ($min_x,$min_y,$max_x,$max_y) = qw(Inf Inf -Inf -Inf);

HexGrid/Tile.pm

@@ -140,8 +140,8 @@ sub render($this, $container, $width, $height, $laters = undef)
 			my $y = $height * $docks{$key}->{y};
 			my $h = $height * $docks{$key}->{h};
 
-			my $image_element = $this->{pins}{$key}->render($g, $x, $y, $w, $h, $laters);
-			$image_element->{"clip-path"} = "url(#$clipPath->{id})";
+			my $pin_element = $this->{pins}{$key}->render($g, $x, $y, $w, $h, $laters);
+			$pin_element->{"clip-path"} = "url(#$clipPath->{id})";
 		}
 	}
 	return $g;

wiki-map.pl

@@ -14,7 +14,7 @@ use Data::Dumper;
 use feature "signatures";
 no warnings "experimental::signatures";
 
-# The below regex is a whitespace forgiving version of /^(-?\d+),(-?\d+)/, an int pair
+# This regex is a whitespace forgiving version of /^(-?\d+),(-?\d+)/, an int pair
 my $coords_regex = qr/^\s*(-?\s*\d+)\s*,\s*(-?\s*\d+)\s*$/;
 
 
@@ -27,6 +27,7 @@ my $site_template_name = "MapSite";
 my $border_width = 1;
 my $border_colour = 'black';
 my $show_coords = 0;
+my $embed_images = 1;
 
 my $html_document = 1;
 my $outfile = '-';
@@ -43,6 +44,7 @@ GetOptions
 	'border-width|bw=f' => \$border_width,
 	'border-colour|border-color|bc=s' => \$border_colour,
 	'show-coords|coords!' => \$show_coords,
+	'embed-images!' => \$embed_images,
 
 	'html-document!' => \$html_document,
 	'outfile=s' => \$outfile,
@@ -51,10 +53,15 @@ GetOptions
 
 $api_url // croak "Base API URL is required! Use --api-url to set";
 
-my $grid = HexGrid->new(defaults => {
+my $grid = HexGrid->new(embed_images => $embed_images, defaults => {
 		style => { 'stroke-width' => $border_width, stroke => $border_colour },
-		show_coords => $show_coords });
-my %region_grids;
+		show_coords => $show_coords});
+
+# my %region_grids;
+my %regions_by_subregion;
+my %images_for_region_grids;
+my %location_grids;
+
 my $mw = MediaWiki::API->new();
 $mw->{config}->{api_url} = $api_url;
 
@@ -83,17 +90,7 @@ foreach my $page (values %{$region_query_results->{query}{pages}})
 	$region->{defaults}{colour} = $parsed_template->{named_params}{colour};
 	if($regiondir)
 	{
-		$region_grids{$page->{title}} = HexGrid->new
-		(
-			defaults =>
-			{
-				style => { 'stroke-width' => $border_width, stroke => $border_colour },
-				show_coords => $show_coords
-			},
-			height => 300,
-			width => 300
-		);
-		$region_grids{$page->{title}}->add_region($region);
+		$regions_by_subregion{$region->{name}} = $region->{name};
 	}
 
 	push @tile_pages, "$page->{title}/Tiles";
@@ -125,7 +122,7 @@ foreach my $page (values %{$subregion_query_results->{query}{pages}})
 	if($regiondir)
 	{
 		my $region_name = $parsed_template->{positional_params}[0];
-		$region_grids{$region_name}->add_region($subregion);
+		$regions_by_subregion{$subregion->{name}} = $region_name;
 	}
 
 	push @tile_pages, "$page->{title}/Tiles";
@@ -152,45 +149,48 @@ foreach my $page (values %{$location_query_results->{query}{pages}})
 	next if $page->{title} =~ /^Category:/;
 	my $parsed_template = MWTemplate::Parse($page->{revisions}[0]{'*'}, $location_template_name);
 	next unless $parsed_template;
+
 	say STDERR "Processing location: $page->{title}";
+
 	my $location = $grid->make_region($page->{title});
 	$location->{defaults}{colour} = $parsed_template->{named_params}{colour};
 	push @{$background_pages{"File:$parsed_template->{named_params}{background}"}}, $location;
+	my $region_name = $parsed_template->{positional_params}[1];
+	$regions_by_subregion{$location->{name}} = $region_name;
+
 	push @location_continuations, sub
 	{
 		return unless $parsed_template->{positional_params}[0] =~ $coords_regex;
 		my ($nw, $sw) = ($1, $2);
 		$location->make_tile_at($nw, $sw);
-		my $region_name = $parsed_template->{positional_params}[1];
 		if($regiondir)
 		{
-			$region_grids{$region_name}->add_region($location);
-			my $region_name = $parsed_template->{positional_params}[1];
-			$region_grids{$region_name}->add_region($location);
-
-			$region_grids{$location->{name}} = HexGrid->new
-			(
-				defaults =>
-				{
-					style => { 'stroke-width' => $border_width, stroke => $border_colour },
-					show_coords => $show_coords
-				},
-				height => 300,
-				width => 300
-			);
-			my $location_with_context = $region_grids{$location->{name}}->make_region($location->{name});
-			$location_with_context->add_tile($grid->get_tile_at($nw, $sw));
+			my @coords_list = ({ nw => $nw, sw => $sw});
 			foreach my $coords (split /;/, $parsed_template->{named_params}{context_tiles})
 			{
 				do { carp "Skipping bad spec: $coords"; next; } unless $coords =~ $coords_regex;
-				$location_with_context->add_tile($grid->get_tile_at($1, $2));
+				# $location_with_context->add_tile($grid->get_tile_at($1, $2));
+				push @coords_list, { nw => $1, sw => $2 };
 			}
+			my $location_grid = $grid->subgrid_for_tiles(@coords_list);
+			$location_grid->iter_tile(
+				sub($tile)
+				{
+					# if haven't added image to grid yet, do so
+					if($tile->image && !(exists $location_grid->{images}{$tile->image}))
+					{
+						$location_grid->{images}{$tile->image} = $grid->{images}{$tile->image};
+					}
+				});
+			$location_grids{$location->{name}} = $location_grid;
 		}
 	};
 }
 
 
 
+# HexGrid::Image::DEBUG();
+
 say STDERR "Getting Background image pages";
 my $background_query_results = $mw->api({ action => 'query',
 		prop => 'imageinfo',
@@ -198,19 +198,34 @@ my $background_query_results = $mw->api({ action => 'query',
 		iiprop => 'url'
 	}) || carp $mw->{error}->{code} . ': ' . $mw->{error}->{details};
 
+# say STDERR Dumper(\%background_pages);
 foreach my $page (values %{$background_query_results->{query}{pages}})
 {
 	if($page->{imageinfo})
 	{
 		say STDERR "Processing image: $page->{title}";
 		$grid->add_image(HexGrid::to_id($page->{title}), $page->{imageinfo}[0]{url});
-		foreach my $region (@{$background_pages{$page->{title}}})
+		foreach my $subregion (@{$background_pages{$page->{title}}})
 		{
-			$region->{defaults}{image} = HexGrid::to_id($page->{title});
+			$subregion->{defaults}{image} = HexGrid::to_id($page->{title});
+			if($regiondir)
+			{
+				my $region_name = $regions_by_subregion{$subregion->{name}};
+				# say STDERR $page->{title} unless $region_name;
+				# say STDERR "$region_name";
+				push @{$images_for_region_grids{$region_name}},
+				{
+					name => HexGrid::to_id($page->{title}),
+					source => $page->{imageinfo}[0]{url}
+				};
+			}
 		}
 	}
 }
 
+# say STDERR Dumper($grid->{images});
+# say STDERR Dumper(\%images_for_region_grids);
+
 
 
 say STDERR "Getting Tile pages";
@@ -273,12 +288,13 @@ foreach my $site_page_ref (values %{$site_query_results->{query}{pages}})
 		}) || carp $mw->{error}->{code} . ': ' . $mw->{error}->{details};
 	my %image_pages = %{$imageinfo_query_results->{query}{pages}};
 	my $image_url = (values %image_pages)[0]{imageinfo}[0]{url};
+	$grid->add_image(HexGrid::to_id($parsed_template->{named_params}{icon}), $image_url);
 
 	my $pin = HexGrid::Pin->new
 	(
 		name => $site_name,
-		id => "${site_name}_pin",
-		icon => $image_url,
+		id => HexGrid::to_id($site_name),
+		icon => HexGrid::to_id($parsed_template->{named_params}{icon}),
 		link => $site_url,
 		description => $parsed_template->{named_params}{abstract}
 	);
@@ -294,15 +310,41 @@ if($regiondir)
 {
 	chdir $regiondir || croak "Couldn't chdir to $regiondir: $!";
 	my $extension = $html_document ? 'html' : 'svg';
-	while(my ($region, $region_grid) = each %region_grids)
+	my %region_grid_listings;
+	while(my ($subregion, $region) = each %regions_by_subregion)
+	{
+		push @{$region_grid_listings{$region}}, $subregion;
+	}
+	while(my ($region, $subregions) = each %region_grid_listings)
 	{
+		my $region_grid = $grid->subgrid_for_regions(@$subregions);
+		# say STDERR Dumper($images_for_region_grids{$region});
+		if(exists $images_for_region_grids{$region})
+		{
+			foreach my $image (@{$images_for_region_grids{$region}})
+			{
+				# say STDERR Dumper($image);
+				$region_grid->{images}{$image->{name}} = $grid->{images}{$image->{name}};
+				# $region_grid->add_image($image->{name}, $image->{source});
+			}
+		}
+
 		open (my $region_fh, "> $region.$extension")
 			or croak "Couldn't open $region.extension for writing: $!";
 		say $region_fh ($html_document ? wrap_in_html($region_grid) : $region_grid->render);
 		close $region_fh;
 	}
+	# Location grids need to import images
+	while(my ($location_name, $location_grid) = each %location_grids)
+	{
+		open (my $location_fh, "> $location_name.$extension")
+			or croak "Couldn't open $location_name.extension for writing: $!";
+		say $location_fh ($html_document ? wrap_in_html($location_grid) : $location_grid->render);
+		close $location_fh;
+	}
 }
 
+
 sub wrap_in_html($grid)
 {
 	my $html_builder = "<!DOCTYPE html>";