Fix bug with MWTemplate::Parse

The slurp after the template name needs to be non-greedy so it ends at the first }}.
Now that I think about it,
this will break if the template invocation has template/variable calls within it

HexGrid/Image.pm

@@ -29,12 +29,11 @@ sub render($this, $container)
 	my $href = $this->{source};
 	if ($this->{fetch})
 	{
-		$this->_fetch_base64 unless defined($this->{_cached_data});
+		$href = $this->{_cached_data} // $this->_fetch_base64;
-		$href = $this->{_cached_data};
 	}
 	$image_element->{href} = $href;
-	$image_element->{width} = $this->{width} if defined($this->{width});
+	$image_element->{width} = $this->{width};
-	$image_element->{height} = $this->{height} if defined($this->{height});
+	$image_element->{height} = $this->{height};
 	return $image_element;
 }
 

HexGrid/Path.pm

@@ -34,17 +34,11 @@ sub get_edge_direction($tile1, $tile2)
 	return $HexGrid::DIR{ne} if $nw_diff ==  0 && $sw_diff == -1;
 	return $HexGrid::DIR{n}  if $nw_diff ==  1 && $sw_diff == -1;
 
-	#TODO: render and splinter should check this returns successfully;
 	carp("Tiles are not adjacent: " . $tile1->nw . "," . $tile1->sw . "—"
 		. $tile2->nw . "," . $tile2->sw);
 	return undef;
 }
 
-sub curve_to($qx, $qy, $x, $y)
-{
-	return "Q $qx,$qy $x,$y";
-}
-
 
 # Instance
 
@@ -59,9 +53,13 @@ sub clone_settings($this)
 	);
 }
 
+# Given a Path that may not be entirely within a given Grid,
+# reduce the Path to smaller subpaths each fully contained in the Grid.
 sub splinter($this, $grid)
 {
 
+	# Collection of subpaths to be generated and returned
+	# Each will have the id of the original path proceeded by its index, e.g. My-Path-0
 	my @splinters;
 	my $in_splinter = 0;
 
@@ -76,6 +74,7 @@ sub splinter($this, $grid)
 		$splinter->{starts_from} = $this->starts_from;
 		push @splinters, $splinter;
 	}
+	# We need to reference the preceeding tile in the loop, so a foreach won't suffice
 	for(my $i = 0; $i <= $#{$this->tiles}; $i++)
 	{
 		unless($in_splinter)
@@ -94,7 +93,13 @@ sub splinter($this, $grid)
 				# Don't set source on first tile
 				if($i >= 1)
 				{
-					$splinter->{starts_from} = get_edge_direction($this->{tiles}[$i], $this->{tiles}[$i-1]);
+					my $starting_edge = get_edge_direction($this->{tiles}[$i], $this->{tiles}[$i-1]);
+					unless($starting_edge)
+					{
+						carp("Path " . $this->{id} . " has non-adjacent edges, aborting.");
+						return;
+					}
+					$splinter->{starts_from} = $starting_edge;
 				}
 				push @{$splinter->tiles}, $this->{tiles}[$i];
 				push @splinters, $splinter;
@@ -110,10 +115,17 @@ sub splinter($this, $grid)
 			}
 			else
 			{
-				# In a splinter but tile not present, set previous tile sink to this missing tile
+				# In a splinter but tile not present, end splinter
+				# and set previous tile sink to this missing tile
 				$in_splinter = 0;
-				$splinters[$#splinters]{ends_to} =
+				my $ending_edge = get_edge_direction($this->{tiles}[$i-1], $this->{tiles}[$i]);
-					get_edge_direction($this->{tiles}[$i-1], $this->{tiles}[$i]);
+				unless($ending_edge)
+				{
+					carp("Path " . $this->{id} . " has non-adjacent edges, aborting.");
+					return;
+				}
+				$splinters[$#splinters]{ends_to} = $ending_edge;
+					
 			}
 		}
 	}
@@ -134,6 +146,7 @@ sub render($this, $grid, $svg)
 	return unless @{$this->tiles};
 
 	my $g = $svg->g(id => $this->id, class => $this->css_class);
+	# We will be destructively processing the tile array, so copy first
 	my @tiles = @{$this->tiles};
 	my $current_tile = shift @tiles;
 
@@ -153,7 +166,7 @@ sub render($this, $grid, $svg)
 			}
 			else
 			{
-				# line from starts_from to the centre
+				# Line from starts_from to the centre
 				$g->line(x1 => $x1, y1 => $y1, x2 => $cx, y2 => $cy,
 					stroke => $this->colour, style => $this->style, class => $this->css_class);
 			}
