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.
150 lines
3.7 KiB
150 lines
3.7 KiB
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');
|
|
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 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]);
|
|
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 $image_element = $g->image(id => "$this->{nw}_$this->{sw}_${image}_img",
|
|
href => $image, 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->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 $image_element = $this->{pins}{$key}->render($g, $x, $y, $w, $h, $laters);
|
|
$image_element->{"clip-path"} = "url(#$clipPath->{id})";
|
|
}
|
|
}
|
|
return $g;
|
|
}
|
|
|
|
1;
|
|
|