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 HexGrid::Image; use Carp; use Data::Dumper; use feature "signatures"; no warnings "experimental::signatures"; my $DEBUG = 0; has regions => (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); 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 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}; } croak "No tile at $nw,$sw"; } 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"; } # 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; say STDERR Dumper($subgrid) if $DEBUG; 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(exists $subgrid->{regions}{$region->{name}}) { my $clone = $region->clone; $subgrid->add_region($clone); } $subgrid->{regions}{$region->{name}}->add_tile($tile); } return $subgrid; } 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); } 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; } sub DEBUG { $DEBUG = 1; } 1;