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

100 lines
3.2 KiB

11 months ago
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');
# 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: should die here, to be caught/bubbled in render...
}
sub curve_path($x1, $y1, $qx, $qy, $x2, $y2)
{
return "M $x1,$y1 Q $qx,$qy $x2,$y2";
}
# Instance
sub render($this, $grid, $svg)
{
return unless @{$this->tiles};
my $g = $svg->g(id => $this->id, class => $this->css_class);
my ($x1, $x2, $y1, $y2);
my $current_tile = shift @{$this->tiles};
unless (@{$this->tiles})
{
my ($cx, $cy) = $grid->coords_of_centre($current_tile->nw, $current_tile->sw);
$g->circle(cx => $cx, cy => $cy,
r => $this->{style}{'stroke-width'} // $DEFAULT_WIDTH,
fill => $this->colour, style => $this->style, class => $this->css_class);
return;
}
my $previous_tile = $current_tile;
$current_tile = shift @{$this->tiles};
my $next_edge = get_edge_direction($previous_tile, $current_tile);
($x1, $y1) = $grid->coords_of_centre($previous_tile->nw, $previous_tile->sw);
($x2, $y2) = $grid->coords_of_edge($previous_tile->nw, $previous_tile->sw, $next_edge);
$g->line(x1 => $x1, y1 => $y1, x2 => $x2, y2 => $y2,
stroke => $this->colour, style => $this->style, class => $this->css_class);
my $previous_edge; # not defined yet
my $next_tile; # not defined yet
while(@{$this->tiles})
{
$next_tile = shift @{$this->tiles};
$previous_edge = -$next_edge;
$next_edge = get_edge_direction($current_tile, $next_tile);
($x1,$y1) = $grid->coords_of_edge($current_tile->nw, $current_tile->sw, $previous_edge);
my ($qx,$qy) = $grid->coords_of_centre($current_tile->nw, $current_tile->sw);
($x2,$y2) = $grid->coords_of_edge($current_tile->nw, $current_tile->sw, $next_edge);
# TODO: Draw curve from $current_tile:$previous_edge to $current_tile:$next_edge
# with $current_tile centre as the control point
$g->path(d => curve_path($x1,$y1, $qx,$qy, $x2,$y2),
stroke => $this->colour, style => $this->style, class => $this->css_class
);
$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 will be the last used edge, so use it's opposite for the source of last line
($x1, $y1) = $grid->coords_of_edge($current_tile->nw, $current_tile->sw, -$next_edge);
($x2, $y2) = $grid->coords_of_centre($current_tile->nw, $current_tile->sw);
$g->line(x1 => $x1, y1 => $y1, x2 => $x2, y2 => $y2,
stroke => $this->colour, style => $this->style, class => $this->css_class);
}
1;