File Coverage

blib/lib/Game/TextMapper/Point/Hex.pm
Criterion Covered Total %
statement 62 68 91.1
branch 13 22 59.0
condition 11 19 57.8
subroutine 11 11 100.0
pod 5 6 83.3
total 102 126 80.9


line stmt bran cond sub pod time code
1             # Copyright (C) 2009-2022 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 11     11   63 use Game::TextMapper::Constants qw($dx $dy);
  11         18  
  11         1123  
46              
47 11     11   59 use Modern::Perl '2018';
  11         20  
  11         55  
48 11     11   2987 use Mojo::Util qw(url_escape);
  11         23  
  11         607  
49 11     11   90 use Encode qw(encode_utf8);
  11         14  
  11         595  
50 11     11   50 use Mojo::Base 'Game::TextMapper::Point';
  11         45  
  11         65  
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 2010 return @hex;
68             }
69              
70             sub pixels {
71 12337     12337 0 16589 my ($self, $offset, $add_x, $add_y) = @_;
72 12337         17727 my $x = $self->x;
73 12337         36948 my $y = $self->y;
74 12337         34829 my $z = $self->z;
75 12337 50       37971 $y += $offset->[$z] if defined $offset->[$z];
76 12337   100     20457 $add_x //= 0;
77 12337   100     18950 $add_y //= 0;
78 12337         54697 return $x * $dx * 3/2 + $add_x, $y * $dy - $x%2 * $dy/2 + $add_y;
79             }
80              
81             sub svg_region {
82 1382     1382 1 4993 my ($self, $attributes, $offset) = @_;
83 1382         2158 my $x = $self->x;
84 1382         4579 my $y = $self->y;
85 1382         4040 my $z = $self->z;
86 1382         3708 my $id = "hex";
87 1382 50 33     4728 if ($x < 100 and $y < 100 and $z < 100) {
      33        
88 1382         1675 $id .= "$x$y";
89 1382 50       1944 $id .= $z if $z != 0;
90             } else {
91 0         0 $id .= "$x.$y";
92 0 0       0 $id .= ".$z" if $z != 0;
93             }
94 1382         2026 my $points = join(" ", map { sprintf("%.1f,%.1f", $self->pixels($offset, @$_)) } $self->corners());
  8292         12298  
95 1382         5196 return qq{ \n}
96             }
97              
98             sub svg {
99 2764     2764 1 8804 my ($self, $offset) = @_;
100 2764         3189 my $data = '';
101 2764         2914 for my $type (@{$self->type}) {
  2764         3922  
102 2586         6654 $data .= sprintf(qq{ \n},
103             $self->pixels($offset), $type);
104             }
105 2764         6587 return $data;
106             }
107              
108             sub svg_coordinates {
109 1382     1382 1 4331 my ($self, $offset) = @_;
110 1382         1530 my $data = qq{
111 1382         2214 $data .= sprintf(qq{ x="%.1f" y="%.1f"}, $self->pixels($offset, 0, -$dy * 0.4));
112 1382         1788 $data .= ' ';
113 1382   100     2150 $data .= $self->map->text_attributes || '';
114 1382         7169 $data .= '>';
115 1382         2024 $data .= Game::TextMapper::Point::coord($self->x, $self->y, ".");
116 1382         1972 $data .= qq{\n};
117 1382         2885 return $data;
118             }
119              
120             sub svg_label {
121 1382     1382 1 5596 my ($self, $url, $offset) = @_;
122 1382 100       1664 return '' unless defined $self->label;
123 39         127 my $attributes = $self->map->label_attributes;
124 39 50       184 if ($self->size) {
125 0 0       0 if (not $attributes =~ s/\bfont-size="\d+pt"/'font-size="' . $self->size . 'pt"'/e) {
  0         0  
126 0         0 $attributes .= ' font-size="' . $self->size . '"';
127             }
128             }
129 39 100 33     119 $url =~ s/\%s/url_escape(encode_utf8($self->label))/e or $url .= url_escape(encode_utf8($self->label)) if $url;
  0         0  
130 39         83 my $data = " ";
131 39 50 0     54 $data .= sprintf(''
132             . $self->label
133             . '',
134             $self->pixels($offset, 0, $dy * 0.4),
135             $attributes ||'',
136             $self->map->glow_attributes)
137             if $self->map->glow_attributes;
138 39 100       190 $data .= qq{} if $url;
139 39   100     54 $data .= sprintf(''
140             . $self->label
141             . '',
142             $self->pixels($offset, 0, $dy * 0.4),
143             $attributes ||'');
144 39 100       58 $data .= "" if $url;
145 39         40 $data .= "\n";
146 39         106 return $data;
147             }
148              
149             =head1 SEE ALSO
150              
151             This is a specialisation of L.
152              
153             The SVG size is determined by C<$dx> and C<$dy> from
154             L.
155              
156             =cut
157              
158             1;