File Coverage

blib/lib/Game/TextMapper/Point/Hex.pm
Criterion Covered Total %
statement 64 68 94.1
branch 10 14 71.4
condition 8 10 80.0
subroutine 10 10 100.0
pod 5 5 100.0
total 97 107 90.6


line stmt bran cond sub pod time code
1             # Copyright (C) 2009-2021 Alex Schroeder
2             #
3             # This program is free software: you can redistribute it and/or modify it under
4             # the terms of the GNU Affero General Public License as published by the Free
5             # Software Foundation, either version 3 of the License, or (at your option) any
6             # later version.
7             #
8             # This program is distributed in the hope that it will be useful, but WITHOUT
9             # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
10             # FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for more
11             # details.
12             #
13             # You should have received a copy of the GNU Affero General Public License along
14             # with this program. If not, see .
15              
16             =encoding utf8
17              
18             =head1 NAME
19              
20             Game::TextMapper::Point::Hex - a hex on a map
21              
22             =head1 SYNOPSIS
23              
24             use Modern::Perl;
25             use Game::TextMapper::Point::Hex;
26             my $hex = Game::TextMapper::Point::Hex->new(x => 1, y => 1, z => 0);
27             say $hex->svg_region('', [0]);
28             #
29              
30             =head1 DESCRIPTION
31              
32             This class holds information about a hex region: coordinates, a label, and
33             types. Types are the kinds of symbols that can be found in the region: a keep, a
34             tree, a mountain. They correspond to SVG definitions. The class knows how to
35             draw a SVG polygon at the correct coordinates using these definitions.
36              
37             For attributes and methods, see L.
38              
39             =head2 Additional Methods
40              
41             =cut
42              
43             package Game::TextMapper::Point::Hex;
44              
45 1     1   6 use Game::TextMapper::Constants qw($dx $dy);
  1         1  
  1         105  
46              
47 1     1   6 use Modern::Perl '2018';
  1         1  
  1         5  
48 1     1   107 use Mojo::Util qw(url_escape);
  1         1  
  1         36  
49 1     1   7 use Encode qw(encode_utf8);
  1         2  
  1         56  
50 1     1   6 use Mojo::Base 'Game::TextMapper::Point';
  1         1  
  1         5  
51              
52             =head3 corners
53              
54             Return the relative SVG coordinates of the points making up the shape, i.e. six
55             for L and four for
56             L.
57              
58             The SVG coordinates are arrays with x and y coordinates relative to the center
59             of the shape.
60              
61             =cut
62              
63             my @hex = ([-$dx, 0], [-$dx/2, $dy/2], [$dx/2, $dy/2],
64             [$dx, 0], [$dx/2, -$dy/2], [-$dx/2, -$dy/2]);
65              
66             sub corners {
67 1412     1412 1 2085 return @hex;
68             }
69              
70             sub svg_region {
71 1381     1381 1 5133 my ($self, $attributes, $offset) = @_;
72 1381         2021 my $x = $self->x;
73 1381         4810 my $y = $self->y;
74 1381         4240 my $z = $self->z;
75 1381 50       4920 my $id = "hex$x$y" . ($z != 0 ? $z : ''); # z-axis 0 means no z axis for the $id
76 1381         1836 $y += $offset->[$z];
77             my $points = join(" ", map {
78 1381         2027 sprintf("%.1f,%.1f",
  8286         52244  
79             $x * $dx * 3/2 + $_->[0],
80             $y * $dy - $self->x % 2 * $dy/2 + $_->[1]) } $self->corners());
81 1381         13527 return qq{ \n}
82             }
83              
84             sub svg {
85 2762     2762 1 8960 my ($self, $offset) = @_;
86 2762         3997 my $x = $self->x;
87 2762         8880 my $y = $self->y;
88 2762         8504 my $z = $self->z;
89 2762         8454 $y += $offset->[$z];
90 2762         3184 my $data = '';
91 2762         2940 for my $type (@{$self->type}) {
  2762         3978  
92 2628         17259 $data .= sprintf(qq{ \n},
93             $x * $dx * 3/2, $y * $dy - $x%2 * $dy/2, $type);
94             }
95 2762         7849 return $data;
96             }
97              
98             sub svg_coordinates {
99 1381     1381 1 4641 my ($self, $offset) = @_;
100 1381         2009 my $x = $self->x;
101 1381         4713 my $y = $self->y;
102 1381         4267 my $z = $self->z;
103 1381         4259 $y += $offset->[$z];
104 1381         1576 my $data = '';
105 1381         1956 $data .= qq{
106 1381         6776 $data .= sprintf(qq{ x="%.1f" y="%.1f"},
107             $x * $dx * 3/2,
108             $y * $dy - $x%2 * $dy/2 - $dy * 0.4);
109 1381         1757 $data .= ' ';
110 1381   100     2161 $data .= $self->map->text_attributes || '';
111 1381         8026 $data .= '>';
112 1381         2211 $data .= Game::TextMapper::Point::coord($self->x, $self->y, ".");
113 1381         2645 $data .= qq{\n};
114 1381         3177 return $data;
115             }
116              
117             sub svg_label {
118 1381     1381 1 6479 my ($self, $url, $offset) = @_;
119 1381 100       1904 return '' unless defined $self->label;
120 42         162 my $attributes = $self->map->label_attributes;
121 42 50       204 if ($self->size) {
122 0 0       0 if (not $attributes =~ s/\bfont-size="\d+pt"/'font-size="' . $self->size . 'pt"'/e) {
  0         0  
123 0         0 $attributes .= ' font-size="' . $self->size . '"';
124             }
125             }
126 42 100 50     141 $url =~ s/\%s/url_escape(encode_utf8($self->label))/e or $url .= url_escape(encode_utf8($self->label)) if $url;
  0         0  
127 42         105 my $x = $self->x;
128 42         134 my $y = $self->y;
129 42         126 my $z = $self->z;
130 42         136 $y += $offset->[$z];
131 42   100     63 my $data = sprintf(qq{ }
      50        
132             . $self->label
133             . qq{},
134             $x * $dx * 3/2, $y * $dy - $x%2 * $dy/2 + $dy * 0.4,
135             $attributes ||'',
136             $self->map->glow_attributes ||'');
137 42 100       970 $data .= qq{} if $url;
138 42   100     84 $data .= sprintf(qq{}
139             . $self->label
140             . qq{},
141             $x * $dx * 3/2, $y * $dy - $x%2 * $dy/2 + $dy * 0.4,
142             $attributes ||'');
143 42 100       380 $data .= qq{} if $url;
144 42         64 $data .= qq{\n};
145 42         135 return $data;
146             }
147              
148             =head1 SEE ALSO
149              
150             This is a specialisation of L.
151              
152             The SVG size is determined by C<$dx> and C<$dy> from
153             L.
154              
155             =cut
156              
157             1;