@@ -162,13 +175,14 @@ sub render($this, $grid, $svg)
 		{
 			if($this->ends_to)
 			{
-				# line from the centre to ends_to
+				# Line from the centre to ends_to
 				my ($x2, $y2) = $grid->coords_of_edge($current_tile->nw, $current_tile->sw, $this->ends_to);
 				$g->line(x1 => $cx, y1 => $cy, x2 => $x2, y2 => $y2,
 					stroke => $this->colour, style => $this->style, class => $this->css_class);
 			}
 			else
 			{
+				# Point at centre
 				$g->circle(cx => $cx, cy => $cy,
 					r => $this->{style}{'stroke-width'} // $DEFAULT_WIDTH,
 					fill => $this->colour, style => $this->style, class => $this->css_class);
@@ -177,37 +191,53 @@ sub render($this, $grid, $svg)
 		return $g;
 	}
 
+	# Setup iterated variables
 	my ($x0, $x, $y0, $y);
 	my $path_spec;
 	my $previous_tile = $current_tile;
 	$current_tile = shift @tiles;
 	my $next_edge = get_edge_direction($previous_tile, $current_tile);
+	unless($next_edge)
+	{
+		carp("Path " . $this->{id} . " has non-adjacent edges, aborting.");
+		return;
+	}
 	($x, $y) = $grid->coords_of_edge($previous_tile->nw, $previous_tile->sw, $next_edge);
+	my $previous_edge;
+	my $next_tile;
+
 	if($this->starts_from)
 	{
+		# Go from source edge to edge with next tile
 		($x0, $y0) = $grid->coords_of_edge($previous_tile->nw, $previous_tile->sw, $this->starts_from);
-		$path_spec .= "M $x0,$y0 ";
 		my ($cx, $cy) = $grid->coords_of_centre($previous_tile->nw, $previous_tile->sw);
-		$path_spec .= curve_to($cx, $cy, $x, $y);
+		$path_spec .= "M $x0,$y0 Q $cx,$cy $x,$y";
 	}
 	else
 	{
+		# Go from centre to edge with next tile
 		($x0, $y0) = $grid->coords_of_centre($previous_tile->nw, $previous_tile->sw);
 		$path_spec .= "M $x0,$y0 L $x,$y";
 	}
 
-	my $previous_edge; # not defined yet
+	# This loop adds all the intermediate segments
-	my $next_tile; # not defined yet
+	# Importantly, all go from edge to edge
 	while (@tiles)
 	{
 		$next_tile = shift @tiles;
-		$previous_edge = -$next_edge;
+		$previous_edge = -$next_edge; #Edge from previous-to-current is opposite the previous current-to-next
 		$next_edge = get_edge_direction($current_tile, $next_tile);
+		unless($next_edge)
+		{
+			carp("Path " . $this->{id} . " has non-adjacent edges, aborting.");
+			return;
+		}
 
+		# Curve from previous edge to next edge controlled through current centre
 		my ($qx,$qy) = $grid->coords_of_centre($current_tile->nw, $current_tile->sw);
 		($x,$y) = $grid->coords_of_edge($current_tile->nw, $current_tile->sw, $next_edge);
 
-		$path_spec .= " " . curve_to($qx,$qy, $x,$y);
+		$path_spec .= " Q $qx,$qy $x,$y";
 
 		$previous_tile = $current_tile;
 		$current_tile = $next_tile;
@@ -216,12 +246,14 @@ sub render($this, $grid, $svg)
 	# $next_edge is the last used edge, so use it's opposite for the source of last line
 	if($this->ends_to)
 	{
+		# Go from edge with previous tile to sink edge
 		($x, $y) = $grid->coords_of_centre($current_tile->nw, $current_tile->sw);
 		my ($xe, $ye) = $grid->coords_of_edge($current_tile->nw, $current_tile->sw, $this->ends_to);
-		$path_spec .= curve_to($x, $y, $xe, $ye);
+		$path_spec .= "Q $x,$y $xe,$ye";
 	}
 	else
 	{
+		# Go from edge with previous tile to centre
 		($x, $y) = $grid->coords_of_centre($current_tile->nw, $current_tile->sw);
 		$path_spec .= " L $x,$y";
 	}

HexGrid/Pin.pm

@@ -11,6 +11,7 @@ has id => (is => 'ro', required => 1);
 has icon => (is => 'rw', alias => [qw(img source src)], required => 1);
 has link => (is => 'rw', alias => 'href');
 has description => (is => 'rw', alias => 'desc');
+has popup => (is => 'rw', default => 1, alias => 'use_popup');
 
 has popup_class => (is => 'rw', default => 'pin-popup');
 
@@ -20,14 +21,16 @@ sub render($this, $pin_container, $x, $y, $w, $h, $laters = undef)
 	my $element = $group->use(href => "#$this->{icon}_symbol",
 		x => $x, y => $y, width => $w, height => $h);
 	$element->{id} = "$this->{id}-use";
-	$element->{onclick} = "clickPin('$this->{id}', '$pin_container->{id}');";
+	$element->{onclick} = "clickPin('$this->{id}', '$pin_container->{id}');"
+		if $this->popup;
 	my $center_x = $x + $w/2;
 	my $center_y = $y + $h/2;
 
 	if(defined $laters)
 	{
 		push @$laters, sub ($popup_container) { $this->render_popup($popup_container,
-				$pin_container->{transform}, $center_x, $center_y); };
+				$pin_container->{transform}, $center_x, $center_y); }
+			if $this->popup;
 	}
 	return $group;
 }

