Coord trippler MVP

HexGrid.pm

@@ -31,6 +31,7 @@ has make_popups => (is => 'rw', default => 1, alias => 'popups');
 has popup_class => (is => 'rw', default => 'popup');
 has hidden_popups => (is => 'rw', default => 1, alias => 'popups_are_hidden');
 has embed_images => (is => 'rw', default => 1);
+has path_class => (is => 'rw', default => 'path');
 
 # Equilateral hexagon math
 sub tile_width($this) { 2 * $this->{sideLength} }
@@ -118,7 +119,8 @@ sub subgrid_for_regions($this, @region_names)
 		make_popups => $this->{make_popups},
 		popup_class => $this->{popup_class},
 		hidden_popups => $this->{hidden_popups},
-		embed_images => $this->{embed_images}
+		embed_images => $this->{embed_images},
+		path_class => $this->{path_class}
 	);
 	$subgrid->add_region($this->{regions}{$_}) for @region_names;
 	foreach my $path (values %{$this->paths})
@@ -142,7 +144,9 @@ sub subgrid_for_tiles($this, @coords_list)
 		make_popups => $this->{make_popups},
 		popup_class => $this->{popup_class},
 		hidden_popups => $this->{hidden_popups},
-		embed_images => $this->{embed_images}
+		embed_images => $this->{embed_images},
+		path_class => $this->{path_class}
+
 	);
 	foreach my $coords (@coords_list)
 	{
@@ -193,7 +197,8 @@ sub render($this)
 	my $svg = SVG->new();
 	my $root_style = $svg->style();
 	my $style_text = "";
-	$style_text .= ".$this->{popup_class} { visibility: hidden; }" if $this->{hidden_popups};
+	$style_text .= ".$this->{popup_class} { visibility: hidden; }\n" if $this->{hidden_popups};
+	$style_text .= ".$this->{path_class} { pointer-events: none; }\n";
 	$root_style->cdata($style_text);
 
 	my $defs = $svg->defs();

HexGrid/Path.pm

@@ -15,7 +15,7 @@ has tiles => (is => 'rw', default => sub { [] });
 has id => (is => 'ro', required => 1);
 has style => (is => 'rw', default => sub { {} });
 has colour => (is => 'rw', alias => 'color', default => 'blue');
-has css_class => (is => 'rw');
+has css_class => (is => 'rw', default => 'path');
 has starts_from => (is => 'rw');
 has ends_to => (is => 'rw');
 
@@ -126,7 +126,7 @@ sub splinter($this, $grid)
 					return;
 				}
 				$splinters[$#splinters]{ends_to} = $ending_edge;
-					
+
 			}
 		}
 	}

coord_tripler.pl

@@ -1,13 +1,39 @@
 use v5.36;
 use rlib '.';
 
+use Getopt::Long;
 use Carp;
 use Data::Dumper;
 
+use MediaWiki::API;
+use MWTemplate;
+
 use feature "signatures";
 no warnings "experimental::signatures";
 
-my $coords_regex = qr/^\s*(-?\d+)\s*,\s*(-?\d+)\s*$/;
+my $coords_regex = qr/^\s*(\s*-?\d+\s*)\s*,\s*(\s*-?\d+\s*)\s*$/;
+
+my $api_url;
+my $region_template_name = "MapRegion";
+my $subregion_template_name = "MapSubregion";
+my $location_template_name = "MapLocation";
+my $site_template_name = "MapSite";
+my $path_template_name = "MapPath";
+
+GetOptions
+(
+	'api-url=s' => \$api_url,
+	'region-template-name=s' => \$region_template_name,
+	'subregion-template-name=s' => \$subregion_template_name,
+	'location-template-name=s' => \$location_template_name,
+	'site-template-name=s' => \$site_template_name,
+	'path-template-name=s' => \$path_template_name,
+);
+
+my $mw = MediaWiki::API->new();
+$mw->{config}->{api_url} = $api_url;
+
+$api_url // croak "Base API URL is required! Use --api-url to set";
 
 my %regions;
 my %tile_to_regions;
