wiki-map/HexGrid/Tile.pm

package HexGrid::Tile;

use v5.30;

use Moo;
use MooX::Aliases;
use Carp;
use HexGrid::Pin;
use Data::Dumper;

use feature "signatures";
no warnings "experimental::signatures";


has nw => (is => 'ro', required => 1);
has sw => (is => 'ro', required => 1);

has style => (is => 'rw', default => sub { {} });
has colour => (is => 'rw', alias => 'color');
has opacity => (is => 'rw');
has images => (is => 'rw', alias => [qw(image background backgrounds)]);
has show_coords => (is => 'rw');
has coords_colour => (is => 'rw', default => 'white');
has css_class => (is => 'rw');
has id_suffix => (is => 'rw', default => '_tile');

my %docks = ( #values are fractions of the height/width
	sw => { order => 1, x => 0,    y => 0.5, w => 0.5, h => 0.5 },
	se => { order => 2, x => 0.5,  y => 0.5, w => 0.5, h => 0.5 },
	n  => { order => 3, x => 0.25, y => 0,   w => 0.5, h => 0.5 },
);
has pins => (is => 'rw', default => sub { +{ map {$_ => undef} keys %docks } });

# Class


sub at($nw,$sw,@rest)
{
	return HexGrid::Tile->new(nw => $nw, sw => $sw, @rest);
}

sub hex_path($w, $h)
{
	# More readable for me at least as a sequence of points than as two sequences
	my @points = ([0, $h/2], [$w*1/4, 0], [$w*3/4, 0], [$w, $h/2], [$w*3/4, $h], [$w*1/4, $h]);
	# Join pairs with a comma, and sequence with spaces
	return join " ", (map {join ",", @$_} @points);
}

# Instance

sub pin($this, $pin, $dock = undef)
{
	if(ref $pin eq 'HexGrid::Pin')
	{
		$this->_do_pin($pin, $dock);
	}
	elsif(ref $pin eq 'ARRAY')
	{
		map $this->_do_pin($_), @$pin;
	}
	elsif(ref $pin eq 'HASH')
	{
		foreach my $dock (keys %$pin)
		{
			croak "dock $dock doesn't exist" unless grep { $_ eq $dock } keys %docks;
			$this->{pins}{$dock} = $pin->{$dock};
		}
		return;
	}
	else
	{
		croak "bad pin type";
	}
}

sub _do_pin($this, $pin, $dock = undef)
{
	if($dock)
	{
		croak "bad dock" unless $dock =~ /^sw|se|n$/i;
		$this->{pins}{$dock} = $pin;
	}
	else
	{
		my $success = 0;
		DOCK: foreach my $dock (sort { $docks{$a}->{order} <=> $docks{$b}->{order} } (keys %docks))
		{
			# say STDERR Dumper($dock);
			unless(defined $this->{pins}{$dock})
			{
				$this->{pins}{$dock} = $pin;
				$success = 1;
				last DOCK;
			}
		}
		croak "no free dock" unless $success;
	}
}

sub render($this, $container, $width, $height, $laters = undef)
{
	my $g = $container->g(
		id =>  HexGrid::to_id("$this->{nw}_$this->{sw}$this->{id_suffix}"),
	);
	# $g->{onclick} = "say('($this->{nw},$this->{sw})')";
	my $hex = $g->polygon(points => hex_path($width, $height),
		id => "$this->{nw}_$this->{sw}_inner_hex", style => $this->style);
	my $clipPath = $g->clipPath(id => "$this->{nw}_$this->{sw}_clip");
	$clipPath->use(href => "#$hex->{id}");

	if($this->{colour})
	{
		$hex->{fill} = $this->{colour};
	}
	if(defined($this->{images}))
	{
		$this->{images} = [$this->{images}] if ref($this->{images}) ne 'ARRAY';
		foreach my $image ($this->{images}->@*)
		{
			my $use_element = $g->use(id => "$this->{nw}_$this->{sw}_${image}_use",
				href => "#${image}_symbol", width => $width, height => $height,
				"clip-path" => "url(#$clipPath->{id})");
		}
	}

	if(defined($this->{opacity})) { $hex->{'fill-opacity'} = $this->{opacity}; }
	if($this->{show_coords})
	{
		my $text = $g->text(x => "@{[0.1 * $width]}", y => "@{[0.6 * $height]}", class => 'coords');
		$text->{'font-size'} = '3em';
		$text->{fill} = $this->{coords_colour};
		$text->cdata("$this->{nw},$this->{sw}");
	}
	if(defined $this->{css_class}) { $g->{class} = $this->{css_class} }
	if(defined $this->{pins})
	{
		foreach my $key (keys $this->{pins}->%*)
		{
			next unless defined $this->{pins}{$key};
			my $x = $width  * $docks{$key}->{x};
			my $w = $width  * $docks{$key}->{w};
			my $y = $height * $docks{$key}->{y};
			my $h = $height * $docks{$key}->{h};

			my $pin_element = $this->{pins}{$key}->render($g, $x, $y, $w, $h, $laters);
			$pin_element->{"clip-path"} = "url(#$clipPath->{id})";
		}
	}
	return $g;
}

1;