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
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
78
|
|
39
|
1
|
|
|
1
|
|
6
|
use Game::TextMapper::Point; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
5
|
|
40
|
|
|
|
|
|
|
|
41
|
1
|
|
|
1
|
|
24
|
use Modern::Perl '2018'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
5
|
|
42
|
1
|
|
|
1
|
|
105
|
use Mojo::Base 'Game::TextMapper::Line'; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
5
|
|
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
sub pixels { |
45
|
8506
|
|
|
8506
|
0
|
11048
|
my ($self, $point) = @_; |
46
|
8506
|
|
|
|
|
12029
|
my ($x, $y) = ($point->x * $dx * 3/2, ($point->y + $self->offset->[$point->z]) * $dy - $point->x % 2 * $dy/2); |
47
|
8506
|
50
|
|
|
|
88967
|
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
|
2000
|
|
|
2000
|
0
|
6225
|
my ($self, $from, $to) = @_; |
67
|
2000
|
|
|
|
|
7119
|
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
|
2000
|
|
|
|
|
3043
|
my ($min, $best); |
70
|
2000
|
|
|
|
|
2809
|
for my $i (0 .. 5) { |
71
|
|
|
|
|
|
|
# make a new guess |
72
|
12000
|
|
|
|
|
44025
|
my ($x, $y) = ($from->x + $delta->[$from->x % 2]->[$i]->[0], |
73
|
|
|
|
|
|
|
$from->y + $delta->[$from->x % 2]->[$i]->[1]); |
74
|
12000
|
|
|
|
|
87061
|
my $d = ($to->x - $x) * ($to->x - $x) |
75
|
|
|
|
|
|
|
+ ($to->y - $y) * ($to->y - $y); |
76
|
12000
|
100
|
100
|
|
|
109290
|
if (!defined($min) || $d < $min) { |
77
|
4629
|
|
|
|
|
5266
|
$min = $d; |
78
|
4629
|
|
|
|
|
7070
|
$best = Game::TextMapper::Point->new(x => $x, y => $y, z => $from->z); |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
} |
81
|
2000
|
|
|
|
|
8058
|
return $best; |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
1; |