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.pm

193 lines
5.1 KiB

1 year ago
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::PopUp;
1 year ago
use HexGrid::Image;
1 year ago
use Carp;
use Data::Dumper;
use feature "signatures";
no warnings "experimental::signatures";
1 year ago
my $DEBUG = 0;
1 year ago
has regions => (is => 'rw', default => sub { {} });
1 year ago
has images => (is => 'rw', default => sub{ {} });
1 year ago
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');
1 year ago
has embed_images => (is => 'rw', default => 1);
1 year ago
sub tile_width($this) { 2 * $this->{sideLength} }
sub tile_height($this) { sqrt(3) * $this->{sideLength} }
#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));
}
1 year ago
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,
1 year ago
height => 1,
fetch => $this->embed_images
1 year ago
);
}
1 year ago
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};
}
1 year ago
croak "No tile at $nw,$sw";
1 year ago
}
1 year ago
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};
}
croak "No tile at $nw,$sw";
}
1 year ago
1 year ago
# Clones settings
# Regions (and by extension tiles) are tied to $this
# Images are not imported
1 year ago
sub subgrid_for_regions($this, @region_names)
{
my $subgrid = HexGrid->new
(
sideLength => $this->{sideLength},
width => $this->{width},
height => $this->{height},
1 year ago
defaults => merge($this->{defaults}, {}),
1 year ago
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;
say STDERR Dumper($subgrid) if $DEBUG;
return $subgrid;
}
1 year ago
sub subgrid_for_tiles($this, @coords_list)
1 year ago
{
1 year ago
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(exists $subgrid->{regions}{$region->{name}})
{
my $clone = $region->clone;
$subgrid->add_region($clone);
}
$subgrid->{regions}{$region->{name}}->add_tile($tile);
}
return $subgrid;
1 year ago
}
1 year ago
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) });
}
1 year ago
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);
1 year ago
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);
}
1 year ago
my $laters = [];
foreach my $region (keys %{$this->{regions}})
{
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 $later (@$laters)
{
$later->($svg);
}
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 to_id($string) { $string =~ s/\W/-/g && return $string; }
1 year ago
sub DEBUG { $DEBUG = 1; }
1 year ago
1;