main
Daniel Asher Resnick 11 months ago
parent 54e4708484
commit b7674c1a47
  1. 20
      HexGrid.pm
  2. 4
      HexGrid/Region.pm
  3. 21
      HexGrid/Tile.pm
  4. 40
      wiki-map.pl

@ -32,6 +32,7 @@ has popup_class => (is => 'rw', default => 'pin-popup');
has hidden_popups => (is => 'rw', default => 1, alias => 'popups_are_hidden'); has hidden_popups => (is => 'rw', default => 1, alias => 'popups_are_hidden');
has embed_images => (is => 'rw', default => 1); has embed_images => (is => 'rw', default => 1);
# Equilateral hexagon math
sub tile_width($this) { 2 * $this->{sideLength} } sub tile_width($this) { 2 * $this->{sideLength} }
sub tile_height($this) { sqrt(3) * $this->{sideLength} } sub tile_height($this) { sqrt(3) * $this->{sideLength} }
@ -71,6 +72,7 @@ sub make_path_from($this, $id, $tile_coords, %rest)
return $path; return $path;
} }
# Adds an image to the HexGrid's cache, to be referenced elsewhere (e.g. tile background, pin icons)
sub add_image($this, $name, $source) sub add_image($this, $name, $source)
{ {
# Height/width of the image within the symbol doesn't matter # Height/width of the image within the symbol doesn't matter
@ -87,7 +89,7 @@ sub add_image($this, $name, $source)
sub get_tile_at($this, $nw, $sw) sub get_tile_at($this, $nw, $sw)
{ {
foreach my $region (keys $this->{regions}->%*) foreach my $region (keys %{$this->{regions}})
{ {
return $this->{regions}{$region}{tiles}{$nw}{$sw} if exists $this->{regions}{$region}{tiles}{$nw}{$sw}; return $this->{regions}{$region}{tiles}{$nw}{$sw} if exists $this->{regions}{$region}{tiles}{$nw}{$sw};
} }
@ -95,7 +97,7 @@ sub get_tile_at($this, $nw, $sw)
} }
sub get_tile_and_region_at($this, $nw, $sw) sub get_tile_and_region_at($this, $nw, $sw)
{ {
foreach my $region (values $this->{regions}->%*) foreach my $region (values %{$this->{regions}})
{ {
return ($region->{tiles}{$nw}{$sw}, $region) if exists $region->{tiles}{$nw}{$sw}; return ($region->{tiles}{$nw}{$sw}, $region) if exists $region->{tiles}{$nw}{$sw};
} }
@ -119,7 +121,6 @@ sub subgrid_for_regions($this, @region_names)
embed_images => $this->{embed_images} embed_images => $this->{embed_images}
); );
$subgrid->add_region($this->{regions}{$_}) for @region_names; $subgrid->add_region($this->{regions}{$_}) for @region_names;
# say STDERR Dumper($this->{paths});
foreach my $path (values %{$this->paths}) foreach my $path (values %{$this->paths})
{ {
foreach my $splinter ($path->splinter($subgrid)) foreach my $splinter ($path->splinter($subgrid))
@ -127,7 +128,6 @@ sub subgrid_for_regions($this, @region_names)
$subgrid->add_path($splinter); $subgrid->add_path($splinter);
} }
} }
say STDERR Dumper($subgrid->paths) if $DEBUG;
return $subgrid; return $subgrid;
} }
@ -171,7 +171,6 @@ sub subgrid_for_tiles($this, @coords_list)
$subgrid->add_path($splinter); $subgrid->add_path($splinter);
} }
} }
say STDERR Dumper($subgrid->paths) if $DEBUG;
return $subgrid; return $subgrid;
} }
@ -210,9 +209,12 @@ sub render($this)
$image->render($symbol); $image->render($symbol);
} }
# Continuations to be performed after other renders have finished
# Registered by subcomponents' render methods
my $laters = []; my $laters = [];
foreach my $region (keys %{$this->{regions}}) 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, $laters, $this);
$min_x = $m->{min_x} if $m->{min_x} < $min_x; $min_x = $m->{min_x} if $m->{min_x} < $min_x;
@ -228,6 +230,7 @@ sub render($this)
{ {
$later->($svg); $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 $width = $max_x - $min_x + $this->tile_width;
my $height = $max_y - $min_y + $this->tile_height; my $height = $max_y - $min_y + $this->tile_height;
$svg->{-docref}{-document}{viewBox} = "$min_x $min_y $width $height"; $svg->{-docref}{-document}{viewBox} = "$min_x $min_y $width $height";
@ -285,12 +288,17 @@ sub coords_of_edge($this, $nw, $sw, $dir)
$x_translate = $this->tile_width / 2; $x_translate = $this->tile_width / 2;
$y_translate = 0; $y_translate = 0;
} }
else
{
carp("Bad direction: $dir");
return;
}
my ($x_root, $y_root) = $this->translate_coords($nw, $sw); my ($x_root, $y_root) = $this->translate_coords($nw, $sw);
return ($x_root + $x_translate, $y_root + $y_translate); return ($x_root + $x_translate, $y_root + $y_translate);
} }
sub to_id($string) { $string =~ s/\W/-/g && return $string; } sub to_id($string) { $string =~ s/\W/-/g; return $string; }
sub DEBUG { $DEBUG = 1; } sub DEBUG { $DEBUG = 1; }
1; 1;

