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;