From 2469ca32cc21613f5fa9ada89adb3e48912f8d56 Mon Sep 17 00:00:00 2001 From: Daniel Asher Resnick Date: Wed, 27 Dec 2023 16:43:30 -0600 Subject: [PATCH] Add Paths --- HexGrid.pm | 79 +++++++- HexGrid/Path.pm | 99 ++++++++++ svg/hex-lines_equilateral.svg | 22 +++ tests/paths.pl | 48 +++++ tests/paths.svg | 329 ++++++++++++++++++++++++++++++++++ 5 files changed, 576 insertions(+), 1 deletion(-) create mode 100644 HexGrid/Path.pm create mode 100644 svg/hex-lines_equilateral.svg create mode 100644 tests/paths.pl create mode 100644 tests/paths.svg diff --git a/HexGrid.pm b/HexGrid.pm index beda636..6715d32 100644 --- a/HexGrid.pm +++ b/HexGrid.pm @@ -8,6 +8,7 @@ use SVG; use Hash::Merge qw(merge); use HexGrid::Tile; use HexGrid::Region; +use HexGrid::Path; use HexGrid::PopUp; use HexGrid::Image; use Carp; @@ -19,6 +20,7 @@ no warnings "experimental::signatures"; my $DEBUG = 0; has regions => (is => 'rw', default => sub { {} }); +has paths => (is => 'rw', default => sub { {} }); has images => (is => 'rw', default => sub{ {} }); has sideLength => (is => 'rw', default => 100); @@ -33,6 +35,18 @@ has embed_images => (is => 'rw', default => 1); sub tile_width($this) { 2 * $this->{sideLength} } sub tile_height($this) { sqrt(3) * $this->{sideLength} } +# Enumeration of each direction; opposite directions are negated +%HexGrid::DIR = +( + nw => 1, + sw => 2, + s => 3, + se => -1, + ne => -2, + n => -3 +); + + #Hash::Merge::merge defaults to Left Precedence, i.e. merge first arg onto second arg sub add_region($this, $region) { $this->{regions}{$region->{name}} = $region; } @@ -42,6 +56,20 @@ sub make_region($this, $name, %defaults) $this->add_region(HexGrid::Region->new(name => $name, defaults => $tile_defaults)); } +sub add_path($this, $path) { $this->{paths}{$path->id} = $path; } +sub make_path_from($this, $id, $tile_coords, %rest) +{ + my $path = HexGrid::Path->new + ( + id => $id, %rest + ); + foreach my $pair (@$tile_coords) + { + push @{$path->tiles}, $this->get_tile_at($pair->[0], $pair->[1]); + } + $this->add_path($path); +} + sub add_image($this, $name, $source) { # Height/width of the image within the symbol doesn't matter @@ -150,7 +178,8 @@ sub render($this) id => "${key}_symbol", viewBox => "0 0 $image->{width} $image->{height}", width => $image->{width}, - height => $image->{height}); + height => $image->{height} + ); $image->render($symbol); } @@ -164,6 +193,10 @@ sub render($this) $max_x = $m->{max_x} if $m->{max_x} > $max_x; $max_y = $m->{max_y} if $m->{max_y} > $max_y; } + foreach my $path (keys %{$this->paths}) + { + $this->{paths}{$path}->render($this, $svg); + } foreach my $later (@$laters) { $later->($svg); @@ -186,6 +219,50 @@ sub translate_coords($this, $nw, $sw) 1/2 * $this->tile_height * ($sw - $nw)); } +sub coords_of_centre($this, $nw, $sw) +{ + my ($x_root, $y_root) = $this->translate_coords($nw, $sw); + return ($x_root + $this->tile_width / 2, $y_root + $this->tile_height / 2); +} + +sub coords_of_edge($this, $nw, $sw, $dir) +{ + my ($x_translate, $y_translate); + if($dir == $HexGrid::DIR{nw}) + { + $x_translate = $this->tile_width / 8; + $y_translate = $this->tile_height / 4; + } + elsif($dir == $HexGrid::DIR{sw}) + { + $x_translate = $this->tile_width / 8; + $y_translate = $this->tile_height * 3 / 4; + } + elsif($dir == $HexGrid::DIR{s}) + { + $x_translate = $this->tile_width / 2; + $y_translate = $this->tile_height; + } + elsif($dir == $HexGrid::DIR{se}) + { + $x_translate = $this->tile_width * 7 / 8; + $y_translate = $this->tile_height * 3 / 4; + } + elsif($dir == $HexGrid::DIR{ne}) + { + $x_translate = $this->tile_width * 7 / 8; + $y_translate = $this->tile_height / 4; + } + elsif($dir == $HexGrid::DIR{n}) + { + $x_translate = $this->tile_width / 2; + $y_translate = 0; + } + + my ($x_root, $y_root) = $this->translate_coords($nw, $sw); + return ($x_root + $x_translate, $y_root + $y_translate); +} + sub to_id($string) { $string =~ s/\W/-/g && return $string; } sub DEBUG { $DEBUG = 1; } diff --git a/HexGrid/Path.pm b/HexGrid/Path.pm new file mode 100644 index 0000000..b16d3b3 --- /dev/null +++ b/HexGrid/Path.pm @@ -0,0 +1,99 @@ +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; diff --git a/svg/hex-lines_equilateral.svg b/svg/hex-lines_equilateral.svg new file mode 100644 index 0000000..4c105a4 --- /dev/null +++ b/svg/hex-lines_equilateral.svg @@ -0,0 +1,22 @@ + + + + + + + + + + + + + + + + + + + + diff --git a/tests/paths.pl b/tests/paths.pl new file mode 100644 index 0000000..0002c6d --- /dev/null +++ b/tests/paths.pl @@ -0,0 +1,48 @@ +use v5.36; +use rlib '..'; + +use HexGrid; +use HexGrid::Path; + +use Carp; + +use Data::Dumper; + +my $MAP_SIZE = 3; + +my $grid = HexGrid->new(defaults => { + style => { 'stroke-width' => 1, stroke => 'white' }, + show_coords => 0}); +my $region = $grid->make_region("TEST"); + +for (my $nw=-$MAP_SIZE; $nw <= $MAP_SIZE; $nw++) +{ + for (my $sw=-$MAP_SIZE; $sw <= $MAP_SIZE; $sw++) + { + $region->make_tile_at($nw, $sw); + } +} + +$grid->make_path_from('test-id', + [[0,0], [1,0], [1,1], [2,0], [2,-1], [2,-2], [1,-2], [1,-1], [2,-1], [3,-1]], + colour => 'lime', css_class => 'path', style => { 'stroke-width' => 5 } +); +$grid->make_path_from('point-id', [[-1,1]], + colour => 'cyan', css_class => 'path', style => { 'stroke-width' => 5 } +); +$grid->make_path_from('loop-id', + [[-2,0], [-1,0], [-1,-1], [-2,-1], [-2,0]], + colour => 'red', css_class => 'path', style => { 'stroke-width' => 5 } +); + +# say "@{[$grid->coords_of_centre(-2,0)]}"; +# say "@{[$grid->coords_of_edge(-2,0,$HexGrid::DIR{nw})]}"; +# say "@{[$grid->coords_of_edge(-2,0,$HexGrid::DIR{sw})]}"; +# say "@{[$grid->coords_of_edge(-2,0,$HexGrid::DIR{s})]}" ; +# say "@{[$grid->coords_of_edge(-2,0,$HexGrid::DIR{se})]}"; +# say "@{[$grid->coords_of_edge(-2,0,$HexGrid::DIR{ne})]}"; +# say "@{[$grid->coords_of_edge(-2,0,$HexGrid::DIR{n})]}" ; + +# say Dumper($grid); + +say $grid->render; diff --git a/tests/paths.svg b/tests/paths.svg new file mode 100644 index 0000000..c410d9b --- /dev/null +++ b/tests/paths.svg @@ -0,0 +1,329 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +