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; use Carp; use Data::Dumper; use feature "signatures"; no warnings "experimental::signatures"; has regions => (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'); 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)); } 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}; } croak "No tile at $nw,$sw"; } 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 $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;