You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
399 lines
13 KiB
399 lines
13 KiB
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*(\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;
|
|
my %bounds =
|
|
(
|
|
nw_min => "Inf",
|
|
nw_max => "-Inf",
|
|
sw_min => "Inf",
|
|
sw_max => "-Inf"
|
|
);
|
|
|
|
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};
|
|
}
|
|
|
|
|
|
# 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};
|
|
|
|
foreach my $page (values %{$path_tile_query_results->{query}{pages}})
|
|
{
|
|
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 ("$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)
|
|
{
|
|
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 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++)
|
|
{
|
|
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 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 = "";
|
|
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;
|
|
}
|
|
|