@@ -19,27 +45,189 @@ my %bounds =
 	sw_max => "-Inf"
 );
 
-my $input_file = shift;
-open (my $input_fh, $input_file);
+my %GRID_DIR =
+(
+	nw =>  1,
+	sw =>  2,
+	s =>   3,
+	se => -1,
+	ne => -2,
+	n =>  -3
+);
+
+my $region_query_results = $mw->api
+( {
+	action => 'query',
+	generator => 'categorymembers',
+	gcmtitle => 'Category:Regions',
+	gcmlimit => 'max',
+	prop => 'info|revisions',
+	rvprop => 'content',
+	inprop => 'url',
+} ) || croak $mw->{error}->{code} . ': ' . $mw->{error}->{details};
+
+my (@tile_pages, %background_pages);
+foreach my $page (values %{$region_query_results->{query}{pages}})
+{
+	my $region_name = $page->{title};
+	next if $region_name =~ /^Category:/;
+	# say STDERR "Processing region: $region_name";
+	my $parsed_template = MWTemplate::Parse($page->{revisions}[0]{'*'}, $region_template_name);
+	next unless $parsed_template;
+	$regions{$region_name}{bg} = $parsed_template->{named_params}{colour};
+	push @tile_pages, "$region_name/Tiles";
+}
+
+my $subregion_query_results = $mw->api
+( {
+	action => 'query',
+	generator => 'categorymembers',
+	gcmtitle => 'Category:Subregions',
+	gcmlimit => 'max',
+	prop => 'info|revisions',
+	rvprop => 'content',
+	inprop => 'url',
+} ) || croak $mw->{error}->{code} . ': ' . $mw->{error}->{details};
+
+foreach my $page (values %{$subregion_query_results->{query}{pages}})
+{
+	my $subregion_name = $page->{title};
+	next if $subregion_name =~ /^Category:/;
+	my $parsed_template = MWTemplate::Parse($page->{revisions}[0]{'*'}, $subregion_template_name);
+	next unless $parsed_template;
+	$regions{$subregion_name}{bg} = $parsed_template->{named_params}{colour};
+	# say STDERR "Processing subregion: $subregion_name";
+	push @tile_pages, "$subregion_name/Tiles";
+}
+
+# Get all tile pages in one request.
+# By doing so, we lose context as to which page corresponds to which region,
+# so we extract it from the title of the page.
+
+# say STDERR "Getting Tile pages";
+my $tile_query_results = $mw->api
+( {
+	action => 'query',
+	titles => join('|', @tile_pages),
+	prop => 'revisions',
+	rvprop => 'content',
+} ) || croak $mw->{error}->{code} . ': ' . $mw->{error}->{details};
+
+foreach my $page (values %{$tile_query_results->{query}{pages}})
+{
+	my $content = $page->{revisions}[0]{'*'};
+	my ($region_name) = $page->{title} =~ /(.*)\/Tiles/;
+	# say STDERR "Processing tiles for: $region_name";
+	expand_coords(\%regions, \%tile_to_regions, $region_name, \%bounds, split ';', $content);
+}
+
+# say STDERR "Getting Location pages";
+my $location_query_results = $mw->api
+( {
+	action => 'query',
+	generator => 'categorymembers',
+	gcmtitle => 'Category:Locations',
+	gcmlimit => 'max',
+	prop => 'info|revisions',
+	rvprop => 'content',
+	inprop => 'url',
+} ) || croak $mw->{error}->{code} . ': ' . $mw->{error}->{details};
+
+foreach my $page (values %{$location_query_results->{query}{pages}})
+{
+	my $location_name = $page->{title};
+	next if $location_name =~ /^Category:/;
+	my $parsed_template = MWTemplate::Parse($page->{revisions}[0]{'*'}, $location_template_name);
+	next unless $parsed_template;
+	next unless $parsed_template->{positional_params}[0] =~ $coords_regex;
+	my ($nw, $sw) = ($1, $2);
+
+	# say STDERR "Processing location: $location_name";
+
+	$regions{$location_name}{bg} = $parsed_template->{named_params}{colour};
+	my $region_name = $parsed_template->{positional_params}[1];
+	add_location(\%regions, \%tile_to_regions, $location_name, $region_name, \%bounds, $nw, $sw);
+}
+
+my (%path_specs);
+# say STDERR "Getting Path pages";
+my $path_query_results = $mw->api
+( {
+	action => 'query',
+	generator => 'categorymembers',
+	prop => 'info|revisions',
+	gcmtitle => 'Category:Paths',
+	gcmlimit => 'max',
+	rvprop => 'content',
+	inprop => 'url',
+} ) || croak $mw->{error}->{code} . ': ' . $mw->{error}->{details};
+
+foreach my $path_page_ref (values %{$path_query_results->{query}{pages}})
+{
+	next if $path_page_ref->{title} =~ /^Category:/;
+	my $path_name = $path_page_ref->{title};
+
+	# say STDERR "Processing Path $path_name";
+
+	my $path_content = $path_page_ref->{revisions}[0]{'*'};
+	my $parsed_template = MWTemplate::Parse($path_content, $path_template_name);
+	next unless $parsed_template;
+
+	$path_specs{$path_name} =
+	{
+		tile_page => "$path_name/Tiles",
+		colour => $parsed_template->{named_params}{colour},
+	};
+	$path_specs{$path_name}{starts_from} = $parsed_template->{named_params}{starts_from}
+		if $parsed_template->{named_params}{starts_from};
+	$path_specs{$path_name}{ends_to} = $parsed_template->{named_params}{ends_to}
+		if $parsed_template->{named_params}{ends_to};
+}
+
 
