File Coverage

blib/lib/Game/TextMapper/Point/Hex.pm
Criterion Covered Total %
statement 61 67 91.0
branch 12 20 60.0
condition 14 21 66.6
subroutine 11 11 100.0
pod 5 6 83.3
total 103 125 82.4


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   81 use Game::TextMapper::Constants qw($dx $dy);
  11         57  
  11         1432  
46              
47 11     11   79 use Modern::Perl '2018';
  11         25  
  11         86  
48 11     11   4136 use Mojo::Util qw(url_escape);
  11         56  
  11         817  
49 11     11   91 use Encode qw(encode_utf8);
  11         21  
  11         682  
50 11     11   86 use Mojo::Base 'Game::TextMapper::Point';
  11         19  
  11         137  
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 1410     1410 1 3651 return @hex;
68             }
69              
70             sub pixels {
71 12434     12434 0 26323 my ($self, $offset, $add_x, $add_y) = @_;
72 12434         27719 my $x = $self->x;
73 12434         61928 my $y = $self->y;
74 12434         55641 my $z = $self->z;
75 12434 50       60359 $y += $offset->[$z] if defined $offset->[$z];
76 12434   100     35776 $add_x //= 0;
77 12434   100     32067 $add_y //= 0;
78 12434         103940 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 8995 my ($self, $attributes, $offset) = @_;
83 1382         5440 my $x = $self->x;
84 1382         7077 my $y = $self->y;
85 1382         6200 my $z = $self->z;
86 1382         5596 my $id = "hex";
87 1382 50 33     8012 if ($x < 100 and $y < 100 and $z < 100) {
      33        
88 1382         2495 $id .= "$x$y";
89 1382 50       2992 $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         4760 my $points = join(" ", map { sprintf("%.1f,%.1f", $self->pixels($offset, @$_)) } $self->corners());
  8292         20823  
95 1382         8777 return qq{ \n}
96             }
97              
98             sub svg {
99 2764     2764 1 13585 my ($self, $offset) = @_;
100 2764         4684 my $data = '';
101 2764         4156 for my $type (@{$self->type}) {
  2764         5666  
102 2632         10709 $data .= sprintf(qq{ \n},
103             $self->pixels($offset), $type);
104             }
105 2764         10885 return $data;
106             }
107              
108             sub svg_coordinates {
109 1382     1382 1 9152 my ($self, $offset) = @_;
110 1382         2548 my $data = qq{
111 1382         4016 $data .= sprintf(qq{ x="%.1f" y="%.1f"}, $self->pixels($offset, 0, -$dy * 0.4));
112 1382         3036 $data .= ' ';
113 1382   100     3693 $data .= $self->map->text_attributes || '';
114 1382         12603 $data .= '>';
115 1382         5885 $data .= Game::TextMapper::Point::coord($self->x, $self->y, ".");
116 1382         3468 $data .= qq{\n};
117 1382         5474 return $data;
118             }
119              
120             sub svg_label {
121 1382     1382 1 9359 my ($self, $url, $offset) = @_;
122 1382 100       2687 return '' unless defined $self->label;
123 43         262 my $attributes = $self->map->label_attributes;
124 43 50       351 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 43 100 33     221 $url =~ s/\%s/url_escape(encode_utf8($self->label))/e or $url .= url_escape(encode_utf8($self->label)) if $url;
  0         0  
130 43   100     142 my $data = sprintf(qq{ }
      50        
131             . $self->label
132             . qq{},
133             $self->pixels($offset, 0, $dy * 0.4),
134             $attributes ||'',
135             $self->map->glow_attributes ||'');
136 43 100       830 $data .= qq{} if $url;
137 43   100     107 $data .= sprintf(qq{}
138             . $self->label
139             . qq{},
140             $self->pixels($offset, 0, $dy * 0.4),
141             $attributes ||'');
142 43 100       130 $data .= qq{} if $url;
143 43         74 $data .= qq{\n};
144 43         257 return $data;
145             }
146              
147             =head1 SEE ALSO
148              
149             This is a specialisation of L.
150              
151             The SVG size is determined by C<$dx> and C<$dy> from
152             L.
153              
154             =cut
155              
156             1;