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.
 
 
wiki-map/HexGrid/Tile.pm

151 lines
3.8 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', 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 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->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;