-my $output_file = shift // "$input_file.out";
-open (my $output_fh, ">$output_file");
+# say STDERR "Getting Path Tile pages";
+my $path_tile_query_results = $mw->api
+( {
+	action => 'query',
+	titles => join('|', map { $_->{tile_page} } values %path_specs),
+	prop => 'revisions',
+	rvprop => 'content',
+} ) || croak $mw->{error}->{code} . ': ' . $mw->{error}->{details};
 
-$regions{holes}{bg} = '#000000';
-while (my $line = <$input_fh>)
+foreach my $page (values %{$path_tile_query_results->{query}{pages}})
 {
-	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);
+	my $content = $page->{revisions}[0]{'*'};
+	my ($path_name) = $page->{title} =~ /(.*)\/Tiles/;
+	# say STDERR "Processing tiles for: $path_name";
+	my @path_coords;
+	foreach my $coords (split /;/, $content)
+	{
+		do { carp "Skipping bad spec: $coords"; next; } unless $coords =~ $coords_regex;
+		push @path_coords, [$1,$2];
+	}
+	$path_specs{$path_name}{new_coords} = [expand_path(@path_coords)];
 }
 
 fill_holes(\%regions, \%tile_to_regions, \%bounds);
+say "== Regions";
 foreach my $region (keys %regions)
 {
-	say $output_fh ("$region; $regions{$region}{bg}; " . make_output_region_line(\%regions, $region));
+	say ("$region; $regions{$region}{bg}; " . make_output_region_line(\%regions, $region));
+}
+say "== Paths";
+foreach my $path (keys %path_specs)
+{
+	my $line = "$path; " . $path_specs{$path}{colour}
+		. "; " . $path_specs{$path}{starts_from}
+		. "; " . $path_specs{$path}{ends_to};
+	foreach my $coord_pair (@{$path_specs{$path}{new_coords}})
+	{
+		$line .= "; " . (join ",", @$coord_pair);
+	}
+	say $line;
 }
 
+
 sub expand_coords($regions_hashref, $tile_to_region_hashref, $region, $bounds, @coord_list)
 {
 	foreach my $coords (@coord_list)
@@ -71,6 +259,33 @@ sub expand_coords($regions_hashref, $tile_to_region_hashref, $region, $bounds, @
 	}
 }
 