@ -27,12 +27,12 @@ sub clone($this)
); );
} }
sub add_tile($this, $tile) { $this->{tiles}{$tile->{nw}}{$tile->{sw}} = $tile; } sub add_tile($this, $tile) { return $this->{tiles}{$tile->{nw}}{$tile->{sw}} = $tile; }
sub make_tile_at($this, $nw, $sw, %tile_settings) sub make_tile_at($this, $nw, $sw, %tile_settings)
{ {
my %settings = %{merge(\%tile_settings, $this->{defaults})}; my %settings = %{merge(\%tile_settings, $this->{defaults})};
$settings{css_class} = HexGrid::to_id($this->{name}); $settings{css_class} = HexGrid::to_id($this->{name});
$this->add_tile(HexGrid::Tile::at($nw, $sw, %settings)); return $this->add_tile(HexGrid::Tile::at($nw, $sw, %settings));
} }
sub iter_tile($this, $code) sub iter_tile($this, $code)

@ -24,21 +24,26 @@ has coords_colour => (is => 'rw', default => 'white');
has css_class => (is => 'rw'); has css_class => (is => 'rw');
has id_suffix => (is => 'rw', default => '_tile'); has id_suffix => (is => 'rw', default => '_tile');
my %docks = ( #values are fractions of the height/width my %docks = #values are fractions of the height/width
(
sw => { order => 1, x => 0, y => 0.5, w => 0.5, h => 0.5 }, sw => { order => 1, x => 0, y => 0.5, w => 0.5, h => 0.5 },
se => { order => 2, x => 0.5, y => 0.5, w => 0.5, h => 0.5 }, se => { order => 2, x => 0.5, y => 0.5, w => 0.5, h => 0.5 },
n => { order => 3, x => 0.25, y => 0, w => 0.5, h => 0.5 }, n => { order => 3, x => 0.25, y => 0, w => 0.5, h => 0.5 },
); );
# By default makes all pin docks exist but unfilled
has pins => (is => 'rw', default => sub { +{ map {$_ => undef} keys %docks } }); has pins => (is => 'rw', default => sub { +{ map {$_ => undef} keys %docks } });
# Class # Class
# Convenience factory method
sub at($nw,$sw,@rest) sub at($nw,$sw,@rest)
{ {
return HexGrid::Tile->new(nw => $nw, sw => $sw, @rest); return HexGrid::Tile->new(nw => $nw, sw => $sw, @rest);
} }
# Returns the sequence of points making up an equilateral hexagon inscribed in a $w x $h rectangle
sub hex_path($w, $h) sub hex_path($w, $h)
{ {
# More readable for me at least as a sequence of points than as two sequences # More readable for me at least as a sequence of points than as two sequences
@ -78,15 +83,15 @@ sub _do_pin($this, $pin, $dock = undef)
{ {
if($dock) if($dock)
{ {
(carp("bad dock") && retrun) unless $dock =~ /^sw|se|n$/i; (carp("bad dock") && return) unless $dock =~ /^sw|se|n$/i;
$this->{pins}{$dock} = $pin; $this->{pins}{$dock} = $pin;
} }
else else
{ {
# If no dock was specified, find the first available according to the order above
my $success = 0; my $success = 0;
DOCK: foreach my $dock (sort { $docks{$a}->{order} <=> $docks{$b}->{order} } (keys %docks)) DOCK: foreach my $dock (sort { $docks{$a}->{order} <=> $docks{$b}->{order} } (keys %docks))
{ {
# say STDERR Dumper($dock);
unless(defined $this->{pins}{$dock}) unless(defined $this->{pins}{$dock})
{ {
$this->{pins}{$dock} = $pin; $this->{pins}{$dock} = $pin;
@ -100,12 +105,13 @@ sub _do_pin($this, $pin, $dock = undef)
sub render($this, $container, $width, $height, $laters = undef) sub render($this, $container, $width, $height, $laters = undef)
{ {
my $g = $container->g( my $g = $container->g
(
id => HexGrid::to_id("$this->{nw}_$this->{sw}$this->{id_suffix}"), id => HexGrid::to_id("$this->{nw}_$this->{sw}$this->{id_suffix}"),
); );
# $g->{onclick} = "say('($this->{nw},$this->{sw})')";
my $hex = $g->polygon(points => hex_path($width, $height), my $hex = $g->polygon(points => hex_path($width, $height),
id => "$this->{nw}_$this->{sw}_inner_hex", style => $this->style); 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 $clipPath = $g->clipPath(id => "$this->{nw}_$this->{sw}_clip");
$clipPath->use(href => "#$hex->{id}"); $clipPath->use(href => "#$hex->{id}");
@ -115,9 +121,11 @@ sub render($this, $container, $width, $height, $laters = undef)
} }
if(defined($this->{images})) if(defined($this->{images}))
{ {
# This allows for the image/images property to be single- or multi-valued
$this->{images} = [$this->{images}] if ref($this->{images}) ne 'ARRAY'; $this->{images} = [$this->{images}] if ref($this->{images}) ne 'ARRAY';
foreach my $image ($this->{images}->@*) foreach my $image (@{$this->{images}})
{ {
# 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", my $use_element = $g->use(id => "$this->{nw}_$this->{sw}_${image}_use",
href => "#${image}_symbol", width => $width, height => $height, href => "#${image}_symbol", width => $width, height => $height,
"clip-path" => "url(#$clipPath->{id})"); "clip-path" => "url(#$clipPath->{id})");
@ -127,6 +135,7 @@ sub render($this, $container, $width, $height, $laters = undef)
if(defined($this->{opacity})) { $hex->{'fill-opacity'} = $this->{opacity}; } if(defined($this->{opacity})) { $hex->{'fill-opacity'} = $this->{opacity}; }
if($this->{show_coords}) if($this->{show_coords})
{ {
#TODO: Should probably parametrize these numbers, particularly font-size
my $text = $g->text(x => "@{[0.1 * $width]}", y => "@{[0.6 * $height]}", class => 'coords'); my $text = $g->text(x => "@{[0.1 * $width]}", y => "@{[0.6 * $height]}", class => 'coords');
$text->{'font-size'} = '3em'; $text->{'font-size'} = '3em';
$text->{fill} = $this->{coords_colour}; $text->{fill} = $this->{coords_colour};

@ -43,6 +43,7 @@ GetOptions
'subregion-template-name=s' => \$subregion_template_name, 'subregion-template-name=s' => \$subregion_template_name,
'location-template-name=s' => \$location_template_name, 'location-template-name=s' => \$location_template_name,
'site-template-name=s' => \$site_template_name, 'site-template-name=s' => \$site_template_name,
'path-template-name=s' => \$path_template_name,
'border-width|bw=f' => \$border_width, 'border-width|bw=f' => \$border_width,
'border-colour|border-color|bc=s' => \$border_colour, 'border-colour|border-color|bc=s' => \$border_colour,
@ -62,6 +63,7 @@ my $grid = HexGrid->new(embed_images => $embed_images, defaults => {
style => { 'stroke-width' => $border_width, stroke => $border_colour }, style => { 'stroke-width' => $border_width, stroke => $border_colour },
show_coords => $show_coords}); show_coords => $show_coords});
# Used in producing region subgrids, maps each subregion to its parent region
my %regions_by_subregion; my %regions_by_subregion;
my %images_for_region_grids; my %images_for_region_grids;
my %location_grids; my %location_grids;
@ -87,10 +89,10 @@ my (@tile_pages, %background_pages);
foreach my $page (values %{$region_query_results->{query}{pages}}) foreach my $page (values %{$region_query_results->{query}{pages}})
{ {
next if $page->{title} =~ /^Category:/; next if $page->{title} =~ /^Category:/;
my $region = $grid->make_region($page->{title});
my $parsed_template = MWTemplate::Parse($page->{revisions}[0]{'*'}, $region_template_name); my $parsed_template = MWTemplate::Parse($page->{revisions}[0]{'*'}, $region_template_name);
next unless $parsed_template; next unless $parsed_template;
say STDERR "Processing region: $page->{title}"; say STDERR "Processing region: $page->{title}";
my $region = $grid->make_region($page->{title});
$region->{defaults}{colour} = $parsed_template->{named_params}{colour}; $region->{defaults}{colour} = $parsed_template->{named_params}{colour};
$region->{defaults}{coords_colour} = $parsed_template->{named_params}{coordinates_colour} $region->{defaults}{coords_colour} = $parsed_template->{named_params}{coordinates_colour}
if $parsed_template->{named_params}{coordinates_colour}; if $parsed_template->{named_params}{coordinates_colour};
@ -170,15 +172,16 @@ foreach my $page (values %{$location_query_results->{query}{pages}})
next unless $parsed_template->{positional_params}[0] =~ $coords_regex; next unless $parsed_template->{positional_params}[0] =~ $coords_regex;
my ($nw, $sw) = ($1, $2); my ($nw, $sw) = ($1, $2);
$location->make_tile_at($nw, $sw);
push @location_continuations, sub
{
# We create the tile after the location region has its image set, which happens later
$location->make_tile_at($nw, $sw);
if($regiondir) if($regiondir)
{ {
# Locations can have their own images rendered, given a list of context tiles # Locations can have their own images rendered, given a list of context tiles
# To reference these tiles, they must exist in the parent grid, # To reference these tiles, they must exist in the parent grid,
# so the remainder of the processing must happen after the region tile pages are processed # so the remainder of the processing must happen after the region tile pages are processed
push @location_continuations, sub
{
my @coords_list = ({ nw => $nw, sw => $sw}); my @coords_list = ({ nw => $nw, sw => $sw});
foreach my $coords (split /;/, $parsed_template->{named_params}{context_tiles}) foreach my $coords (split /;/, $parsed_template->{named_params}{context_tiles})
{ {
@ -202,6 +205,10 @@ foreach my $page (values %{$location_query_results->{query}{pages}})
# To minimize API calls, and since some images may be referenced by more than one region,
# all background images for all regions are put in one request.
# The list of pages to get was constructed in the region, subregion, and location processing.
say STDERR "Getting Background image pages"; say STDERR "Getting Background image pages";
my $background_query_results = $mw->api({ action => 'query', my $background_query_results = $mw->api({ action => 'query',
prop => 'imageinfo', prop => 'imageinfo',
@ -215,14 +222,14 @@ foreach my $page (values %{$background_query_results->{query}{pages}})
{ {
say STDERR "Processing image: $page->{title}"; say STDERR "Processing image: $page->{title}";
$grid->add_image(HexGrid::to_id($page->{title}), $page->{imageinfo}[0]{url}); $grid->add_image(HexGrid::to_id($page->{title}), $page->{imageinfo}[0]{url});
# For every region which declared this image its background
foreach my $subregion (@{$background_pages{$page->{title}}}) foreach my $subregion (@{$background_pages{$page->{title}}})
{ {
$subregion->{defaults}{image} = HexGrid::to_id($page->{title}); $subregion->{defaults}{image} = HexGrid::to_id($page->{title});
if($regiondir) if($regiondir)
{ {
# If we make subgrids for the regions, we'll need to add this image to the region's subgrid
my $region_name = $regions_by_subregion{$subregion->{name}}; 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}}, push @{$images_for_region_grids{$region_name}},
{ {
name => HexGrid::to_id($page->{title}), name => HexGrid::to_id($page->{title}),
@ -234,6 +241,9 @@ foreach my $page (values %{$background_query_results->{query}{pages}})
} }
# As above, 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"; say STDERR "Getting Tile pages";
my $tile_query_results = $mw->api my $tile_query_results = $mw->api
@ -284,7 +294,6 @@ foreach my $path_page_ref (values %{$path_query_results->{query}{pages}})
say STDERR "Processing Path $path_name"; say STDERR "Processing Path $path_name";
my $path_url = $path_page_ref->{canonicalurl};
my $path_content = $path_page_ref->{revisions}[0]{'*'}; my $path_content = $path_page_ref->{revisions}[0]{'*'};
my $parsed_template = MWTemplate::Parse($path_content, $path_template_name); my $parsed_template = MWTemplate::Parse($path_content, $path_template_name);
next unless $parsed_template; next unless $parsed_template;
@ -327,10 +336,8 @@ foreach my $page (values %{$path_tile_query_results->{query}{pages}})
my $path = $grid->make_path_from($path_spec{id}, \@path_coords, css_class => 'path', my $path = $grid->make_path_from($path_spec{id}, \@path_coords, css_class => 'path',
colour => $path_spec{colour}, colour => $path_spec{colour},
style => { 'stroke-width' => $path_spec{stroke_width} // $default_path_stroke_width }); style => { 'stroke-width' => $path_spec{stroke_width} // $default_path_stroke_width });
$path->{starts_from} = $HexGrid::DIR{$path_spec{starts_from}} $path->{starts_from} = $HexGrid::DIR{$path_spec{starts_from}} if $path_spec{starts_from};
if $path_spec{starts_from}; $path->{ends_to} = $HexGrid::DIR{$path_spec{ends_to}} if $path_spec{ends_to};
$path->{ends_to} = $HexGrid::DIR{$path_spec{ends_to}}
if $path_spec{ends_to};
} }
@ -386,14 +393,16 @@ foreach my $site_page_ref (values %{$site_query_results->{query}{pages}})
$tile->pin($pin); $tile->pin($pin);
} }
# Render and output
open (my $fh, "> $outfile") or croak "Couldn't open $outfile for writing: $!"; open (my $fh, "> $outfile") or croak "Couldn't open $outfile for writing: $!";
say $fh ($html_document ? wrap_in_html($grid) : $grid->render); say $fh ($html_document ? wrap_in_html($grid) : $grid->render);
close $fh; close $fh;
if($regiondir) if($regiondir)
{ {
chdir $regiondir || croak "Couldn't chdir to $regiondir: $!"; chdir $regiondir || croak "Couldn't chdir to $regiondir: $!";
my $extension = $html_document ? 'html' : 'svg'; my $extension = $html_document ? 'html' : 'svg';
my %region_grid_listings; my %region_grid_listings; # Maps a region name to the list of its subregions (including itself)
while(my ($subregion, $region) = each %regions_by_subregion) while(my ($subregion, $region) = each %regions_by_subregion)
{ {
push @{$region_grid_listings{$region}}, $subregion; push @{$region_grid_listings{$region}}, $subregion;
@ -401,14 +410,11 @@ if($regiondir)
while(my ($region, $subregions) = each %region_grid_listings) while(my ($region, $subregions) = each %region_grid_listings)
{ {
my $region_grid = $grid->subgrid_for_regions(@$subregions); my $region_grid = $grid->subgrid_for_regions(@$subregions);
# say STDERR Dumper($images_for_region_grids{$region});
if(exists $images_for_region_grids{$region}) if(exists $images_for_region_grids{$region})
{ {
foreach my $image (@{$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->{images}{$image->{name}} = $grid->{images}{$image->{name}};
# $region_grid->add_image($image->{name}, $image->{source});
} }
} }
@ -418,7 +424,7 @@ if($regiondir)
say $region_fh ($html_document ? wrap_in_html($region_grid) : $region_grid->render); say $region_fh ($html_document ? wrap_in_html($region_grid) : $region_grid->render);
close $region_fh; close $region_fh;
} }
# Location grids need to import images # TODO: Location grids need to import images
while(my ($location_name, $location_grid) = each %location_grids) while(my ($location_name, $location_grid) = each %location_grids)
{ {
say STDERR "Rendering Location $location_name\'s grid"; say STDERR "Rendering Location $location_name\'s grid";
@ -430,6 +436,8 @@ if($regiondir)
} }
# Puts the rendered SVG inside an html document,
# along with a bit of javascript to show popups for sites and to toggle coordinates visibility
sub wrap_in_html($grid) sub wrap_in_html($grid)
{ {
my $html_builder = "<!DOCTYPE html>"; my $html_builder = "<!DOCTYPE html>";

Loading…
Cancel
Save