| 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::Line::Hex - a line implementation for hex maps |
|
21
|
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
23
|
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
The line connects two points on a hex map. This class knows how to compute all |
|
25
|
|
|
|
|
|
|
the regions between these two points, how to compute the next region along the |
|
26
|
|
|
|
|
|
|
line, and how to output SVG. |
|
27
|
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
=head1 SEE ALSO |
|
29
|
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
L |
|
31
|
|
|
|
|
|
|
L |
|
32
|
|
|
|
|
|
|
L |
|
33
|
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
=cut |
|
35
|
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
package Game::TextMapper::Line::Hex; |
|
37
|
|
|
|
|
|
|
|
|
38
|
1
|
|
|
1
|
|
6
|
use Game::TextMapper::Constants qw($dx $dy); |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
73
|
|
|
39
|
1
|
|
|
1
|
|
5
|
use Game::TextMapper::Point; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
5
|
|
|
40
|
|
|
|
|
|
|
|
|
41
|
1
|
|
|
1
|
|
24
|
use Modern::Perl '2018'; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
4
|
|
|
42
|
1
|
|
|
1
|
|
113
|
use Mojo::Base 'Game::TextMapper::Line'; |
|
|
1
|
|
|
|
|
1
|
|
|
|
1
|
|
|
|
|
5
|
|
|
43
|
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
sub pixels { |
|
45
|
5080
|
|
|
5080
|
0
|
6267
|
my ($self, $point) = @_; |
|
46
|
5080
|
|
|
|
|
6911
|
my ($x, $y) = ($point->x * $dx * 3/2, ($point->y + $self->offset->[$point->z]) * $dy - $point->x % 2 * $dy/2); |
|
47
|
5080
|
50
|
|
|
|
53126
|
return ($x, $y) if wantarray; |
|
48
|
0
|
|
|
|
|
0
|
return sprintf("%.1f,%.1f", $x, $y); |
|
49
|
|
|
|
|
|
|
} |
|
50
|
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
# Brute forcing the "next" step by trying all the neighbors. The |
|
52
|
|
|
|
|
|
|
# connection data to connect to neighboring hexes. |
|
53
|
|
|
|
|
|
|
# |
|
54
|
|
|
|
|
|
|
# Example Map Index for the array |
|
55
|
|
|
|
|
|
|
# |
|
56
|
|
|
|
|
|
|
# 0201 2 |
|
57
|
|
|
|
|
|
|
# 0102 0302 1 3 |
|
58
|
|
|
|
|
|
|
# 0202 0402 |
|
59
|
|
|
|
|
|
|
# 0103 0303 6 4 |
|
60
|
|
|
|
|
|
|
# 0203 0403 5 |
|
61
|
|
|
|
|
|
|
# 0104 0304 |
|
62
|
|
|
|
|
|
|
# |
|
63
|
|
|
|
|
|
|
# Note that the arithmetic changes when x is odd. |
|
64
|
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
sub one_step { |
|
66
|
1151
|
|
|
1151
|
0
|
3453
|
my ($self, $from, $to) = @_; |
|
67
|
1151
|
|
|
|
|
4054
|
my $delta = [[[-1, 0], [ 0, -1], [+1, 0], [+1, +1], [ 0, +1], [-1, +1]], # x is even |
|
68
|
|
|
|
|
|
|
[[-1, -1], [ 0, -1], [+1, -1], [+1, 0], [ 0, +1], [-1, 0]]]; # x is odd |
|
69
|
1151
|
|
|
|
|
1686
|
my ($min, $best); |
|
70
|
1151
|
|
|
|
|
1643
|
for my $i (0 .. 5) { |
|
71
|
|
|
|
|
|
|
# make a new guess |
|
72
|
6906
|
|
|
|
|
27424
|
my ($x, $y) = ($from->x + $delta->[$from->x % 2]->[$i]->[0], |
|
73
|
|
|
|
|
|
|
$from->y + $delta->[$from->x % 2]->[$i]->[1]); |
|
74
|
6906
|
|
|
|
|
51903
|
my $d = ($to->x - $x) * ($to->x - $x) |
|
75
|
|
|
|
|
|
|
+ ($to->y - $y) * ($to->y - $y); |
|
76
|
6906
|
100
|
100
|
|
|
62071
|
if (!defined($min) || $d < $min) { |
|
77
|
3003
|
|
|
|
|
3310
|
$min = $d; |
|
78
|
3003
|
|
|
|
|
4575
|
$best = Game::TextMapper::Point->new(x => $x, y => $y, z => $from->z); |
|
79
|
|
|
|
|
|
|
} |
|
80
|
|
|
|
|
|
|
} |
|
81
|
1151
|
|
|
|
|
3993
|
return $best; |
|
82
|
|
|
|
|
|
|
} |
|
83
|
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
1; |