+sub add_location($regions_hashref, $tile_to_region_hashref, $location_name, $region_name, $bounds, $nw, $sw)
+{
+	my $nw_base = $nw * 3;
+	my $sw_base = $sw * 3;
+
+	push @{$regions_hashref->{$location_name}{tiles}{$nw_base}}, $sw_base;
+	push @{$regions_hashref->{$region_name}{tiles}{$nw_base+1}}, $sw_base;
+	push @{$regions_hashref->{$region_name}{tiles}{$nw_base-1}}, $sw_base;
+	push @{$regions_hashref->{$region_name}{tiles}{$nw_base}}, $sw_base+1;
+	push @{$regions_hashref->{$region_name}{tiles}{$nw_base}}, $sw_base-1;
+	push @{$regions_hashref->{$region_name}{tiles}{$nw_base+1}}, $sw_base-1;
+	push @{$regions_hashref->{$region_name}{tiles}{$nw_base-1}}, $sw_base+1;
+
+	$tile_to_region_hashref->{$nw_base}{$sw_base} = $location_name;
+	$tile_to_region_hashref->{$nw_base+1}{$sw_base} = $region_name;
+	$tile_to_region_hashref->{$nw_base-1}{$sw_base} = $region_name;
+	$tile_to_region_hashref->{$nw_base}{$sw_base+1} = $region_name;
+	$tile_to_region_hashref->{$nw_base}{$sw_base-1} = $region_name;
+	$tile_to_region_hashref->{$nw_base+1}{$sw_base-1} = $region_name;
+	$tile_to_region_hashref->{$nw_base-1}{$sw_base+1} = $region_name;
+
+	$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++)
@@ -110,6 +325,64 @@ sub fill_holes($regions_hashref, $tile_to_region_hashref, $bounds)
 	}
 }
 