HexGrid/Region.pm

@@ -12,11 +12,11 @@ use feature "signatures";
 no warnings "experimental::signatures";
 
 has tiles => (is => 'rw', default => sub { {} });
-has subregions => (is => 'rw', default => sub { {} });
 has name => (is => 'rw', required => 1);
 has defaults => (is => 'rw', default => sub { {} });
 has id_suffix => (is => 'rw', default => '_region');
 
+# New region with same properties, but doesn't import tiles
 sub clone($this)
 {
 	return HexGrid::Region->new
@@ -35,13 +35,6 @@ sub make_tile_at($this, $nw, $sw, %tile_settings)
 	$this->add_tile(HexGrid::Tile::at($nw, $sw, %settings));
 }
 
-sub add_subregion($this, $region) { $this->{subregions}{$region->{name}} = $region; }
-sub make_subregion($this, $name, %defaults)
-{
-	my $tile_defaults = merge(\%defaults, $this->{defaults});
-	$this->add_subregion(HexGrid::Region->new(name => $name, defaults => $tile_defaults));
-}
-
 sub iter_tile($this, $code)
 {
 	foreach my $nw (keys %{$this->{tiles}})
@@ -71,15 +64,6 @@ sub render($this, $svg, $laters, $grid)
 			$max_y = $y_translate if $y_translate > $max_y;
 		}
 	}
-	foreach my $region (keys %{$this->{subregions}})
-	{
-		my $m = $this->{subregions}{$region}->render($svg, $laters, $grid);
-
-		$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;
-	}
 	return { min_x => $min_x,min_y => $min_y,max_x => $max_x,max_y => $max_y, group => $g };
 }
 

HexGrid/Tile.pm

@@ -63,14 +63,14 @@ sub pin($this, $pin, $dock = undef)
 	{
 		foreach my $dock (keys %$pin)
 		{
-			croak "dock $dock doesn't exist" unless grep { $_ eq $dock } keys %docks;
+			(carp("dock $dock doesn't exist") && return) unless grep { $_ eq $dock } keys %docks;
 			$this->{pins}{$dock} = $pin->{$dock};
 		}
 		return;
 	}
 	else
 	{
-		croak "bad pin type";
+		carp ("bad pin type") && return;
 	}
 }
 
@@ -78,7 +78,7 @@ sub _do_pin($this, $pin, $dock = undef)
 {
 	if($dock)
 	{
-		croak "bad dock" unless $dock =~ /^sw|se|n$/i;
+		(carp("bad dock") && retrun) unless $dock =~ /^sw|se|n$/i;
 		$this->{pins}{$dock} = $pin;
 	}
 	else
@@ -94,7 +94,7 @@ sub _do_pin($this, $pin, $dock = undef)
 				last DOCK;
 			}
 		}
-		croak "no free dock" unless $success;
+		(carp("no free dock") && return) unless $success;
 	}
 }
 

MWTemplate.pm

@@ -9,9 +9,7 @@ my $DEBUG = 1;
 
 sub Parse($input, $template_name)
 {
-	# say STDERR "Looking for $template_name in:";
+	my ($contents) = $input =~ /\{\{ \s* $template_name \s* \| (.*?) \}\}/sx;
-	# say STDERR $input;
-	my ($contents) = $input =~ /\{\{ \s* $template_name \s* \| (.*) \}\}/sx;
 	return 0 unless $contents;
 	my @params = split /\|/, $contents;
 	my @positional_params;

wiki-map.pl

@@ -376,7 +376,8 @@ foreach my $site_page_ref (values %{$site_query_results->{query}{pages}})
 		id => HexGrid::to_id($site_name),
 		icon => HexGrid::to_id($parsed_template->{named_params}{icon}),
 		link => $site_url,
-		description => $parsed_template->{named_params}{abstract}
+		description => $parsed_template->{named_params}{abstract},
+		popup => $html_document
 	);
 	$tile->pin($pin);
 }
@@ -418,7 +419,7 @@ if($regiondir)
 	{
 		say STDERR "Rendering Location $location_name\'s grid";
 		open (my $location_fh, "> $location_name.$extension")
-			or croak "Couldn't open $location_name.extension for writing: $!";
+			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;
 	}