@ -34,17 +34,11 @@ 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: 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
@ -59,9 +53,13 @@ sub clone_settings($this)
) ;
}
# 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 ;
@ -76,6 +74,7 @@ sub splinter($this, $grid)
$ 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 )
@ -94,7 +93,13 @@ sub splinter($this, $grid)
# Don't set source on first tile
if ( $ i >= 1 )
{
$ splinter - > { starts_from } = get_edge_direction ( $ this - > { tiles } [ $ i ] , $ this - > { tiles } [ $ 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 ;
@ -110,10 +115,17 @@ sub splinter($this, $grid)
}
else
{
# In a splinter but tile not present, set previous tile sink to this missing tile
# In a splinter but tile not present, end splinter
# and 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 ] ) ;
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 ;
}
}
}
@ -134,6 +146,7 @@ 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 ;
@ -153,7 +166,7 @@ sub render($this, $grid, $svg)
}
else
{
# l ine from starts_from to the centre
# L ine 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 ) ;
}
@ -162,13 +175,14 @@ sub render($this, $grid, $svg)
{
if ( $ this - > ends_to )
{
# l ine from the centre to ends_to
# L ine 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 ) ;
@ -177,37 +191,53 @@ sub render($this, $grid, $svg)
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 ) ;
$ 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 ) ;
$ 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" ;
}
my $ previous_edge ; # not defined yet
my $ next_tile ; # not defined yet
# This loop adds all the intermediate segments
# Importantly, all go from edge to edge
while ( @ tiles )
{
$ next_tile = shift @ tiles ;
$ previous_edge = - $ next_edge ;
$ 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 . = " " . curve_to ( $ qx , $ qy , $ x , $ y ) ;
$ path_spec . = " Q $qx,$qy $x,$y" ;
$ previous_tile = $ current_tile ;
$ current_tile = $ next_tile ;
@ -216,12 +246,14 @@ sub render($this, $grid, $svg)
# $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 . = curve_to ( $ x , $ y , $ xe , $ ye ) ;
$ 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" ;
}