wiki-map/HexGrid/Path.pm

package HexGrid::Path;

use v5.30;

use Moo;
use MooX::Aliases;
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;

	#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)
{
	return "Q $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 @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
			{
				$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;
	}

	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);
	($x, $y) = $grid->coords_of_edge($previous_tile->nw, $previous_tile->sw, $next_edge);
	if($this->starts_from)
	{
		($x0, $y0) = $grid->coords_of_edge($previous_tile->nw, $previous_tile->sw, $this->starts_from);
		$path_spec .= "M $x0,$y0 ";
		my ($cx, $cy) = $grid->coords_of_centre($previous_tile->nw, $previous_tile->sw);
		$path_spec .= curve_to($cx, $cy, $x, $y);
	}
	else
	{
		($x0, $y0) = $grid->coords_of_centre($previous_tile->nw, $previous_tile->sw);
		$path_spec .= "M $x0,$y0 L $x,$y";
	}

	my $previous_edge; # not defined yet
	my $next_tile; # not defined yet
	while (@tiles)
	{
		$next_tile = shift @tiles;
		$previous_edge = -$next_edge;
		$next_edge = get_edge_direction($current_tile, $next_tile);

		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 .= " " . curve_to($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)
	{
		($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 .= curve_to($x, $y, $xe, $ye);
	}
	else
	{
		($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;