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; 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;