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         2  
  1         72  
46              
47 1     1   6 use Modern::Perl '2018';
  1         2  
  1         4  
48 1     1   114 use Mojo::Util qw(url_escape);
  1         2  
  1         38  
49 1     1   5 use Encode qw(encode_utf8);
  1         2  
  1         43  
50 1     1   6 use Mojo::Base 'Game::TextMapper::Point';
  1         2  
  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 1411     1411 1 1933 return @hex;
68             }
69              
70             sub svg_region {
71 1381     1381 1 4873 my ($self, $attributes, $offset) = @_;
72 1381         2087 my $x = $self->x;
73 1381         4771 my $y = $self->y;
74 1381         4398 my $z = $self->z;
75 1381         4237 my $id = "hex$x$y$z";
76 1381         1980 $y += $offset->[$z];
77             my $points = join(" ", map {
78 1381         1959 sprintf("%.1f,%.1f",
  8286         51272  
79             $x * $dx * 3/2 + $_->[0],
80             $y * $dy - $self->x % 2 * $dy/2 + $_->[1]) } $self->corners());
81 1381         13020 return qq{ \n}
82             }
83              
84             sub svg {
85 2762     2762 1 8796 my ($self, $offset) = @_;
86 2762         4050 my $x = $self->x;
87 2762         9057 my $y = $self->y;
88 2762         8622 my $z = $self->z;
89 2762         8453 $y += $offset->[$z];
90 2762         3148 my $data = '';
91 2762         2872 for my $type (@{$self->type}) {
  2762         4125  
92 2469         15657 $data .= sprintf(qq{ \n},
93             $x * $dx * 3/2, $y * $dy - $x%2 * $dy/2, $type);
94             }
95 2762         7596 return $data;
96             }
97              
98             sub svg_coordinates {
99 1381     1381 1 4744 my ($self, $offset) = @_;
100 1381         1916 my $x = $self->x;
101 1381         4800 my $y = $self->y;
102 1381         4301 my $z = $self->z;
103 1381         4227 $y += $offset->[$z];
104 1381         1679 my $data = '';
105 1381         1828 $data .= qq{
106 1381         6241 $data .= sprintf(qq{ x="%.1f" y="%.1f"},
107             $x * $dx * 3/2,
108             $y * $dy - $x%2 * $dy/2 - $dy * 0.4);
109 1381         1691 $data .= ' ';
110 1381   100     2175 $data .= $self->map->text_attributes || '';
111 1381         7922 $data .= '>';
112 1381         2230 $data .= Game::TextMapper::Point::coord($self->x, $self->y, ".");
113 1381         2537 $data .= qq{\n};
114 1381         3230 return $data;
115             }
116              
117             sub svg_label {
118 1381     1381 1 6730 my ($self, $url, $offset) = @_;
119 1381 100       1870 return '' unless defined $self->label;
120 37         141 my $attributes = $self->map->label_attributes;
121 37 50       187 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 37 50 0     131 $url =~ s/\%s/url_escape(encode_utf8($self->label))/e or $url .= url_escape(encode_utf8($self->label)) if $url;
  0         0  
127 37         56 my $x = $self->x;
128 37         121 my $y = $self->y;
129 37         123 my $z = $self->z;
130 37         122 $y += $offset->[$z];
131 37   50     58 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 37 50       513 $data .= qq{} if $url;
138 37   50     64 $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 37 50       322 $data .= qq{} if $url;
144 37         59 $data .= qq{\n};
145 37         114 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;