+sub expand_path(@coord_list)
+{
+	my @new_coords;
+	for(my $i = 0; $i < $#coord_list; $i++)
+	{
+		push @new_coords, [$coord_list[$i][0]*3,$coord_list[$i][1]*3];
+		my $dir = get_edge_direction($coord_list[$i][0], $coord_list[$i][1], $coord_list[$i+1][0], $coord_list[$i+1][1]);
+		if($dir == $GRID_DIR{nw})
+		{
+			push @new_coords, [$coord_list[$i][0]*3+1, $coord_list[$i][1]*3];
+			push @new_coords, [$coord_list[$i][0]*3+2, $coord_list[$i][1]*3];
+		}
+		elsif($dir == $GRID_DIR{sw})
+		{
+			push @new_coords, [$coord_list[$i][0]*3, $coord_list[$i][1]*3+1];
+			push @new_coords, [$coord_list[$i][0]*3, $coord_list[$i][1]*3+2];
+		}
+		elsif($dir == $GRID_DIR{s})
+		{
+			push @new_coords, [$coord_list[$i][0]*3-1, $coord_list[$i][1]*3+1];
+			push @new_coords, [$coord_list[$i][0]*3-2, $coord_list[$i][1]*3+2];
+		}
+		elsif($dir == $GRID_DIR{se})
+		{
+			push @new_coords, [$coord_list[$i][0]*3-1, $coord_list[$i][1]*3];
+			push @new_coords, [$coord_list[$i][0]*3-2, $coord_list[$i][1]*3];
+		}
+		elsif($dir == $GRID_DIR{ne})
+		{
+			push @new_coords, [$coord_list[$i][0]*3, $coord_list[$i][1]*3-1];
+			push @new_coords, [$coord_list[$i][0]*3, $coord_list[$i][1]*3-2];
+		}
+		elsif($dir == $GRID_DIR{n})
+		{
+			push @new_coords, [$coord_list[$i][0]*3+1, $coord_list[$i][1]*3-1];
+			push @new_coords, [$coord_list[$i][0]*3+2, $coord_list[$i][1]*3-2];
+		}
+	}
+	push @new_coords, [$coord_list[$#coord_list][0]*3,$coord_list[$#coord_list][1]*3];
+	return @new_coords;
+}
+
+sub get_edge_direction($nw1, $sw1, $nw2, $sw2)
+{
+	my $nw_diff = $nw2 - $nw1;
+	my $sw_diff = $sw2 - $sw1;
+
+	return $GRID_DIR{nw} if $nw_diff ==  1 && $sw_diff ==  0;
+	return $GRID_DIR{sw} if $nw_diff ==  0 && $sw_diff ==  1;
+	return $GRID_DIR{s}  if $nw_diff == -1 && $sw_diff ==  1;
+	return $GRID_DIR{se} if $nw_diff == -1 && $sw_diff ==  0;
+	return $GRID_DIR{ne} if $nw_diff ==  0 && $sw_diff == -1;
+	return $GRID_DIR{n}  if $nw_diff ==  1 && $sw_diff == -1;
+
+	carp("Tiles are not adjacent: $nw1,$sw1—$nw2,$sw2");
+	return undef;
+}
+
 sub make_output_region_line($regions_hashref, $region)
 {
 	my $line = "";
@@ -124,6 +397,3 @@ sub make_output_region_line($regions_hashref, $region)
 	chop($line);
 	return $line;
 }
-
-close $input_fh;
-close $output_fh;

grid-tester.pl

@@ -3,6 +3,7 @@ use rlib '.';
 
 use HexGrid;
 use HexGrid::Pin;
+use HexGrid::Dynamic;
 
 use Carp;
 use Data::Dumper;
@@ -17,52 +18,53 @@ my $grid = HexGrid->new(defaults => {
 		show_coords => 1});
 
 my $test_file = shift;
-open (my $test_fh, $test_file);
+open(my $test_fh, $test_file);
 
+my $mode = "";
 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)
+	if ($line =~ /== Regions/)
 	{
-		do { carp "Skipping bad spec: $coords"; next; } unless $coords =~ $coords_regex;
-		$region->make_tile_at($1,$2);
+		$mode = "Regions";
+		next;
 	}
-}
-
-# 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';
+	if ($line =~ /== Paths/)
+	{
+		$mode = "Paths";
+		next;
 	}
-</script>
-EOS
-	if(1)
+	if($mode eq "Regions")
 	{
-		$html_builder .= <<EOS;
-<script>
-	function toggleCoords(show) {
-		for (var elem of document.getElementsByClassName('coords')) {
-			elem.style.visibility = show ? 'visible' : 'hidden';
+		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);
 		}
 	}
-</script>
-	<label for="show-coords-checkbox">Show coordinates</label>
-	<input type="checkbox" checked id="show-coords-checkbox" onclick="toggleCoords(event.srcElement.checked)" />
-EOS
+	if($mode eq "Paths")
+	{
+		my @fields = split '; ', $line;
+		my $name = shift @fields;
+		my $colour = shift @fields;
+		my $starts_from = shift @fields;
+		my $ends_to = shift @fields;
+
+		my @path_coords;
+		foreach my $coords (@fields)
+		{
+			do { carp "Skipping bad spec: $coords"; next; } unless $coords =~ $coords_regex;
+			push @path_coords, [$1,$2];
+		}
+
+		my $path = $grid->make_path_from($name, \@path_coords, colour => $colour, style => { 'stroke-width' => 5 });
+		$path->{starts_from} = $HexGrid::DIR{$starts_from} if $starts_from;
+		$path->{ends_to} = $HexGrid::DIR{$ends_to} if $ends_to;
 	}
-	$html_builder .= "\n" . $grid->render;
-	$html_builder .= "\n</body>\n</html>";
-	return $html_builder;
 }
 
+say $grid->render;
+# say HexGrid::Dynamic::render_html($grid->render, {});
+close $test_fh;