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.
 
 
wiki-map/HexGrid/Path.pm

268 lines
8.0 KiB

package HexGrid::Path;
use v5.30;
use Moo;
use MooX::Aliases;
use Carp;
use Data::Dumper;
use feature "signatures";
no warnings "experimental::signatures";
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 starts_from => (is => 'rw');
has ends_to => (is => 'rw');
# Class
my $DEFAULT_WIDTH = 5;
sub get_edge_direction($tile1, $tile2)
{
my $nw_diff = $tile2->nw - $tile1->nw;
my $sw_diff = $tile2->sw - $tile1->sw;
return $HexGrid::DIR{nw} if $nw_diff == 1 && $sw_diff == 0;
return $HexGrid::DIR{sw} if $nw_diff == 0 && $sw_diff == 1;
return $HexGrid::DIR{s} if $nw_diff == -1 && $sw_diff == 1;
return $HexGrid::DIR{se} if $nw_diff == -1 && $sw_diff == 0;
return $HexGrid::DIR{ne} if $nw_diff == 0 && $sw_diff == -1;
return $HexGrid::DIR{n} if $nw_diff == 1 && $sw_diff == -1;
carp("Tiles are not adjacent: " . $tile1->nw . "," . $tile1->sw . "—"
. $tile2->nw . "," . $tile2->sw);
return undef;
}
# Instance
sub clone_settings($this)
{
return HexGrid::Path->new
(
id => $this->id,
style => $this->style,
colour => $this->colour,
css_class => $this->css_class,
);
}
# 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;
# 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;
}
# 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)
{
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)
{
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;
$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, end splinter
# and set previous tile sink to this missing tile
$in_splinter = 0;
my $ending_edge = 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;
}
}
}
# 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);
# We will be destructively processing the tile array, so copy first
my @tiles = @{$this->tiles};
my $current_tile = shift @tiles;
# Single tile
unless (@tiles)
{
my ($cx, $cy) = $grid->coords_of_centre($current_tile->nw, $current_tile->sw);
if($this->starts_from)
{
my ($x1, $y1) = $grid->coords_of_edge($current_tile->nw, $current_tile->sw, $this->starts_from);
if($this->ends_to)
{
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", fill => 'transparent',
stroke => $this->colour, style => $this->style, class => $this->css_class);
}
else
{
# 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);
}
}
else
{
if($this->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);
}
}
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);
my ($cx, $cy) = $grid->coords_of_centre($previous_tile->nw, $previous_tile->sw);
$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";
}
# This loop adds all the intermediate segments
# Importantly, all go from edge to edge
while (@tiles)
{
$next_tile = shift @tiles;
$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 .= " Q $qx,$qy $x,$y";
$previous_tile = $current_tile;
$current_tile = $next_tile;
}
# When loop is done (or if it was empty) $current_tile is the last tile
# $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 .= "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";
}
$g->path(d => $path_spec, fill => 'transparent',
stroke => $this->colour, style => $this->style, class => $this->css_class
);
return $g;
}
1;