181 lines
6.7 KiB
Perl
Executable File
181 lines
6.7 KiB
Perl
Executable File
#
|
|
# PERL mapgenRules module by gary68
|
|
#
|
|
#
|
|
# Copyright (C) 2010, Gerhard Schwanz
|
|
#
|
|
# 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
|
|
# Free Software Foundation; either version 3 of the License, or (at your option) any later version.
|
|
#
|
|
# This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
|
# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
|
|
#
|
|
# You should have received a copy of the GNU General Public License along with this program; if not, see <http://www.gnu.org/licenses/>
|
|
|
|
|
|
package OSM::mapgenRules ; #
|
|
|
|
use strict ;
|
|
use warnings ;
|
|
|
|
use List::Util qw[min max] ;
|
|
use OSM::osm ;
|
|
use OSM::mapgen 1.19 ;
|
|
|
|
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
|
|
|
|
$VERSION = '1.19' ;
|
|
|
|
require Exporter ;
|
|
|
|
@ISA = qw ( Exporter AutoLoader ) ;
|
|
|
|
@EXPORT = qw ( readRules printRules ) ;
|
|
|
|
#
|
|
# constants
|
|
#
|
|
|
|
#
|
|
# variables
|
|
#
|
|
my @nodes = () ;
|
|
my @ways = () ;
|
|
my @routes = () ;
|
|
|
|
sub readRules {
|
|
my $csvName = shift ;
|
|
# READ STYLE File
|
|
print "read style file and preprocess tile icons for areas...\n" ;
|
|
open (my $csvFile, "<", $csvName) or die ("ERROR: style file not found.") ;
|
|
my $line = <$csvFile> ; # omit SECTION
|
|
|
|
# READ NODE RULES
|
|
$line = <$csvFile> ;
|
|
while (! grep /^\"SECTION/, $line) {
|
|
if (! grep /^\"COMMENT/i, $line) {
|
|
my ($key, $value, $color, $thickness, $label, $labelColor, $labelSize, $labelFont, $labelOffset, $legend, $legendLabel, $icon, $iconSize, $fromScale, $toScale) = ($line =~ /\"(.+)\" \"(.+)\" \"(.+)\" (\d+) \"(.+)\" \"(.+)\" (\d+) \"(.+)\" (\d+) (\d) \"(.+)\" \"(.+)\" (\d+) (\d+) (\d+)/ ) ;
|
|
# print "N $key, $value, $color, $thickness, $label, $labelColor, $labelSize, $labelFont, $labelOffset, $legend, $legendLabel, $icon, $iconSize, $fromScale, $toScale\n" ;
|
|
push @nodes, [$key, $value, $color, $thickness, $label, $labelColor, $labelSize, $labelFont, $labelOffset, $legend, $legendLabel, $icon, $iconSize, $fromScale, $toScale] ;
|
|
}
|
|
$line = <$csvFile> ;
|
|
}
|
|
|
|
# READ WAY RULES
|
|
$line = <$csvFile> ; # omit SECTION
|
|
while ( (! grep /^\"SECTION/, $line) and (defined $line) ) {
|
|
if (! grep /^\"COMMENT/i, $line) {
|
|
# print "way line: $line\n" ;
|
|
my ($key, $value, $color, $thickness, $dash, $borderColor, $borderSize, $fill, $label, $labelColor, $labelSize, $labelFont, $labelOffset, $legend, $legendLabel, $baseLayer, $areaIcon, $fromScale, $toScale) =
|
|
($line =~ /\"(.+)\" \"(.+)\" \"(.+)\" (\d+) \"(.+)\" \"(.+)\" (\d+) (\d+) \"(.+)\" \"(.+)\" (\d+) \"(.+)\" ([\d\-]+) (\d) \"(.+)\" (\d) \"(.+)\" (\d+) (\d+)/ ) ;
|
|
# print "W $key, $value, $color, $thickness, $dash, $borderColor, $borderSize, $fill, $label, $labelColor, $labelSize, $labelFont, $labelOffset, $legend, $legendLabel, $baseLayer, $areaIcon, $fromScale, $toScale\n" ;
|
|
push @ways, [$key, $value, $color, $thickness, $dash, $borderColor, $borderSize, $fill, $label, $labelColor, $labelSize, $labelFont, $labelOffset, $legend, $legendLabel, $baseLayer, $areaIcon, $fromScale, $toScale] ;
|
|
if (($areaIcon ne "") and ($areaIcon ne "none")) { addAreaIcon ($areaIcon) ; }
|
|
}
|
|
$line = <$csvFile> ;
|
|
}
|
|
|
|
# READ ROUTE RULES
|
|
#print "ROUTE LINE: $line\n" ;
|
|
$line = <$csvFile> ; # omit SECTION
|
|
#print "ROUTE LINE: $line\n" ;
|
|
while ( (! grep /^\"SECTION/, $line) and (defined $line) ) {
|
|
if (! grep /^\"COMMENT/i, $line) {
|
|
#print "ROUTE LINE: $line\n" ;
|
|
my ($route, $color, $thickness, $dash, $opacity, $label, $nodeThickness, $fromScale, $toScale) = ($line =~ /\"(.+)\" \"(.+)\" (\d+) \"(.+)\" (\d+) \"(.+)\" (\d+) (\d+) (\d+)/ ) ;
|
|
$opacity = $opacity / 100 ;
|
|
push @routes, [$route, $color, $thickness, $dash, $opacity, $label, $nodeThickness, $fromScale, $toScale] ;
|
|
}
|
|
$line = <$csvFile> ;
|
|
}
|
|
close ($csvFile) ;
|
|
|
|
foreach my $node (@nodes) {
|
|
$node->[3] = scalePoints ($node->[3]) ;
|
|
$node->[6] = scalePoints ($node->[6]) ;
|
|
$node->[8] = scalePoints ($node->[8]) ;
|
|
$node->[12] = scalePoints ($node->[12]) ;
|
|
}
|
|
|
|
foreach my $way (@ways) {
|
|
$way->[3] = scalePoints ($way->[3]) ;
|
|
$way->[6] = scalePoints ($way->[6]) ;
|
|
$way->[10] = scalePoints ($way->[10]) ;
|
|
$way->[12] = scalePoints ($way->[12]) ;
|
|
}
|
|
|
|
foreach my $route (@routes) {
|
|
$route->[2] = scalePoints ($route->[2]) ;
|
|
$route->[6] = scalePoints ($route->[6]) ;
|
|
}
|
|
|
|
foreach my $way (@ways) {
|
|
if ($way->[4] ne "none") {
|
|
# print "DASH BEFORE $way->[4]\n" ;
|
|
my @dash = split /,/, $way->[4] ;
|
|
my $dashNew = "" ;
|
|
my $cap = pop @dash ;
|
|
my $validCap = 0 ;
|
|
foreach my $c ("butt", "round", "square") {
|
|
if ($cap eq $c) { $validCap = 1 ; }
|
|
}
|
|
if ($validCap == 0) { $cap = "round" ; }
|
|
if (scalar @dash % 2 != 0) { die "ERROR: odd number in dash definition $way->[4]\n" ; }
|
|
foreach my $v (@dash) {
|
|
$v = scalePoints ($v) ;
|
|
$dashNew .= $v . "," ;
|
|
}
|
|
$dashNew .= $cap ;
|
|
$way->[4] = $dashNew ;
|
|
# print "DASH AFTER $way->[4]\n" ;
|
|
}
|
|
}
|
|
|
|
foreach my $route (@routes) {
|
|
if ($route->[3] ne "none") {
|
|
my @dash = split /,/, $route->[3] ;
|
|
my $dashNew = "" ;
|
|
my $cap = pop @dash ;
|
|
my $validCap = 0 ;
|
|
foreach my $c ("butt", "round", "square") {
|
|
if ($cap eq $c) { $validCap = 1 ; }
|
|
}
|
|
if ($validCap == 0) { $cap = "round" ; }
|
|
if (scalar @dash % 2 != 0) { die "ERROR: odd number in dash definition $route->[3]\n" ; }
|
|
foreach my $v (@dash) {
|
|
$v = scalePoints ($v) ;
|
|
$dashNew .= $v . "," ;
|
|
}
|
|
$dashNew .= $cap ;
|
|
$route->[3] = $dashNew ;
|
|
}
|
|
}
|
|
|
|
return (\@nodes, \@ways, \@routes) ;
|
|
}
|
|
|
|
|
|
sub printRules {
|
|
print "WAYS/AREAS\n" ;
|
|
foreach my $way (@ways) {
|
|
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] ;
|
|
}
|
|
print "\n" ;
|
|
print "NODES\n" ;
|
|
foreach my $node (@nodes) {
|
|
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] ;
|
|
}
|
|
print "\n" ;
|
|
|
|
print "ROUTES\n" ;
|
|
foreach my $route (@routes) {
|
|
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] ;
|
|
}
|
|
print "\n" ;
|
|
}
|
|
|
|
|
|
1 ;
|
|
|
|
|