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.
304 lines
7.7 KiB
304 lines
7.7 KiB
package HexGrid;
|
|
|
|
use v5.30;
|
|
|
|
use Moo;
|
|
use MooX::Aliases;
|
|
use SVG;
|
|
use Hash::Merge qw(merge);
|
|
use HexGrid::Tile;
|
|
use HexGrid::Region;
|
|
use HexGrid::Path;
|
|
use HexGrid::PopUp;
|
|
use HexGrid::Image;
|
|
use Carp;
|
|
use Data::Dumper;
|
|
|
|
use feature "signatures";
|
|
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);
|
|
has width => (is => 'rw', default => 1000);
|
|
has height => (is => 'rw', default => 1000);
|
|
has defaults => (is => 'rw', default => sub { {} });
|
|
has make_popups => (is => 'rw', default => 1, alias => 'popups');
|
|
has popup_class => (is => 'rw', default => 'pin-popup');
|
|
has hidden_popups => (is => 'rw', default => 1, alias => 'popups_are_hidden');
|
|
has embed_images => (is => 'rw', default => 1);
|
|
|
|
# Equilateral hexagon math
|
|
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; }
|
|
sub make_region($this, $name, %defaults)
|
|
{
|
|
my $tile_defaults = merge(\%defaults, $this->{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);
|
|
return $path;
|
|
}
|
|
|
|
# Adds an image to the HexGrid's cache, to be referenced elsewhere (e.g. tile background, pin icons)
|
|
sub add_image($this, $name, $source)
|
|
{
|
|
# Height/width of the image within the symbol doesn't matter
|
|
# it will be scaled on use by matching the symbol viewbox to the declared image dimensions
|
|
$this->{images}{$name} = HexGrid::Image->new
|
|
(
|
|
source => $source,
|
|
id => "${name}_img",
|
|
width => 1,
|
|
height => 1,
|
|
fetch => $this->embed_images
|
|
);
|
|
}
|
|
|
|
sub get_tile_at($this, $nw, $sw)
|
|
{
|
|
foreach my $region (keys %{$this->{regions}})
|
|
{
|
|
return $this->{regions}{$region}{tiles}{$nw}{$sw} if exists $this->{regions}{$region}{tiles}{$nw}{$sw};
|
|
}
|
|
return;
|
|
}
|
|
sub get_tile_and_region_at($this, $nw, $sw)
|
|
{
|
|
foreach my $region (values %{$this->{regions}})
|
|
{
|
|
return ($region->{tiles}{$nw}{$sw}, $region) if exists $region->{tiles}{$nw}{$sw};
|
|
}
|
|
return;
|
|
}
|
|
|
|
# Clones settings
|
|
# Regions (and by extension tiles) are tied to $this
|
|
# Images are not imported
|
|
sub subgrid_for_regions($this, @region_names)
|
|
{
|
|
my $subgrid = HexGrid->new
|
|
(
|
|
sideLength => $this->{sideLength},
|
|
width => $this->{width},
|
|
height => $this->{height},
|
|
defaults => merge($this->{defaults}, {}),
|
|
make_popups => $this->{make_popups},
|
|
popup_class => $this->{popup_class},
|
|
hidden_popups => $this->{hidden_popups},
|
|
embed_images => $this->{embed_images}
|
|
);
|
|
$subgrid->add_region($this->{regions}{$_}) for @region_names;
|
|
foreach my $path (values %{$this->paths})
|
|
{
|
|
foreach my $splinter ($path->splinter($subgrid))
|
|
{
|
|
$subgrid->add_path($splinter);
|
|
}
|
|
}
|
|
return $subgrid;
|
|
}
|
|
|
|
sub subgrid_for_tiles($this, @coords_list)
|
|
{
|
|
my $subgrid = HexGrid->new
|
|
(
|
|
sideLength => $this->{sideLength},
|
|
width => $this->{width},
|
|
height => $this->{height},
|
|
defaults => $this->{defaults},
|
|
make_popups => $this->{make_popups},
|
|
popup_class => $this->{popup_class},
|
|
hidden_popups => $this->{hidden_popups},
|
|
embed_images => $this->{embed_images}
|
|
);
|
|
foreach my $coords (@coords_list)
|
|
{
|
|
my ($tile, $region) = $this->get_tile_and_region_at($coords->{nw}, $coords->{sw});
|
|
unless ($tile)
|
|
{
|
|
carp "No tile at " . $coords->{nw} . "," . $coords->{sw} . ", skipping.";
|
|
next;
|
|
}
|
|
unless ($region)
|
|
{
|
|
carp "No region at " . $coords->{nw} . "," . $coords->{sw} . ", skipping.";
|
|
next;
|
|
}
|
|
unless(exists $subgrid->{regions}{$region->{name}})
|
|
{
|
|
my $clone = $region->clone;
|
|
$subgrid->add_region($clone);
|
|
}
|
|
$subgrid->{regions}{$region->{name}}->add_tile($tile);
|
|
}
|
|
foreach my $path (values %{$this->paths})
|
|
{
|
|
foreach my $splinter ($path->splinter($subgrid))
|
|
{
|
|
$subgrid->add_path($splinter);
|
|
}
|
|
}
|
|
return $subgrid;
|
|
}
|
|
|
|
sub iter_region($this, $code)
|
|
{
|
|
foreach my $region (values %{$this->{regions}})
|
|
{
|
|
$code->($region);
|
|
}
|
|
}
|
|
|
|
sub iter_tile($this, $code)
|
|
{
|
|
$this->iter_region(sub($region) { $region->iter_tile($code) });
|
|
}
|
|
|
|
sub render($this)
|
|
{
|
|
my ($min_x,$min_y,$max_x,$max_y) = qw(Inf Inf -Inf -Inf);
|
|
my $svg = SVG->new();
|
|
my $root_style = $svg->style();
|
|
my $style_text = "";
|
|
$style_text .= ".$this->{popup_class} { visibility: hidden; }" if $this->{hidden_popups};
|
|
$root_style->cdata($style_text);
|
|
|
|
my $defs = $svg->defs();
|
|
while (my ($key, $image) = each %{$this->{images}})
|
|
{
|
|
my $symbol = $defs->symbol
|
|
(
|
|
id => "${key}_symbol",
|
|
viewBox => "0 0 $image->{width} $image->{height}",
|
|
width => $image->{width},
|
|
height => $image->{height}
|
|
);
|
|
$image->render($symbol);
|
|
}
|
|
|
|
# Continuations to be performed after other renders have finished
|
|
# Registered by subcomponents' render methods
|
|
my $laters = [];
|
|
foreach my $region (keys %{$this->{regions}})
|
|
{
|
|
# $m contains the min/max extents of the region
|
|
my $m = $this->{regions}{$region}->render($svg, $laters, $this);
|
|
|
|
$min_x = $m->{min_x} if $m->{min_x} < $min_x;
|
|
$min_y = $m->{min_y} if $m->{min_y} < $min_y;
|
|
$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);
|
|
}
|
|
# Max and min coordinates are all at the top-left corner of tiles, add one width/height to get full extent
|
|
my $width = $max_x - $min_x + $this->tile_width;
|
|
my $height = $max_y - $min_y + $this->tile_height;
|
|
$svg->{-docref}{-document}{viewBox} = "$min_x $min_y $width $height";
|
|
$svg->{-docref}{-document}{width} = $this->{width};
|
|
$svg->{-docref}{-document}{height} = $this->{height};
|
|
$svg->{-docref}{-document}{preserveAspectRatio} = "xMidYMid";
|
|
$svg->{-docref}{-document}{id}='grid-root';
|
|
$svg->{-docref}{-document}{version}='1.2';
|
|
|
|
return $svg->xmlify;
|
|
}
|
|
|
|
sub translate_coords($this, $nw, $sw)
|
|
{
|
|
return (-3/4 * $this->tile_width * ($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;
|
|
}
|
|
else
|
|
{
|
|
carp("Bad direction: $dir");
|
|
return;
|
|
}
|
|
|
|
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; }
|
|
1;
|
|
|