File Coverage

blib/lib/Game/TextMapper/Point/Hex.pm
Criterion Covered Total %
statement 64 68 94.1
branch 6 12 50.0
condition 5 11 45.4
subroutine 10 10 100.0
pod 5 5 100.0
total 90 106 84.9


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   5 use Game::TextMapper::Constants qw($dx $dy);
  1         4  
  1         77  
46              
47 1     1   6 use Modern::Perl '2018';
  1         2  
  1         11  
48 1     1   228 use Mojo::Util qw(url_escape);
  1         2  
  1         51  
49 1     1   5 use Encode qw(encode_utf8);
  1         2  
  1         47  
50 1     1   6 use Mojo::Base 'Game::TextMapper::Point';
  1         1  
  1         10  
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 1414     1414 1 2109 return @hex;
68             }
69              
70             sub svg_region {
71 1381     1381 1 5115 my ($self, $attributes, $offset) = @_;
72 1381         2138 my $x = $self->x;
73 1381         5252 my $y = $self->y;
74 1381         4762 my $z = $self->z;
75 1381         4387 my $id = "hex$x$y$z";
76 1381         2083 $y += $offset->[$z];
77             my $points = join(" ", map {
78 1381         1983 sprintf("%.1f,%.1f",
  8286         49823  
79             $x * $dx * 3/2 + $_->[0],
80             $y * $dy - $self->x % 2 * $dy/2 + $_->[1]) } $self->corners());
81 1381         13837 return qq{ \n}
82             }
83              
84             sub svg {
85 2762     2762 1 8907 my ($self, $offset) = @_;
86 2762         3962 my $x = $self->x;
87 2762         9208 my $y = $self->y;
88 2762         8746 my $z = $self->z;
89 2762         8479 $y += $offset->[$z];
90 2762         3161 my $data = '';
91 2762         3331 for my $type (@{$self->type}) {
  2762         3893  
92 2643         17146 $data .= sprintf(qq{ \n},
93             $x * $dx * 3/2, $y * $dy - $x%2 * $dy/2, $type);
94             }
95 2762         7949 return $data;
96             }
97              
98             sub svg_coordinates {
99 1381     1381 1 4726 my ($self, $offset) = @_;
100 1381         2053 my $x = $self->x;
101 1381         4876 my $y = $self->y;
102 1381         4547 my $z = $self->z;
103 1381         4473 $y += $offset->[$z];
104 1381         1626 my $data = '';
105 1381         1893 $data .= qq{
106 1381         6433 $data .= sprintf(qq{ x="%.1f" y="%.1f"},
107             $x * $dx * 3/2,
108             $y * $dy - $x%2 * $dy/2 - $dy * 0.4);
109 1381         1706 $data .= ' ';
110 1381   100     2196 $data .= $self->map->text_attributes || '';
111 1381         7906 $data .= '>';
112 1381         2246 $data .= Game::TextMapper::Point::coord($self->x, $self->y, ".");
113 1381         2501 $data .= qq{\n};
114 1381         3464 return $data;
115             }
116              
117             sub svg_label {
118 1381     1381 1 6555 my ($self, $url, $offset) = @_;
119 1381 100       1875 return '' unless defined $self->label;
120 44         170 my $attributes = $self->map->label_attributes;
121 44 50       216 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 44 50 0     142 $url =~ s/\%s/url_escape(encode_utf8($self->label))/e or $url .= url_escape(encode_utf8($self->label)) if $url;
  0         0  
127 44         64 my $x = $self->x;
128 44         138 my $y = $self->y;
129 44         140 my $z = $self->z;
130 44         159 $y += $offset->[$z];
131 44   50     70 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 44 50       693 $data .= qq{} if $url;
138 44   50     72 $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 44 50       384 $data .= qq{} if $url;
144 44         63 $data .= qq{\n};
145 44         154 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;