From 4681cb901079d4feb072c4102fd509c43753d2e9 Mon Sep 17 00:00:00 2001 From: Daniel Asher Resnick Date: Sun, 31 Dec 2023 17:38:59 -0600 Subject: [PATCH] Introduce Path splintering Primarily for use splintering parent Grid Paths onto Subgrids. Only the sections of the Path present in the Subgrid get included. --- HexGrid.pm | 19 ++++++- HexGrid/Path.pm | 99 ++++++++++++++++++++++++++++++++--- wiki-map.pl | 136 ++++++++++++++++++++++++++---------------------- 3 files changed, 183 insertions(+), 71 deletions(-) diff --git a/HexGrid.pm b/HexGrid.pm index fde185c..5fc5e03 100644 --- a/HexGrid.pm +++ b/HexGrid.pm @@ -68,6 +68,7 @@ sub make_path_from($this, $id, $tile_coords, %rest) push @{$path->tiles}, $this->get_tile_at($pair->[0], $pair->[1]); } $this->add_path($path); + return $path; } sub add_image($this, $name, $source) @@ -118,7 +119,15 @@ sub subgrid_for_regions($this, @region_names) embed_images => $this->{embed_images} ); $subgrid->add_region($this->{regions}{$_}) for @region_names; - say STDERR Dumper($subgrid) if $DEBUG; + # say STDERR Dumper($this->{paths}); + foreach my $path (values %{$this->paths}) + { + foreach my $splinter ($path->splinter($subgrid)) + { + $subgrid->add_path($splinter); + } + } + say STDERR Dumper($subgrid->paths) if $DEBUG; return $subgrid; } @@ -155,6 +164,14 @@ sub subgrid_for_tiles($this, @coords_list) } $subgrid->{regions}{$region->{name}}->add_tile($tile); } + foreach my $path (values %{$this->paths}) + { + foreach my $splinter ($path->splinter($subgrid)) + { + $subgrid->add_path($splinter); + } + } + say STDERR Dumper($subgrid->paths) if $DEBUG; return $subgrid; } diff --git a/HexGrid/Path.pm b/HexGrid/Path.pm index e2e02e7..5203dd5 100644 --- a/HexGrid/Path.pm +++ b/HexGrid/Path.pm @@ -34,7 +34,10 @@ 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: should die here, to be caught/bubbled in render... + #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) @@ -45,15 +48,97 @@ sub curve_to($qx, $qy, $x, $y) # Instance +sub clone_settings($this) +{ + return HexGrid::Path->new + ( + id => $this->id, + style => $this->style, + colour => $this->colour, + css_class => $this->css_class, + ); +} + +sub splinter($this, $grid) +{ + + my @splinters; + my $in_splinter = 0; + + # If the base path sources at an edge, and the first tile is present, + # the first splinter must source at the same edge + # (the splinter implicitly exists since the first tile is present) + if($this->starts_from && $grid->get_tile_at($this->{tiles}[0]{nw}, $this->{tiles}[0]{sw})) + { + $in_splinter = 1; + my $splinter = $this->clone_settings; + $splinter->{id} .= "-0"; + $splinter->{starts_from} = $this->starts_from; + push @splinters, $splinter; + } + for(my $i = 0; $i <= $#{$this->tiles}; $i++) + { + unless($in_splinter) + { + unless ($grid->get_tile_at($this->{tiles}[$i]{nw}, $this->{tiles}[$i]{sw})) + { + # Not in a splinter and tile not present, skip + next; + } + else + { + # Not in a splinter but tile present, start a new splinter, + # with source where previous tile would be + $in_splinter = 1; + my $splinter = $this->clone_settings; + # Don't set source on first tile + if($i >= 1) + { + $splinter->{starts_from} = get_edge_direction($this->{tiles}[$i], $this->{tiles}[$i-1]); + } + push @{$splinter->tiles}, $this->{tiles}[$i]; + push @splinters, $splinter; + $splinter->{id} .= "-$#splinters"; + } + } + else + { + if($grid->get_tile_at($this->{tiles}[$i]{nw}, $this->{tiles}[$i]{sw})) + { + # In a splinter and tile present, just extend current splinter with current tile + push @{$splinters[$#splinters]{tiles}}, $this->{tiles}[$i]; + } + else + { + # In a splinter but tile not present, set previous tile sink to this missing tile + $in_splinter = 0; + $splinters[$#splinters]{ends_to} = + get_edge_direction($this->{tiles}[$i-1], $this->{tiles}[$i]); + } + } + } + # If the base path sinks at an edge and the last tile is present, + # the last splinter must sink at the same edge. + # (the splinter implicitly exists since the last tile is present) + my $last_tile = $this->{tiles}[$#{$this->tiles}]; + if($this->ends_to && $grid->get_tile_at($last_tile->{nw}, $last_tile->{sw})) + { + $splinters[$#splinters]{ends_to} = $this->ends_to; + } + + return @splinters; +} + sub render($this, $grid, $svg) { return unless @{$this->tiles}; my $g = $svg->g(id => $this->id, class => $this->css_class); - my $current_tile = shift @{$this->tiles}; + my @tiles = @{$this->tiles}; + my $current_tile = shift @tiles; # Single tile - unless (@{$this->tiles}) + unless (@tiles) { my ($cx, $cy) = $grid->coords_of_centre($current_tile->nw, $current_tile->sw); if($this->starts_from) @@ -63,7 +148,7 @@ sub render($this, $grid, $svg) { my ($x2, $y2) = $grid->coords_of_edge($current_tile->nw, $current_tile->sw, $this->ends_to); # Curve from starts_from to ends_to with the centre as control point - $g->path(d => "M $x1,$y1 Q $cx,$cy $x2,$y2", + $g->path(d => "M $x1,$y1 Q $cx,$cy $x2,$y2", fill => 'transparent', stroke => $this->colour, style => $this->style, class => $this->css_class); } else @@ -95,7 +180,7 @@ sub render($this, $grid, $svg) my ($x0, $x, $y0, $y); my $path_spec; my $previous_tile = $current_tile; - $current_tile = shift @{$this->tiles}; + $current_tile = shift @tiles; my $next_edge = get_edge_direction($previous_tile, $current_tile); ($x, $y) = $grid->coords_of_edge($previous_tile->nw, $previous_tile->sw, $next_edge); if($this->starts_from) @@ -113,9 +198,9 @@ sub render($this, $grid, $svg) my $previous_edge; # not defined yet my $next_tile; # not defined yet - while(@{$this->tiles}) + while (@tiles) { - $next_tile = shift @{$this->tiles}; + $next_tile = shift @tiles; $previous_edge = -$next_edge; $next_edge = get_edge_direction($current_tile, $next_tile); diff --git a/wiki-map.pl b/wiki-map.pl index ac85ab9..ed04f0f 100644 --- a/wiki-map.pl +++ b/wiki-map.pl @@ -54,6 +54,8 @@ GetOptions 'regiondir=s' => \$regiondir ); +# HexGrid::DEBUG(); + $api_url // croak "Base API URL is required! Use --api-url to set"; my $grid = HexGrid->new(embed_images => $embed_images, defaults => { @@ -203,7 +205,6 @@ 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}) @@ -252,64 +253,6 @@ foreach my $page (values %{$tile_query_results->{query}{pages}}) } } - - -say STDERR "Continuing Location processing"; -$_->() for @location_continuations; - - - -say STDERR "Getting Site pages"; -my $site_query_results = $mw->api -( { - action => 'query', - generator => 'categorymembers', - prop => 'info|revisions', - gcmtitle => 'Category:Sites', - gcmlimit => 'max', - rvprop => 'content', - inprop => 'url', -} ) || croak $mw->{error}->{code} . ': ' . $mw->{error}->{details}; - -foreach my $site_page_ref (values %{$site_query_results->{query}{pages}}) -{ - next if $site_page_ref->{title} =~ /^Category:/; - my $site_name = $site_page_ref->{title}; - - say STDERR "Processing Site $site_name"; - - my $site_url = $site_page_ref->{canonicalurl}; - my $site_content = $site_page_ref->{revisions}[0]{'*'}; - my $parsed_template = MWTemplate::Parse($site_content, $site_template_name); - next unless $parsed_template; - my ($nw,$sw) = split /,/, $parsed_template->{named_params}{coords}; - my $tile = $grid->get_tile_at($nw, $sw); - unless($tile) - { - carp "Coordinates of Site $site_name do not appear in the grid, skipping."; - next; - } - - my $imageinfo_query_results = $mw->api({ action => 'query', - prop => 'imageinfo', - titles => "File:$parsed_template->{named_params}{icon}", - iiprop => 'url' - }) || 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 => HexGrid::to_id($site_name), - icon => HexGrid::to_id($parsed_template->{named_params}{icon}), - link => $site_url, - description => $parsed_template->{named_params}{abstract} - ); - $tile->pin($pin); -} - my (%path_specs); say STDERR "Getting Path pages"; my $path_query_results = $mw->api @@ -337,16 +280,18 @@ foreach my $path_page_ref (values %{$path_query_results->{query}{pages}}) $path_specs{$path_name} = { - id => "$path_name-path", + id => HexGrid::to_id($path_name) . "-path", tile_page => "$path_name/Tiles", colour => $parsed_template->{named_params}{colour}, stroke_width => $parsed_template->{named_params}{stroke_width} }; + $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 ( { @@ -368,11 +313,74 @@ foreach my $page (values %{$path_tile_query_results->{query}{pages}}) do { carp "Skipping bad spec: $coords"; next; } unless $coords =~ $coords_regex; push @path_coords, [$1,$2]; } - $grid->make_path_from($path_spec{id}, \@path_coords, css_class => 'path', colour => $path_spec{colour}, + my $path = $grid->make_path_from($path_spec{id}, \@path_coords, css_class => 'path', + colour => $path_spec{colour}, style => { 'stroke-width' => $path_spec{stroke_width} // $default_path_stroke_width }); + $path->{starts_from} = $HexGrid::DIR{$path_spec{starts_from}} + if $path_spec{starts_from}; + $path->{ends_to} = $HexGrid::DIR{$path_spec{ends_to}} + if $path_spec{ends_to}; } + + +say STDERR "Continuing Location processing"; +$_->() for @location_continuations; + + + +say STDERR "Getting Site pages"; +my $site_query_results = $mw->api +( { + action => 'query', + generator => 'categorymembers', + prop => 'info|revisions', + gcmtitle => 'Category:Sites', + gcmlimit => 'max', + rvprop => 'content', + inprop => 'url', +} ) || croak $mw->{error}->{code} . ': ' . $mw->{error}->{details}; + +foreach my $site_page_ref (values %{$site_query_results->{query}{pages}}) +{ + next if $site_page_ref->{title} =~ /^Category:/; + my $site_name = $site_page_ref->{title}; + + say STDERR "Processing Site $site_name"; + + my $site_url = $site_page_ref->{canonicalurl}; + my $site_content = $site_page_ref->{revisions}[0]{'*'}; + my $parsed_template = MWTemplate::Parse($site_content, $site_template_name); + next unless $parsed_template; + my ($nw,$sw) = split /,/, $parsed_template->{named_params}{coords}; + my $tile = $grid->get_tile_at($nw, $sw); + unless($tile) + { + carp "Coordinates of Site $site_name do not appear in the grid, skipping."; + next; + } + + my $imageinfo_query_results = $mw->api({ action => 'query', + prop => 'imageinfo', + titles => "File:$parsed_template->{named_params}{icon}", + iiprop => 'url' + }) || 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 => HexGrid::to_id($site_name), + icon => HexGrid::to_id($parsed_template->{named_params}{icon}), + link => $site_url, + description => $parsed_template->{named_params}{abstract} + ); + $tile->pin($pin); +} + open (my $fh, "> $outfile") or croak "Couldn't open $outfile for writing: $!"; say $fh ($html_document ? wrap_in_html($grid) : $grid->render); close $fh; @@ -399,6 +407,7 @@ if($regiondir) } } + say STDERR "Rendering Region's $region grid"; 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); @@ -407,6 +416,7 @@ if($regiondir) # Location grids need to import images while(my ($location_name, $location_grid) = each %location_grids) { + say STDERR "Rendering Location's $location_name grid"; 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);