1 | # |
---|
2 | # PERL mapgenRules module by gary68 |
---|
3 | # |
---|
4 | # |
---|
5 | # Copyright (C) 2010, Gerhard Schwanz |
---|
6 | # |
---|
7 | # This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the |
---|
8 | # Free Software Foundation; either version 3 of the License, or (at your option) any later version. |
---|
9 | # |
---|
10 | # This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
---|
11 | # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. |
---|
12 | # |
---|
13 | # You should have received a copy of the GNU General Public License along with this program; if not, see <http://www.gnu.org/licenses/> |
---|
14 | |
---|
15 | |
---|
16 | package OSM::mapgenRules ; # |
---|
17 | |
---|
18 | use strict ; |
---|
19 | use warnings ; |
---|
20 | |
---|
21 | use List::Util qw[min max] ; |
---|
22 | use OSM::osm ; |
---|
23 | use OSM::mapgen 1.18 ; |
---|
24 | |
---|
25 | use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); |
---|
26 | |
---|
27 | $VERSION = '1.18' ; |
---|
28 | |
---|
29 | require Exporter ; |
---|
30 | |
---|
31 | @ISA = qw ( Exporter AutoLoader ) ; |
---|
32 | |
---|
33 | @EXPORT = qw ( readRules printRules ) ; |
---|
34 | |
---|
35 | # |
---|
36 | # constants |
---|
37 | # |
---|
38 | |
---|
39 | # |
---|
40 | # variables |
---|
41 | # |
---|
42 | my @nodes = () ; |
---|
43 | my @ways = () ; |
---|
44 | my @routes = () ; |
---|
45 | |
---|
46 | sub readRules { |
---|
47 | my $csvName = shift ; |
---|
48 | # READ STYLE File |
---|
49 | print "read style file and preprocess tile icons for areas...\n" ; |
---|
50 | open (my $csvFile, "<", $csvName) or die ("ERROR: style file not found.") ; |
---|
51 | my $line = <$csvFile> ; # omit SECTION |
---|
52 | |
---|
53 | # READ NODE RULES |
---|
54 | $line = <$csvFile> ; |
---|
55 | while (! grep /^\"SECTION/, $line) { |
---|
56 | if (! grep /^\"COMMENT/i, $line) { |
---|
57 | my ($key, $value, $color, $thickness, $label, $labelColor, $labelSize, $labelFont, $labelOffset, $legend, $legendLabel, $icon, $iconSize, $fromScale, $toScale) = ($line =~ /\"(.+)\" \"(.+)\" \"(.+)\" (\d+) \"(.+)\" \"(.+)\" (\d+) \"(.+)\" (\d+) (\d) \"(.+)\" \"(.+)\" (\d+) (\d+) (\d+)/ ) ; |
---|
58 | # print "N $key, $value, $color, $thickness, $label, $labelColor, $labelSize, $labelFont, $labelOffset, $legend, $legendLabel, $icon, $iconSize, $fromScale, $toScale\n" ; |
---|
59 | push @nodes, [$key, $value, $color, $thickness, $label, $labelColor, $labelSize, $labelFont, $labelOffset, $legend, $legendLabel, $icon, $iconSize, $fromScale, $toScale] ; |
---|
60 | } |
---|
61 | $line = <$csvFile> ; |
---|
62 | } |
---|
63 | |
---|
64 | # READ WAY RULES |
---|
65 | $line = <$csvFile> ; # omit SECTION |
---|
66 | while ( (! grep /^\"SECTION/, $line) and (defined $line) ) { |
---|
67 | if (! grep /^\"COMMENT/i, $line) { |
---|
68 | # print "way line: $line\n" ; |
---|
69 | my ($key, $value, $color, $thickness, $dash, $borderColor, $borderSize, $fill, $label, $labelColor, $labelSize, $labelFont, $labelOffset, $legend, $legendLabel, $baseLayer, $areaIcon, $fromScale, $toScale) = |
---|
70 | ($line =~ /\"(.+)\" \"(.+)\" \"(.+)\" (\d+) \"(.+)\" \"(.+)\" (\d+) (\d+) \"(.+)\" \"(.+)\" (\d+) \"(.+)\" ([\d\-]+) (\d) \"(.+)\" (\d) \"(.+)\" (\d+) (\d+)/ ) ; |
---|
71 | # print "W $key, $value, $color, $thickness, $dash, $borderColor, $borderSize, $fill, $label, $labelColor, $labelSize, $labelFont, $labelOffset, $legend, $legendLabel, $baseLayer, $areaIcon, $fromScale, $toScale\n" ; |
---|
72 | push @ways, [$key, $value, $color, $thickness, $dash, $borderColor, $borderSize, $fill, $label, $labelColor, $labelSize, $labelFont, $labelOffset, $legend, $legendLabel, $baseLayer, $areaIcon, $fromScale, $toScale] ; |
---|
73 | if (($areaIcon ne "") and ($areaIcon ne "none")) { addAreaIcon ($areaIcon) ; } |
---|
74 | } |
---|
75 | $line = <$csvFile> ; |
---|
76 | } |
---|
77 | |
---|
78 | # READ ROUTE RULES |
---|
79 | #print "ROUTE LINE: $line\n" ; |
---|
80 | $line = <$csvFile> ; # omit SECTION |
---|
81 | #print "ROUTE LINE: $line\n" ; |
---|
82 | while ( (! grep /^\"SECTION/, $line) and (defined $line) ) { |
---|
83 | if (! grep /^\"COMMENT/i, $line) { |
---|
84 | #print "ROUTE LINE: $line\n" ; |
---|
85 | my ($route, $color, $thickness, $dash, $opacity, $label, $nodeThickness, $fromScale, $toScale) = ($line =~ /\"(.+)\" \"(.+)\" (\d+) \"(.+)\" (\d+) \"(.+)\" (\d+) (\d+) (\d+)/ ) ; |
---|
86 | $opacity = $opacity / 100 ; |
---|
87 | push @routes, [$route, $color, $thickness, $dash, $opacity, $label, $nodeThickness, $fromScale, $toScale] ; |
---|
88 | } |
---|
89 | $line = <$csvFile> ; |
---|
90 | } |
---|
91 | close ($csvFile) ; |
---|
92 | |
---|
93 | foreach my $node (@nodes) { |
---|
94 | $node->[3] = scalePoints ($node->[3]) ; |
---|
95 | $node->[6] = scalePoints ($node->[6]) ; |
---|
96 | $node->[8] = scalePoints ($node->[8]) ; |
---|
97 | $node->[12] = scalePoints ($node->[12]) ; |
---|
98 | } |
---|
99 | |
---|
100 | foreach my $way (@ways) { |
---|
101 | $way->[3] = scalePoints ($way->[3]) ; |
---|
102 | $way->[6] = scalePoints ($way->[6]) ; |
---|
103 | $way->[10] = scalePoints ($way->[10]) ; |
---|
104 | $way->[12] = scalePoints ($way->[12]) ; |
---|
105 | } |
---|
106 | |
---|
107 | foreach my $route (@routes) { |
---|
108 | $route->[2] = scalePoints ($route->[2]) ; |
---|
109 | $route->[6] = scalePoints ($route->[6]) ; |
---|
110 | } |
---|
111 | |
---|
112 | foreach my $way (@ways) { |
---|
113 | if ($way->[4] ne "none") { |
---|
114 | # print "DASH BEFORE $way->[4]\n" ; |
---|
115 | my @dash = split /,/, $way->[4] ; |
---|
116 | my $dashNew = "" ; |
---|
117 | my $cap = pop @dash ; |
---|
118 | my $validCap = 0 ; |
---|
119 | foreach my $c ("butt", "round", "square") { |
---|
120 | if ($cap eq $c) { $validCap = 1 ; } |
---|
121 | } |
---|
122 | if ($validCap == 0) { $cap = "round" ; } |
---|
123 | if (scalar @dash % 2 != 0) { die "ERROR: odd number in dash definition $way->[4]\n" ; } |
---|
124 | foreach my $v (@dash) { |
---|
125 | $v = scalePoints ($v) ; |
---|
126 | $dashNew .= $v . "," ; |
---|
127 | } |
---|
128 | $dashNew .= $cap ; |
---|
129 | $way->[4] = $dashNew ; |
---|
130 | # print "DASH AFTER $way->[4]\n" ; |
---|
131 | } |
---|
132 | } |
---|
133 | |
---|
134 | foreach my $route (@routes) { |
---|
135 | if ($route->[3] ne "none") { |
---|
136 | my @dash = split /,/, $route->[3] ; |
---|
137 | my $dashNew = "" ; |
---|
138 | my $cap = pop @dash ; |
---|
139 | my $validCap = 0 ; |
---|
140 | foreach my $c ("butt", "round", "square") { |
---|
141 | if ($cap eq $c) { $validCap = 1 ; } |
---|
142 | } |
---|
143 | if ($validCap == 0) { $cap = "round" ; } |
---|
144 | if (scalar @dash % 2 != 0) { die "ERROR: odd number in dash definition $route->[3]\n" ; } |
---|
145 | foreach my $v (@dash) { |
---|
146 | $v = scalePoints ($v) ; |
---|
147 | $dashNew .= $v . "," ; |
---|
148 | } |
---|
149 | $dashNew .= $cap ; |
---|
150 | $route->[3] = $dashNew ; |
---|
151 | } |
---|
152 | } |
---|
153 | |
---|
154 | return (\@nodes, \@ways, \@routes) ; |
---|
155 | } |
---|
156 | |
---|
157 | |
---|
158 | sub printRules { |
---|
159 | print "WAYS/AREAS\n" ; |
---|
160 | foreach my $way (@ways) { |
---|
161 | printf "%-20s %-20s %-10s %-6s %-6s %-10s %-6s %-6s %-10s %-10s %-10s %-10s %-6s %-6s %-15s %-6s %-20s %-10s %-10s\n", $way->[0], $way->[1], $way->[2], $way->[3], $way->[4], $way->[5], $way->[6], $way->[7], $way->[8], $way->[9], $way->[10], $way->[11], $way->[12], $way->[13], $way->[14], $way->[15], $way->[16], $way->[17], $way->[18] ; |
---|
162 | } |
---|
163 | print "\n" ; |
---|
164 | print "NODES\n" ; |
---|
165 | foreach my $node (@nodes) { |
---|
166 | printf "%-20s %-20s %-10s %-10s %-10s %-10s %-10s %-10s %-10s %-10s %-15s %-20s %6s %-10s %-10s\n", $node->[0], $node->[1], $node->[2], $node->[3], $node->[4], $node->[5], $node->[6], $node->[7], $node->[8], $node->[9], $node->[10], $node->[11], $node->[12], $node->[13], $node->[14] ; |
---|
167 | } |
---|
168 | print "\n" ; |
---|
169 | |
---|
170 | print "ROUTES\n" ; |
---|
171 | foreach my $route (@routes) { |
---|
172 | printf "%-20s %-20s %-10s %-10s %-10s %-10s %-10s %-10s %-10s\n", $route->[0], $route->[1], $route->[2], $route->[3], $route->[4], $route->[5], $route->[6], $route->[7], $route->[8] ; |
---|
173 | } |
---|
174 | print "\n" ; |
---|
175 | } |
---|
176 | |
---|
177 | |
---|
178 | 1 ; |
---|
179 | |
---|
180 | |
---|