Atlas48
/
mapweaver
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Partial refactor

This commit is contained in:
Atlas Cove 2022-07-28 11:32:59 +01:00
parent cc3d03f9ed
commit 5e9af49939
17 changed files with 3591 additions and 5485 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

165
mw.pl Normal file → Executable file
View File

@ -1,8 +1,5 @@
#
# PERL mapweaver by gary68
#
#
#
# PERL mapweaver by gary68 & atlas48
#
# Copyright(C)2011, Gerhard Schwanz
#
@ -15,72 +12,15 @@
# You should have received a copy of the GNU General Public License along with this program; if not, see <http://www.gnu.org/licenses/>
#
# 0.03 20110614 -help
# 0.03 20110614 square for nodes
# 0.03 print prg name and version
# 0.03 ruler
# 0.04 ruler positions; ruler background; disc opacity correction; -debug; -verbose
# 0.04 scale, colors and positions; header/footer
# 0.04 triangle and diamond for nodes; labels and icons for nodes
# 0.05 categories for config values
# 0.06 drawArea; area rules; extended help, added valid object properties
# 0.07 way labels; minsizearea implemented;
# 0.08 added coastlines; problems with completeObjects! use option -cie
# 0.09 oneways
# 0.10 pagenumbers; rectangles; comments and empty lines in rule file; config in rule file
# 0.10 coast lines fixed; auto bridge implemented
# 0.11 area icons / patterns added; time; street directory; poi directory; pdf directoriy
# 0.12 way shields
# 0.13 routes, not yet working...
# 0.14 route work
# 0.15 routes working now - finetuning needed; bgbolor implemented; multipolygons
# 0.16 size check for multipolygon areas; scale rule sizes (x:y)
# 0.17 -forcenodes; projection in footer
# 0.18 direxclude options and rule properties
# 0.19 pagenumber bug solved
# 0.20 legend
# 0.21 legend in separate file
# 0.22 help texts for object properties in rule file
# 0.23 latex string sanitize
# 0.24 labels for areas
# 0.25 labels for multipolygons
# 0.26 fix directory bugs
# 0.27 way name substitution, if name is too long for way. incl. legend for map
# 0.28 oceancolor bug fixed
# 0.29 fonts/families
# 0.30 -wns=5 now possible; way name substitutions in separate file
# 0.31 getXXXrule bug fixed; wnsunique
# 0.32 -targetSize
# 0.33 -onewayautosize
# 0.34 pbf support; halo; label transform; bold print of labels
# 0.35 svg text creation bug fixed
# 0.36 font size error wns corrected; box occupy; new place management
# 0.37 -dirprg program to create directory; gpx support
# 0.38 -gpxcolor; -gpxsize
# 0.39 parameter bug dirprg fixed; sanitize bug fixed
# 0.40 draw only items inside drawing area; check for undefined relation nodes, reduce errors
# 0.41 fixed icon space occupy error; eliminated labels drawn outside map area
# 0.42 fixed error with area label svg string
# 0.43 check if areas (simple ways) are closed before drawing
# 0.44 overpass options added
# 0.45 utf-8 encoding error solved for overpass data
# 0.46 out parameter fixed
# 0.47 added srtm option
# 0.48 shield error corrected
# TODO
# -different tempfilenames
my $version = "0.48";
my $programName = "mapweaver";
use strict ;
use warnings ;
use strict; use warnings;
use OSM::osm;
use mwConfig;
use mwMap;
use mwRules;
@ -95,90 +35,53 @@ use mwGPX ;
my $time0 = time();
print "\n$programName $version by gary68\n\n";
initConfig() ;
initConfig;
getProgramOptions;
getProgramOptions() ;
readConfigFile cv('ini');
readConfigFile( cv('ini') ) ;
if ( cv('help') eq "1" ) {
printConfigDescriptions() ;
printValidObjectProperties() ;
die ("quit after help output\n") ;
if(cv('help')eq "1"){ printConfigDescriptions;
printValidObjectProperties;
die "quit after help output\n";
}
printConfig if cv('verbose');
readRules;
if ( cv('verbose') eq "1" ) {
printConfig() ;
if(cv('debug')eq "1"){ printNodeRules;
printWayRules;
printAreaRules;
printRouteRules;
}
readRules() ;
if ( cv('debug') eq "1" ) {
printNodeRules() ;
printWayRules() ;
printAreaRules() ;
printRouteRules() ;
}
readFile() ;
readFile;
my $renderTime0 = time();
adaptRuleSizes;
adaptRuleSizes() ;
if ( cv('multionly') eq "0" ) {
processNodes() ;
if ( cv('poi') eq "1") {
createPoiDirectory() ;
unless(cv('multionly')){ processNodes;
createPoiDirectory()if cv('poi');
initOneways;
processWays;
createDirectory if cv('dir');
createDirPdf if cv('dirpdf');
processRoutes;
}
processMultipolygons;
createLegend if cv('legend');
processPageNumbers if cv('pagenumbers');
processRectanglesif if cv('rectangles');
boxDrawOccupiedAreas if cv('test');
processGPXFile if cv('gpx');
initOneways() ;
processWays() ;
if ( cv('dir') eq "1") {
createDirectory() ;
}
if ( cv('dirpdf') eq "1") {
createDirPdf() ;
}
processRoutes() ;
} # multionly
processMultipolygons() ;
if ( cv('legend') ne "0" ) { createLegend() ; }
if ( cv('pagenumbers') ne "" ) { processPageNumbers() ; }
if ( cv('rectangles') ne "" ) { processRectangles() ; }
if ( cv ('test') eq "1") {
boxDrawOccupiedAreas() ;
}
if ( cv ('gpx') ne "") {
processGPXFile() ;
}
writeMap() ;
writeMap;
my $renderTime1 = time();
my ($paper, $x, $y) = fitsPaper () ; $x = int ($x*10) / 10 ; $y = int ($y*10) / 10 ;
my($paper, $x, $y)= fitsPaper();
$x = int($x*10)/10;
$y = int($y*10)/10;
print "map($x cm x $y cm)fits paper $paper\n\n";
my $time1 = time();
print "\nrender time(excluding all file operations)", stringTimeSpent($renderTime1-$renderTime0), "\n";
print "\n$programName finished after ", stringTimeSpent($time1-$time0), "\n\n";

318
mwCoastLines.pm
View File

@ -1,9 +1,6 @@
#
# PERL mapweaver module by gary68
#
#
#
#
# Copyright(C)2011, 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
@ -17,11 +14,8 @@
package mwCoastLines;
use strict ;
use warnings ;
use Math::Polygon ;
use List::Util qw[min max] ;
use strict; use warnings;
use Math::Polygon; use List::Util qw[min max];
use mwMap;
use mwFile;
@ -39,8 +33,7 @@ require Exporter ;
);
sub nearestPoint {
#
sub nearestPoint{#
# accepts x/y coordinates and returns nearest point on border of map to complete cut coast ways
#
my $ref = shift;
@ -55,30 +48,21 @@ sub nearestPoint {
$xn = $xmax;
$yn = $y;
$min = abs($xmax-$x);
}
if ( abs ($ymax-$y) < $min) { # bottom
} if(abs($ymax-$y)<$min){# bottom
$xn = $x;
$yn = $ymax;
$min = abs($ymax-$y);
}
if ( abs ($x) < $min) { # left
} if(abs($x)<$min){# left
$xn = 0;
$yn = $y;
$min = abs($x);
}
if ( abs ($y) < $min) { # top
} if(abs($y)< $min){# top
$xn = $x;
$yn = 0;
}
# print " NP: final $xn $yn\n" ;
} # print " NP: final $xn $yn\n";
my @a =($xn, $yn);
return (\@a) ;
}
sub nextPointOnBorder {
#
return \@a;
}sub nextPointOnBorder{#
# accepts x/y coordinates and returns next point on border - to complete coast rings with other polygons and corner points
# hints if returned point is a corner
#
@ -88,161 +72,83 @@ sub nextPointOnBorder {
my $corner = 0;
my($xmax, $ymax)= getDimensions();
if($x == $xmax){# right border
if ($y < $ymax) {
$xn = $xmax ; $yn = $y + 1 ;
}
else {
$xn = $xmax - 1 ; $yn = $ymax ;
}
}
else {
if ($x == 0) { # left border
if ($y > 0) {
$xn = 0 ; $yn = $y - 1 ;
}
else {
$xn = 1 ; $yn = 0 ;
}
}
else {
if ($y == $ymax) { # bottom border
if ($x > 0) {
$xn = $x - 1 ; $yn = $ymax ;
}
else {
$xn = 0 ; $yn = $ymax - 1 ;
}
}
else {
if ($y == 0) { # top border
if ($x < $xmax) {
$xn = $x + 1 ; $yn = 0 ;
}
else {
$xn = $xmax ; $yn = 1 ;
}
}
}
}
}
# print "NPOB: $x, $y --- finito $xn $yn\n" ;
if ( ($xn == 0) and ($yn == 0) ) { $corner = 1 ; }
if ( ($xn == 0) and ($yn == $ymax) ) { $corner = 1 ; }
if ( ($xn == $xmax) and ($yn == 0) ) { $corner = 1 ; }
if ( ($xn == $xmax) and ($yn == $ymax) ) { $corner = 1 ; }
if($y < $ymax){ $xn = $xmax; $yn = $y + 1;
} else{ $xn = $xmax - 1; $yn = $ymax;
}} else{ if($x == 0){# left border
if($y > 0){ $xn = 0; $yn = $y - 1;
} else{ $xn = 1; $yn = 0;
} } else{ if($y == $ymax){# bottom border
if($x > 0){ $xn = $x - 1; $yn = $ymax;
} else{ $xn = 0; $yn = $ymax - 1;
} } else{ if($y == 0){# top border
if($x < $xmax){ $xn = $x + 1; $yn = 0;
} else{ $xn = $xmax; $yn = 1;
} } } }} # print "NPOB: $x, $y --- finito $xn $yn\n";
if(($xn == 0)and($yn == 0)){$corner = 1;} if(($xn == 0)and($yn == $ymax)){$corner = 1;} if(($xn == $xmax)and($yn == 0)){$corner = 1;} if(($xn == $xmax)and($yn == $ymax)){$corner = 1;}
return($xn, $yn, $corner);
}
# ---------------------------------------------------------------------------------
sub processCoastLines {
#
#
#
print "check and process coastlines...\n" ;
sub processCoastLines{ print "check and process coastlines...\n";
my $ref = shift; # ref to all coast ways
my @allWays = @$ref;
if (cv('debug') eq "1") {
if(cv('debug')){
print "COAST: " . scalar(@allWays). " coast ways initially found.\n";
print "COAST: ways: @allWays\n\n";
}
my($lonRef, $latRef)= getNodePointers();
my($nodesRef, $tagRef)= getWayPointers();
# check coast ways. eliminate invisible ways. eliminate points outside map.
my @newWays =();
foreach my $w ( @allWays ) {
my @nodes = @{ $$nodesRef{ $w } } ;
foreach my $w(@allWays){ my @nodes = @{$$nodesRef{$w}};
my $allIn = 1;
my $allOut = 1;
foreach my $n ( @nodes ) {
if ( pointInMap ($n) ) {
$allOut = 0 ;
}
else {
$allIn = 0 ;
}
}
if ( $allIn ) {
# use way as it is
foreach my $n(@nodes){ if(pointInMap($n)){ $allOut = 0;
} else{ $allIn = 0;
} }
if($allIn){ # use way as it is
push @newWays, $w;
if ( cv ('debug') eq "1" ) { print "COAST: way $w will be used unmodified.\n" ; }
}
elsif ( $allOut) {
# do nothing
if ( cv ('debug') eq "1" ) { print "COAST: way $w will NOT be used. outside map.\n" ; }
}
else {
# eliminate all outside nodes at start and end of way, then use new way
print "COAST: way $w will be used unmodified.\n" if cv('debug');
} elsif($allOut){ # do nothing
print "COAST: way $w will NOT be used. outside map.\n" if cv('debug');} } else{ # eliminate all outside nodes at start and end of way, then use new way
# eliminate outsides at start
while ( (scalar @nodes >= 1) and ( ! pointInMap ($nodes[0]) ) ) {
shift @nodes ;
}
shift @nodes while((scalar(@nodes)>= 1)and not pointInMap($nodes[0]));
# eliminate outsides at end
while ( (scalar @nodes >= 1) and ( ! pointInMap ($nodes[-1]) ) ) {
pop @nodes ;
while((scalar @nodes >= 1)and not pointInMap($nodes[-1])){ pop @nodes;
}
if ( scalar @nodes >= 2 ) {
@{ $$nodesRef{$w}} = @nodes ;
if(scalar @nodes >= 2){ @{$$nodesRef{$w}}= @nodes;
push @newWays, $w;
if ( cv ('debug') eq "1" ) { print "COAST: modified way $w will be used.\n" ; }
if(cv('debug')eq "1"){print "COAST: modified way $w will be used.\n";} } else{ if(cv('debug')eq "1"){print "COAST: way $w too short now.\n";} } }
}
else {
if ( cv ('debug') eq "1" ) { print "COAST: way $w too short now.\n" ; }
}
}
}
@allWays = @newWays;
if(cv('debug')eq "1"){
print "\nCOAST: " . scalar(@allWays). " coast ways will be used.\n";
print "COAST: ways: @allWays\n\n";
}
if (scalar @allWays > 0) {
# build rings
if(scalar @allWays > 0){ # build rings
my($refWays, $refNodes)= buildRings(\@allWays, 0);
my @ringNodes = @$refNodes; # contains all nodes of rings // array of arrays !
if (cv('debug') eq "1") { print "COAST: " . scalar (@ringNodes) . " rings found.\n" ; }
print "COAST: " . scalar(@ringNodes). " rings found.\n" if cv('debug');
# convert rings to coordinate system
my @ringCoordsOpen =(); my @ringCoordsClosed =();
for (my $i=0; $i<=$#ringNodes; $i++) {
# print "COAST: initial ring $i\n" ;
for(my $i=0; $i<=$#ringNodes; $i++){ # print "COAST: initial ring $i\n";
my @actualCoords =();
foreach my $node (@{$ringNodes[$i]}) {
push @actualCoords, [convert ($$lonRef{$node}, $$latRef{$node})] ;
}
if (${$ringNodes[$i]}[0] == ${$ringNodes[$i]}[-1]) {
push @ringCoordsClosed, [@actualCoords] ; # islands
}
else {
push @ringCoordsOpen, [@actualCoords] ;
}
# printRingCoords (\@actualCoords) ;
foreach my $node(@{$ringNodes[$i]}){ push @actualCoords, [convert($$lonRef{$node}, $$latRef{$node})];
} if(${$ringNodes[$i]}[0] == ${$ringNodes[$i]}[-1]){ push @ringCoordsClosed, [@actualCoords]; # islands
} else{ push @ringCoordsOpen, [@actualCoords];
} # printRingCoords(\@actualCoords);
my $num = scalar @actualCoords;
if (cv('debug') eq "1") { print "COAST: initial ring $i - $actualCoords[0]->[0],$actualCoords[0]->[1] -->> $actualCoords[-1]->[0],$actualCoords[-1]->[1] nodes: $num\n" ; }
print "COAST: initial ring $i - $actualCoords[0]->[0],$actualCoords[0]->[1] -->> $actualCoords[-1]->[0],$actualCoords[-1]->[1] nodes: $num\n" if cv('debug');
}
if (cv('debug') eq "1") { print "COAST: add points on border...\n" ; }
foreach my $ring (@ringCoordsOpen) {
# print "COAST: ring $ring with border nodes\n" ;
if(cv('debug')eq "1"){print "COAST: add points on border...\n";} foreach my $ring(@ringCoordsOpen){ # print "COAST: ring $ring with border nodes\n";
# add first point on border
my $ref = nearestPoint($ring->[0]);
my @a = @$ref;
@ -253,15 +159,14 @@ sub processCoastLines {
push @$ring, [@a];
# printRingCoords($ring);
}
my @islandRings = @ringCoordsClosed;
if (cv('debug') eq "1") { print "COAST: " . scalar (@islandRings) . " islands found.\n" ; }
print "COAST: " . scalar(@islandRings). " islands found.\n" if cv('debug');
@ringCoordsClosed =();
# process ringCoordsOpen
# add other rings, corners...
while(scalar @ringCoordsOpen > 0){# as long as there are open rings
if (cv('debug') eq "1") { print "COAST: building ring...\n" ; }
print "COAST: building ring...\n" if(cv('debug');
my $ref = shift @ringCoordsOpen; # get start ring
my @actualRing = @$ref;
@ -272,7 +177,7 @@ sub processCoastLines {
my $actualStartX = $actualRing[0]->[0];
my $actualStartY = $actualRing[0]->[1];
if (cv('debug') eq "1") { print "COAST: actual and actualStart $actualX, $actualY - $actualStartX, $actualStartY\n" ; }
print "COAST: actual and actualStart $actualX, $actualY - $actualStartX, $actualStartY\n" if cv('debug');
my $corner;
while(!$closed){# as long as this ring is not closed
@ -280,19 +185,12 @@ sub processCoastLines {
# print " actual $actualX, $actualY\n";
my $startFromOtherPolygon = -1;
# find matching ring if there is another ring
if (scalar @ringCoordsOpen > 0) {
for (my $i=0; $i <= $#ringCoordsOpen; $i++) {
my @test = @{$ringCoordsOpen[$i]} ;
if(scalar(@ringCoordsOpen)> 0){ for(my $i=0; $i <= $#ringCoordsOpen; $i++){ my @test = @{$ringCoordsOpen[$i]};
# print " test ring $i: ", $test[0]->[0], " " , $test[0]->[1] , "\n";
if ( ($actualX == $test[0]->[0]) and ($actualY == $test[0]->[1]) ) {
$startFromOtherPolygon = $i ;
if (cv('debug') eq "1") { print "COAST: matching start other polygon found i= $i\n" ; }
}
}
}
# process matching polygon, if present
if ($startFromOtherPolygon != -1) { # start from other polygon {
# append nodes
if(($actualX == $test[0]->[0])and($actualY == $test[0]->[1])){ $startFromOtherPolygon = $i;
print "COAST: matching start other polygon found i= $i\n" if cv('debug');
} } } # process matching polygon, if present
if($startFromOtherPolygon != -1){# start from other polygon{ # append nodes
# print "ARRAY TO PUSH: @{$ringCoordsOpen[$startFromOtherPolygon]}\n";
push @actualRing, @{$ringCoordsOpen[$startFromOtherPolygon]};
# set actual
@ -300,118 +198,72 @@ sub processCoastLines {
$actualY = $actualRing[-1]->[1];
# drop p2 from opens
splice @ringCoordsOpen, $startFromOtherPolygon, 1;
if (cv('debug') eq "1") { print "COAST: openring $startFromOtherPolygon added to actual ring\n" ; }
}
else {
if ($corner) { # add corner to actual ring
print "COAST: openring $startFromOtherPolygon added to actual ring\n" if cv('debug');
} else{ if($corner){# add corner to actual ring
push @actualRing, [$actualX, $actualY];
if (cv('debug') eq "1") { print "COAST: corner $actualX, $actualY added to actual ring\n" ; }
}
}
# check if closed
if ( ($actualX == $actualStartX) and ($actualY == $actualStartY) ) {
$closed = 1 ;
print "COAST: corner $actualX, $actualY added to actual ring\n" if cv('debug');
} } # check if closed
if(($actualX == $actualStartX)and($actualY == $actualStartY)){ $closed = 1;
push @actualRing, [$actualX, $actualY];
push @ringCoordsClosed, [@actualRing];
if (cv('debug') eq "1") { print "COAST: ring now closed and moved to closed rings.\n" ; }
}
} # !closed
print "COAST: ring now closed and moved to closed rings.\n" if cv('debug');
} }# !closed
}# open rings
my $color = cv('oceancolor');
# build islandRings polygons
if (cv('debug') eq "1") { print "OCEAN: building island polygons\n" ; }
print "OCEAN: building island polygons\n" if cv('debug');
my @islandPolygons =();
if (scalar @islandRings > 0) {
for (my $i=0; $i<=$#islandRings; $i++) {
my @poly = () ;
foreach my $node ( @{$islandRings[$i]} ) {
push @poly, [$node->[0], $node->[1]] ;
}
my ($p) = Math::Polygon->new(@poly) ;
if(scalar @islandRings > 0){ for(my $i=0; $i<=$#islandRings; $i++){ my @poly =();
foreach my $node(@{$islandRings[$i]}){ push @poly, [$node->[0], $node->[1]];
} my($p)= Math::Polygon->new(@poly);
$islandPolygons[$i] = $p;
}
}
} }
# build ocean ring polygons
if (cv('debug') eq "1") { print "OCEAN: building ocean polygons\n" ; }
my @oceanPolygons = () ;
if (scalar @ringCoordsClosed > 0) {
for (my $i=0; $i<=$#ringCoordsClosed; $i++) {
my @poly = () ;
foreach my $node ( @{$ringCoordsClosed[$i]} ) {
push @poly, [$node->[0], $node->[1]] ;
}
my ($p) = Math::Polygon->new(@poly) ;
if(cv('debug')eq "1"){print "OCEAN: building ocean polygons\n";} my @oceanPolygons =();
if(scalar(@ringCoordsClosed)> 0){ for(my $i=0; $i<=$#ringCoordsClosed; $i++){ my @poly =();
foreach my $node(@{$ringCoordsClosed[$i]}){ push @poly, [$node->[0], $node->[1]];
} my($p)= Math::Polygon->new(@poly);
$oceanPolygons[$i] = $p;
}
}
else {
if (scalar @islandRings > 0) {
if (cv('debug') eq "1") { print "OCEAN: build ocean rect\n" ; }
my @ocean = () ;
} } else{ if(scalar(@islandRings)> 0){ if(cv('debug')eq "1"){print "OCEAN: build ocean rect\n";} my @ocean =();
my($x, $y)= getDimensions();
push @ocean, [0,0], [$x,0], [$x,$y], [0,$y], [0,0];
push @ringCoordsClosed, [@ocean];
my($p)= Math::Polygon->new(@ocean);
push @oceanPolygons, $p;
}
}
} }
# finally create pathes for SVG
for (my $i=0; $i<=$#ringCoordsClosed; $i++) {
# foreach my $ring (@ringCoordsClosed) {
my @ring = @{$ringCoordsClosed[$i]} ;
for(my $i=0; $i<=$#ringCoordsClosed; $i++){ # foreach my $ring(@ringCoordsClosed){ my @ring = @{$ringCoordsClosed[$i]};
my @array =();
my @coords =();
foreach my $c (@ring) {
push @coords, $c->[0], $c->[1] ;
}
push @array, [@coords] ;
if (scalar @islandRings > 0) {
for (my $j=0; $j<=$#islandRings; $j++) {
# island in ring? 1:1 and coast on border?
# if (isIn ($islandPolygons[$j], $oceanPolygons[$i]) == 1) {
if ( (isIn ($islandPolygons[$j], $oceanPolygons[$i]) == 1) or
( (scalar @islandRings == 1) and (scalar @ringCoordsClosed == 1) ) ) {
if (cv('debug') eq "1") { print "OCEAN: island $j in ocean $i\n" ; }
my @coords = () ;
foreach my $c (@{$islandRings[$j]}) {
push @coords, $c->[0], $c->[1] ;
}
push @array, [@coords] ;
}
}
}
foreach my $c(@ring){ push @coords, $c->[0], $c->[1];
} push @array, [@coords];
if(scalar @islandRings > 0){ for(my $j=0; $j<=$#islandRings; $j++){ # island in ring? 1:1 and coast on border?
# if(isIn($islandPolygons[$j], $oceanPolygons[$i])== 1){ if((isIn($islandPolygons[$j], $oceanPolygons[$i])== 1)or
((scalar @islandRings == 1)and(scalar @ringCoordsClosed == 1))){ if(cv('debug')eq "1"){print "OCEAN: island $j in ocean $i\n";} my @coords =();
foreach my $c(@{$islandRings[$j]}){ push @coords, $c->[0], $c->[1];
} push @array, [@coords];
} } }
# drawAreaOcean($color, \@array);
my $svgText = "fill=\"$color\" ";
drawArea($svgText, "none", \@array, 0, "base");
}
}
}
sub pointInMap {
my ($n) = shift ;
}}}
sub pointInMap{ my($n)= shift;
my($sizeX, $sizeY)= getDimensions();
my($lonRef, $latRef)= getNodePointers();
my($x, $y)= convert($$lonRef{$n}, $$latRef{$n});
my $ok = 0;
if (
( $x >= 0 ) and
if(($x >= 0)and
($x <= $sizeX)and
($y >= 0)and
( $y <= $sizeY ) ) {
$ok = 1 ;
($y <= $sizeY)){ $ok = 1;
} return $ok;
}
return $ok ;
}
1;

119
mwConfig.pm
View File

@ -1,9 +1,6 @@
#
# PERL mapweaver module by gary68
#
#
#
#
# Copyright(C)2011, 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
@ -21,7 +18,6 @@ package mwConfig ;
use strict;
use warnings;
use Getopt::Long;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
@ -198,71 +194,37 @@ my %explanation = () ;
# --------------------------------------------------------------------------------
sub initConfig {
# set initial values according to program internal values from array @initial
foreach my $kv (@initial) {
$cv{ lc( $kv->[0] ) } = $kv->[1] ;
sub initConfig{ # set initial values according to program internal values from array @initial
foreach my $kv(@initial){ $cv{lc($kv->[0])}= $kv->[1];
$explanation{lc($kv->[0])}= $kv->[2];
}
}
sub setConfigValue {
# allows any module to change a certain k/v pair
}}
sub setConfigValue{ # allows any module to change a certain k/v pair
my($k, $v)= @_;
$k = lc($k);
$cv{$k}= $v;
if ($cv{"verbose"} > 1) { print "config key $k. value changed to $v\n" ; }
}
sub cv {
# access a value by key
if($cv{"verbose"}> 1){print "config key $k. value changed to $v\n";}}
sub cv{ # access a value by key
my $k = shift;
$k = lc($k);
if ( ! defined $cv{ $k } ) { print "WARNING: requested config key $k not defined!\n" ; }
return ( $cv{ $k } ) ;
if(! defined $cv{$k}){print "WARNING: requested config key $k not defined!\n";} return($cv{$k});
}
sub printConfig {
# print actual config to stdout
sub printConfig{ # print actual config to stdout
print "\nActual configuration\n";
my %cats =();
foreach my $e (@initial) {
$cats{ $e->[3] } = 1 ;
foreach my $e(@initial){ $cats{$e->[3]}= 1;
}
foreach my $cat (sort keys %cats) {
my @entries = () ;
foreach my $e (@initial) {
if ($e->[3] eq $cat) {
push @entries, $e->[0] ;
}
}
print "\nCATEGORY $cat\n" ;
foreach my $cat(sort keys %cats){ my @entries =();
foreach my $e(@initial){ if($e->[3] eq $cat){ push @entries, $e->[0];
} } print "\nCATEGORY $cat\n";
print "--------\n";
foreach my $e ( sort { $a cmp $b } @entries ) {
printf "%-30s %-30s\n", $e, cv($e) ;
foreach my $e(sort{$a cmp $b}@entries){ printf "%-30s %-30s\n", $e, cv($e);
}} print "\n";
}
}
print "\n" ;
}
sub readConfigFile {
# read ini file; initial k/v pairs might be changed
sub readConfigFile{ # read ini file; initial k/v pairs might be changed
my $fileName = shift;
my $lc = 0;
@ -270,30 +232,14 @@ sub readConfigFile {
open(my $file, "<", $fileName)or die("ERROR: could not open ini file $fileName\n");
my $line = "";
while ($line = <$file>) {
$lc ++ ;
if ( ! grep /^#/, $line) {
my ($k, $v) = ( $line =~ /(.+?)=(.*)/ ) ;
if ( ( ! defined $k ) or ( ! defined $v ) ) {
print "WARNING: could not parse config line: $line" ;
}
else {
$k = lc ( $k ) ;
while($line = <$file>){ $lc++;
unless(grep(/^#/, $line)){ my($k, $v)=($line =~ /(.+?)=(.*)/);
if((! defined $k)or(! defined $v)){ print "WARNING: could not parse config line: $line";
} else{ $k = lc($k);
$cv{$k}= $v;
}
}
}
close ($file) ;
} }} close $file;
print "$lc lines read.\n\n";
}
# ---------------------------------------------------------------------------------------
sub getProgramOptions {
my $optResult = GetOptions ( "in=s" => \$cv{'in'}, # the in file, mandatory
}sub getProgramOptions{my $optResult = GetOptions("in=s" => \$cv{'in'}, # the in file, mandatory
"overpass" => \$cv{'overpass'},
"near:s" => \$cv{'near'},
"overpassdistance:i" => \$cv{'overpassdistance'},
@ -378,27 +324,14 @@ my $optResult = GetOptions ( "in=s" => \$cv{'in'}, # the in file, mandatory
"cie" => \$cv{'cie'}, # turns debug messages on
"verbose" => \$cv{'verbose'}, # turns twitter on
"test" => \$cv{'test'}); # test
}
sub printConfigDescriptions {
my @texts = @initial ;
sub printConfigDescriptions{ my @texts = @initial;
@texts = sort{$a->[0] cmp $b->[0]}@texts;
print "\nconfig value descriptions\n\n";
printf "%-25s %-50s %-20s\n" , "key" , "description", "default";
foreach my $t (@texts) {
my $def = $t->[1] ;
if ($def eq "") { $def = "<EMPTY>" ; }
foreach my $t(@texts){ my $def = $t->[1];
$def = "<EMPTY>" unless $def;
printf "%-25s %-50s %-20s\n" , $t->[0] , $t->[2], $def;
}
print "\n" ;
}
1 ;
} print "\n";
}1;

224
mwFile.pm
View File

@ -24,8 +24,8 @@ use warnings ;
use mwConfig;
use mwMap;
use mwLabel;
use LWP::Simple ;
use LWP::Simple;
use OSM::osm;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
@ -42,11 +42,10 @@ require Exporter ;
my %lon;
my %lat;
my %memNodeTags ;
my %memNodeTags;
my %memWayNodes;
my %memWayTags;
my %memRelationMembers;
my %memRelationTags;
@ -56,7 +55,6 @@ my $overpassSource3 = "interpreter?data=%28node%28BOTTOM%2CLEFT%2CTOP%2CRIGHT%29
sub readFile{
my($nodeId, $nodeLon, $nodeLat, $nodeUser, $aRef1, @nodeTags);
my($wayId, $wayUser, $aRef2, @wayTags, @wayNodes);
my($relationId, $relationUser, @relationTags, @relationMembers);
@ -66,40 +64,30 @@ sub readFile {
my $osmName;
if(defined cv('in')){$osmName = cv('in');}
my $clipbbox = "";
if(defined cv('clipbbox')){$clipbbox = cv('clipbbox');}
if ( cv('overpass') eq "1" ) {
if ( cv('place') eq "" ) { die ("ERROR: option place not specified.\n") ; }
if(cv('overpass')eq "1"){ if(cv('place')eq ""){die("ERROR: option place not specified.\n");}
my $overpassNear = cv('near');
my $overpassDistance = cv('overpassdistance');
my $overpassName = cv('place');
my $overpassUrl1 = cv('overpassserver'). $overpassSource1;
if ( cv('near') eq "" ) {
$overpassUrl1 = cv('overpassserver') . $overpassSource0 ;
if(cv('near')eq ""){ $overpassUrl1 = cv('overpassserver'). $overpassSource0;
}
$overpassUrl1 =~ s/NEAR/$overpassNear/;
$overpassUrl1 =~ s/DIST/$overpassDistance/;
$overpassUrl1 =~ s/NAME/$overpassName/;
if ( cv('debug') eq "1" ) { print "Overpass Query1: $overpassUrl1 ...\n" ; }
print "Send Query 1 to overpass server..\n" ;
if(cv('debug')eq "1"){print "Overpass Query1: $overpassUrl1 ...\n";} print "Send Query 1 to overpass server..\n";
my $result1 = get($overpassUrl1);
if(! defined $result1){die("ERROR: bad overpass result!\n");}
if(cv('debug')eq "1"){print "\n$result1\n\n";}
# get lon, lat
my($placeLon)=($result1 =~ /lon=\"([\d\.\-]+)/);
my($placeLat)=($result1 =~ /lat=\"([\d\.\-]+)/);
if((! defined $placeLon)or(! defined $placeLat)){die("ERROR: lon/lat could not be obtained from 1st overpass result.\n");}
print "place $overpassName found:\n";
print "lon= $placeLon\n";
print "lat= $placeLat\n";
@ -119,11 +107,9 @@ sub readFile {
$overpassUrl2 =~ s/BOTTOM/$overBottom/;
if ( cv('debug') eq "1" ) { print "Overpass Query2: $overpassUrl2\n" ; }
print "Send Query 2 to overpass server..\n" ;
if(cv('debug')eq "1"){print "Overpass Query2: $overpassUrl2\n";} print "Send Query 2 to overpass server..\n";
my $result2 = get($overpassUrl2);
if(! defined $result2){die("ERROR: bad overpass result!\n");}
# save
@ -138,11 +124,8 @@ sub readFile {
# setConfigValue('place', '');
$clipbbox = "$overLeft,$overBottom,$overRight,$overTop";
if ( cv('debug') eq "1" ) { print "clipbox: $clipbbox\n" ; }
}
if ( grep /\.pbf/, $osmName ) {
my $newName = $osmName ;
if(cv('debug')eq "1"){print "clipbox: $clipbbox\n";}}
if(grep /\.pbf/, $osmName){ my $newName = $osmName;
$newName =~ s/\.pbf/\.osm/i;
# osmosis
@ -154,7 +137,6 @@ sub readFile {
setConfigValue("in", $newName);
}
# -place given? look for place and call osmosis
my $left;
@ -163,46 +145,28 @@ sub readFile {
my $bottom;
my $placeFound = 0; my $placeLon; my $placeLat;
if ( ( cv('place') ne "") and (cv('overpass') ne "1" ) ) {
my ($placeId) = ( cv('place') =~ /([\d]+)/);
if (!defined $placeId) { $placeId = -999999999 ; }
print "looking for place...\n" ;
if((cv('place')ne "")and(cv('overpass')ne "1")){ my($placeId)=(cv('place')=~ /([\d]+)/);
if(!defined $placeId){$placeId = -999999999;} print "looking for place...\n";
my $placeFileName = "";
if(cv('placeFile')ne ""){
$placeFileName = cv('placeFile');
} else{ $placeFileName = cv('in');
}
else {
$placeFileName = cv('in') ;
}
openOsmFile($placeFileName);
($nodeId, $nodeLon, $nodeLat, $nodeUser, $aRef1)= getNode2();
if ($nodeId != -1) {
@nodeTags = @$aRef1 ;
}
my $place = cv ('place') ;
while ( ($nodeId != -1) and ($placeFound == 0) ) {
my $placeNode = 0 ; my $placeName = 0 ;
foreach my $tag ( @nodeTags ) {
if ($tag->[0] eq "place") { $placeNode = 1 ; }
if ( ($tag->[0] eq "name") and (grep /$place/i, $tag->[1]) ){ $placeName = 1 ; }
}
if ( (($placeNode == 1) and ($placeName == 1)) or ($placeId == $nodeId) ) {
$placeFound = 1 ;
if($nodeId != -1){ @nodeTags = @$aRef1;
} my $place = cv('place');
while(($nodeId != -1)and($placeFound == 0)){ my $placeNode = 0; my $placeName = 0;
foreach my $tag(@nodeTags){ if($tag->[0] eq "place"){$placeNode = 1;} if(($tag->[0] eq "name")and(grep /$place/i, $tag->[1])){$placeName = 1;} } if((($placeNode == 1)and($placeName == 1))or($placeId == $nodeId)){ $placeFound = 1;
$placeLon = $nodeLon;
$placeLat = $nodeLat;
}
($nodeId, $nodeLon, $nodeLat, $nodeUser, $aRef1) = getNode2 () ;
if ($nodeId != -1) {
@nodeTags = @$aRef1 ;
}
}
} ($nodeId, $nodeLon, $nodeLat, $nodeUser, $aRef1)= getNode2();
if($nodeId != -1){ @nodeTags = @$aRef1;
} }
closeOsmFile();
if ($placeFound == 1) {
print "place $place found at " ;
if($placeFound == 1){ print "place $place found at ";
print "lon: $placeLon ";
print "lat: $placeLat\n";
$left = $placeLon - cv('lonrad')/(111.11 * cos($placeLat / 360 * 3.14 * 2));
@ -212,41 +176,28 @@ sub readFile {
print "call osmosis...\n";
if ( cv('cie') eq "0" ) {
print "OSMOSIS STRING: --bounding-box completeWays=yes completeRelations=yes bottom=$bottom top=$top left=$left right=$right\n" ;
if(cv('cie')eq "0"){ print "OSMOSIS STRING: --bounding-box completeWays=yes completeRelations=yes bottom=$bottom top=$top left=$left right=$right\n";
`osmosis --read-xml $osmName --bounding-box completeWays=yes completeRelations=yes bottom=$bottom top=$top left=$left right=$right --write-xml ./temp.osm`;
}
else {
print "OSMOSIS STRING: --bounding-box clipIncompleteEntities=yes bottom=$bottom top=$top left=$left right=$right\n" ;
} else{ print "OSMOSIS STRING: --bounding-box clipIncompleteEntities=yes bottom=$bottom top=$top left=$left right=$right\n";
`osmosis --read-xml $osmName --bounding-box clipIncompleteEntities=yes bottom=$bottom top=$top left=$left right=$right --write-xml ./temp.osm`;
}
print "osmosis done.\n";
$osmName = "./temp.osm";
$clipbbox = "$left,$bottom,$right,$top";
}
else {
print "ERROR: place $place not found.\n" ;
} else{ print "ERROR: place $place not found.\n";
die();
}
}
}}
my $srtmFileName = cv('srtm');
if($srtmFileName ne ""){
my $cmdX = "osmosis --read-xml $osmName --rx file=\"$srtmFileName\" --bounding-box completeWays=yes completeRelations=yes bottom=$bottom top=$top left=$left right=$right --merge --write-xml file=\"./temp2.osm\"";
my $cmdP = "osmosis --read-xml $osmName --read-pbf file=\"$srtmFileName\" --bounding-box completeWays=yes completeRelations=yes bottom=$bottom top=$top left=$left right=$right --merge --write-xml file=\"./temp2.osm\"";
my $cmd = "";
if (grep /\.pbf/, $srtmFileName) {
$cmd = $cmdP ;
if(grep /\.pbf/, $srtmFileName){ $cmd = $cmdP;
} else{ $cmd = $cmdX;
}
else {
$cmd = $cmdX ;
}
print "call osmosis to merge SRTM data...\n$cmd\n";
`$cmd`;
@ -254,146 +205,90 @@ sub readFile {
$osmName = "temp2.osm";
}
# STORE DATA
my $nr = 0; my $wr = 0; my $rr = 0;
print "reading osm file...\n";
openOsmFile($osmName);
($nodeId, $nodeLon, $nodeLat, $nodeUser, $aRef1)= getNode2();
if ($nodeId != -1) {
@nodeTags = @$aRef1 ;
}
while ($nodeId != -1) {
$nr++ ;
if($nodeId != -1){ @nodeTags = @$aRef1;
} while($nodeId != -1){ $nr++;
$lon{$nodeId}= $nodeLon; $lat{$nodeId}= $nodeLat;
@{$memNodeTags{$nodeId}}= @nodeTags;
($nodeId, $nodeLon, $nodeLat, $nodeUser, $aRef1)= getNode2();
if ($nodeId != -1) {
@nodeTags = @$aRef1 ;
}
}
if($nodeId != -1){ @nodeTags = @$aRef1;
}}
($wayId, $wayUser, $aRef1, $aRef2)= getWay2();
if ($wayId != -1) {
@wayNodes = @$aRef1 ;
if($wayId != -1){ @wayNodes = @$aRef1;
@wayTags = @$aRef2;
}
while ($wayId != -1) {
$wr++ ;
if (scalar (@wayNodes) > 1) {
@{$memWayTags{$wayId}} = @wayTags ;
} while($wayId != -1){ $wr++;
if(scalar(@wayNodes)> 1){ @{$memWayTags{$wayId}}= @wayTags;
@{$memWayNodes{$wayId}}= @wayNodes;
foreach my $node (@wayNodes) {
if (!defined $lon{$node}) {
print " ERROR: way $wayId references node $node, which is not present!\n" ;
foreach my $node(@wayNodes){ if(!defined $lon{$node}){ print " ERROR: way $wayId references node $node, which is not present!\n";
} } } else{ $invalidWays{$wayId}= 1;
}
}
}
else {
$invalidWays{$wayId} = 1 ;
}
($wayId, $wayUser, $aRef1, $aRef2)= getWay2();
if ($wayId != -1) {
@wayNodes = @$aRef1 ;
if($wayId != -1){ @wayNodes = @$aRef1;
@wayTags = @$aRef2;
}
}
}}
($relationId, $relationUser, $aRef1, $aRef2)= getRelation();
if ($relationId != -1) {
@relationMembers = @$aRef1 ;
if($relationId != -1){ @relationMembers = @$aRef1;
@relationTags = @$aRef2;
}
while ($relationId != -1) {
$rr++ ;
while($relationId != -1){ $rr++;
@{$memRelationTags{$relationId}}= @relationTags;
@{$memRelationMembers{$relationId}}= @relationMembers;
foreach my $member (@relationMembers) {
if ( ($member->[0] eq "node") and (!defined $lon{$member->[1]}) ) {
print " ERROR: relation $relationId references node $member->[1] which is not present!\n" ;
}
if ( ($member->[0] eq "way") and (!defined $memWayNodes{$member->[1]} ) and (!defined $invalidWays{$member->[1]}) ) {
print " ERROR: relation $relationId references way $member->[1] which is not present or invalid!\n" ;
}
}
foreach my $member(@relationMembers){ if(($member->[0] eq "node")and(!defined $lon{$member->[1]})){ print " ERROR: relation $relationId references node $member->[1] which is not present!\n";
} if(($member->[0] eq "way")and(!defined $memWayNodes{$member->[1]})and(!defined $invalidWays{$member->[1]})){ print " ERROR: relation $relationId references way $member->[1] which is not present or invalid!\n";
} }
#next
($relationId, $relationUser, $aRef1, $aRef2)= getRelation();
if ($relationId != -1) {
@relationMembers = @$aRef1 ;
if($relationId != -1){ @relationMembers = @$aRef1;
@relationTags = @$aRef2;
}
}
}}
closeOsmFile();
print "read: $nr nodes, $wr ways and $rr relations.\n\n";
# calc area of pic and init graphics
my $lonMin = 999; my $lonMax = -999; my $latMin = 999; my $latMax = -999;
foreach my $key (keys %lon) {
if ($lon{$key} > $lonMax) { $lonMax = $lon{$key} ; }
if ($lon{$key} < $lonMin) { $lonMin = $lon{$key} ; }
if ($lat{$key} > $latMax) { $latMax = $lat{$key} ; }
if ($lat{$key} < $latMin) { $latMin = $lat{$key} ; }
}
foreach my $key(keys %lon){ if($lon{$key}> $lonMax){$lonMax = $lon{$key};} if($lon{$key}< $lonMin){$lonMin = $lon{$key};} if($lat{$key}> $latMax){$latMax = $lat{$key};} if($lat{$key}< $latMin){$latMin = $lat{$key};}}
# clip picture if desired
if ($clipbbox ne "") {
my ($bbLeft, $bbBottom, $bbRight, $bbTop) = ($clipbbox =~ /([\d\-\.]+),([\d\-\.]+),([\d\-\.]+),([\d\-\.]+)/ ) ;
if($clipbbox ne ""){ my($bbLeft, $bbBottom, $bbRight, $bbTop)=($clipbbox =~ /([\d\-\.]+),([\d\-\.]+),([\d\-\.]+),([\d\-\.]+)/);
# print "$bbLeft, $bbBottom, $bbRight, $bbTop\n";
if (($bbLeft > $lonMax) or ($bbLeft < $lonMin)) { print "WARNING -clipbox left parameter outside data.\n" ; }
if (($bbRight > $lonMax) or ($bbRight < $lonMin)) { print "WARNING -clipbox right parameter outside data.\n" ; }
if (($bbBottom > $latMax) or ($bbBottom < $latMin)) { print "WARNING -clipbox bottom parameter outside data.\n" ; }
if (($bbTop > $latMax) or ($bbTop < $latMin)) { print "WARNING -clipbox top parameter outside data.\n" ; }
$lonMin = $bbLeft ;
if(($bbLeft > $lonMax)or($bbLeft < $lonMin)){print "WARNING -clipbox left parameter outside data.\n";} if(($bbRight > $lonMax)or($bbRight < $lonMin)){print "WARNING -clipbox right parameter outside data.\n";} if(($bbBottom > $latMax)or($bbBottom < $latMin)){print "WARNING -clipbox bottom parameter outside data.\n";} if(($bbTop > $latMax)or($bbTop < $latMin)){print "WARNING -clipbox top parameter outside data.\n";} $lonMin = $bbLeft;
$lonMax = $bbRight;
$latMin = $bbBottom;
$latMax = $bbTop;
}
else {
if (defined cv('clip')) {
if ( (cv('clip') > 0) and (cv('clip') < 100) ) {
} else{ if(defined cv('clip')){ if((cv('clip')> 0)and(cv('clip')< 100)){
my $clip = cv('clip');
$clip = $clip / 100;
$lonMin +=($lonMax-$lonMin)* $clip;
$lonMax -=($lonMax-$lonMin)* $clip;
$latMin +=($latMax-$latMin)* $clip;
$latMax -=($latMax-$latMin)* $clip;
}
}
}
} }}
# pad picture if desired
if (defined cv('pad')) {
my $pad = cv('pad') ;
if(defined cv('pad')){ my $pad = cv('pad');
if(($pad > 0)and($pad < 100)){
$pad = $pad / 100;
$lonMin -=($lonMax-$lonMin)* $pad;
$lonMax +=($lonMax-$lonMin)* $pad;
$latMin -=($latMax-$latMin)* $pad;
$latMax +=($latMax-$latMin)* $pad;
}
}
}}
my $size = cv('size');
# calc pic size
if ( cv('scaleSet') != 0 ) {
my $dist = distance ($lonMin, $latMin, $lonMax, $latMin) ;
if(cv('scaleSet')!= 0){ my $dist = distance($lonMin, $latMin, $lonMax, $latMin);
my $width = $dist / cv('scaleSet')* 1000 * 100 / 2.54; # inches
$size = int($width * 300);
}
if ( cv('maxTargetSize') ne "" ) {
my @a = split /,/, cv('maxTargetSize') ;
if(cv('maxTargetSize')ne ""){ my @a = split /,/, cv('maxTargetSize');
my $targetWidth = $a[0];
my $targetHeight = $a[1];
# print "TS: $targetWidth, $targetHeight [cm]\n";
@ -403,32 +298,23 @@ sub readFile {
my $scaleLon =($distLon * 1000 * 100)/ $targetWidth;
my $scaleLat =($distLat * 1000 * 100)/ $targetHeight;
my $targetScale = int $scaleLon;
if ( $scaleLat > $targetScale ) { $targetScale = int $scaleLat ; }
# print "TS: $targetScale [1:n]\n" ;
if($scaleLat > $targetScale){$targetScale = int $scaleLat;} # print "TS: $targetScale [1:n]\n";
my $width = $distLon / $targetScale * 1000 * 100 / 2.54; # inches
$size = int($width * 300);
print "Map width now $size [px] due to maxTargetSize parameter\n";
}
mwMap::initGraph($size, $lonMin, $latMin, $lonMax, $latMax);
}
sub getNodePointers {
return ( \%lon, \%lat, \%memNodeTags) ;
sub getNodePointers{ return(\%lon, \%lat, \%memNodeTags);
}
sub getWayPointers {
return ( \%memWayNodes, \%memWayTags) ;
sub getWayPointers{ return(\%memWayNodes, \%memWayTags);
}
sub getRelationPointers{
return(\%memRelationMembers, \%memRelationTags);
}
1;

32
mwGPX.pm
View File

@ -38,7 +38,6 @@ require Exporter ;
sub processGPXFile{
my($ref1, $ref2, $ref3)= readGPXFile(cv('gpx'));
my %wptHash = %$ref1;
@ -48,30 +47,24 @@ sub processGPXFile {
my $size = cv('gpxsize');
my $color = cv('gpxcolor');
foreach my $wptNr ( sort { $a <=> $b } keys %wptHash) {
# print "WPT $wptNr: $wptHash{$wptNr}{'lon'} $wptHash{$wptNr}{'lat'}\n" ;
foreach my $wptNr(sort{$a <=> $b}keys %wptHash){ # print "WPT $wptNr: $wptHash{$wptNr}{'lon'}$wptHash{$wptNr}{'lat'}\n";
if(defined $wptHash{$wptNr}{'name'}){
# print " name: $wptHash{$wptNr}{'name'}\n";
}
if (defined $wptHash{$wptNr}{'ele'}) {
} if(defined $wptHash{$wptNr}{'ele'}){
# print " ele: $wptHash{$wptNr}{'ele'}\n";
}
my $svgString = "fill=\"$color\" stroke=\"none\" ";
my $lon = $wptHash{$wptNr}{'lon'};
my $lat = $wptHash{$wptNr}{'lat'};
drawCircle($lon, $lat, 1, 3*$size, 0, $svgString, 'gpx');
}
foreach my $rteNr ( sort { $a <=> $b } keys %rteHash) {
# print "RTE $rteNr\n" ;
foreach my $rteNr(sort{$a <=> $b}keys %rteHash){ # print "RTE $rteNr\n";
my @coords =();
foreach my $rteWptNr ( sort { $a <=> $b } keys %{$rteHash{$rteNr}}) {
# print " wpt $rteWptNr: $rteHash{$rteNr}{$rteWptNr}{'lon'} $rteHash{$rteNr}{$rteWptNr}{'lat'}\n" ;
foreach my $rteWptNr(sort{$a <=> $b}keys %{$rteHash{$rteNr}}){ # print " wpt $rteWptNr: $rteHash{$rteNr}{$rteWptNr}{'lon'}$rteHash{$rteNr}{$rteWptNr}{'lat'}\n";
my $svgString = "fill=\"$color\" stroke=\"none\" ";
my $lon = $rteHash{$rteNr}{$rteWptNr}{'lon'};
@ -81,7 +74,6 @@ sub processGPXFile {
my($x, $y)= convert($lon, $lat);
push @coords, $x, $y;
}
my $svgString = "";
my $lc = "round";
@ -91,29 +83,21 @@ sub processGPXFile {
drawWay(\@coords, 0, $svgString, "gpx", undef);
}
foreach my $trkNr ( sort { $a <=> $b } keys %trkHash) {
# print "TRK $trkNr\n" ;
foreach my $trkNr(sort{$a <=> $b}keys %trkHash){ # print "TRK $trkNr\n";
my %seg;
%seg = %{$trkHash{$trkNr}};
foreach my $segNr ( sort {$a <=> $b} keys %seg) {
# print " SEG $segNr\n" ;
foreach my $segNr(sort{$a <=> $b}keys %seg){ # print " SEG $segNr\n";
my %points;
%points = %{$seg{$segNr}};
foreach my $ptNr ( sort { $a <=> $b } keys %points) {
# print " trkpt $ptNr: $points{$ptNr}{'lon'} $points{$ptNr}{'lat'}\n" ;
foreach my $ptNr(sort{$a <=> $b}keys %points){ # print " trkpt $ptNr: $points{$ptNr}{'lon'}$points{$ptNr}{'lat'}\n";
my $svgString = "fill=\"$color\" stroke=\"none\" ";
my $lon = $points{$ptNr}{'lon'};
my $lat = $points{$ptNr}{'lat'};
drawCircle($lon, $lat, 1, $size, 0, $svgString, 'gpx');
} }}
}
}
}
}

28
mwInteractive.pl
View File

@ -22,13 +22,11 @@ my $style = "" ;
print "Mapweaver interactive\n\n";
while ($place eq "") {
print "Please enter exact place name:\n" ;
while($place eq ""){ print "Please enter exact place name:\n";
$place = <STDIN>;
print "\n";
chomp $place;
}
# ---
print "Please enter exact place name of bigger city i.e. in vicinity:\n";
@ -44,7 +42,6 @@ print "\n" ;
chomp $dist;
if($dist eq ""){$dist = 50000;}
# ---
print "Please enter radius in km for latitude(defaults to 2km):\n";
@ -52,7 +49,6 @@ $latrad = <STDIN> ;
print "\n";
chomp $latrad;
if($latrad eq ""){$latrad=2;}
# ---
print "Please enter radius in km for longitude(defaults to 2km):\n";
@ -60,7 +56,6 @@ $lonrad = <STDIN> ;
print "\n";
chomp $lonrad;
if($lonrad eq ""){$lonrad=2;}
# ---
print "Please enter scale of map(i.e. 10000 for 1:10.000):\n";
@ -68,7 +63,6 @@ $scaleset = <STDIN> ;
print "\n";
chomp $scaleset;
if($scaleset eq ""){$scaleset = 10000;}
# ---
print "Output map in PDF format yes/no(defaults to yes):\n";
@ -76,16 +70,13 @@ $pdf = <STDIN> ;
print "\n";
chomp $pdf;
if(($pdf eq "")or(lc $pdf eq "yes")){$pdf = 1;}
# ---
print "Output map in PNG format yes/no(defaults to no):\n";
$png = <STDIN>;
print "\n";
chomp $png;
if (($png eq "") or (lc $png eq "no")) { $png = 0 ; }
if (lc $png eq "yes") { $png = 1 ; }
if(($png eq "")or(lc $png eq "no")){$png = 0;}if(lc $png eq "yes"){$png = 1;}
# ---
$outName = $place . ".svg";
@ -95,9 +86,7 @@ $outName = <STDIN> ;
print "\n";
chomp $outName;
if ($outName eq "") { $outName = $place . ".svg" ; }
if (! grep /\.svg$/, $outName) { $outName .= ".svg" ; }
if($outName eq ""){$outName = $place . ".svg";}if(! grep /\.svg$/, $outName){$outName .= ".svg";}
# ---
print "Select map style from list:\n";
@ -107,18 +96,13 @@ $style = <STDIN> ;
print "\n";
chomp $style;
if ($style eq "2") { $style = "mwTopoRules.txt" ; }
else { $style = "mwStandardRules.txt" ; }
if($style eq "2"){$style = "mwTopoRules.txt";}else{$style = "mwStandardRules.txt";}
my $cmd = "perl mw.pl -place=\"$place\" -overpass -style=\"$style\" -out=\"$outName\" -scaleset=$scaleset ";
if ($near ne "") { $cmd .= "-near=\"$near\" -overpassdistance=$dist " ; }
$cmd .= " -lonrad=$lonrad -latrad=$latrad " ;
if ($png eq "1") { $cmd .= " -png " ; }
if ($pdf eq "1") { $cmd .= " -pdf " ; }
if($near ne ""){$cmd .= "-near=\"$near\" -overpassdistance=$dist ";}$cmd .= " -lonrad=$lonrad -latrad=$latrad ";
if($png eq "1"){$cmd .= " -png ";}if($pdf eq "1"){$cmd .= " -pdf ";}
print "call mw.pl: $cmd\n";
`$cmd`;

148
mwLabel.pm
View File

@ -45,8 +45,7 @@ require Exporter ;
@ISA = qw(Exporter AutoLoader);
@EXPORT = qw (
placeLabelAndIcon
@EXPORT = qw( placeLabelAndIcon
addToPoiHash
getPoiHash
);
@ -54,18 +53,15 @@ require Exporter ;
sub placeLabelAndIcon {
#
sub placeLabelAndIcon{#
# intelligent icon and label placement alg.
#
my($lon, $lat, $offset, $thickness, $text, $svgText, $icon, $iconSizeX, $iconSizeY, $layer)= @_;
if(cv('debug')eq "1"){print "PLAI: $lon, $lat, $offset, $thickness, $text, $svgText, $icon, $iconSizeX, $iconSizeY, $layer\n";}
my($x, $y)= mwMap::convert($lon, $lat); # center !
if(! coordsOut($x, $y)){
$y = $y + $offset;
my($ref)= splitLabel($text);
@ -79,52 +75,34 @@ sub placeLabelAndIcon {
my($textSize)=($svgText =~ /font-size=\"(\d+)\"/);
if(! defined $textSize){die("ERROR: font size could not be determined from svg format string \"$svgText\"\n");}
foreach my $line (@lines) {
my $len = length ($line) * cv('ppc') / 10 * $textSize ; # in pixels
if ($len > $maxTextLenPix) { $maxTextLenPix = $len ; }
}
my $spaceTextX = $maxTextLenPix ;
foreach my $line(@lines){ my $len = length($line)* cv('ppc')/ 10 * $textSize; # in pixels
if($len > $maxTextLenPix){$maxTextLenPix = $len;} } my $spaceTextX = $maxTextLenPix;
my $spaceTextY = $numLines *($lineDist+$textSize);
if ($icon ne "none") {
$numIcons++ ;
if($icon ne "none"){ $numIcons++;
# space for icon?
my $sizeX1 = $iconSizeX ; if ($sizeX1 == 0) { $sizeX1 = 20 ; }
my $sizeY1 = $iconSizeY ; if ($sizeY1 == 0) { $sizeY1 = 20 ; }
my $iconX = $x - $sizeX1/2 ; # top left corner
my $sizeX1 = $iconSizeX; if($sizeX1 == 0){$sizeX1 = 20;} my $sizeY1 = $iconSizeY; if($sizeY1 == 0){$sizeY1 = 20;} my $iconX = $x - $sizeX1/2; # top left corner
my $iconY = $y - $sizeY1/2;
my @shifts =(0);
if ($allowIconMove eq "1") {
@shifts = ( 0, -15, 15 ) ;
}
my $posFound = 0 ; my $posCount = 0 ;
if($allowIconMove eq "1"){ @shifts =(0, -15, 15);
} my $posFound = 0; my $posCount = 0;
my($iconAreaX1, $iconAreaY1, $iconAreaX2, $iconAreaY2);
LABAB: foreach my $xShift (@shifts) {
foreach my $yShift (@shifts) {
$posCount++ ;
if ( ( ! boxAreaOccupied ($iconX+$xShift, $iconY+$sizeY1+$yShift, $iconX+$sizeX1+$xShift, $iconY+$yShift) ) or ( cv('forcenodes') eq "1" ) ) {
placeIcon ($iconX+$xShift, $iconY+$yShift, $icon, $sizeX1, $sizeY1, "nodes") ;
LABAB: foreach my $xShift(@shifts){ foreach my $yShift(@shifts){ $posCount++;
if((! boxAreaOccupied($iconX+$xShift, $iconY+$sizeY1+$yShift, $iconX+$sizeX1+$xShift, $iconY+$yShift))or(cv('forcenodes')eq "1")){ placeIcon($iconX+$xShift, $iconY+$yShift, $icon, $sizeX1, $sizeY1, "nodes");
$iconAreaX1 = $iconX+$xShift;
$iconAreaY1 = $iconY+$sizeY1+$yShift;
$iconAreaX2 = $iconX+$sizeX1+$xShift;
$iconAreaY2 = $iconY+$yShift;
$posFound = 1;
if ($posCount > 1) { $numIconsMoved++ ; }
$iconX = $iconX + $xShift ; # for later use with label
if($posCount > 1){$numIconsMoved++;} $iconX = $iconX + $xShift; # for later use with label
$iconY = $iconY + $yShift;
last LABAB;
}
}
}
if ($posFound == 1) {
} } } if($posFound == 1){
# label text?
if ($text ne "") {
$numLabels++ ;
if($text ne ""){ $numLabels++;
$sizeX1 += 1; $sizeY1 += 1;
@ -169,27 +147,18 @@ sub placeLabelAndIcon {
$tries = 0;
LABB: foreach my $pos (@positions) {
$tries++ ;
LABB: foreach my $pos(@positions){ $tries++;
$positionFound = checkAndDrawText($pos->[0], $pos->[1], $pos->[2], $pos->[3], $pos->[4], \@lines, $svgText, $layer);
if ($positionFound == 1) {
last LABB ;
}
}
if ($positionFound == 0) { $numLabelsOmitted++ ; }
if ($tries > 1) { $numLabelsMoved++ ; }
} # label
if($positionFound == 1){ last LABB;
} } if($positionFound == 0){$numLabelsOmitted++;} if($tries > 1){$numLabelsMoved++;} }# label
boxOccupyArea($iconAreaX1, $iconAreaY1, $iconAreaX2, $iconAreaY2, 0, 2);
}# pos found
else {
# no, count omitted
else{ # no, count omitted
$numIconsOmitted++;
}
}
else { # only text
} } else{# only text
my($x1, $x2, $y1, $y2);
# x1, x2, y1, y2
# left, right, bottom, top
@ -215,31 +184,20 @@ sub placeLabelAndIcon {
my $positionFound = 0;
$tries = 0;
LABA: foreach my $pos (@positions) {
$tries++ ;
LABA: foreach my $pos(@positions){ $tries++;
# print "$lines[0] $pos->[0], $pos->[1], $pos->[2], $pos->[3], $pos->[4], $numLines\n";
$positionFound = checkAndDrawText($pos->[0], $pos->[1], $pos->[2], $pos->[3], $pos->[4], \@lines, $svgText, $layer);
if ($positionFound == 1) {
last LABA ;
}
}
if ($positionFound == 0) { $numLabelsOmitted++ ; }
if ($tries > 1) { $numLabelsMoved++ ; }
}
}
}
if($positionFound == 1){ last LABA;
} } if($positionFound == 0){$numLabelsOmitted++;} if($tries > 1){$numLabelsMoved++;} }}}
sub checkAndDrawText {
#
sub checkAndDrawText{#
# checks if area available and if so draws text
#
my($x1, $x2, $y1, $y2, $orientation, $refLines, $svgText, $layer)= @_;
if(cv('debug')eq "1"){print "CADT: $x1, $x2, $y1, $y2, $orientation, $refLines, $svgText, $layer\n";}
my @lines = @$refLines;
my $numLines = scalar @lines;
my $lineDist = cv('linedist');
@ -247,82 +205,48 @@ sub checkAndDrawText {
my($size)=($svgText =~ /font-size=\"(\d+)\"/);
if(! defined $size){die("ERROR: font size could not be determined from svg format string \"$svgText\"\n");}
# WATCH for variable sequence!
if (
( ! boxAreaOccupied ($x1, $y1, $x2, $y2) ) or
( cv('forcenodes') eq "1" )
) {
if((! boxAreaOccupied($x1, $y1, $x2, $y2))or
(cv('forcenodes')eq "1")){
for(my $i=0; $i<=$#lines; $i++){
my @points =($x1, $y2+($i+1)*($size+$lineDist), $x2, $y2+($i+1)*($size+$lineDist));
my $pathName = "LabelPath" . $labelPathId;
$labelPathId++;
createPath($pathName, \@points, "definitions");
if ($orientation eq "centered") {
pathText ($svgText, $lines[$i], $pathName, 0, "middle", 50, $layer)
}
if ($orientation eq "left") {
pathText ($svgText, $lines[$i], $pathName, 0, "start", 0, $layer)
}
if ($orientation eq "right") {
pathText ($svgText, $lines[$i], $pathName, 0, "end", 100, $layer)
}
}
if($orientation eq "centered"){ pathText($svgText, $lines[$i], $pathName, 0, "middle", 50, $layer) } if($orientation eq "left"){ pathText($svgText, $lines[$i], $pathName, 0, "start", 0, $layer) } if($orientation eq "right"){ pathText($svgText, $lines[$i], $pathName, 0, "end", 100, $layer) } }
boxOccupyArea($x1, $y1, $x2, $y2, 0, 2);
return(1);
}
else {
return 0 ;
}
}
sub splitLabel {
#
} else{ return 0;
}}
sub splitLabel{#
# split label text at space locations and then merge new parts if new part will be smaller than XX chars
#
my $text = shift;
my @lines = split / /, $text;
my $merged = 1;
while ($merged) {
$merged = 0 ;
LAB2: for (my $i=0; $i<$#lines; $i++) {
if (length ($lines[$i] . " " . $lines[$i+1]) <= cv ('maxcharperline') ) {
while($merged){ $merged = 0;
LAB2: for(my $i=0; $i<$#lines; $i++){ if(length($lines[$i] . " " . $lines[$i+1])<= cv('maxcharperline')){
$lines[$i] = $lines[$i] . " " . $lines[$i+1];
splice(@lines, $i+1, 1);
$merged = 1;
last LAB2;
} }} return(\@lines);
}
}
}
return (\@lines) ;
}
# ------------------------------------------------------------
sub addToPoiHash {
my ($name, $sq) = @_ ;
if (defined $sq) {
$poiHash{$name}{$sq} = 1 ;
}
else {
$poiHash{$name} = 1 ;
}
}
sub addToPoiHash{ my($name, $sq)= @_;
if(defined $sq){ $poiHash{$name}{$sq}= 1;
} else{ $poiHash{$name}= 1;
}}
sub getPoiHash {
return \%poiHash ;
sub getPoiHash{ return \%poiHash;
}
1;

633
mwMap.pm
View File

File diff suppressed because it is too large Load Diff

484
mwMisc.pm
View File

@ -58,17 +58,11 @@ require Exporter ;
sub getValue {
my ($key, $aRef) = @_ ;
sub getValue{ my($key, $aRef)= @_;
my $value = undef;
foreach my $kv (@$aRef) {
if ($kv->[0] eq $key) { $value = $kv->[1]; }
foreach my $kv(@$aRef){ if($kv->[0] eq $key){$value = $kv->[1];}} return $value;
}
return $value ;
}
sub createLabel {
#
sub createLabel{#
# takes @tags and labelKey(s)from style file and creates labelTextTotal and array of labels for directory
# takes more keys in one string - using a separator.
#
@ -86,39 +80,23 @@ sub createLabel {
if(grep /!/, $styleLabelText){# AND
@keys = split(/!/, $styleLabelText);
# print "par found: $styleLabelText; @keys\n";
for (my $i=0; $i<=$#keys; $i++) {
if ($keys[$i] eq "_lat") { push @labels, $lat ; }
for(my $i=0; $i<=$#keys; $i++){ if($keys[$i] eq "_lat"){push @labels, $lat;}
if($keys[$i] eq "_lon"){push @labels, $lon;}
foreach my $tag (@tags) {
if ($tag->[0] eq $keys[$i]) {
push @labels, $tag->[1] ;
}
}
}
$labelTextTotal = "" ;
foreach my $label (@labels) { $labelTextTotal .= $label . " " ; }
}
else { # PRIO
foreach my $tag(@tags){ if($tag->[0] eq $keys[$i]){ push @labels, $tag->[1];
} } } $labelTextTotal = "";
foreach my $label(@labels){$labelTextTotal .= $label . " ";}} else{# PRIO
@keys = split(/#/, $styleLabelText);
my $i = 0; my $found = 0;
while ( ($i<=$#keys) and ($found == 0) ) {
if ($keys[$i] eq "_lat") { push @labels, $lat ; $found = 1 ; $labelTextTotal = $lat ; }
while(($i<=$#keys)and($found == 0)){ if($keys[$i] eq "_lat"){push @labels, $lat; $found = 1; $labelTextTotal = $lat;}
if($keys[$i] eq "_lon"){push @labels, $lon; $found = 1; $labelTextTotal = $lon;}
foreach my $tag (@tags) {
if ($tag->[0] eq $keys[$i]) {
push @labels, $tag->[1] ;
foreach my $tag(@tags){ if($tag->[0] eq $keys[$i]){ push @labels, $tag->[1];
$labelTextTotal = $tag->[1];
$found = 1;
} } $i++;
}
} return($labelTextTotal, \@labels);
}
$i++ ;
}
}
return ( $labelTextTotal, \@labels) ;
}
sub buildRings {
#
sub buildRings{#
# accepts ref to array of ways and option if unclosed rings shoulf be returned
# closeOpt == 1 returns only closed rings
#
@ -133,68 +111,44 @@ sub buildRings {
my($memWayNodesRef, $memWayTagsRef)= mwFile::getWayPointers();
# print "build rings for @allWays\n";
if (cv('debug') eq "1" ) { print "BR: called.\n" ; }
while ( scalar @allWays > 0) {
# build new test ring
if(cv('debug')eq "1"){print "BR: called.\n";} while(scalar @allWays > 0){ # build new test ring
my(@currentWays)=(); my(@currentNodes)=();
push @currentWays, $allWays[0];
if (cv('debug') eq "1" ) { print "BR: initial way for next ring id= $allWays[0]\n" ; }
push @currentNodes, @{$$memWayNodesRef{$allWays[0]}} ;
if(cv('debug')eq "1"){print "BR: initial way for next ring id= $allWays[0]\n";} push @currentNodes, @{$$memWayNodesRef{$allWays[0]}};
my $startNode = $currentNodes[0];
my $endNode = $currentNodes[-1];
if (cv('debug') eq "1" ) { print "BR: initial start and end node $startNode $endNode\n" ; }
my $closed = 0 ;
if(cv('debug')eq "1"){print "BR: initial start and end node $startNode $endNode\n";} my $closed = 0;
shift @allWays; # remove first element
if($startNode == $endNode){$closed = 1;}
my $success = 1;
while ( ($closed == 0) and ( (scalar @allWays) > 0) and ($success == 1) ) {
# try to find new way
if (cv('debug') eq "1" ) { print "TRY TO FIND NEW WAY\n" ; }
$success = 0 ;
if (cv('debug') eq "1" ) { print "BR: actual start and end node $startNode $endNode\n" ; }
my $i = 0 ;
while ( ($i < (scalar @allWays) ) and ($success == 0) ) {
if (cv('debug') eq "1" ) { print "BR: testing way $i = $allWays[$i]\n" ; }
if (cv('debug') eq "1" ) { print "BR: rev in front?\n" ; }
if ( $$memWayNodesRef{$allWays[$i]}[0] == $startNode ) {
while(($closed == 0)and((scalar @allWays)> 0)and($success == 1)){ # try to find new way
if(cv('debug')eq "1"){print "TRY TO FIND NEW WAY\n";} $success = 0;
if(cv('debug')eq "1"){print "BR: actual start and end node $startNode $endNode\n";} my $i = 0;
while(($i <(scalar @allWays))and($success == 0)){ if(cv('debug')eq "1"){print "BR: testing way $i = $allWays[$i]\n";} if(cv('debug')eq "1"){print "BR: rev in front?\n";} if($$memWayNodesRef{$allWays[$i]}[0] == $startNode){
$success = 1;
# reverse in front
@currentWays =($allWays[$i], @currentWays);
@currentNodes =(reverse(@{$$memWayNodesRef{$allWays[$i]}}), @currentNodes);
splice(@allWays, $i, 1);
}
if ($success ==0) {
if (cv('debug') eq "1" ) { print "BR: app at end?\n" ; }
if ( $$memWayNodesRef{$allWays[$i]}[0] == $endNode) {
} if($success ==0){ if(cv('debug')eq "1"){print "BR: app at end?\n";} if($$memWayNodesRef{$allWays[$i]}[0] == $endNode){
$success = 1;
# append at end
@currentWays =(@currentWays, $allWays[$i]);
@currentNodes =(@currentNodes, @{$$memWayNodesRef{$allWays[$i]}});
splice(@allWays, $i, 1);
}
}
if ($success ==0) {
if (cv('debug') eq "1" ) { print "BR: app in front?\n" ; }
if ( $$memWayNodesRef{$allWays[$i]}[-1] == $startNode) {
} } if($success ==0){ if(cv('debug')eq "1"){print "BR: app in front?\n";} if($$memWayNodesRef{$allWays[$i]}[-1] == $startNode){
$success = 1;
# append in front
@currentWays =($allWays[$i], @currentWays);
@currentNodes =(@{$$memWayNodesRef{$allWays[$i]}}, @currentNodes);
splice(@allWays, $i, 1);
}
}
if ($success ==0) {
if (cv('debug') eq "1" ) { print "BR: rev at end?\n" ; }
if ( $$memWayNodesRef{$allWays[$i]}[-1] == $endNode) {
} } if($success ==0){ if(cv('debug')eq "1"){print "BR: rev at end?\n";} if($$memWayNodesRef{$allWays[$i]}[-1] == $endNode){
$success = 1;
# append reverse at the end
@currentWays =(@currentWays, $allWays[$i]);
@currentNodes =(@currentNodes,(reverse(@{$$memWayNodesRef{$allWays[$i]}})));
splice(@allWays, $i, 1);
}
}
$i++ ;
} } $i++;
}# look for new way that fits
$startNode = $currentNodes[0];
@ -202,34 +156,23 @@ sub buildRings {
if($startNode == $endNode){
$closed = 1;
if(cv('debug')eq "1"){print "BR: ring now closed\n";}
}
} # new ring
} }# new ring
# examine ring and act
if ( ($closed == 1) or ($closeOpt == 0) ) {
# eliminate double nodes in @currentNodes
if(($closed == 1)or($closeOpt == 0)){ # eliminate double nodes in @currentNodes
my $found = 1;
while ($found) {
$found = 0 ;
LABCN: for (my $i=0; $i<$#currentNodes; $i++) {
if ($currentNodes[$i] == $currentNodes[$i+1]) {
$found = 1 ;
while($found){ $found = 0;
LABCN: for(my $i=0; $i<$#currentNodes; $i++){ if($currentNodes[$i] == $currentNodes[$i+1]){ $found = 1;
splice @currentNodes, $i, 1;
last LABCN;
}
}
}
# add data to return data
} } } # add data to return data
@{$ringWays[$ringCount]}= @currentWays;
@{$ringNodes[$ringCount]}= @currentNodes;
$ringCount++;
}
}
}}
return(\@ringWays, \@ringNodes);
}
sub angleMapgen {
#
sub angleMapgen{#
# angle between lines/segments
#
my($g1x1)= shift;
@ -242,39 +185,23 @@ sub angleMapgen {
my($g2y2)= shift;
my $g1m;
if ( ($g1x2-$g1x1) != 0 ) {
$g1m = ($g1y2-$g1y1)/($g1x2-$g1x1) ; # steigungen
if(($g1x2-$g1x1)!= 0){ $g1m =($g1y2-$g1y1)/($g1x2-$g1x1); # steigungen
} else{ $g1m = 999999999;
}
else {
$g1m = 999999999 ;
}
my $g2m;
if ( ($g2x2-$g2x1) != 0 ) {
$g2m = ($g2y2-$g2y1)/($g2x2-$g2x1) ;
if(($g2x2-$g2x1)!= 0){ $g2m =($g2y2-$g2y1)/($g2x2-$g2x1);
} else{ $g2m = 999999999;
}
else {
$g2m = 999999999 ;
}
if($g1m == $g2m){ # parallel
return(0);
}
else {
my $t1 = $g1m -$g2m ;
} else{ my $t1 = $g1m -$g2m;
my $t2 = 1 + $g1m * $g2m;
if ($t2 == 0) {
return 90 ;
}
else {
my $a = atan (abs ($t1/$t2)) / 3.141592654 * 180 ;
if($t2 == 0){ return 90;
} else{ my $a = atan(abs($t1/$t2))/ 3.141592654 * 180;
return $a;
}
}
}
}}}
sub triangleNode {
#
sub triangleNode{#
# get segment of segment as coordinates
# from start or from end of segment
#
@ -288,18 +215,12 @@ sub triangleNode {
if($startEnd == 0){
$x = $x1 +($x2-$x1)*$percent;
$y = $y1 +($y2-$y1)*$percent;
}
else {
$x = $x2 - ($x2-$x1)*$percent ;
} else{ $x = $x2 -($x2-$x1)*$percent;
$y = $y2 -($y2-$y1)*$percent;
} return($x, $y);
}
return ($x, $y) ;
}
sub intersection {
#
# returns intersection point of two lines, else (0,0)
#
sub intersection{#
# returns intersection point of two lines, else(0,0)#
my($g1x1)= shift;
my($g1y1)= shift;
my($g1x2)= shift;
@ -312,38 +233,25 @@ sub intersection {
if(($g1x1 == $g2x1)and($g1y1 == $g2y1)){# p1 = p1 ?
return($g1x1, $g1y1);
}
if (($g1x1 == $g2x2) and ($g1y1 == $g2y2)) { # p1 = p2 ?
} if(($g1x1 == $g2x2)and($g1y1 == $g2y2)){# p1 = p2 ?
return($g1x1, $g1y1);
}
if (($g1x2 == $g2x1) and ($g1y2 == $g2y1)) { # p2 = p1 ?
} if(($g1x2 == $g2x1)and($g1y2 == $g2y1)){# p2 = p1 ?
return($g1x2, $g1y2);
}
if(($g1x2 == $g2x2)and($g1y2 == $g2y2)){# p2 = p1 ?
return($g1x2, $g1y2);
}
my $g1m;
if ( ($g1x2-$g1x1) != 0 ) {
$g1m = ($g1y2-$g1y1)/($g1x2-$g1x1) ; # steigungen
if(($g1x2-$g1x1)!= 0){ $g1m =($g1y2-$g1y1)/($g1x2-$g1x1); # steigungen
} else{ $g1m = 999999;
}
else {
$g1m = 999999 ;
}
my $g2m;
if ( ($g2x2-$g2x1) != 0 ) {
$g2m = ($g2y2-$g2y1)/($g2x2-$g2x1) ;
if(($g2x2-$g2x1)!= 0){ $g2m =($g2y2-$g2y1)/($g2x2-$g2x1);
} else{ $g2m = 999999;
}
else {
$g2m = 999999 ;
}
if($g1m == $g2m){ # parallel
return(0, 0);
}
my($g1b)= $g1y1 - $g1m * $g1x1; # abschnitte
my($g2b)= $g2y1 - $g2m * $g2x1;
@ -367,17 +275,12 @@ sub intersection {
($sy >= $g1ymin)and
($sy >= $g2ymin)and
($sy <= $g1ymax)and
($sy <= $g2ymax)) {
return ($sx, $sy) ;
}
else {
return (0, 0) ;
}
}
($sy <= $g2ymax)){ return($sx, $sy);
} else{ return(0, 0);
}}
sub isIn {
# checks two polygons
sub isIn{# checks two polygons
# return 0 = neither
# 1 = p1 is in p2
# 2 = p2 is in p1
@ -387,124 +290,73 @@ sub isIn {
my($p2In1)= 1;
# p1 in p2 ?
foreach my $pt1 ($p1->points) {
if ($p2->contains ($pt1) ) {
# good
}
else {
$p1In2 = 0 ;
}
}
foreach my $pt1($p1->points){ if($p2->contains($pt1)){ # good
} else{ $p1In2 = 0;
}}
# p2 in p1 ?
foreach my $pt2 ($p2->points) {
if ($p1->contains ($pt2) ) {
# good
}
else {
$p2In1 = 0 ;
}
}
if ($p1In2 == 1) {
return 1 ;
}
elsif ($p2In1 == 1) {
return 2 ;
}
else {
return 0 ;
}
}
foreach my $pt2($p2->points){ if($p1->contains($pt2)){ # good
} else{ $p2In1 = 0;
}}
if($p1In2 == 1){ return 1;
} elsif($p2In1 == 1){ return 2;
} else{ return 0;
}}
# -------------------------------------------------------------------------------
sub processPageNumbers {
if ( cv('pageNumbers') ne "") {
my $pnSize ; my $pnColor ;
sub processPageNumbers{ if(cv('pageNumbers')ne ""){ my $pnSize; my $pnColor;
my @a = split /,/, cv('pageNumbers');
if (scalar @a >= 3) {
$pnSize = $a[0] ;
if(scalar @a >= 3){ $pnSize = $a[0];
$pnColor = $a[1];
my $pnNumber = $a[2];
if ($pnNumber != 0) {
drawPageNumber ($pnSize, $pnColor, $pnNumber) ;
}
}
if (scalar @a == 7) {
# draw 4 other positions if ne 0!!!
if($pnNumber != 0){ drawPageNumber($pnSize, $pnColor, $pnNumber);
} } if(scalar @a == 7){ # draw 4 other positions if ne 0!!!
if($a[3] != 0){# left
drawPageNumberLeft($pnSize, $pnColor, $a[3]);
}
if ($a[4] != 0) { # bottom
} if($a[4] != 0){# bottom
drawPageNumberBottom($pnSize, $pnColor, $a[4]);
}
if ($a[5] != 0) { # right
} if($a[5] != 0){# right
drawPageNumberRight($pnSize, $pnColor, $a[5]);
}
if ($a[6] != 0) { # top
} if($a[6] != 0){# top
drawPageNumberTop($pnSize, $pnColor, $a[6]);
}
}
}
}
sub drawPageNumber {
my ($size, $col, $num) = @_ ;
} }}}
sub drawPageNumber{ my($size, $col, $num)= @_;
my($sizeX, $sizeY)= mwMap::getDimensions();
my $x = $sizeX - 2 * $size;
my $y = $sizeY - 2 * $size;
my $svgString = "fill=\"$col\" font-size=\"$size\" ";
mwMap::drawText ($x, $y, 0, $num, $svgString, "text")
}
sub drawPageNumberLeft {
my ($size, $col, $num) = @_ ;
mwMap::drawText($x, $y, 0, $num, $svgString, "text")}
sub drawPageNumberLeft{ my($size, $col, $num)= @_;
my($sizeX, $sizeY)= mwMap::getDimensions();
my $x = 2 * $size;
my $y = $sizeY / 2;
my $svgString = "fill=\"$col\" font-size=\"$size\" ";
mwMap::drawText ($x, $y, 0, $num, $svgString, "text")
}
sub drawPageNumberBottom {
my ($size, $col, $num) = @_ ;
mwMap::drawText($x, $y, 0, $num, $svgString, "text")}
sub drawPageNumberBottom{ my($size, $col, $num)= @_;
my($sizeX, $sizeY)= mwMap::getDimensions();
my $x = $sizeX / 2;
my $y = $sizeY - 2 * $size;
my $svgString = "fill=\"$col\" font-size=\"$size\" ";
mwMap::drawText ($x, $y, 0, $num, $svgString, "text")
}
sub drawPageNumberRight {
my ($size, $col, $num) = @_ ;
mwMap::drawText($x, $y, 0, $num, $svgString, "text")}
sub drawPageNumberRight{ my($size, $col, $num)= @_;
my($sizeX, $sizeY)= mwMap::getDimensions();
my $x = $sizeX - 2 * $size;
my $y = $sizeY / 2;
my $svgString = "fill=\"$col\" font-size=\"$size\" ";
mwMap::drawText ($x, $y, 0, $num, $svgString, "text")
}
sub drawPageNumberTop {
my ($size, $col, $num) = @_ ;
mwMap::drawText($x, $y, 0, $num, $svgString, "text")}
sub drawPageNumberTop{ my($size, $col, $num)= @_;
my($sizeX, $sizeY)= mwMap::getDimensions();
my $x = $sizeX / 2;
my $y = 2 * $size;
my $svgString = "fill=\"$col\" font-size=\"$size\" ";
mwMap::drawText ($x, $y, 0, $num, $svgString, "text")
}
mwMap::drawText($x, $y, 0, $num, $svgString, "text")}
# ---------------------------------------------------------------------
sub processRectangles {
my $no = 0 ;
sub processRectangles{ my $no = 0;
if ( cv('rectangles') ne "") {
my @rects ;
if(cv('rectangles')ne ""){ my @rects;
@rects = split /#/, cv('rectangles');
foreach my $r (@rects) {
$no++ ;
foreach my $r(@rects){ $no++;
my @coords;
@coords = split /,/, $r;
@ -525,8 +377,7 @@ sub processRectangles {
drawWay(\@nodes, 0, $svgString, "rectangles", undef);
# drawRect($left, $bottom, $right, $top, 1, $svgString, "rectangles");
if ( cv('pagenumbers') ne "") {
my $x = ($right + $left) / 2 ;
if(cv('pagenumbers')ne ""){ my $x =($right + $left)/ 2;
my $y =($bottom + $top)/ 2;
my $xp; my $yp;
($xp, $yp)= convert($x, $y);
@ -534,15 +385,10 @@ sub processRectangles {
my $svgString = "fill=\"black\" font-size=\"60\" ";
drawText($xp, $yp, 0, $no, $svgString, "rectangles");
}
}
}
}
}}}
# --------------------------------------------------------------------
sub sizePNG {
#
sub sizePNG{#
# evaluates size of png graphics
#
my $fileName = shift;
@ -550,19 +396,13 @@ sub sizePNG {
my($x, $y);
my $file;
my $result = open($file, "<", $fileName);
if ($result) {
my $pic = newFromPng GD::Image($file) ;
if($result){ my $pic = newFromPng GD::Image($file);
($x, $y)= $pic->getBounds;
close($file);
} else{($x, $y)=(0, 0);
} return($x, $y);
}
else {
($x, $y) = (0, 0) ;
}
return ($x, $y) ;
}
sub sizeSVG {
#
sub sizeSVG{#
# evaluates size of svg graphics
#
my $fileName = shift;
@ -570,65 +410,43 @@ sub sizeSVG {
my($x, $y); undef $x; undef $y;
my $result = open($file, "<", $fileName);
if ($result) {
my $line ;
while ($line = <$file>) {
my ($x1) = ( $line =~ /^.*width=\"([\d]+)px\"/ ) ;
if($result){ my $line;
while($line = <$file>){ my($x1)=($line =~ /^.*width=\"([\d]+)px\"/);
my($y1)=($line =~ /^.*height=\"([\d]+)px\"/);
if (!defined $x1) {
($x1) = ( $line =~ /^\s*width=\"([\d]+)\"/ ) ;
if(!defined $x1){ ($x1)=($line =~ /^\s*width=\"([\d]+)\"/);
}
if (!defined $y1) {
($y1) = ( $line =~ /^\s*height=\"([\d]+)\"/ ) ;
if(!defined $y1){ ($y1)=($line =~ /^\s*height=\"([\d]+)\"/);
}
if (defined $x1) { $x = $x1 ; }
if (defined $y1) { $y = $y1 ; }
if(defined $x1){$x = $x1;} if(defined $y1){$y = $y1;} } close($file);
}
close ($file) ;
}
if((!defined $x)or(!defined $y)){
$x = 0; $y = 0;
print "WARNING: size of file $fileName could not be determined.\n";
}
return($x, $y);
}
# ------------------------------------------------------------------------
sub createDirPdf {
if ((cv('dir') eq "1") or (cv('poi') eq "1")) {
if (cv('grid') > 0) {
my $dirPdfName = cv('out') ;
sub createDirPdf{ if((cv('dir')eq "1")or(cv('poi')eq "1")){ if(cv('grid')> 0){ my $dirPdfName = cv('out');
$dirPdfName =~ s/.svg/_dir.pdf/;
my $sName = "none";
my $pName = "none";
my $prg = cv('dirprg');
if (cv('dir') eq "1") { $sName = cv('directoryname') ; }
if (cv('poi') eq "1") { $pName = cv('poiname') ; }
my $dirColNum = cv ('dircolnum') ;
if(cv('dir')eq "1"){$sName = cv('directoryname');} if(cv('poi')eq "1"){$pName = cv('poiname');} my $dirColNum = cv('dircolnum');
my $dirTitle = cv('dirtitle');
print "\ncalling perl $prg $sName $pName $dirTitle $dirPdfName $dirColNum\n\n";
`perl $prg $sName $pName \"$dirTitle\" $dirPdfName $dirColNum > out.txt`;
} else{ print "WARNING: directory PDF will not be created because -grid was not specified\n";
}
else {
print "WARNING: directory PDF will not be created because -grid was not specified\n" ;
}
}
else {
print "WARNING: directory PDF will not be created because neither -dir nor -poi was specified\n" ;
}
}
} else{ print "WARNING: directory PDF will not be created because neither -dir nor -poi was specified\n";
}}
# -----------------------------------------------------------------------------
sub getPointOfWay {
#
sub getPointOfWay{ #
# returns point of way at distance/position
# coordinates and units are pixels
@ -636,18 +454,14 @@ sub getPointOfWay {
my @points = @$ref;
my @double =();
while (scalar @points > 0) {
my $x = shift @points ;
while(scalar @points > 0){ my $x = shift @points;
my $y = shift @points;
push @double, [$x, $y];
}
my $i = 0; my $actLen = 0;
while ($actLen < $position) {
$actLen += sqrt ( ($double[$i]->[0]-$double[$i+1]->[0])**2 + ($double[$i]->[1]-$double[$i+1]->[1])**2 ) ;
while($actLen < $position){ $actLen += sqrt(($double[$i]->[0]-$double[$i+1]->[0])**2 +($double[$i]->[1]-$double[$i+1]->[1])**2);
$i++;
}
my $x = int(($double[$i]->[0] + $double[$i-1]->[0])/ 2);
my $y = int(($double[$i]->[1] + $double[$i-1]->[1])/ 2);
@ -655,11 +469,9 @@ sub getPointOfWay {
return($x, $y);
}
# ----------------------------------------------------------------
sub nodes2Coordinates {
#
sub nodes2Coordinates{#
# transform list of nodeIds to list of x/y
# straight array in and out
#
@ -670,17 +482,13 @@ sub nodes2Coordinates {
my($lonRef, $latRef)= mwFile::getNodePointers();
foreach my $n (@nodes) {
my ($x, $y) = mwMap::convert ( $$lonRef{$n}, $$latRef{$n}) ;
foreach my $n(@nodes){ my($x, $y)= mwMap::convert($$lonRef{$n}, $$latRef{$n});
push @result, $x, $y;
}
return @result;
}
sub areaCenter {
#
sub areaCenter{#
# calculate center of area by averageing lons/lats. could be smarter because result could be outside of area! TODO
#
my $ref = shift;
@ -694,20 +502,16 @@ sub areaCenter {
my($lonRef, $latRef)= getNodePointers();
foreach my $n (@nodes) {
$x += $$lonRef{$n} ;
foreach my $n(@nodes){ $x += $$lonRef{$n};
$y += $$latRef{$n};
$num++;
}
$x = $x / $num ;
} $x = $x / $num;
$y = $y / $num;
return($x, $y);
}
sub areaSize {
my $ref = shift ; # nodes
sub areaSize{ my $ref = shift; # nodes
my @nodes = @$ref;
# print "SIZE: @nodes\n";
@ -715,86 +519,54 @@ sub areaSize {
my($lonRef, $latRef)= mwFile::getNodePointers();
my @poly =();
foreach my $node ( @nodes ) {
my ($x, $y) = mwMap::convert ($$lonRef{$node}, $$latRef{$node}) ;
foreach my $node(@nodes){ my($x, $y)= mwMap::convert($$lonRef{$node}, $$latRef{$node});
push @poly, [$x, $y];
}
my ($p) = Math::Polygon->new(@poly) ;
} my($p)= Math::Polygon->new(@poly);
my $size = $p->area;
return $size;
}
# ---------------------------------------------------------------
sub createTextSVG {
my ($fontFamily, $font, $bold, $italic, $size, $color, $strokeWidth, $strokeColor) = @_ ;
sub createTextSVG{ my($fontFamily, $font, $bold, $italic, $size, $color, $strokeWidth, $strokeColor)= @_;
my $svg = "";
if ( (defined $font) and ( $font ne "") ) {
$svg .= "font=\"$font\" " ;
if((defined $font)and($font ne "")){ $svg .= "font=\"$font\" ";
} if((defined $fontFamily)and($fontFamily ne "")){ $svg .= "font-family=\"$fontFamily\" ";
}
if ( (defined $fontFamily) and ( $fontFamily ne "") ) {
$svg .= "font-family=\"$fontFamily\" " ;
if((defined $bold)and(lc($bold)eq "yes")){ $svg .= "font-weight=\"bold\" ";
} if((defined $italic)and(lc($italic)eq "yes")){ $svg .= "font-style=\"italic\" ";
}
if ( (defined $bold) and ( lc ($bold) eq "yes") ) {
$svg .= "font-weight=\"bold\" " ;
if((defined $size)and($size ne "")){ $svg .= "font-size=\"$size\" ";
} if((defined $color)and($color ne "")){ $svg .= "fill=\"$color\" ";
}
if ( (defined $italic) and ( lc ($italic) eq "yes") ) {
$svg .= "font-style=\"italic\" " ;
if((defined $strokeColor)and($strokeColor ne "")){ $svg .= "stroke=\"$strokeColor\" ";
} if((defined $strokeWidth)and($strokeWidth ne "")){ $svg .= "stroke-width=\"$strokeWidth\" ";
}
if ( (defined $size) and ( $size ne "") ) {
$svg .= "font-size=\"$size\" " ;
}
if ( (defined $color) and ( $color ne "") ) {
$svg .= "fill=\"$color\" " ;
}
if ( (defined $strokeColor) and ( $strokeColor ne "") ) {
$svg .= "stroke=\"$strokeColor\" " ;
}
if ( (defined $strokeWidth) and ( $strokeWidth ne "") ) {
$svg .= "stroke-width=\"$strokeWidth\" " ;
}
return $svg;
}
# --------------------------------------------------------------------
sub wayVisible {
my $ref = shift ;
sub wayVisible{ my $ref = shift;
my @points = @$ref;
my($sizeX, $sizeY)= mwMap::getDimensions();
my $result = 0;
for (my $i = 0; $i < $#points; $i += 2) {
my $x = $points[$i] ;
for(my $i = 0; $i < $#points; $i += 2){ my $x = $points[$i];
my $y = $points[$i+1];
if ( ( $x >= 0 ) and ( $y >= 0 ) and ( $x <= $sizeX ) and ( $y <= $sizeY ) ) {
$result = 1 ;
if(($x >= 0)and($y >= 0)and($x <= $sizeX)and($y <= $sizeY)){ $result = 1;
}} return $result;
}
}
return $result ;
}
# --------------------------------------------------------------------
sub labelTransform {
my ($label, $cmd) = @_ ;
if ($cmd ne "") {
eval $cmd ;
if ($@) { print "ERROR processing label '$label' with command: '$cmd'\nERROR: $@\n" ; }
sub labelTransform{ my($label, $cmd)= @_;
if($cmd ne ""){ eval $cmd;
if($@){print "ERROR processing label '$label' with command: '$cmd'\nERROR: $@\n";}} return $label;
}
return $label ;
}
1;

268
mwMulti.pm
View File

@ -52,8 +52,7 @@ my %wayUsed = () ;
# -------------------------------------------------------------------------
sub processMultipolygons {
my $notDrawnMP = 0 ;
sub processMultipolygons{ my $notDrawnMP = 0;
my $mp = 0;
my $mpLabels = 0;
my $mpNotDrawnLabels = 0;
@ -62,47 +61,33 @@ sub processMultipolygons {
preprocessMultipolygons();
foreach my $multiId(keys %multiTags){
my $ruleRef = getAreaRule(\@{$multiTags{$multiId}});
if(defined $ruleRef){
my $svgText = "";
my $icon = "";
if ($$ruleRef{'icon'} ne "none") {
$icon = $$ruleRef{'icon'} ;
}
else {
my $col = $$ruleRef{'color'} ;
if($$ruleRef{'icon'}ne "none"){ $icon = $$ruleRef{'icon'};
} else{ my $col = $$ruleRef{'color'};
$svgText = "fill=\"$col\" ";
}
my $ref = $multiPaths{$multiId}[0]; # first, outer way
my $size = areaSize($ref);
if ($size >= cv('minareasize') ) {
drawArea ($svgText, $icon, $multiPaths{$multiId}, 1, "multi") ;
if($size >= cv('minareasize')){ drawArea($svgText, $icon, $multiPaths{$multiId}, 1, "multi");
$mp++;
# LABELS
my $name = ""; my $ref1;
if ( cv('ignorelabels') eq "0" ) {
($name, $ref1) = createLabel ( $multiTags{$multiId}, $$ruleRef{'label'}, 0, 0) ;
if(cv('ignorelabels')eq "0"){ ($name, $ref1)= createLabel($multiTags{$multiId}, $$ruleRef{'label'}, 0, 0);
if(($$ruleRef{'label'}ne "none")and
(cv('nolabel')eq "1")and
($name eq "") )
{
($name eq "")) {
$name = "NO LABEL";
}
}
if ($name ne "") {
if ($size >= cv('minarealabelsize') ) {
$mpLabels++ ;
} }
if($name ne ""){ if($size >= cv('minarealabelsize')){ $mpLabels++;
if(cv('debug')eq "1"){print "MP LABEL: $name, size: $$ruleRef{'labelsize'}, color: $$ruleRef{'labelcolor'}\n";}
my($x, $y)= areaCenter($multiPaths{$multiId}[0]);
@ -123,104 +108,57 @@ sub processMultipolygons {
# $svgText = createTextSVG(undef, undef, $$ruleRef{'labelsize'}, $$ruleRef{'labelcolor'}, undef, undef);
if (cv('debug') eq "1") { print "MP LABEL: svg: \"$svgText\"\n" ; }
placeLabelAndIcon ($x, $y, 1, 0, $name, $svgText, "none", 0, 0, "arealabels") ;
if(cv('debug')eq "1"){print "MP LABEL: svg: \"$svgText\"\n";} placeLabelAndIcon($x, $y, 1, 0, $name, $svgText, "none", 0, 0, "arealabels");
}# if size
else {
$mpNotDrawnLabels++ ;
else{ $mpNotDrawnLabels++;
} } else{
} } else{ $notDrawnMP++;
}
}
else {
}
}
else {
$notDrawnMP++ ;
}
}# if rule
}# foreach multi
print "$mp multipolygon areas drawn, $notDrawnMP not drawn because they were too small.\n";
print "$mpLabels multipolygon labels drawn, $mpNotDrawnLabels not drawn because belonging areas were too small.\n";
}
# ------------------------------------------------------------------------------------------
sub preprocessMultipolygons {
#
sub preprocessMultipolygons{#
# preprecess all multipolygons
#
my($wayNodesRef, $wayTagsRef)= getWayPointers();
my($relationMembersRef, $relationTagsRef)= getRelationPointers();
foreach my $relId (keys %$relationMembersRef) {
my $isMulti = 0 ;
foreach my $tag (@{$$relationTagsRef{$relId}}) {
if ( ($tag->[0] eq "type") and ($tag->[1] eq "multipolygon") ) { $isMulti = 1 ; }
}
if ($isMulti) {
if (cv('debug') eq "1") { print "\n---------------------------------------------------\n" ; }
if (cv('debug') eq "1") { print "\nRelation $relId is multipolygon!\n" ; }
foreach my $relId(keys %$relationMembersRef){ my $isMulti = 0;
foreach my $tag(@{$$relationTagsRef{$relId}}){ if(($tag->[0] eq "type")and($tag->[1] eq "multipolygon")){$isMulti = 1;} }
if($isMulti){ if(cv('debug')eq "1"){print "\n---------------------------------------------------\n";} if(cv('debug')eq "1"){print "\nRelation $relId is multipolygon!\n";}
# get inner and outer ways
my(@innerWays)=(); my(@outerWays)=();
foreach my $member ( @{$$relationMembersRef{$relId}} ) {
if ( ($member->[0] eq "way") and ($member->[2] eq "outer") and (defined @{$$wayNodesRef{$member->[1]}} ) ) { push @outerWays, $member->[1] ; }
if ( ($member->[0] eq "way") and ($member->[2] eq "inner") and (defined @{$$wayNodesRef{$member->[1]}} )) { push @innerWays, $member->[1] ; }
}
if (cv('debug') eq "1") { print "OUTER WAYS: @outerWays\n" ; }
if (cv('debug') eq "1") { print "INNER WAYS: @innerWays\n" ; }
foreach my $member(@{$$relationMembersRef{$relId}}){ if(($member->[0] eq "way")and($member->[2] eq "outer")and(defined @{$$wayNodesRef{$member->[1]}})){push @outerWays, $member->[1];} if(($member->[0] eq "way")and($member->[2] eq "inner")and(defined @{$$wayNodesRef{$member->[1]}})){push @innerWays, $member->[1];} } if(cv('debug')eq "1"){print "OUTER WAYS: @outerWays\n";} if(cv('debug')eq "1"){print "INNER WAYS: @innerWays\n";}
my($ringsWaysRef, $ringsNodesRef);
my @ringWaysInner =(); my @ringNodesInner =(); my @ringTagsInner =();
# build rings inner
if (scalar @innerWays > 0) {
($ringsWaysRef, $ringsNodesRef) = buildRings (\@innerWays, 1) ;
if(scalar @innerWays > 0){ ($ringsWaysRef, $ringsNodesRef)= buildRings(\@innerWays, 1);
@ringWaysInner = @$ringsWaysRef;
@ringNodesInner = @$ringsNodesRef;
for (my $ring=0; $ring<=$#ringWaysInner; $ring++) {
if (cv('debug') eq "1") { print "INNER RING $ring: @{$ringWaysInner[$ring]}\n" ; }
my $firstWay = $ringWaysInner[$ring]->[0] ;
for(my $ring=0; $ring<=$#ringWaysInner; $ring++){ if(cv('debug')eq "1"){print "INNER RING $ring: @{$ringWaysInner[$ring]}\n";} my $firstWay = $ringWaysInner[$ring]->[0];
if(scalar @{$ringWaysInner[$ring]}== 1){$wayUsed{$firstWay}= 1;}# way will be marked as used/drawn by multipolygon
@{$ringTagsInner[$ring]}= @{$$wayTagsRef{$firstWay}}; # ring will be tagged like first contained way
if (cv('debug') eq "1") {
print "tags from first way...\n" ;
foreach my $tag (@{$$wayTagsRef{$firstWay}}) {
print " $tag->[0] - $tag->[1]\n" ;
}
}
if ( (scalar @{$$wayTagsRef{$firstWay}}) == 0 ) {
if (cv('debug') eq "1") { print "tags set to hole in mp.\n" ; }
push @{$ringTagsInner[$ring]}, ["multihole", "yes"] ;
}
}
}
if(cv('debug')eq "1"){ print "tags from first way...\n";
foreach my $tag(@{$$wayTagsRef{$firstWay}}){ print " $tag->[0] - $tag->[1]\n";
} } if((scalar @{$$wayTagsRef{$firstWay}})== 0){ if(cv('debug')eq "1"){print "tags set to hole in mp.\n";} push @{$ringTagsInner[$ring]}, ["multihole", "yes"];
} } }
# build rings outer
my @ringWaysOuter =(); my @ringNodesOuter =(); my @ringTagsOuter =();
if (scalar @outerWays > 0) {
($ringsWaysRef, $ringsNodesRef) = buildRings (\@outerWays, 1) ;
if(scalar @outerWays > 0){ ($ringsWaysRef, $ringsNodesRef)= buildRings(\@outerWays, 1);
@ringWaysOuter = @$ringsWaysRef; # not necessary for outer
@ringNodesOuter = @$ringsNodesRef;
for (my $ring=0; $ring<=$#ringWaysOuter; $ring++) {
if (cv('debug') eq "1") { print "OUTER RING $ring: @{$ringWaysOuter[$ring]}\n" ; }
my $firstWay = $ringWaysOuter[$ring]->[0] ;
if (scalar @{$ringWaysOuter[$ring]} == 1) {$wayUsed{$firstWay} = 1 ; }
@{$ringTagsOuter[$ring]} = @{$$relationTagsRef{$relId}} ; # tags from relation
if (cv('debug') eq "1") {
print "tags from relation...\n" ;
foreach my $tag (@{$$relationTagsRef{$relId}}) {
print " $tag->[0] - $tag->[1]\n" ;
}
}
if (scalar @{$$relationTagsRef{$relId}} == 1) {
@{$ringTagsOuter[$ring]} = @{$$wayTagsRef{$firstWay}} ; # ring will be tagged like first way
}
}
} # outer
for(my $ring=0; $ring<=$#ringWaysOuter; $ring++){ if(cv('debug')eq "1"){print "OUTER RING $ring: @{$ringWaysOuter[$ring]}\n";} my $firstWay = $ringWaysOuter[$ring]->[0];
if(scalar @{$ringWaysOuter[$ring]}== 1){$wayUsed{$firstWay}= 1;} @{$ringTagsOuter[$ring]}= @{$$relationTagsRef{$relId}}; # tags from relation
if(cv('debug')eq "1"){ print "tags from relation...\n";
foreach my $tag(@{$$relationTagsRef{$relId}}){ print " $tag->[0] - $tag->[1]\n";
} } if(scalar @{$$relationTagsRef{$relId}}== 1){ @{$ringTagsOuter[$ring]}= @{$$wayTagsRef{$firstWay}}; # ring will be tagged like first way
} } }# outer
my @ringNodesTotal =(@ringNodesInner, @ringNodesOuter);
my @ringWaysTotal =(@ringWaysInner, @ringWaysOuter);
@ -231,11 +169,9 @@ sub preprocessMultipolygons {
}# relIds
}
# -----------------------------------------------------------------------------------------
sub processRings {
#
sub processRings{#
# process rings of multipolygons and create path data for svg
#
my($ref1, $ref2, $ref3)= @_;
@ -254,145 +190,82 @@ sub processRings {
my($wayNodesRef, $wayTagsRef)= getWayPointers();
# create polygons
if (cv('debug') eq "1") { print "CREATING POLYGONS\n" ; }
for (my $ring = 0 ; $ring <= $#ringWays; $ring++) {
my @poly = () ;
foreach my $node ( @{$ringNodes[$ring]} ) {
push @poly, [$$lonRef{$node}, $$latRef{$node}] ;
}
my ($p) = Math::Polygon->new(@poly) ;
if(cv('debug')eq "1"){print "CREATING POLYGONS\n";} for(my $ring = 0; $ring <= $#ringWays; $ring++){ my @poly =();
foreach my $node(@{$ringNodes[$ring]}){ push @poly, [$$lonRef{$node}, $$latRef{$node}];
} my($p)= Math::Polygon->new(@poly);
$polygon[$ring] = $p;
$polygonSize[$ring] = $p->area;
if(cv('debug')eq "1"){
print " POLYGON $ring - created, size = $polygonSize[$ring] \n";
foreach my $tag (@{$ringTags[$ring]}) {
print " $tag->[0] - $tag->[1]\n" ;
}
}
}
foreach my $tag(@{$ringTags[$ring]}){ print " $tag->[0] - $tag->[1]\n";
} }}
# create is_in list(unsorted)for each ring
if (cv('debug') eq "1") { print "CALC isIn\n" ; }
for (my $ring1=0 ; $ring1<=$#polygon; $ring1++) {
my $res = 0 ;
for (my $ring2=0 ; $ring2<=$#polygon; $ring2++) {
if ($ring1 < $ring2) {
$res = isIn ($polygon[$ring1], $polygon[$ring2]) ;
if(cv('debug')eq "1"){print "CALC isIn\n";} for(my $ring1=0; $ring1<=$#polygon; $ring1++){ my $res = 0;
for(my $ring2=0; $ring2<=$#polygon; $ring2++){ if($ring1 < $ring2){ $res = isIn($polygon[$ring1], $polygon[$ring2]);
if($res == 1){
push @{$ringIsIn[$ring1]}, $ring2;
if (cv('debug') eq "1") { print " $ring1 isIn $ring2\n" ; }
}
if(cv('debug')eq "1"){print " $ring1 isIn $ring2\n";} }
if($res == 2){
push @{$ringIsIn[$ring2]}, $ring1;
if (cv('debug') eq "1") { print " $ring2 isIn $ring1\n" ; }
if(cv('debug')eq "1"){print " $ring2 isIn $ring1\n";} }
} }} if(cv('debug')eq "1"){ print "IS IN LIST\n";
for(my $ring1=0; $ring1<=$#ringNodes; $ring1++){ if(defined @{$ringIsIn[$ring1]}){ print " ring $ring1 isIn - @{$ringIsIn[$ring1]}\n";
} } print "\n";
}
}
}
}
if (cv('debug') eq "1") {
print "IS IN LIST\n" ;
for (my $ring1=0 ; $ring1<=$#ringNodes; $ring1++) {
if (defined @{$ringIsIn[$ring1]}) {
print " ring $ring1 isIn - @{$ringIsIn[$ring1]}\n" ;
}
}
print "\n" ;
}
# sort is_in list, biggest first
if (cv('debug') eq "1") { print "SORTING isIn\n" ; }
for (my $ring=0 ; $ring<=$#ringIsIn; $ring++) {
my @isIn = () ;
foreach my $ring2 (@{$ringIsIn[$ring]}) {
push @isIn, [$ring2, $polygonSize[$ring2]] ;
}
@isIn = sort { $a->[1] <=> $b->[1] } (@isIn) ; # sorted array
if(cv('debug')eq "1"){print "SORTING isIn\n";} for(my $ring=0; $ring<=$#ringIsIn; $ring++){ my @isIn =();
foreach my $ring2(@{$ringIsIn[$ring]}){ push @isIn, [$ring2, $polygonSize[$ring2]];
} @isIn = sort{$a->[1] <=> $b->[1]}(@isIn); # sorted array
my @isIn2 =(); # only ring numbers
foreach my $temp (@isIn) {
push @isIn2, $temp->[0] ;
}
@{$stack[$ring]} = reverse (@isIn2) ;
foreach my $temp(@isIn){ push @isIn2, $temp->[0];
} @{$stack[$ring]}= reverse(@isIn2);
push @{$stack[$ring]}, $ring; # sorted descending and ring self appended
if (cv('debug') eq "1") { print " stack ring $ring sorted: @{$stack[$ring]}\n" ; }
}
if(cv('debug')eq "1"){print " stack ring $ring sorted: @{$stack[$ring]}\n";}}
# find tops and select stacks
if (cv('debug') eq "1") { print "SELECTING STACKS\n" ; }
my $actualStack = 0 ;
for (my $stackNumber=0 ; $stackNumber<=$#stack; $stackNumber++) {
# look for top element
if(cv('debug')eq "1"){print "SELECTING STACKS\n";} my $actualStack = 0;
for(my $stackNumber=0; $stackNumber<=$#stack; $stackNumber++){ # look for top element
my $topElement = $stack[$stackNumber]->[(scalar @{$stack[$stackNumber]}- 1)];
my $found = 0;
for (my $stackNumber2=0 ; $stackNumber2<=$#stack; $stackNumber2++) {
if ($stackNumber != $stackNumber2) {
foreach my $ring (@{$stack[$stackNumber2]}) {
if ($ring == $topElement) {
for(my $stackNumber2=0; $stackNumber2<=$#stack; $stackNumber2++){ if($stackNumber != $stackNumber2){ foreach my $ring(@{$stack[$stackNumber2]}){ if($ring == $topElement){
$found = 1;
if (cv('debug') eq "1") { print " element also found in stack $stackNumber2\n" ; }
}
}
}
}
if ($found == 0) {
@{$selectedStacks{$actualStack}} = @{$stack[$stackNumber]} ;
if(cv('debug')eq "1"){print " element also found in stack $stackNumber2\n";} } } } }
if($found == 0){ @{$selectedStacks{$actualStack}}= @{$stack[$stackNumber]};
$actualStack++;
if (cv('debug') eq "1") { print " stack $stackNumber has been selected.\n" ; }
if(cv('debug')eq "1"){print " stack $stackNumber has been selected.\n";} }
}
}
# process selected stacks
if (cv('debug') eq "1") { print "PROCESS SELECTED STACKS\n" ; }
# while stacks left
while (scalar (keys %selectedStacks) > 0) {
my (@k) = keys %selectedStacks ;
if (cv('debug') eq "1") { print " stacks available: @k\n" ; }
my @nodes = () ;
if(cv('debug')eq "1"){print "PROCESS SELECTED STACKS\n";} # while stacks left
while(scalar(keys %selectedStacks)> 0){ my(@k)= keys %selectedStacks;
if(cv('debug')eq "1"){print " stacks available: @k\n";} my @nodes =();
my @nodesOld;
my @processedStacks =();
# select one bottom element
my $key = $k[0]; # key of first stack
if (cv('debug') eq "1") { print " stack nr $key selected\n" ; }
my $ringToDraw = $selectedStacks{$key}[0] ;
if(cv('debug')eq "1"){print " stack nr $key selected\n";} my $ringToDraw = $selectedStacks{$key}[0];
if(cv('debug')eq "1"){print " ring to draw: $ringToDraw\n";}
push @nodesOld, @{$ringNodes[$ringToDraw]}; # outer polygon
push @nodes, [@{$ringNodes[$ringToDraw]}]; # outer polygon as array
# and remove ring from stacks; store processed stacks
foreach my $k2 (keys %selectedStacks) {
if ($selectedStacks{$k2}[0] == $ringToDraw) {
foreach my $k2(keys %selectedStacks){ if($selectedStacks{$k2}[0] == $ringToDraw){
shift(@{$selectedStacks{$k2}});
push @processedStacks, $k2;
if (scalar @{$selectedStacks{$k2}} == 0) { delete $selectedStacks{$k2} ; }
if (cv('debug') eq "1") { print " removed $ringToDraw from stack $k2\n" ; }
if(scalar @{$selectedStacks{$k2}}== 0){delete $selectedStacks{$k2};} if(cv('debug')eq "1"){print " removed $ringToDraw from stack $k2\n";} }
}
}
# foreach stack in processed stacks
foreach my $k (@processedStacks) {
# if now bottom of a stack is hole, then add this polygon to points
if (defined $selectedStacks{$k}) {
my $tempRing = $selectedStacks{$k}[0] ;
foreach my $k(@processedStacks){ # if now bottom of a stack is hole, then add this polygon to points
if(defined $selectedStacks{$k}){ my $tempRing = $selectedStacks{$k}[0];
my $temp = $ringTags[$tempRing]->[0]->[0];
if (cv('debug') eq "1") { print " testing for hole: stack $k, ring $tempRing, tag $temp\n" ; }
if ($ringTags[$tempRing]->[0]->[0] eq "multihole") {
push @nodesOld, @{$ringNodes[$tempRing]} ;
if(cv('debug')eq "1"){print " testing for hole: stack $k, ring $tempRing, tag $temp\n";} if($ringTags[$tempRing]->[0]->[0] eq "multihole"){ push @nodesOld, @{$ringNodes[$tempRing]};
push @nodes, [@{$ringNodes[$tempRing]}];
# print " nodes so far: @nodes\n";
# and remove this element from stack
shift @{$selectedStacks{$k}};
if (scalar @{$selectedStacks{$k}} == 0) { delete $selectedStacks{$k} ; }
if (cv('debug') eq "1") { print " ring $tempRing identified as hole\n" ; }
}
}
}
if(scalar @{$selectedStacks{$k}}== 0){delete $selectedStacks{$k};} if(cv('debug')eq "1"){print " ring $tempRing identified as hole\n";} } } }
# add way
@{$multiNodes{$newId}}= @nodesOld;
@ -404,16 +277,11 @@ sub processRings {
if(cv('debug')eq "1"){
print " DRAWN: $ringToDraw, wayId $newId\n";
foreach my $tag (@{$ringTags[$ringToDraw]}) {
print " k/v $tag->[0] - $tag->[1]\n" ;
}
}
foreach my $tag(@{$ringTags[$ringToDraw]}){ print " k/v $tag->[0] - $tag->[1]\n";
} }
$newId++;
} # (while)
}
}#(while)}
1;

112
mwNodes.pm
View File

@ -42,67 +42,37 @@ require Exporter ;
sub processNodes{
print "drawing nodes...\n";
my $lonRef; my $latRef; my $tagRef;
($lonRef, $latRef, $tagRef)= getNodePointers();
foreach my $nodeId (keys %$lonRef) {
my @tags = @{ $$tagRef{$nodeId} } ;
foreach my $nodeId(keys %$lonRef){ my @tags = @{$$tagRef{$nodeId}};
my $tagsString = "";
my $ruleRef = getNodeRule(\@tags);
if(defined $ruleRef){
# draw disc first !
if (grep /yes/, $$ruleRef{'disc'}) {
my $svgString = "" ;
if ( $$ruleRef{'discsvgstring'} ne "" ) {
$svgString = $$ruleRef{'discsvgstring'} ;
if(grep /yes/, $$ruleRef{'disc'}){ my $svgString = "";
if($$ruleRef{'discsvgstring'}ne ""){ $svgString = $$ruleRef{'discsvgstring'};
} else{ $svgString = "fill=\"$$ruleRef{'disccolor'}\" stroke=\"none\" fill-opacity=\"$$ruleRef{'discopacity'}\"";
} drawCircle($$lonRef{$nodeId}, $$latRef{$nodeId}, 1, $$ruleRef{'discradius'}, 1, $svgString, 'nodes');
}
else {
$svgString = "fill=\"$$ruleRef{'disccolor'}\" stroke=\"none\" fill-opacity=\"$$ruleRef{'discopacity'}\"" ;
if(grep /yes/, $$ruleRef{'circle'}){ my $svgString = "";
if($$ruleRef{'circlesvgstring'}ne ""){ $svgString = $$ruleRef{'circlesvgstring'};
} else{ $svgString = "fill=\"none\" stroke=\"$$ruleRef{'circlecolor'}\" stroke-width=\"$$ruleRef{'circlethickness'}\"";
} drawCircle($$lonRef{$nodeId}, $$latRef{$nodeId}, 1, $$ruleRef{'circleradius'}, 1, $svgString, 'nodes');
}
drawCircle ($$lonRef{$nodeId}, $$latRef{$nodeId}, 1, $$ruleRef{'discradius'}, 1, $svgString, 'nodes') ;
if(($$ruleRef{'size'}> 0)and($$ruleRef{'icon'}eq "none")){ my $svgString = "";
if($$ruleRef{'svgstring'}ne ""){ $svgString = $$ruleRef{'svgstring'};
} else{ $svgString = "fill=\"$$ruleRef{'color'}\"";
}
if (grep /yes/, $$ruleRef{'circle'}) {
my $svgString = "" ;
if ( $$ruleRef{'circlesvgstring'} ne "" ) {
$svgString = $$ruleRef{'circlesvgstring'} ;
}
else {
$svgString = "fill=\"none\" stroke=\"$$ruleRef{'circlecolor'}\" stroke-width=\"$$ruleRef{'circlethickness'}\"" ;
}
drawCircle ($$lonRef{$nodeId}, $$latRef{$nodeId}, 1, $$ruleRef{'circleradius'}, 1, $svgString, 'nodes') ;
}
if ( ($$ruleRef{'size'} > 0) and ($$ruleRef{'icon'} eq "none") ) {
my $svgString = "" ;
if ( $$ruleRef{'svgstring'} ne "" ) {
$svgString = $$ruleRef{'svgstring'} ;
}
else {
$svgString = "fill=\"$$ruleRef{'color'}\"" ;
}
if ( $$ruleRef{'shape'} eq "circle") {
drawCircle ($$lonRef{$nodeId}, $$latRef{$nodeId}, 1, $$ruleRef{'size'}, 0, $svgString, 'nodes') ;
}
elsif ( $$ruleRef{'shape'} eq "square") {
drawSquare ($$lonRef{$nodeId}, $$latRef{$nodeId}, 1, $$ruleRef{'size'}, 0, $svgString, 'nodes') ;
}
elsif ( $$ruleRef{'shape'} eq "triangle") {
drawTriangle ($$lonRef{$nodeId}, $$latRef{$nodeId}, 1, $$ruleRef{'size'}, 0, $svgString, 'nodes') ;
}
elsif ( $$ruleRef{'shape'} eq "diamond") {
drawDiamond ($$lonRef{$nodeId}, $$latRef{$nodeId}, 1, $$ruleRef{'size'}, 0, $svgString, 'nodes') ;
}
}
if ( ($$ruleRef{'label'} ne "none") or ($$ruleRef{'icon'} ne "none") ) {
my ($labelText, $ref) = createLabel (\@tags, $$ruleRef{'label'}, $$lonRef{$nodeId}, $$latRef{$nodeId}) ;
if($$ruleRef{'shape'}eq "circle"){ drawCircle($$lonRef{$nodeId}, $$latRef{$nodeId}, 1, $$ruleRef{'size'}, 0, $svgString, 'nodes');
} elsif($$ruleRef{'shape'}eq "square"){ drawSquare($$lonRef{$nodeId}, $$latRef{$nodeId}, 1, $$ruleRef{'size'}, 0, $svgString, 'nodes');
} elsif($$ruleRef{'shape'}eq "triangle"){ drawTriangle($$lonRef{$nodeId}, $$latRef{$nodeId}, 1, $$ruleRef{'size'}, 0, $svgString, 'nodes');
} elsif($$ruleRef{'shape'}eq "diamond"){ drawDiamond($$lonRef{$nodeId}, $$latRef{$nodeId}, 1, $$ruleRef{'size'}, 0, $svgString, 'nodes');
} }
if(($$ruleRef{'label'}ne "none")or($$ruleRef{'icon'}ne "none")){ my($labelText, $ref)= createLabel(\@tags, $$ruleRef{'label'}, $$lonRef{$nodeId}, $$latRef{$nodeId});
$labelText = labelTransform($labelText, $$ruleRef{'labeltransform'});
my $labelSize = $$ruleRef{'labelsize'};
my $labelColor = $$ruleRef{'labelcolor'};
@ -119,7 +89,6 @@ sub processNodes {
placeLabelAndIcon($$lonRef{$nodeId}, $$latRef{$nodeId}, 0, $$ruleRef{'size'}, $labelText, $svgText, $icon, $iconSize, $iconSize, "nodes");
}
# fill poi directory
my $thing0 = $$ruleRef{'keyvalue'};
@ -128,31 +97,19 @@ sub processNodes {
my $dirName = getValue("name", $$tagRef{$nodeId});
if((cv('poi')eq "1")and
(defined $dirName)and
( $$ruleRef{'direxclude'} eq "no")
) {
$dirName .= " ($thing)" ;
if ( cv('grid') > 0) {
my $sq = gridSquare($$lonRef{$nodeId}, $$latRef{$nodeId}, cv('grid')) ;
if (defined $sq) {
addToPoiHash ($dirName, $sq) ;
}
}
else {
# $poiHash{$dirName} = 1 ;
($$ruleRef{'direxclude'}eq "no") ){ $dirName .= "($thing)";
if(cv('grid')> 0){ my $sq = gridSquare($$lonRef{$nodeId}, $$latRef{$nodeId}, cv('grid'));
if(defined $sq){ addToPoiHash($dirName, $sq);
} } else{ # $poiHash{$dirName}= 1;
addToPoiHash($dirName, undef);
}
}
} }
}# defined ruleref
}
}
# ------------------------------------------------------------------------------------
sub createPoiDirectory {
my $poiName ;
sub createPoiDirectory{ my $poiName;
my $poiFile;
$poiName = cv('out');
$poiName =~ s/\.svg/\_pois.txt/;
@ -163,25 +120,14 @@ sub createPoiDirectory {
my $ref = getPoiHash();
my %poiHash = %$ref;
if ( cv('grid') eq "0") {
foreach my $poi (sort keys %poiHash) {
$poi = replaceHTMLCode ( $poi ) ;
if(cv('grid')eq "0"){ foreach my $poi(sort keys %poiHash){ $poi = replaceHTMLCode($poi);
print $poiFile "$poi\n";
}
}
else {
foreach my $poi (sort keys %poiHash) {
$poi = replaceHTMLCode ( $poi ) ;
}} else{ foreach my $poi(sort keys %poiHash){ $poi = replaceHTMLCode($poi);
print $poiFile "$poi\t";
foreach my $square (sort keys %{$poiHash{$poi}}) {
print $poiFile "$square " ;
foreach my $square(sort keys %{$poiHash{$poi}}){ print $poiFile "$square ";
} print $poiFile "\n";
}} close($poiFile);
}
print $poiFile "\n" ;
}
}
close ($poiFile) ;
}
1;

159
mwOccupy.pm
View File

@ -46,17 +46,13 @@ my %box = () ;
# -------------------------------------------------------------
sub boxOccupyLines {
my ($refCoords, $buffer, $value) = @_ ;
sub boxOccupyLines{ my($refCoords, $buffer, $value)= @_;
my @coordinates = @$refCoords;
my @lines =();
for ( my $i = 0; $i < $#coordinates-2; $i += 2 ) {
push @lines, [$coordinates[$i], $coordinates[$i+1], $coordinates[$i+2], $coordinates[$i+3]] ;
for(my $i = 0; $i < $#coordinates-2; $i += 2){ push @lines, [$coordinates[$i], $coordinates[$i+1], $coordinates[$i+2], $coordinates[$i+3]];
}
foreach my $line ( @lines ) {
my $x1 = $line->[0] ;
foreach my $line(@lines){ my $x1 = $line->[0];
my $y1 = $line->[1];
my $x2 = $line->[2];
my $y2 = $line->[3];
@ -65,18 +61,14 @@ sub boxOccupyLines {
# print "$x1, $y1, $x2, $y2\n";
if($x1 != $x2){
my $m =($y2 - $y1)/($x2 - $x1);
my $b = $y1 - $m * $x1;
if(abs($x1 - $x2)> abs($y1 - $y2)){
# calc points on x axis
my $x = $x1;
my $stepX = $boxSize;
if ( $x2 < $x1 ) { $stepX = - $boxSize ; }
while ( ( $x >= min ($x1, $x2) ) and ( $x <= max ($x1, $x2) ) ) {
if($x2 < $x1){$stepX = - $boxSize;} while(($x >= min($x1, $x2))and($x <= max($x1, $x2))){
my $y = $m * $x + $b;
# ACTUAL COORDINATE $x, $y
@ -87,16 +79,12 @@ sub boxOccupyLines {
boxOccupyArea($ax1, $ay1, $ax2, $ay2, 0, $value);
$x += $stepX;
}
}
else {
} else{
# calc points on y axis
my $y = $y1;
my $stepY = $boxSize;
if ( $y2 < $y1 ) { $stepY = - $boxSize ; }
while ( ( $y >= min ($y1, $y2) ) and ( $y <= max ($y1, $y2) ) ) {
if($y2 < $y1){$stepY = - $boxSize;} while(($y >= min($y1, $y2))and($y <= max($y1, $y2))){
my $x =($y - $b)/ $m;
# ACTUAL COORDINATE $x, $y
@ -108,19 +96,14 @@ sub boxOccupyLines {
$y += $stepY;
}
}# abs
}
else {
my $x = $x1 ;
} else{ my $x = $x1;
# calc points on y axis
my $y = $y1;
my $stepY = $boxSize;
if ( $y2 < $y1 ) { $stepY = - $boxSize ; }
while ( ( $y >= min ($y1, $y2) ) and ( $y <= max ($y1, $y2) ) ) {
if($y2 < $y1){$stepY = - $boxSize;} while(($y >= min($y1, $y2))and($y <= max($y1, $y2))){
# ACTUAL COORDINATE $x, $y
my $ax1 = $x - $buffer;
my $ax2 = $x + $buffer;
@ -129,25 +112,18 @@ sub boxOccupyLines {
boxOccupyArea($ax1, $ay1, $ax2, $ay2, 0, $value);
$y += $stepY;
}
}
} }
}
}
}}
sub boxLinesOccupied {
my ($refCoords, $buffer) = @_ ;
sub boxLinesOccupied{ my($refCoords, $buffer)= @_;
my @coordinates = @$refCoords;
my @lines =();
my $result = 0;
for ( my $i = 0; $i < $#coordinates-2; $i += 2 ) {
push @lines, [$coordinates[$i], $coordinates[$i+1], $coordinates[$i+2], $coordinates[$i+3]] ;
for(my $i = 0; $i < $#coordinates-2; $i += 2){ push @lines, [$coordinates[$i], $coordinates[$i+1], $coordinates[$i+2], $coordinates[$i+3]];
}
foreach my $line ( @lines ) {
my $x1 = $line->[0] ;
foreach my $line(@lines){ my $x1 = $line->[0];
my $y1 = $line->[1];
my $x2 = $line->[2];
my $y2 = $line->[3];
@ -156,18 +132,14 @@ sub boxLinesOccupied {
# print "$x1, $y1, $x2, $y2\n";
if($x1 != $x2){
my $m =($y2 - $y1)/($x2 - $x1);
my $b = $y1 - $m * $x1;
if(abs($x1 - $x2)> abs($y1 - $y2)){
# calc points on x axis
my $x = $x1;
my $stepX = $boxSize;
if ( $x2 < $x1 ) { $stepX = - $boxSize ; }
while ( ( $x >= min ($x1, $x2) ) and ( $x <= max ($x1, $x2) ) ) {
if($x2 < $x1){$stepX = - $boxSize;} while(($x >= min($x1, $x2))and($x <= max($x1, $x2))){
my $y = $m * $x + $b;
# ACTUAL COORDINATE $x, $y
@ -176,19 +148,14 @@ sub boxLinesOccupied {
my $ay1 = $y - $buffer;
my $ay2 = $y + $buffer;
my $tmp = boxAreaOccupied($ax1, $ay1, $ax2, $ay2);
if ($tmp > $result) { $result = $tmp ; }
$x += $stepX ;
if($tmp > $result){$result = $tmp;} $x += $stepX;
}
}
else {
} else{
# calc points on y axis
my $y = $y1;
my $stepY = $boxSize;
if ( $y2 < $y1 ) { $stepY = - $boxSize ; }
while ( ( $y >= min ($y1, $y2) ) and ( $y <= max ($y1, $y2) ) ) {
if($y2 < $y1){$stepY = - $boxSize;} while(($y >= min($y1, $y2))and($y <= max($y1, $y2))){
my $x =($y - $b)/ $m;
# ACTUAL COORDINATE $x, $y
@ -198,22 +165,16 @@ sub boxLinesOccupied {
my $ay2 = $y + $buffer;
my $tmp = boxAreaOccupied($ax1, $ay1, $ax2, $ay2);
if($tmp > $result){$result = $tmp;}
$y += $stepY;
}
}# abs
}
else {
my $x = $x1 ;
} else{ my $x = $x1;
# calc points on y axis
my $y = $y1;
my $stepY = $boxSize;
if ( $y2 < $y1 ) { $stepY = - $boxSize ; }
while ( ( $y >= min ($y1, $y2) ) and ( $y <= max ($y1, $y2) ) ) {
if($y2 < $y1){$stepY = - $boxSize;} while(($y >= min($y1, $y2))and($y <= max($y1, $y2))){
# ACTUAL COORDINATE $x, $y
my $ax1 = $x - $buffer;
my $ax2 = $x + $buffer;
@ -221,111 +182,71 @@ sub boxLinesOccupied {
my $ay2 = $y + $buffer;
my $tmp = boxAreaOccupied($ax1, $ay1, $ax2, $ay2);
if($tmp > $result){$result = $tmp;}
$y += $stepY;
}
}
} }
} return $result;
}
return $result ;
}
# -------------------------------------------------------------
sub boxOccupyArea {
my ($x1, $y1, $x2, $y2, $buffer, $value) = @_ ;
sub boxOccupyArea{ my($x1, $y1, $x2, $y2, $buffer, $value)= @_;
if ( $x2 < $x1) {
my $tmp = $x1 ;
if($x2 < $x1){ my $tmp = $x1;
$x1 = $x2;
$x2 = $tmp;
}
if ( $y2 < $y1) {
my $tmp = $y1 ;
} if($y2 < $y1){ my $tmp = $y1;
$y1 = $y2;
$y2 = $tmp;
}
$x1 -= $buffer;
$x2 += $buffer;
$y1 -= $buffer;
$y2 += $buffer;
for ( my $x = $x1; $x <= $x2; $x += $boxSize) {
for ( my $y = $y1; $y <= $y2; $y += $boxSize) {
my $bx = int ( $x / $boxSize ) ;
for(my $x = $x1; $x <= $x2; $x += $boxSize){ for(my $y = $y1; $y <= $y2; $y += $boxSize){ my $bx = int($x / $boxSize);
my $by = int($y / $boxSize);
$box{$bx}{$by}= $value;
# print "box $bx, $by occupied\n";
}
}
}}
return;
}
sub boxAreaOccupied {
my ($x1, $y1, $x2, $y2) = @_ ;
sub boxAreaOccupied{ my($x1, $y1, $x2, $y2)= @_;
my $result = 0;
if ( $x2 < $x1) {
my $tmp = $x1 ;
if($x2 < $x1){ my $tmp = $x1;
$x1 = $x2;
$x2 = $tmp;
}
if ( $y2 < $y1) {
my $tmp = $y1 ;
} if($y2 < $y1){ my $tmp = $y1;
$y1 = $y2;
$y2 = $tmp;
}
for ( my $x = $x1; $x <= $x2; $x += $boxSize) {
my $bx = int ($x / $boxSize) ;
for ( my $y = $y1; $y <= $y2; $y += $boxSize) {
my $by = int ($y / $boxSize) ;
for(my $x = $x1; $x <= $x2; $x += $boxSize){ my $bx = int($x / $boxSize);
for(my $y = $y1; $y <= $y2; $y += $boxSize){ my $by = int($y / $boxSize);
# print " $bx, $by\n";
if ( defined $box{$bx}{$by} ) {
if ( $box{$bx}{$by} > $result ) {
# print "check box $bx, $by\n" ;
if(defined $box{$bx}{$by}){ if($box{$bx}{$by}> $result){ # print "check box $bx, $by\n";
$result = $box{$bx}{$by};
} } }} return $result;
}
}
}
}
return $result ;
}
# -------------------------------------------------------------
sub boxDrawOccupiedAreas {
my $format1 = "fill=\"red\" fill-opacity=\"0.3\" " ;
sub boxDrawOccupiedAreas{ my $format1 = "fill=\"red\" fill-opacity=\"0.3\" ";
my $format2 = "fill=\"blue\" fill-opacity=\"0.3\" ";
my $format3 = "fill=\"green\" fill-opacity=\"0.5\" ";
foreach my $bx ( sort {$a <=> $b} keys %box ) {
foreach my $by ( sort {$a <=> $b} keys %{$box{$bx}} ) {
my $x1 = $bx * $boxSize ;
foreach my $bx(sort{$a <=> $b}keys %box){ foreach my $by(sort{$a <=> $b}keys %{$box{$bx}}){ my $x1 = $bx * $boxSize;
my $x2 = $x1 + $boxSize;
my $y1 = $by * $boxSize;
my $y2 = $y1 + $boxSize;
if ( $box{$bx}{$by} == 1) {
drawRect ($x1, $y1, $x2, $y2, 0, $format1, "occupied") ;
if($box{$bx}{$by}== 1){ drawRect($x1, $y1, $x2, $y2, 0, $format1, "occupied");
} elsif($box{$bx}{$by}== 2){ drawRect($x1, $y1, $x2, $y2, 0, $format2, "occupied");
} else { drawRect($x1, $y1, $x2, $y2, 0, $format3, "occupied");
} # print "occupied $bx, $by\n";
}}
}
elsif ( $box{$bx}{$by} == 2) {
drawRect ($x1, $y1, $x2, $y2, 0, $format2, "occupied") ;
}
else {
drawRect ($x1, $y1, $x2, $y2, 0, $format3, "occupied") ;
}
# print "occupied $bx, $by\n" ;
}
}
}
1;

156
mwRelations.pm
View File

@ -46,8 +46,7 @@ my %iconSizeY = () ;
# --------------------------------------------------------------------------
sub processRoutes {
#
sub processRoutes{#
# process route data
#
my %routeColors =(); # will point to arrays of colors per route type
@ -64,51 +63,35 @@ sub processRoutes {
my $ref = getRouteColors();
%routeColors = %$ref;
foreach my $type (keys %routeColors) {
$colorNumber{$type} = scalar @{$routeColors{$type}} ;
foreach my $type(keys %routeColors){ $colorNumber{$type}= scalar @{$routeColors{$type}};
$actualColorIndex{$type}= 0;
}
my($lonRef, $latRef)= getNodePointers();
my($wayNodesRef, $wayTagsRef)= getWayPointers();
my($relationMembersRef, $relationTagsRef)= getRelationPointers();
foreach my $relId (keys %$relationTagsRef) {
my $relationType = getValue ("type", $$relationTagsRef{$relId} ) ;
foreach my $relId(keys %$relationTagsRef){ my $relationType = getValue("type", $$relationTagsRef{$relId});
if(! defined $relationType){$relationType = "";}
if(($relationType eq "route")and((cv('relid')== $relId)or(cv('relid')== 0))){
my $ruleRef = getRouteRule($$relationTagsRef{$relId});
if(defined $ruleRef){
# new route detected
if(cv('debug')eq "1"){print "ROUTE: rule found for $relId, $$ruleRef{'type'}.\n";}
# try to get color from relation tags first
#
my $color = getValue("color", $$relationTagsRef{$relId});
if ( ! defined $color) {
$color = getValue ("colour", $$relationTagsRef{$relId} ) ;
if(! defined $color){ $color = getValue("colour", $$relationTagsRef{$relId});
}
# no color yet, then get color from rule
#
if(! defined $color){
if (cv('debug') eq "1" ) { print "ROUTE: actual color index: $actualColorIndex{ $$ruleRef{'type'} }\n" ; }
$color = $routeColors{ $$ruleRef{'type'} }[$actualColorIndex{ $$ruleRef{'type'} }] ;
if(cv('debug')eq "1"){print "ROUTE: actual color index: $actualColorIndex{$$ruleRef{'type'}}\n";} $color = $routeColors{$$ruleRef{'type'}}[$actualColorIndex{$$ruleRef{'type'}}];
$actualColorIndex{$$ruleRef{'type'}}=($actualColorIndex{$$ruleRef{'type'}}+ 1)% $colorNumber{$$ruleRef{'type'}};
}
if (cv('debug') eq "1" ) { print "ROUTE: $relId final color: $color\n" ; }
} if(cv('debug')eq "1"){print "ROUTE: $relId final color: $color\n";}
# find icon
my $iconName = getValue("ref", $$relationTagsRef{$relId});
if ( ! defined $iconName ) {
getValue ("name", $$relationTagsRef{$relId} )
}
if ( ! defined $iconName) { $iconName = "" ; }
if(! defined $iconName){ getValue("name", $$relationTagsRef{$relId}) } if(! defined $iconName){$iconName = "";}
# look for route icon. svg first, then png
my $file;
@ -116,78 +99,55 @@ sub processRoutes {
my $iconResult = open($file, "<", $iconName);
# print " trying $iconName\n";
if($iconResult){
if (cv('debug') eq "1") { print "ROUTE: icon $iconName found!\n" ; }
close ($file) ;
if(cv('debug')eq "1"){print "ROUTE: icon $iconName found!\n";} close($file);
}
if ( ! $iconResult) {
$iconName =~ s/.svg/.png/ ;
if(! $iconResult){ $iconName =~ s/.svg/.png/;
# print " trying $iconName\n";
$iconResult = open($file, "<", $iconName);
if($iconResult){
if (cv('debug') eq "1") { print "ROUTE: icon $iconName found!\n" ; }
close ($file) ;
if(cv('debug')eq "1"){print "ROUTE: icon $iconName found!\n";} close($file);
}
}
if ($iconResult) {
my ($x, $y) ; undef $x ; undef $y ;
if (grep /.svg/, $iconName) {
($x, $y) = sizeSVG ($iconName) ;
if($iconResult){ my($x, $y); undef $x; undef $y;
if(grep /.svg/, $iconName){ ($x, $y)= sizeSVG($iconName);
if(($x == 0)or($y == 0)){
$x = 32; $y = 32;
print "WARNING: size of file $iconName could not be determined. Set to 32px x 32px\n";
}
}
if (grep /.png/, $iconName) {
($x, $y) = sizePNG ($iconName) ;
if(grep /.png/, $iconName){ ($x, $y)= sizePNG($iconName);
}
$iconSizeX{$iconName}= $x;
$iconSizeY{$iconName}= $y;
}
my($label, $ref)= createLabel($$relationTagsRef{$relId}, $$ruleRef{'label'});
my $printIcon = ""; if($iconResult){$printIcon = $iconName;}
if(cv('verbose')eq "1"){
printf "ROUTE: route %10s %10s %10s %30s %40s\n", $relId, $$ruleRef{'type'}, $color, $label, $printIcon;
}
# collect ways
my $mRef = getAllMembers($relId, 0);
my @tempMembers = @$mRef;
my @relWays =();
foreach my $member (@tempMembers) {
if ( ( ($member->[2] eq "none") or ($member->[2] eq "route") ) and ($member->[0] eq "way") ) { push @relWays, $member->[1] ; }
if ( ( ($member->[2] eq "forward") or ($member->[2] eq "backward") ) and ($member->[0] eq "way") ) { push @relWays, $member->[1] ; }
foreach my $member(@tempMembers){ if((($member->[2] eq "none")or($member->[2] eq "route"))and($member->[0] eq "way")){push @relWays, $member->[1];} if((($member->[2] eq "forward")or($member->[2] eq "backward"))and($member->[0] eq "way")){push @relWays, $member->[1];}
# TODO diversions, shortcuts?
# stops
if ( (grep /stop/, $member->[2]) and ($member->[0] eq "node") ) {
if ( ( $$ruleRef{'nodesize'} > 0) and (defined $$latRef{$member->[1]}) and (defined $$lonRef{$member->[1]}) ) {
my $svgString = "fill=\"$color\" " ;
if((grep /stop/, $member->[2])and($member->[0] eq "node")){ if(($$ruleRef{'nodesize'}> 0)and(defined $$latRef{$member->[1]})and(defined $$lonRef{$member->[1]})){ my $svgString = "fill=\"$color\" ";
drawCircle($$lonRef{$member->[1]}, $$latRef{$member->[1]}, 1, $$ruleRef{'nodesize'}, 0, $svgString, 'routes');
}
}
}
} } }
if(cv('debug')eq "1"){print "ROUTE: ways: @relWays\n";}
foreach my $w(@relWays){
my $op = $$ruleRef{'opacity'}/ 100;
my $width = $$ruleRef{'size'};
my $linecap = $$ruleRef{'linecap'};
my $dashString = "";
my $dash = $$ruleRef{'dash'};
if ( $dash ne "") { $dashString = "stroke-dasharray=\"$dash\" " ; }
my $svgString = "stroke=\"$color\" stroke-opacity=\"$op\" stroke-width=\"$width\" fill=\"none\" stroke-linejoin=\"round\" stroke-linecap=\"$linecap\" " . $dashString ;
if($dash ne ""){$dashString = "stroke-dasharray=\"$dash\" ";} my $svgString = "stroke=\"$color\" stroke-opacity=\"$op\" stroke-width=\"$width\" fill=\"none\" stroke-linejoin=\"round\" stroke-linecap=\"$linecap\" " . $dashString;
drawWay($$wayNodesRef{$w}, 1, $svgString, "routes", undef);
@ -196,35 +156,25 @@ sub processRoutes {
$wayRouteLabels{$w}{$label}= 1;
if($iconResult){
$wayRouteIcons{$w}{$iconName}= 1;
}
}
} }
}# rule found
if (cv('debug') eq "1") { print "\n" ; }
} # rel route
if(cv('debug')eq "1"){print "\n";} }# rel route
}# relation
# label route ways after all relations have been processed
foreach my $w (keys %wayRouteLabels) {
if ( (defined $$wayNodesRef{$w}) and (scalar @{$$wayNodesRef{$w}} > 1) ) {
my $label = "" ;
foreach my $l (keys %{$wayRouteLabels{$w}}) {
$label .= $l . " " ;
foreach my $w(keys %wayRouteLabels){ if((defined $$wayNodesRef{$w})and(scalar @{$$wayNodesRef{$w}}> 1)){ my $label = "";
foreach my $l(keys %{$wayRouteLabels{$w}}){ $label .= $l . " ";
}
my @way = @{$$wayNodesRef{$w}};
if ($$lonRef{$way[0]} > $$lonRef{$way[-1]}) {
@way = reverse (@way) ;
if($$lonRef{$way[0]}> $$lonRef{$way[-1]}){ @way = reverse(@way);
}
if (labelFitsWay ( \@way, $label, cv('routelabelfont'), cv('routelabelsize') ) ) {
my $pathName = "RoutePath" . $pathNumber ;
if(labelFitsWay(\@way, $label, cv('routelabelfont'), cv('routelabelsize'))){ my $pathName = "RoutePath" . $pathNumber;
$pathNumber++;
my @points = nodes2Coordinates(@way);
if(! coordsOut(@points)){
createPath($pathName, \@points, "definitions");
my $size = cv('routelabelsize');
@ -234,35 +184,23 @@ sub processRoutes {
my $svgText = createTextSVG($fontFamily, $font, $size, $color, undef, undef);
pathText($svgText, $label, $pathName, cv('routelabeloffset'), "middle", 50, "routes");
}
}
}
}
} } }}
# place icons
foreach my $w (keys %wayRouteIcons) {
my $offset = 0 ;
foreach my $w(keys %wayRouteIcons){ my $offset = 0;
my $nodeNumber = scalar @{$$wayNodesRef{$w}};
if ($nodeNumber > 1) {
my $node = $$wayNodesRef{$w}[int ($nodeNumber / 2)] ;
if($nodeNumber > 1){ my $node = $$wayNodesRef{$w}[int($nodeNumber / 2)];
my $num = scalar(keys %{$wayRouteIcons{$w}});
$offset = int(-($num-1)* cv('routeicondist')/ 2);
foreach my $iconName(keys %{$wayRouteIcons{$w}}){
my $size = 40;
placeLabelAndIcon($$lonRef{$node}, $$latRef{$node}, $offset, $size, "", "", $iconName, $iconSizeX{$iconName}, $iconSizeY{$iconName}, "routes");
$offset += cv('routeicondist');
}
}
}
}
} }}}
# --------------------------------------------------------------------------
sub getAllMembers {
#
sub getAllMembers{#
# get all members of a relation recursively
# takes rel id and nesting level
# retruns ref to array with all members
@ -275,51 +213,33 @@ sub getAllMembers {
if($nestingLevel > $maxNestingLevel){
print "ERROR/WARNING nesting level of relations too deep. recursion stopped at depth $maxNestingLevel! relId=$relId\n";
}
else {
foreach my $member ( @{$$relationMembersRef{$relId}} ) {
if ( ($member->[0] eq "way") or ($member->[0] eq "node") ) {
push @allMembers, $member ;
}
if ( $member->[0] eq "relation" ) {
my $ref = getAllMembers ($member->[1], $nestingLevel+1) ;
} else{ foreach my $member(@{$$relationMembersRef{$relId}}){ if(($member->[0] eq "way")or($member->[0] eq "node")){ push @allMembers, $member;
} if($member->[0] eq "relation"){ my $ref = getAllMembers($member->[1], $nestingLevel+1);
push @allMembers, @$ref;
} }
} return \@allMembers;
}
}
}
return \@allMembers ;
}
sub labelFitsWay {
my ($refWayNodes, $text, $font, $size) = @_ ;
sub labelFitsWay{ my($refWayNodes, $text, $font, $size)= @_;
my @wayNodes = @$refWayNodes;
my($lonRef, $latRef)= getNodePointers();
# calc waylen
my $wayLength = 0; # in pixels
for (my $i=0; $i<$#wayNodes; $i++) {
my ($x1, $y1) = convert ($$lonRef{$wayNodes[$i]}, $$latRef{$wayNodes[$i]}) ;
for(my $i=0; $i<$#wayNodes; $i++){ my($x1, $y1)= convert($$lonRef{$wayNodes[$i]}, $$latRef{$wayNodes[$i]});
my($x2, $y2)= convert($$lonRef{$wayNodes[$i+1]}, $$latRef{$wayNodes[$i+1]});
$wayLength += sqrt(($x2-$x1)**2 +($y2-$y1)**2);
}
# calc label len
my $labelLength = length($text)* cv('ppc')/ 10 * $size; # in pixels
my $fit;
if ($labelLength < $wayLength) { $fit="fit" ; } else { $fit = "NOFIT" ; }
# print "labelFitsWay: $fit, $text, labelLen = $labelLength, wayLen = $wayLength\n" ;
if ($labelLength < $wayLength) {
return 1 ;
}
else {
return 0 ;
}
}
if($labelLength < $wayLength){$fit="fit";}else{$fit = "NOFIT";} # print "labelFitsWay: $fit, $text, labelLen = $labelLength, wayLen = $wayLength\n";
if($labelLength < $wayLength){ return 1;
} else{ return 0;
}}
1;

459
mwRules.pm
View File

@ -46,8 +46,7 @@ require Exporter ;
createLegend
);
my @validNodeProperties = (
["keyValue","key and value like [amenity=hospital]"],
my @validNodeProperties =( ["keyValue","key and value like [amenity=hospital]"],
["color","color of node i.e. [black]"],
["size","size of node i.e. [50]"],
["shape","shape of node [circle|disc|triangle|diamond|rectangle]"],
@ -85,8 +84,7 @@ my @validNodeProperties = (
["direxclude","should these objects be excluded from directory? [yes|no]"]
);
my @validWayProperties = (
["keyValue","key and value like [highway=residential]"],
my @validWayProperties =( ["keyValue","key and value like [highway=residential]"],
["color","color for the way i.e. [gray]"],
["size","size of the way i.e. [15]"],
["dash","svg dash array for the way i.e. [20,20]; old mapgen values are also possible"],
@ -117,8 +115,7 @@ my @validWayProperties = (
["direxclude","should these objects be excluded from directory? [yes|no]"]
);
my @validAreaProperties = (
["keyValue","key and value of object i.e. [amenity=parking]"],
my @validAreaProperties =( ["keyValue","key and value of object i.e. [amenity=parking]"],
["color","color of area i.e. [lightgrey]"],
["icon","icon for fill pattern to be used i.e. [icondir/parking.svg]"],
["label", "label text to be rendered i.e. [name]"] ,
@ -140,8 +137,7 @@ my @validAreaProperties = (
);
my @validRouteProperties = (
["type","type of route like [bus|hiking]"],
my @validRouteProperties =( ["type","type of route like [bus|hiking]"],
["color","color of route like [red]"],
["size","size of route i.e. [10]"],
["dash","svg dash array style like [20,20]"],
@ -172,34 +168,23 @@ my $ruleFile ;
# ---------------------------------------------------------------------------------------
sub printValidObjectProperties{
print "\nValid Object Properties\n";
print "\nNodes\n-----\n";
foreach my $p (sort {$a->[0] cmp $b->[0]} @validNodeProperties) {
printf "%-20s %s\n", $p->[0], $p->[1] ;
foreach my $p(sort{$a->[0] cmp $b->[0]}@validNodeProperties){ printf "%-20s %s\n", $p->[0], $p->[1];
} print "\nWays\n----\n";
foreach my $p(sort{$a->[0] cmp $b->[0]}@validWayProperties){ printf "%-20s %s\n", $p->[0], $p->[1];
} print "\nAreas\n-----\n";
foreach my $p(sort{$a->[0] cmp $b->[0]}@validAreaProperties){ printf "%-20s %s\n", $p->[0], $p->[1];
} print "\nRoutes\n-----\n";
foreach my $p(sort{$a->[0] cmp $b->[0]}@validRouteProperties){ printf "%-20s %s\n", $p->[0], $p->[1];
} print "\n";
}
print "\nWays\n----\n" ;
foreach my $p (sort {$a->[0] cmp $b->[0]} @validWayProperties) {
printf "%-20s %s\n", $p->[0], $p->[1] ;
}
print "\nAreas\n-----\n" ;
foreach my $p (sort {$a->[0] cmp $b->[0]} @validAreaProperties) {
printf "%-20s %s\n", $p->[0], $p->[1] ;
}
print "\nRoutes\n-----\n" ;
foreach my $p (sort {$a->[0] cmp $b->[0]} @validRouteProperties) {
printf "%-20s %s\n", $p->[0], $p->[1] ;
}
print "\n" ;
}
# ---------------------------------------------------------------------------------------
sub readRules{
my $fileName = cv('style');
my $nrr = 0; my $wrr = 0; my $arr = 0; my $rrr = 0; my $crr = 0;
@ -207,20 +192,14 @@ sub readRules {
my %vnp =();
foreach my $p(@validNodeProperties){$vnp{lc($p->[0])}= 1;}
my %vwp =();
foreach my $p(@validWayProperties){$vwp{lc($p->[0])}= 1;}
my %vap =();
foreach my $p(@validAreaProperties){$vap{lc($p->[0])}= 1;}
my %vrp =();
foreach my $p(@validRouteProperties){$vrp{lc($p->[0])}= 1;}
openRuleFile($fileName);
while (defined $line) {
if ( grep /^rule node/i, $line ) {
$nodeNr++ ;
while(defined $line){ if(grep /^rule node/i, $line){ $nodeNr++;
$nrr++;
getRuleLine();
@ -264,24 +243,15 @@ sub readRules {
$nodeRules{$nodeNr}{'direxclude'}= cv('direxcludedefault');
while ( ( defined $line) and ( ! grep /^rule/i, $line) ) {
my ($k, $v) = ( $line =~ /(.+?)=(.+)/ ) ;
if ( ( ! defined $k ) or ( ! defined $v ) ) {
print "WARNING: could not parse rule line: $line" ;
}
else {
$k = lc ( $k ) ;
while((defined $line)and(! grep /^rule/i, $line)){ my($k, $v)=($line =~ /(.+?)=(.+)/);
if((! defined $k)or(! defined $v)){ print "WARNING: could not parse rule line: $line";
} else{ $k = lc($k);
$nodeRules{$nodeNr}{$k}= $v;
if ( ! defined $vnp{$k} ) { print "WARNING: $k is not a valid node property!\n" ; }
}
getRuleLine() ;
}
if ( ! defined $nodeRules{ $nodeNr }{ 'keyvalue' } ) { die "ERROR: rule without keyValue detected!\n" ; }
if(! defined $vnp{$k}){print "WARNING: $k is not a valid node property!\n";} } getRuleLine();
} if(! defined $nodeRules{$nodeNr}{'keyvalue'}){die "ERROR: rule without keyValue detected!\n";}
}# node
elsif(grep /^rule way/i, $line){
$wayNr++;
$wrr++;
getRuleLine();
@ -316,24 +286,15 @@ sub readRules {
$wayRules{$wayNr}{'direxclude'}= cv('direxcludedefault');
while ( ( defined $line) and ( ! grep /^rule/i, $line) ) {
my ($k, $v) = ( $line =~ /(.+?)=(.+)/ ) ;
if ( ( ! defined $k ) or ( ! defined $v ) ) {
print "WARNING: could not parse rule line: $line" ;
}
else {
$k = lc ( $k ) ;
while((defined $line)and(! grep /^rule/i, $line)){ my($k, $v)=($line =~ /(.+?)=(.+)/);
if((! defined $k)or(! defined $v)){ print "WARNING: could not parse rule line: $line";
} else{ $k = lc($k);
$wayRules{$wayNr}{$k}= $v;
if ( ! defined $vwp{$k} ) { print "WARNING: $k is not a valid way property!\n" ; }
}
getRuleLine() ;
}
if ( ! defined $wayRules{ $wayNr }{ 'keyvalue' } ) { die "ERROR: rule without keyValue detected!\n" ; }
if(! defined $vwp{$k}){print "WARNING: $k is not a valid way property!\n";} } getRuleLine();
} if(! defined $wayRules{$wayNr}{'keyvalue'}){die "ERROR: rule without keyValue detected!\n";}
}# way
elsif ( grep /^rule area/i, $line ) {
$areaNr++ ;
elsif(grep /^rule area/i, $line){ $areaNr++;
$arr++;
getRuleLine();
@ -358,26 +319,16 @@ sub readRules {
$areaRules{$areaNr}{'fromscale'}= cv('ruledefaultareafromscale');
$areaRules{$areaNr}{'toscale'}= cv('ruledefaultareatoscale');
while ( ( defined $line) and ( ! grep /^rule/i, $line) ) {
my ($k, $v) = ( $line =~ /(.+?)=(.+)/ ) ;
if ( ( ! defined $k ) or ( ! defined $v ) ) {
print "WARNING: could not parse rule line: $line" ;
}
else {
$k = lc ( $k ) ;
while((defined $line)and(! grep /^rule/i, $line)){ my($k, $v)=($line =~ /(.+?)=(.+)/);
if((! defined $k)or(! defined $v)){ print "WARNING: could not parse rule line: $line";
} else{ $k = lc($k);
$areaRules{$areaNr}{$k}= $v;
if(! defined $vap{$k}){print "WARNING: $k is not a valid area property!\n";}
if ($k eq "icon") { mwMap::addAreaIcon ($v) ; }
}
getRuleLine() ;
}
if ( ! defined $areaRules{ $areaNr }{ 'keyvalue' } ) { die "ERROR: rule without keyValue detected!\n" ; }
if($k eq "icon"){mwMap::addAreaIcon($v);} } getRuleLine();
} if(! defined $areaRules{$areaNr}{'keyvalue'}){die "ERROR: rule without keyValue detected!\n";}
}# area
elsif ( grep /^rule route/i, $line ) {
$routeNr++ ;
elsif(grep /^rule route/i, $line){ $routeNr++;
$rrr++;
getRuleLine();
@ -395,92 +346,65 @@ sub readRules {
$routeRules{$routeNr}{'fromscale'}= cv('ruleDefaultRouteFromScale');
$routeRules{$routeNr}{'toscale'}= cv('ruleDefaultRouteToScale');
while ( ( defined $line) and ( ! grep /^rule/i, $line) ) {
my ($k, $v) = ( $line =~ /(.+?)=(.+)/ ) ;
if ( ( ! defined $k ) or ( ! defined $v ) ) {
print "WARNING: could not parse rule line: $line" ;
}
else {
$k = lc ( $k ) ;
while((defined $line)and(! grep /^rule/i, $line)){ my($k, $v)=($line =~ /(.+?)=(.+)/);
if((! defined $k)or(! defined $v)){ print "WARNING: could not parse rule line: $line";
} else{ $k = lc($k);
$routeRules{$routeNr}{$k}= $v;
if ( ! defined $vrp{$k} ) { print "WARNING: $k is not a valid route property!\n" ; }
}
getRuleLine() ;
}
if ( ! defined $routeRules{ $routeNr }{ 'type' } ) { die "ERROR: route rule without type detected!\n" ; }
if(! defined $vrp{$k}){print "WARNING: $k is not a valid route property!\n";} } getRuleLine();
} if(! defined $routeRules{$routeNr}{'type'}){die "ERROR: route rule without type detected!\n";}
}# route
elsif ( grep /^rule config/i, $line ) {
$crr++ ;
elsif(grep /^rule config/i, $line){ $crr++;
my($key, $value)=($line =~ /^rule config\s+(.+)=(.+)/i);
if ( (defined $key) and (defined $value) ) {
setConfigValue ($key, $value) ;
if ( cv('debug') eq "1" ) {
print "RULES: config changed $key=$value\n" ;
}
}
getRuleLine() ;
if((defined $key)and(defined $value)){ setConfigValue($key, $value);
if(cv('debug')eq "1"){ print "RULES: config changed $key=$value\n";
} } getRuleLine();
}# config
else {
getRuleLine() ;
else{ getRuleLine();
}
}
close($ruleFile);
print "rules read: $nrr nodes, $wrr ways, $arr areas, $rrr routes and $crr configs\n\n";
}
sub getNodeRule{
# takes tagref and returns hashref to rule properties
my $tagRef = shift;
my $scale = getScale();
if ( cv('rulescaleset') != 0 ) { $scale = cv('rulescaleset') ; }
# print "GNR: scale: $scale\n" ;
if(cv('rulescaleset')!= 0){$scale = cv('rulescaleset');} # print "GNR: scale: $scale\n";
my $ruleFound; undef $ruleFound;
# print "\n";
RUL2: foreach my $rule ( sort { $a <=> $b } keys %nodeRules) {
# print "rule $rule\n" ;
RUL2: foreach my $rule(sort{$a <=> $b}keys %nodeRules){ # print "rule $rule\n";
if(($nodeRules{$rule}{'fromscale'}<= $scale)and($nodeRules{$rule}{'toscale'}>= $scale)){
my @kvs = split /;/, $nodeRules{$rule}{'keyvalue'};
my $allValid = 1;
RUL1: foreach my $kv1(@kvs){# for each needed
my($k, $v)=($kv1 =~ /(.+)=(.+)/);
# print " looking for $k=$v\n";
my $found = 0;
RUL3: foreach my $tag ( @$tagRef) {
# print " actual kvs: $tag->[0]=$tag->[1]\n" ;
if ( ( $tag->[0] eq $k) and ( ( $tag->[1] eq $v) or ( $v eq "*") ) ) {
$found = 1 ;
RUL3: foreach my $tag(@$tagRef){ # print " actual kvs: $tag->[0]=$tag->[1]\n";
if(($tag->[0] eq $k)and(($tag->[1] eq $v)or($v eq "*"))){ $found = 1;
# print " FOUND\n";
last RUL3;
}
} # tags
} }# tags
if(! $found){
$allValid = 0;
last RUL1;
}
} # kv1
} }# kv1
if ( $allValid ) {
# print "ALL VALID\n" ;
if($allValid){ # print "ALL VALID\n";
# return the first rule found
$ruleFound = \%{$nodeRules{$rule}};
last RUL2;
}
}# scale
}# all rules
@ -488,63 +412,47 @@ sub getNodeRule {
return($ruleFound);
}
sub printNodeRules {
foreach my $n ( sort { $a <=> $b } keys %nodeRules) {
print "node rule $n\n" ;
foreach my $v (sort keys %{$nodeRules{$n}}) {
print " $v=$nodeRules{$n}{$v}\n" ;
sub printNodeRules{ foreach my $n(sort{$a <=> $b} keys %nodeRules){ print "node rule $n\n";
foreach my $v(sort keys %{$nodeRules{$n}}){ print " $v=$nodeRules{$n}{$v}\n";
}
print "\n";
}
}
}}
# ---------------------------------------------------------------------------------------
sub getWayRule{
# takes tagref and returns hashref to rule properties
my $tagRef = shift;
my $scale = getScale();
if(cv('rulescaleset')!= 0){$scale = cv('rulescaleset');}
my $ruleFound; undef $ruleFound;
RUL5: foreach my $rule ( sort { $a <=> $b } keys %wayRules) {
# print "rule $rule\n" ;
RUL5: foreach my $rule(sort{$a <=> $b}keys %wayRules){ # print "rule $rule\n";
if(($wayRules{$rule}{'fromscale'}<= $scale)and($wayRules{$rule}{'toscale'}>= $scale)){
my @kvs = split /;/, $wayRules{$rule}{'keyvalue'};
my $allValid = 1;
RUL4: foreach my $kv1(@kvs){# for each needed
my($k, $v)=($kv1 =~ /(.+)=(.+)/);
# print " looking for $k=$v\n";
my $found = 0;
RUL6: foreach my $tag ( @$tagRef) {
# print " actual kvs: $tag->[0]=$tag->[1]\n" ;
if ( ( $tag->[0] eq $k) and ( ( $tag->[1] eq $v) or ( $v eq "*") ) ) {
$found = 1 ;
RUL6: foreach my $tag(@$tagRef){ # print " actual kvs: $tag->[0]=$tag->[1]\n";
if(($tag->[0] eq $k)and(($tag->[1] eq $v)or($v eq "*"))){ $found = 1;
# print " FOUND\n";
last RUL6;
}
} # tags
} }# tags
if(! $found){
$allValid = 0;
last RUL4;
}
} # kv1
} }# kv1
if ( $allValid ) {
# print "ALL VALID\n" ;
if($allValid){ # print "ALL VALID\n";
# return the first rule found
$ruleFound = \%{$wayRules{$rule}};
last RUL5;
}
}# scale
}# all rules
@ -553,64 +461,48 @@ sub getWayRule {
}
sub printWayRules {
foreach my $n ( sort { $a <=> $b } keys %wayRules) {
print "way rule $n\n" ;
foreach my $v (sort keys %{$wayRules{$n}}) {
print " $v=$wayRules{$n}{$v}\n" ;
sub printWayRules{ foreach my $n(sort{$a <=> $b} keys %wayRules){ print "way rule $n\n";
foreach my $v(sort keys %{$wayRules{$n}}){ print " $v=$wayRules{$n}{$v}\n";
}
print "\n";
}
}
}}
# ---------------------------------------------------------------------------------------
sub getAreaRule{
# takes tagref and returns hashref to rule properties
my $tagRef = shift;
my $scale = getScale();
if(cv('rulescaleset')!= 0){$scale = cv('rulescaleset');}
my $ruleFound; undef $ruleFound;
RUL8: foreach my $rule ( sort { $a <=> $b } keys %areaRules) {
# print "rule $rule\n" ;
RUL8: foreach my $rule(sort{$a <=> $b}keys %areaRules){ # print "rule $rule\n";
if(($areaRules{$rule}{'fromscale'}<= $scale)and($areaRules{$rule}{'toscale'}>= $scale)){
my @kvs = split /;/, $areaRules{$rule}{'keyvalue'};
my $allValid = 1;
RUL7: foreach my $kv1(@kvs){# for each needed
my($k, $v)=($kv1 =~ /(.+)=(.+)/);
# print " looking for $k=$v\n";
my $found = 0;
RUL9: foreach my $tag ( @$tagRef) {
# print " actual kvs: $tag->[0]=$tag->[1]\n" ;
if ( ( $tag->[0] eq $k) and ( ( $tag->[1] eq $v) or ( $v eq "*") ) ) {
$found = 1 ;
RUL9: foreach my $tag(@$tagRef){ # print " actual kvs: $tag->[0]=$tag->[1]\n";
if(($tag->[0] eq $k)and(($tag->[1] eq $v)or($v eq "*"))){ $found = 1;
# print " FOUND\n";
last RUL9;
}
} # tags
} }# tags
if(! $found){
$allValid = 0;
last RUL7;
}
} # kv1
} }# kv1
if ( $allValid ) {
# print "ALL VALID\n" ;
if($allValid){ # print "ALL VALID\n";
# return the first rule found
$ruleFound = \%{$areaRules{$rule}};
last RUL8;
}
}# scale
}# all rules
@ -619,121 +511,65 @@ sub getAreaRule {
}
sub printAreaRules {
foreach my $n ( sort { $a <=> $b } keys %areaRules) {
print "area rule $n\n" ;
foreach my $v (sort keys %{$areaRules{$n}}) {
print " $v=$areaRules{$n}{$v}\n" ;
sub printAreaRules{ foreach my $n(sort{$a <=> $b} keys %areaRules){ print "area rule $n\n";
foreach my $v(sort keys %{$areaRules{$n}}){ print " $v=$areaRules{$n}{$v}\n";
}
print "\n";
}
}
}}
# --------------------------------------------------------------------------------
sub getRouteRule {
my $tagRef = shift ;
sub getRouteRule{ my $tagRef = shift;
my $scale = getScale();
if(cv('rulescaleset')!= 0){$scale = cv('rulescaleset');}
my $ruleFound; undef $ruleFound;
my $type = getValue("route", $tagRef);
if (defined $type) {
# print " GRR: $type \n" ;
RULA: foreach my $r ( sort { $a <=> $b } keys %routeRules) {
# print " GRR: $routeRules{$r}{'type'}\n" ;
if ($routeRules{$r}{'type'} eq $type) {
if ( ( $routeRules{$r}{'fromscale'} <= $scale) and ( $routeRules{$r}{'toscale'} >= $scale) ) {
$ruleFound = \%{ $routeRules{ $r } } ;
if(defined $type){ # print " GRR: $type \n";
RULA: foreach my $r(sort{$a <=> $b} keys %routeRules){ # print " GRR: $routeRules{$r}{'type'}\n";
if($routeRules{$r}{'type'}eq $type){ if(($routeRules{$r}{'fromscale'}<= $scale)and($routeRules{$r}{'toscale'}>= $scale)){ $ruleFound = \%{$routeRules{$r}};
last RULA;
} } }
}
}
}
}
return $ruleFound;
}
sub getRouteColors {
my %routeColors = () ;
foreach my $n (keys %routeRules) {
my $type = $routeRules{$n}{'type'} ;
sub getRouteColors{ my %routeColors =();
foreach my $n(keys %routeRules){ my $type = $routeRules{$n}{'type'};
my $color = $routeRules{$n}{'color'};
@{$routeColors{$type}}= split(/;/, $color);
} return \%routeColors;
}
return \%routeColors ;
}
sub printRouteRules {
foreach my $n ( sort { $a <=> $b } keys %routeRules) {
print "route rule $n\n" ;
foreach my $v (sort keys %{$routeRules{$n}}) {
print " $v=$routeRules{$n}{$v}\n" ;
sub printRouteRules{ foreach my $n(sort{$a <=> $b} keys %routeRules){ print "route rule $n\n";
foreach my $v(sort keys %{$routeRules{$n}}){ print " $v=$routeRules{$n}{$v}\n";
}
print "\n";
}
}
}}
# --------------------------------------------------------------------------------
sub openRuleFile {
my $fileName = shift ;
sub openRuleFile{ my $fileName = shift;
open($ruleFile, "<", $fileName)or die("ERROR: could not open rule file $fileName\n");
getRuleLine();
}
sub getRuleLine {
$line = <$ruleFile> ;
sub getRuleLine{ $line = <$ruleFile>;
if(defined $line){
$line =~ s/\r//g; # remove dos/win char at line end
} while((defined $line)and((length $line < 2)or(grep /^comment/i, $line)or(grep /^\#/i, $line))){ $line = <$ruleFile>;
} return $line;
}
while ( (defined $line) and ( (length $line < 2) or ( grep /^comment/i, $line) or ( grep /^\#/i, $line) ) ) {
$line = <$ruleFile> ;
}
return $line ;
}
sub adaptRuleSizes {
foreach my $r ( keys %nodeRules ) {
foreach my $p ( qw (iconSize labelOffset labelSize shieldSize size) ) {
if ( defined $nodeRules{ $r }{ $p } ) {
if ( grep /:/, $nodeRules{ $r }{ $p } ) {
my $old = $nodeRules{ $r }{ $p } ;
sub adaptRuleSizes{ foreach my $r(keys %nodeRules){ foreach my $p(qw(iconSize labelOffset labelSize shieldSize size)){ if(defined $nodeRules{$r}{$p}){ if(grep /:/, $nodeRules{$r}{$p}){ my $old = $nodeRules{$r}{$p};
my $new = scaleSize($nodeRules{$r}{$p}, $nodeRules{$r}{'fromscale'}, $nodeRules{$r}{'toscale'});
$nodeRules{$r}{$p}= $new;
if ( cv('debug') eq "1" ) {
print "RULES/scale/node: $old -> $new\n" ;
}
}
}
}
}
foreach my $r ( keys %wayRules ) {
foreach my $p ( qw (bordersize labelsize labeloffset size ) ) {
if ( defined $wayRules{ $r }{ $p } ) {
if ( grep /:/, $wayRules{ $r }{ $p } ) {
my $kv = $wayRules{ $r }{ 'keyvalue' } ;
if(cv('debug')eq "1"){ print "RULES/scale/node: $old -> $new\n";
} } } }} foreach my $r(keys %wayRules){ foreach my $p(qw(bordersize labelsize labeloffset size)){ if(defined $wayRules{$r}{$p}){ if(grep /:/, $wayRules{$r}{$p}){ my $kv = $wayRules{$r}{'keyvalue'};
my $old = $wayRules{$r}{$p};
my $new = 0;
$new = scaleSize($wayRules{$r}{$p}, $wayRules{$r}{'fromscale'}, $wayRules{$r}{'toscale'});
$wayRules{$r}{$p}= $new;
if ( cv('debug') eq "1" ) {
print "RULES/scale/way: $kv $p $old to $new\n" ;
}
}
}
}
}
}
sub scaleSize {
my ($str, $fromScale, $toScale) = @_ ;
if(cv('debug')eq "1"){ print "RULES/scale/way: $kv $p $old to $new\n";
} } } }}}
sub scaleSize{ my($str, $fromScale, $toScale)= @_;
my @tmp = split /:/, $str;
my $lower = $tmp[0];
my $upper = $tmp[1];
@ -742,22 +578,14 @@ sub scaleSize {
my $scale = getScale();
if(cv('rulescaleset')ne "0"){$scale = cv('rulescaleset')};
if ( $scale < $fromScale) {
$newSize = $upper ;
}
elsif ( $scale > $toScale ) {
$newSize = $lower ;
}
else {
my $percent = ( $scale - $fromScale ) / ($toScale - $fromScale) ;
if($scale < $fromScale){ $newSize = $upper;
} elsif($scale > $toScale){ $newSize = $lower;
} else{ my $percent =($scale - $fromScale)/($toScale - $fromScale);
$newSize = $upper - $percent *($upper - $lower);
}
$newSize = int ( $newSize * 10 ) / 10 ;
} $newSize = int($newSize * 10)/ 10;
return $newSize;
}
sub createLegend{
# TODO Auto size
my $nx = 80;
@ -770,17 +598,7 @@ sub createLegend {
my $actualLine = 0;
my $preCount = 0;
foreach my $n (keys %nodeRules) {
if ( $nodeRules{$n}{"legend"} eq "yes" ) { $preCount++ ; }
}
foreach my $n (keys %wayRules) {
if ( $wayRules{$n}{"legend"} eq "yes" ) { $preCount++ ; }
}
foreach my $n (keys %areaRules) {
if ( $areaRules{$n}{"legend"} eq "yes" ) { $preCount++ ; }
}
if ( cv('debug') eq "1" ) { print "LEGEND: $preCount elements found\n" ; }
foreach my $n(keys %nodeRules){ if($nodeRules{$n}{"legend"}eq "yes"){$preCount++;}} foreach my $n(keys %wayRules){ if($wayRules{$n}{"legend"}eq "yes"){$preCount++;}} foreach my $n(keys %areaRules){ if($areaRules{$n}{"legend"}eq "yes"){$preCount++;}} if(cv('debug')eq "1"){print "LEGEND: $preCount elements found\n";}
my $sy = $preCount * $ey;
addToLayer("definitions", "<g id=\"legenddef\" width=\"$sx\" height=\"$sy\" >");
@ -788,67 +606,39 @@ sub createLegend {
my $svgString = "fill=\"$color\"";
drawRect(0, 0, $sx, $sy, 0, $svgString, "definitions");
foreach my $n (keys %nodeRules) {
if ( $nodeRules{$n}{"legend"} eq "yes" ) {
my $x = $nx ;
foreach my $n(keys %nodeRules){ if($nodeRules{$n}{"legend"}eq "yes"){ my $x = $nx;
my $y = $actualLine * $ey + $ny;
if ( ($nodeRules{$n}{'size'} > 0) and ($nodeRules{$n}{'icon'} eq "none") ) {
my $svgString = "" ;
if ( $nodeRules{$n}{'svgstring'} ne "" ) {
$svgString = $nodeRules{$n}{'svgstring'} ;
if(($nodeRules{$n}{'size'}> 0)and($nodeRules{$n}{'icon'}eq "none")){ my $svgString = "";
if($nodeRules{$n}{'svgstring'}ne ""){ $svgString = $nodeRules{$n}{'svgstring'};
} else{ $svgString = "fill=\"$nodeRules{$n}{'color'}\"";
}
else {
$svgString = "fill=\"$nodeRules{$n}{'color'}\"" ;
if($nodeRules{$n}{'shape'}eq "circle"){ drawCircle($x, $y, 0, $nodeRules{$n}{'size'}, 0, $svgString, 'definitions');
} elsif($nodeRules{$n}{'shape'}eq "square"){ drawSquare($x, $y, 0, $nodeRules{$n}{'size'}, 0, $svgString, 'definitions');
} elsif($nodeRules{$n}{'shape'}eq "triangle"){ drawTriangle($x, $y, 0, $nodeRules{$n}{'size'}, 0, $svgString, 'definitions');
} elsif($nodeRules{$n}{'shape'}eq "diamond"){ drawDiamond($x, $y, 0, $nodeRules{$n}{'size'}, 0, $svgString, 'definitions');
}
if ( $nodeRules{$n}{'shape'} eq "circle") {
drawCircle ($x, $y, 0, $nodeRules{$n}{'size'}, 0, $svgString, 'definitions') ;
}
elsif ( $nodeRules{$n}{'shape'} eq "square") {
drawSquare ($x, $y, 0, $nodeRules{$n}{'size'}, 0, $svgString, 'definitions') ;
}
elsif ( $nodeRules{$n}{'shape'} eq "triangle") {
drawTriangle ($x, $y, 0, $nodeRules{$n}{'size'}, 0, $svgString, 'definitions') ;
}
elsif ( $nodeRules{$n}{'shape'} eq "diamond") {
drawDiamond ($x, $y, 0, $nodeRules{$n}{'size'}, 0, $svgString, 'definitions') ;
}
my $textSvgString = createTextSVG(cv('elementFontFamily'), cv('elementFont'), $fs, "black", undef, undef);
drawText($tx,($actualLine+0.5)* $ey + $fs/2, 0, $nodeRules{$n}{'legendlabel'}, $textSvgString, "definitions");
}
else {
# TODO icon
}
$actualLine ++ ;
}
}
foreach my $w (keys %wayRules) {
if ( $wayRules{$w}{"legend"} eq "yes" ) {
my ($x1, $x2) ;
} else{ # TODO icon
} $actualLine ++;
}}
foreach my $w(keys %wayRules){ if($wayRules{$w}{"legend"}eq "yes"){ my($x1, $x2);
$x1 = 0.5 * $nx;
$x2 = 1.5 * $nx;
my $y = $actualLine * $ey + $ny;
my($svg1, $layer1, $svg2, $layer2)= mwWays::createWayParameters($wayRules{$w}, 0, 0, 0);
my @coords =($x1, $y, $x2, $y);
if ($svg2 ne "") {
drawWay ( \@coords, 0, $svg2, "definitions", undef ) ;
}
drawWay ( \@coords, 0, $svg1, "definitions", undef ) ;
if($svg2 ne ""){ drawWay(\@coords, 0, $svg2, "definitions", undef);
} drawWay(\@coords, 0, $svg1, "definitions", undef);
my $textSvgString = createTextSVG(cv('elementFontFamily'), cv('elementFont'), $fs, "black", undef, undef);
drawText($tx,($actualLine+0.5)*$ey + $fs/2, 0, $wayRules{$w}{'legendlabel'}, $textSvgString, "definitions");
$actualLine++;
}
}
foreach my $a (keys %areaRules) {
if ( $areaRules{$a}{"legend"} eq "yes" ) {
my ($x1, $x2) ;
}}
foreach my $a(keys %areaRules){ if($areaRules{$a}{"legend"}eq "yes"){ my($x1, $x2);
my($y1, $y2);
$x1 = 0.7 * $nx;
$x2 = 1.3 * $nx;
@ -860,19 +650,15 @@ sub createLegend {
my $base = $areaRules{$a}{'base'};
my $svgString = $areaRules{$a}{'svgstring'};
if ( ($svgString eq "") and ($icon eq "none") ) {
$svgString = "fill=\"$color\" " ;
if(($svgString eq "")and($icon eq "none")){ $svgString = "fill=\"$color\" ";
}
my @coords =([$x1, $y1, $x2, $y1, $x2, $y2, $x1, $y2, $x1, $y1]);
drawArea($svgString, $icon, \@coords, 0, "definitions");
my $textSvgString = createTextSVG(cv('elementFontFamily'), cv('elementFont'), $fs, "black", undef, undef);
drawText($tx,($actualLine+0.5)*$ey + $fs/2, 0, $areaRules{$a}{'legendlabel'}, $textSvgString, "definitions");
$actualLine++;
}
}
}}
addToLayer("definitions", "</g>");
@ -881,29 +667,18 @@ sub createLegend {
my($sizeX, $sizeY)= getDimensions();
if ( cv('legend') eq "2") {
$posX = $sizeX - $sx ;
if(cv('legend')eq "2"){ $posX = $sizeX - $sx;
$posY = 0;
}
if ( cv('legend') eq "3") {
$posX = 0 ;
if(cv('legend')eq "3"){ $posX = 0;
$posY = $sizeY - $sy;
}
if ( cv('legend') eq "4") {
$posX = $sizeX - $sx ;
if(cv('legend')eq "4"){ $posX = $sizeX - $sx;
$posY = $sizeY - $sy;
}
if ( (cv('legend') >=1) and (cv('legend')<=4) ) {
addToLayer ("legend", "<use x=\"$posX\" y=\"$posY\" xlink:href=\"#legenddef\" />") ;
}
elsif (cv('legend') == 5) {
# separate file
if((cv('legend')>=1)and(cv('legend')<=4)){ addToLayer("legend", "<use x=\"$posX\" y=\"$posY\" xlink:href=\"#legenddef\" />");
} elsif(cv('legend')== 5){ # separate file
createLegendFile($sx, $sy, "_legend", "#legenddef");
}
}
1;

297
mwWayLabel.pm
View File

@ -54,34 +54,21 @@ my @wns =() ;
# ------------------------------------------------------------------------
sub addToDirectory {
my ($name, $square) = @_ ;
if ( ! defined $square ) {
$directory { $name } = 1 ;
sub addToDirectory{ my($name, $square)= @_;
if(! defined $square){ $directory{$name}= 1;
} else{ $directory{$name}{$square}= 1;
}}
sub getDirectory{ return \%directory;
}
else {
$directory { $name } { $square } = 1 ;
}
}
sub getDirectory {
return \%directory ;
}
sub addWayLabel {
#
sub addWayLabel{#
# collect all way label data before actual labeling
#
my($wayId, $name, $ruleRef)= @_;
push @{$wayLabels{$ruleRef}{$name}}, $wayId;
$ruleRefs{$ruleRef}= $ruleRef;
if ( cv ('debug') eq "1" ) {
print "AWL: $wayId, $name, $ruleRef\n" ;
}
}
sub preprocessWayLabels {
#
if(cv('debug')eq "1"){ print "AWL: $wayId, $name, $ruleRef\n";
}}
sub preprocessWayLabels{#
# preprocess way labels collected so far
# combine ways with same rule and name
# split ways where direction in longitude changes so labels will be readable later
@ -91,36 +78,26 @@ sub preprocessWayLabels {
my($lonRef, $latRef)= getNodePointers();
my($memWayNodesRef, $memWayTagsRef)= getWayPointers();
foreach my $rule (keys %wayLabels) {
my $ruleRef = $ruleRefs{ $rule } ;
foreach my $rule(keys %wayLabels){ my $ruleRef = $ruleRefs{$rule};
# print "PPWL: ruleNum $rule\n";
foreach my $name (keys %{$wayLabels{$rule}}) {
my (@ways) = @{$wayLabels{$rule}{$name}} ;
foreach my $name(keys %{$wayLabels{$rule}}){ my(@ways)= @{$wayLabels{$rule}{$name}};
# print "PPWL: processing name $name, " . scalar(@ways). " ways\n";
my($waysRef, $nodesRef)= buildRings(\@ways, 0);
my @segments = @$nodesRef;
# print "PPWL: processing name $name, " . scalar(@segments). " segments\n";
if(! grep /shield:/i, $name){
my @newSegments =();
foreach my $segment (@segments) {
my @actual = @$segment ;
foreach my $segment(@segments){ my @actual = @$segment;
# print "PPWL: Actual segment @actual\n";
my $found = 1;
while ($found) {
$found = 0 ; my $sp = 0 ;
while($found){ $found = 0; my $sp = 0;
# look for splitting point
LABSP: for (my $i=1; $i<$#actual; $i++) {
if ( (($$lonRef{$actual[$i-1]} > $$lonRef{$actual[$i]}) and ($$lonRef{$actual[$i+1]} > $$lonRef{$actual[$i]})) or
(($$lonRef{$actual[$i-1]} < $$lonRef{$actual[$i]}) and ($$lonRef{$actual[$i+1]} < $$lonRef{$actual[$i]})) ) {
$found = 1 ;
LABSP: for(my $i=1; $i<$#actual; $i++){ if((($$lonRef{$actual[$i-1]}> $$lonRef{$actual[$i]})and($$lonRef{$actual[$i+1]}> $$lonRef{$actual[$i]}))or
(($$lonRef{$actual[$i-1]}< $$lonRef{$actual[$i]})and($$lonRef{$actual[$i+1]}< $$lonRef{$actual[$i]}))){ $found = 1;
$sp = $i;
last LABSP;
}
}
if ($found == 1) {
# print "\nname $name --- sp: $sp\n" ;
} } if($found == 1){ # print "\nname $name --- sp: $sp\n";
# print "ACTUAL BEFORE: @actual\n";
# create new seg
my @newSegment = @actual[0..$sp];
@ -130,66 +107,42 @@ sub preprocessWayLabels {
# splice actual
splice @actual, 0, $sp;
# print "ACTUAL AFTER: @actual\n\n";
} } @$segment = @actual;
}
}
@$segment = @actual ;
}
push @segments, @newSegments;
}
foreach my $segment (@segments) {
my (@wayNodes) = @$segment ;
foreach my $segment(@segments){ my(@wayNodes)= @$segment;
my @points =();
if ($$lonRef{$wayNodes[0]} > $$lonRef{$wayNodes[-1]}) {
if ( ( ! grep /motorway/, $$ruleRef{'keyvalue'}) and ( ! grep /trunk/, $$ruleRef{'keyvalue'} ) ) {
@wayNodes = reverse @wayNodes ;
}
}
foreach my $node (@wayNodes) {
push @points, convert ($$lonRef{$node}, $$latRef{$node}) ;
}
# print "PPWL: segment @wayNodes\n" ;
if($$lonRef{$wayNodes[0]}> $$lonRef{$wayNodes[-1]}){ if((! grep /motorway/, $$ruleRef{'keyvalue'})and(! grep /trunk/, $$ruleRef{'keyvalue'})){ @wayNodes = reverse @wayNodes;
} }
foreach my $node(@wayNodes){ push @points, convert($$lonRef{$node}, $$latRef{$node});
} # print "PPWL: segment @wayNodes\n";
# print "PPWL: segment @points\n";
my($segmentLengthPixels)= 0;
for (my $i=0; $i<$#wayNodes; $i++) {
my ($x1, $y1) = convert ($$lonRef{$wayNodes[$i]}, $$latRef{$wayNodes[$i]}) ;
for(my $i=0; $i<$#wayNodes; $i++){ my($x1, $y1)= convert($$lonRef{$wayNodes[$i]}, $$latRef{$wayNodes[$i]});
my($x2, $y2)= convert($$lonRef{$wayNodes[$i+1]}, $$latRef{$wayNodes[$i+1]});
$segmentLengthPixels += sqrt(($x2-$x1)**2 +($y2-$y1)**2);
}
# print "$rule, $wayIndexLabelSize\n" ;
} # print "$rule, $wayIndexLabelSize\n";
my $labelLengthPixels = 0;
if (grep /shield/i, $$ruleRef{'label'} ) {
$labelLengthPixels = $$ruleRef{'labelsize'} ;
if(grep /shield/i, $$ruleRef{'label'}){ $labelLengthPixels = $$ruleRef{'labelsize'};
# print "PPWL: len = $labelLengthPixels\n";
} else{ $labelLengthPixels = length($name)* cv('ppc')/ 10 * $$ruleRef{'labelsize'};
}
else {
$labelLengthPixels = length ($name) * cv('ppc') / 10 * $$ruleRef{'labelsize'} ;
}
# print "\nPPWL: name $name - ppc $ppc - size $ruleArray[$wayIndexLabelSize]\n";
# print "PPWL: wayLen $segmentLengthPixels\n";
# print "PPWL: labLen $labelLengthPixels\n";
push @labelCandidates, [$rule, $name, $segmentLengthPixels, $labelLengthPixels, [@points]];
if ( cv('debug') eq "1") {
print "PLC: $rule, $name, $segmentLengthPixels, $labelLengthPixels\n" ;
}
}
}
}
}
sub subWay {
#
if(cv('debug')eq "1"){ print "PLC: $rule, $name, $segmentLengthPixels, $labelLengthPixels\n";
} } }}}
sub subWay{#
# takes coordinates and label information and creates new way/path
# also calculates total angles / bends
#
@ -199,69 +152,49 @@ sub subWay {
my @dists;
my @angles =();
for (my $i=0; $i < $#coordinates; $i+=2) {
push @points, [$coordinates[$i],$coordinates[$i+1]] ;
for(my $i=0; $i < $#coordinates; $i+=2){ push @points, [$coordinates[$i],$coordinates[$i+1]];
}
$dists[0] = 0;
my $dist = 0;
if (scalar @points > 1) {
for (my $i=1;$i<=$#points; $i++) {
$dist = $dist + sqrt ( ($points[$i-1]->[0]-$points[$i]->[0])**2 + ($points[$i-1]->[1]-$points[$i]->[1])**2 ) ;
if(scalar @points > 1){ for(my $i=1;$i<=$#points; $i++){ $dist = $dist + sqrt(($points[$i-1]->[0]-$points[$i]->[0])**2 +($points[$i-1]->[1]-$points[$i]->[1])**2);
$dists[$i] = $dist;
}
}
# calc angles at nodes
if (scalar @points > 2) {
for (my $i=1;$i<$#points; $i++) {
$angles[$i] = angleMapgen ($points[$i-1]->[0], $points[$i-1]->[1], $points[$i]->[0], $points[$i]->[1], $points[$i]->[0], $points[$i]->[1], $points[$i+1]->[0], $points[$i+1]->[1]) ;
if(scalar @points > 2){ for(my $i=1;$i<$#points; $i++){ $angles[$i] = angleMapgen($points[$i-1]->[0], $points[$i-1]->[1], $points[$i]->[0], $points[$i]->[1], $points[$i]->[0], $points[$i]->[1], $points[$i+1]->[0], $points[$i+1]->[1]);
}
}
my $wayLength = $dist;
my $refPoint = $wayLength / 100 * $position;
my $labelStart; my $labelEnd;
if($alignment eq "start"){# left
$labelStart = $refPoint;
$labelEnd = $labelStart + $labLen;
}
if ($alignment eq "end") { # right
} if($alignment eq "end"){# right
$labelEnd = $refPoint;
$labelStart = $labelEnd - $labLen;
}
if ($alignment eq "middle") { # center
} if($alignment eq "middle"){# center
$labelEnd = $refPoint + $labLen / 2;
$labelStart = $refPoint - $labLen / 2;
}
# find start and end segments
my $startSeg; my $endSeg;
for (my $i=0; $i<$#points; $i++) {
if ( ($dists[$i]<=$labelStart) and ($dists[$i+1]>=$labelStart) ) { $startSeg = $i ; }
if ( ($dists[$i]<=$labelEnd) and ($dists[$i+1]>=$labelEnd) ) { $endSeg = $i ; }
}
for(my $i=0; $i<$#points; $i++){ if(($dists[$i]<=$labelStart)and($dists[$i+1]>=$labelStart)){$startSeg = $i;} if(($dists[$i]<=$labelEnd)and($dists[$i+1]>=$labelEnd)){$endSeg = $i;}}
my @finalWay =();
my $finalAngle = 0;
my($sx, $sy)= triangleNode($coordinates[$startSeg*2], $coordinates[$startSeg*2+1], $coordinates[$startSeg*2+2], $coordinates[$startSeg*2+3], $labelStart-$dists[$startSeg], 0);
push @finalWay, $sx, $sy;
if ($startSeg != $endSeg) {
for (my $i=$startSeg+1; $i<=$endSeg; $i++) {
if($startSeg != $endSeg){ for(my $i=$startSeg+1; $i<=$endSeg; $i++){
push @finalWay, $coordinates[$i*2], $coordinates[$i*2+1];
$finalAngle += abs($angles[$i]);
}
}
}}
my($ex, $ey)= triangleNode($coordinates[$endSeg*2], $coordinates[$endSeg*2+1], $coordinates[$endSeg*2+2], $coordinates[$endSeg*2+3], $labelEnd-$dists[$endSeg], 0);
push @finalWay, $ex, $ey;
return(\@finalWay, $finalAngle);
}
sub createWayLabels {
#
sub createWayLabels{#
# finally take all way label candidates and try to label them
#
@ -273,17 +206,12 @@ sub createWayLabels {
# calc ratio to label ways first where label just fits
# these will be drawn first
foreach my $candidate (@labelCandidates) {
my $wLen = $candidate->[2] ;
foreach my $candidate(@labelCandidates){ my $wLen = $candidate->[2];
my $lLen = $candidate->[3];
if ($wLen == 0) { $wLen = 1 ; }
if ($lLen == 0) { $lLen = 1 ; }
$candidate->[5] = $lLen / $wLen ;
}
@labelCandidates = sort { $b->[5] <=> $a->[5] } @labelCandidates ;
if($wLen == 0){$wLen = 1;} if($lLen == 0){$lLen = 1;} $candidate->[5] = $lLen / $wLen;
} @labelCandidates = sort{$b->[5] <=> $a->[5]}@labelCandidates;
foreach my $candidate (@labelCandidates) {
my $ruleRef = $ruleRefs{ $candidate->[0] } ;
foreach my $candidate(@labelCandidates){ my $ruleRef = $ruleRefs{$candidate->[0]};
my $name = $candidate->[1];
my $wLen = $candidate->[2];
my $lLen = $candidate->[3];
@ -291,37 +219,25 @@ sub createWayLabels {
my $toLabel = 1;
if((cv('declutter')eq "1")and($points[0] > $points[-2])and
( ( grep /motorway/i, $$ruleRef{'keyvalue'}) or (grep /trunk/i, $$ruleRef{'keyvalue'}) ) ) {
$toLabel = 0 ;
((grep /motorway/i, $$ruleRef{'keyvalue'})or(grep /trunk/i, $$ruleRef{'keyvalue'}))){ $toLabel = 0;
}
# wns?
if ( ($lLen > $wLen * 0.95) and ( cv('wns') > 0 ) ) {
if ( ( $toLabel != 0 ) and ( ! grep /shield:/i, $name) and ( wayVisible( \@points ) ) ) {
if ( ! defined $wnsUnique{$name} ) {
my $oldName = $name ;
if(($lLen > $wLen * 0.95)and(cv('wns')> 0)){ if(($toLabel != 0)and(! grep /shield:/i, $name)and(wayVisible(\@points))){ if(! defined $wnsUnique{$name}){ my $oldName = $name;
$wnsUnique{$name}= 1;
push @wns, [ $wnsNumber, $name];
$name = $wnsNumber;
$lLen = cv('ppc')/ 10 * $$ruleRef{'labelsize'}* length($name);
# print "WNS: $oldName - $name\n";
$wnsNumber++;
}
}
}
} } }
if ( ($lLen > $wLen*0.95) or ($toLabel == 0) ) {
# label too long
if(($lLen > $wLen*0.95)or($toLabel == 0)){ # label too long
$numWayLabelsOmitted++;
$notDrawnLabels{$name}= 1;
}
else {
} else{
if(grep /shield:/i, $name){
createShield($name, $$ruleRef{'labelsize'});
my $shieldMaxSize = getMaxShieldSize($name);
@ -329,15 +245,12 @@ sub createWayLabels {
my $numShields = int($wLen /($shieldMaxSize * 12));
# if($numShields > 4){$numShields = 4;}
if ($numShields > 0) {
my $step = $wLen / ($numShields + 1) ;
if($numShields > 0){ my $step = $wLen /($numShields + 1);
my $position = $step;
while ($position < $wLen) {
my ($x, $y) = getPointOfWay (\@points, $position) ;
while($position < $wLen){ my($x, $y)= getPointOfWay(\@points, $position);
# print "XY: $x, $y\n";
if(! coordsOut($x, $y)){
# place shield if not occupied
my($ssx, $ssy)= getShieldSizes($name);
@ -348,29 +261,21 @@ sub createWayLabels {
# print "AREA: $x2, $y2, $x2+$lLen, $y2+$lLen\n";
if(! mwLabel::boxAreaOccupied($x2, $y2+$ssy, $x2+$ssx, $y2)){
my $id = getShieldId($name);
addToLayer("shields", "<use xlink:href=\"#$id\" x=\"$x2\" y=\"$y2\" />");
mwLabel::boxOccupyArea($x2, $y2+$ssy, $x2+$ssx, $y2, 0, 3);
}
}
} }
$position += $step;
}
}
} }
}# shield
else{
# print "$wLen - $name - $lLen\n";
my $numLabels = int($wLen /(4 * $lLen));
if ($numLabels < 1) { $numLabels = 1 ; }
if ($numLabels > 4) { $numLabels = 4 ; }
if ($numLabels == 1) {
# print "LA: $name *1*\n" ;
if($numLabels < 1){$numLabels = 1;} if($numLabels > 4){$numLabels = 4;}
if($numLabels == 1){ # print "LA: $name *1*\n";
my $spare = 0.95 * $wLen - $lLen;
my $sparePercentHalf = $spare /($wLen*0.95)*100 / 2;
my $startOffset = 50 - $sparePercentHalf;
@ -380,18 +285,14 @@ sub createWayLabels {
my @positions =();
my $actual = $startOffset;
my $size = $$ruleRef{'labelsize'};
while ($actual <= $endOffset) {
my ($ref, $angle) = subWay (\@points, $lLen, "middle", $actual) ;
while($actual <= $endOffset){ my($ref, $angle)= subWay(\@points, $lLen, "middle", $actual);
my @way = @$ref;
# my($col)= lineCrossings(\@way);
my($col)= boxLinesOccupied(\@way, $size/2);
# calc quality of position. distance from middle and bend angles
my $quality = $angle + abs(50 - $actual);
if ($col == 0) { push @positions, ["middle", $actual, $quality] ; }
$actual += $step ;
}
if (scalar @positions > 0) {
$drawnLabels { $name } = 1 ;
if($col == 0){push @positions, ["middle", $actual, $quality];} $actual += $step;
} if(scalar @positions > 0){ $drawnLabels{$name}= 1;
# sort by quality and take best one
@positions = sort{$a->[2] <=> $b->[2]}@positions;
my($pos)= shift @positions;
@ -401,8 +302,7 @@ sub createWayLabels {
# TODO IF INSIDE
# print "final way @finalWay\n";
if ( ! coordsOut (@finalWay) ) {
my $pathName = "Path" . $pathNumber ; $pathNumber++ ;
if(! coordsOut(@finalWay)){ my $pathName = "Path" . $pathNumber; $pathNumber++;
createPath($pathName, \@finalWay, "definitions");
my $size = $$ruleRef{'labelsize'};
@ -419,31 +319,22 @@ sub createWayLabels {
pathText($svgText, $name, $pathName, $$ruleRef{'labeloffset'}, $pos->[0], 50, "text");
boxOccupyLines(\@finalWay, $size/2, 3);
}
}
else {
$numWayLabelsOmitted++ ;
}
}
else { # more than one label
} } else{ $numWayLabelsOmitted++;
} } else{# more than one label
# print "LA: $name *X*\n";
my $labelDrawn = 0;
my $interval = int(100 /($numLabels + 1));
my @positions =();
for (my $i=1; $i<=$numLabels; $i++) {
push @positions, $i * $interval ;
for(my $i=1; $i<=$numLabels; $i++){ push @positions, $i * $interval;
}
foreach my $position (@positions) {
my ($refFinal, $angle) = subWay (\@points, $lLen, "middle", $position) ;
foreach my $position(@positions){ my($refFinal, $angle)= subWay(\@points, $lLen, "middle", $position);
my(@finalWay)= @$refFinal;
# my($collision)= lineCrossings(\@finalWay);
my $size = $$ruleRef{'labelsize'};
my($collision)= boxLinesOccupied(\@finalWay, $size/2);
if ($collision == 0) {
$labelDrawn = 1 ;
if($collision == 0){ $labelDrawn = 1;
$drawnLabels{$name}= 1;
my $pathName = "Path" . $pathNumber; $pathNumber++;
@ -466,51 +357,30 @@ sub createWayLabels {
}
else {
# print "INFO: $name labeled less often than desired.\n" ;
}
}
if ($labelDrawn == 0) {
$notDrawnLabels { $name } = 1 ;
}
}
}
}
}
my $labelFileName = cv('out') ;
} else{ # print "INFO: $name labeled less often than desired.\n";
} } if($labelDrawn == 0){ $notDrawnLabels{$name}= 1;
} } } }} my $labelFileName = cv('out');
$labelFileName =~ s/\.svg/_NotDrawnLabels.txt/;
my $labelFile;
open($labelFile, ">", $labelFileName)or die("couldn't open label file $labelFileName");
print $labelFile "Not drawn labels\n\n";
foreach my $labelName (sort keys %notDrawnLabels) {
if (!defined $drawnLabels { $labelName } ) {
print $labelFile "$labelName\n" ;
}
}
close ($labelFile) ;
foreach my $labelName(sort keys %notDrawnLabels){ if(!defined $drawnLabels{$labelName}){ print $labelFile "$labelName\n";
}} close($labelFile);
# way name substitutes legend?
if ( cv('wns') > 0 ) {
createWNSLegend() ;
if(cv('wns')> 0){ createWNSLegend();
}
}
# ------------------------------------------------------------
sub createWNSLegend {
my $size = cv('wnssize') ;
sub createWNSLegend{ my $size = cv('wnssize');
my $color = cv('wnscolor');
# TODO max len auto size
my $maxLen = 0;
foreach my $e ( @wns ) {
if ( length $e->[1] > $maxLen ) { $maxLen = length $e->[1] ; }
}
foreach my $e(@wns){ if(length $e->[1] > $maxLen){$maxLen = length $e->[1];}}
my $sy = 2 * $size;
my $sx =(4 + $maxLen)* $size / 10 * cv('ppc');
my $tx = 4 * $size / 10 * cv('ppc');
@ -532,14 +402,12 @@ sub createWNSLegend {
drawRect(0, 0, $sizeX, $sizeY, 0, $svgString, "definitions");
$svgString = createTextSVG(cv('elementFontFamily'), cv('elementFont'), undef, undef, cv('wnssize'), cv('wnscolor'), undef, undef);
foreach my $e ( @wns ) {
my $y = $actualLine * $sy + $ty ;
foreach my $e(@wns){ my $y = $actualLine * $sy + $ty;
drawText($nx, $y, 0, $e->[0], $svgString, "definitions");
drawText($tx, $y, 0, $e->[1], $svgString, "definitions");
$actualLine++;
}
addToLayer("definitions", "</g>");
my $posX = 0;
@ -549,30 +417,19 @@ sub createWNSLegend {
($sizeX, $sizeY)= getDimensions();
$sy = $sy * scalar @wns;
if ( cv('wns') eq "2") {
$posX = $sizeX - $sx ;
if(cv('wns')eq "2"){ $posX = $sizeX - $sx;
$posY = 0;
}
if ( cv('wns') eq "3") {
$posX = 0 ;
if(cv('wns')eq "3"){ $posX = 0;
$posY = $sizeY - $sy;
}
if ( cv('wns') eq "4") {
$posX = $sizeX - $sx ;
if(cv('wns')eq "4"){ $posX = $sizeX - $sx;
$posY = $sizeY - $sy;
}
if ( ( cv('wns') >=1 ) and ( cv('wns') <= 4 ) ) {
addToLayer ("wns", "<use x=\"$posX\" y=\"$posY\" xlink:href=\"#wnsdef\" />") ;
if((cv('wns')>=1)and(cv('wns')<= 4)){ addToLayer("wns", "<use x=\"$posX\" y=\"$posY\" xlink:href=\"#wnsdef\" />");
}
if ( cv('wns') eq "5") {
createLegendFile ($sx, $sy, "_wns", "#wnsdef") ;
}
}
if(cv('wns')eq "5"){ createLegendFile($sx, $sy, "_wns", "#wnsdef");
}}
1;

208
mwWays.pm
View File

@ -51,156 +51,96 @@ my $areaLabelsOmitted = 0 ;
my @coastWays =();
sub processWays{
print "drawing ways/areas...\n";
my $nodesRef; my $tagRef;
($nodesRef, $tagRef)= getWayPointers();
my($lonRef, $latRef, $nodeTagRef)= getNodePointers();
foreach my $wayId (keys %$nodesRef) {
my @tags = @{ $$tagRef{$wayId} } ;
foreach my $wayId(keys %$nodesRef){ my @tags = @{$$tagRef{$wayId}};
my $tagsString = "";
# coast
my $v = getValue("natural", \@tags);
if ( (defined $v) and ($v eq "coastline") ) {
push @coastWays, $wayId ;
if((defined $v)and($v eq "coastline")){ push @coastWays, $wayId;
}
# WAYS
my $ruleRef = getWayRule(\@tags);
if (defined $ruleRef) {
my @nodes = @{ $$nodesRef{ $wayId } } ;
if(defined $ruleRef){ my @nodes = @{$$nodesRef{$wayId}};
my $layer = getValue("layer", $$tagRef{$wayId});
if(! defined $layer){$layer = 0;}
# TODO check for numeric!!!
my $direction = 0;
my $ow = getValue("oneway", $$tagRef{$wayId});
if (defined $ow) {
if (($ow eq "yes") or ($ow eq "true") or ($ow eq "1")) { $direction = 1 ; }
if ($ow eq "-1") { $direction = -1 ; }
}
if(defined $ow){ if(($ow eq "yes")or($ow eq "true")or($ow eq "1")){$direction = 1;} if($ow eq "-1"){$direction = -1;} }
my $bridge = getValue("bridge", $$tagRef{$wayId});
if (defined $bridge) {
if (($bridge eq "yes") or ($bridge eq "true")) { $bridge = 1 ; } else { $bridge = 0 ; }
}
else { $bridge = 0 ; }
if(defined $bridge){ if(($bridge eq "yes")or($bridge eq "true")){$bridge = 1;}else{$bridge = 0;} } else{$bridge = 0;}
my $tunnel = getValue("tunnel", $$tagRef{$wayId});
if (defined $tunnel) {
if (($tunnel eq "yes") or ($tunnel eq "true")) { $tunnel = 1 ; } else { $tunnel = 0 ; }
}
else { $tunnel = 0 ; }
if(defined $tunnel){ if(($tunnel eq "yes")or($tunnel eq "true")){$tunnel = 1;}else{$tunnel = 0;} } else{$tunnel = 0;}
my($svg1, $layer1, $svg2, $layer2)= createWayParameters($ruleRef, $layer, $bridge, $tunnel);
drawWay(\@nodes, 1, $svg1, undef, $layer1);
if ($svg2 ne "") {
drawWay ( \@nodes, 1, $svg2, undef, $layer2 ) ;
if($svg2 ne ""){ drawWay(\@nodes, 1, $svg2, undef, $layer2);
}
my $size = $$ruleRef{'size'};
if ( ( cv('oneways') eq "1" ) and ($direction != 0) ) {
addOnewayArrows (\@nodes, $direction, $size, $layer) ;
if((cv('oneways')eq "1")and($direction != 0)){ addOnewayArrows(\@nodes, $direction, $size, $layer);
}
# LABEL WAY
if ( cv('ignorelabels') eq "0" ) {
if ($$ruleRef{'label'} ne "none") {
if(cv('ignorelabels')eq "0"){ if($$ruleRef{'label'}ne "none"){
my $name = ""; my $ref1; my @names;
if (grep /shield/i, $$ruleRef{'label'} ) {
($name, $ref1) = createLabel (\@tags, "ref",0, 0) ;
if(grep /shield/i, $$ruleRef{'label'}){ ($name, $ref1)= createLabel(\@tags, "ref",0, 0);
my $ref = $name;
if (grep /;/, $ref) {
my @a = split /;/, $ref ;
if(grep /;/, $ref){ my @a = split /;/, $ref;
$ref = $a[0];
}
if ($ref ne "") {
@names = ($ref) ;
if($ref ne ""){ @names =($ref);
$name = $$ruleRef{'label'}. ":$ref";
# print "DRAW WAY: name set to $name\n";
}
else {
@names = () ;
} else{ @names =();
$name = "";
}
# print "WAY: name for shield >$name<\n";
}
else {
($name, $ref1) = createLabel (\@tags, $$ruleRef{'label'}, 0, 0) ;
} else{ ($name, $ref1)= createLabel(\@tags, $$ruleRef{'label'}, 0, 0);
@names = @$ref1;
$name = labelTransform($name, $$ruleRef{'labeltransform'});
}
if((cv('nolabel')eq "1")and($name eq "")){$name = "NO LABEL";}
if($name ne ""){
addWayLabel($wayId, $name, $ruleRef);
}
if ( ( cv('dir') eq "1") and ( $$ruleRef{'direxclude'} eq "no") ) {
if ( cv('grid') > 0) {
foreach my $node ( @nodes ) {
foreach my $name (@names) {
my $sq = gridSquare($$lonRef{$node}, $$latRef{$node}, cv('grid') ) ;
if (defined $sq) {
addToDirectory($name, $sq) ;
}
}
}
}
else {
foreach my $name (@names) {
addToDirectory ($name, undef) ;
}
}
}
} # label
} if((cv('dir')eq "1")and($$ruleRef{'direxclude'}eq "no")){ if(cv('grid')> 0){ foreach my $node(@nodes){ foreach my $name(@names){ my $sq = gridSquare($$lonRef{$node}, $$latRef{$node}, cv('grid'));
if(defined $sq){ addToDirectory($name, $sq);
} } } } else{ foreach my $name(@names){ addToDirectory($name, undef);
} } } } # label
}# ignorelabels
}
# AREAS
$ruleRef = getAreaRule(\@tags);
my @nodes = @{$$nodesRef{$wayId}};
if ( (defined $ruleRef) and ($nodes[0] == $nodes[-1]) ) {
my $color = $$ruleRef{'color'} ;
if((defined $ruleRef)and($nodes[0] == $nodes[-1])){ my $color = $$ruleRef{'color'};
my $icon = $$ruleRef{'icon'};
my $base = $$ruleRef{'base'};
my $svgString = $$ruleRef{'svgstring'};
my $size = areaSize(\@nodes);
my @ways = [@nodes];
if ( ($svgString eq "") and ($icon eq "none") ) {
$svgString = "fill=\"$color\" " ;
if(($svgString eq "")and($icon eq "none")){ $svgString = "fill=\"$color\" ";
}
if ($size > cv('minareasize') ) {
if ($base eq "yes") {
drawArea ($svgString, $icon, \@ways, 1, "base") ;
}
else {
drawArea ($svgString, $icon, \@ways, 1, "area") ;
}
$areasDrawn++ ;
if($size > cv('minareasize')){ if($base eq "yes"){ drawArea($svgString, $icon, \@ways, 1, "base");
} else{ drawArea($svgString, $icon, \@ways, 1, "area");
} $areasDrawn++;
# DRAW label
if ( $$ruleRef{'label'} ne "none" ) {
$areaLabels++ ;
if ($size > cv('minarealabelsize') ) {
# text
if($$ruleRef{'label'}ne "none"){ $areaLabels++;
if($size > cv('minarealabelsize')){ # text
my($name, $ref1)= createLabel(\@tags, $$ruleRef{'label'},0, 0);
$name = labelTransform($name, $$ruleRef{'labeltransform'});
@ -220,39 +160,26 @@ sub processWays {
my $svgText = createTextSVG($labelFontFamily, $labelFont, $labelBold, $labelItalic, $labelSize, $color, $labelHalo, $labelHaloColor);
mwLabel::placeLabelAndIcon($lon, $lat, 0, 0, $name, $svgText, "none", 0, 0, "arealabels");
}
else {
$areaLabelsOmitted++ ;
}
}
} else{ $areaLabelsOmitted++;
} }
} else{ $areasOmitted++;
}
else {
$areasOmitted++ ;
}
}# Area
}
print "$areasDrawn areas drawn, $areasOmitted omitted because they are too small\n";
print "$areaLabels area labels total, $areaLabelsOmitted omitted because belonging areas were too small\n";
my $cw = scalar @coastWays;
if(cv('verbose')){print "$cw coast line ways found.\n";}
preprocessWayLabels();
createWayLabels();
if ($cw > 0) {
processCoastLines (\@coastWays) ;
}
}
if($cw > 0){ processCoastLines(\@coastWays);
}}
# ----------------------------------------------------------------------------
sub createWayParameters {
my ($ruleRef, $layer, $bridge, $tunnel) = @_ ;
sub createWayParameters{ my($ruleRef, $layer, $bridge, $tunnel)= @_;
my $svg1 = ""; my $layer1 = 0;
my $svg2 = ""; my $layer2 = 0;
@ -281,12 +208,9 @@ sub createWayParameters {
@{$dashDefinition{34}}=("butt", "4,20");
@{$dashDefinition{35}}=("butt", "8,20");
if ( cv ('autobridge') eq "0" ) {
$layer = 0 ;
if(cv('autobridge')eq "0"){ $layer = 0;
}
if(($$ruleRef{'svgstringtop'}ne "")or($$ruleRef{'svgstringbottom'}ne "")){
$svg1 = $$ruleRef{'svgstringtop'};
$svg2 = $$ruleRef{'svgstringbottom'};
@ -294,9 +218,7 @@ sub createWayParameters {
$layer1 = $layer;
$layer2 = $layer;
}
else {
} else{
my $size = $$ruleRef{'size'};
my $color = $$ruleRef{'color'};
@ -304,62 +226,41 @@ sub createWayParameters {
my $lj = "round";
my $dash = "";
if ( $$ruleRef{'dash'} ne "" ) {
if ( ! grep /,/, $$ruleRef{'dash'}) {
my @ds = @{$dashDefinition{ $$ruleRef{'dash'} } } ;
if($$ruleRef{'dash'}ne ""){ if(! grep /,/, $$ruleRef{'dash'}){ my @ds = @{$dashDefinition{$$ruleRef{'dash'}}};
$lc = $ds[0];
my $style = $ds[1];
$dash = "stroke-dasharray=\"$style\" ";
}
else {
$lc = $$ruleRef{'dashcap'} ;
} else{ $lc = $$ruleRef{'dashcap'};
my $style = $$ruleRef{'dash'};
$dash = "stroke-dasharray=\"$style\"";
}
}
# top (actual way)
$svg1 = "stroke=\"$color\" stroke-width=\"$size\" stroke-linecap=\"$lc\" fill=\"none\" stroke-linejoin=\"$lj\" " . $dash ;
} }
# top(actual way) $svg1 = "stroke=\"$color\" stroke-width=\"$size\" stroke-linecap=\"$lc\" fill=\"none\" stroke-linejoin=\"$lj\" " . $dash;
$layer1 = $layer + $size / 100;
my $bs = $$ruleRef{'bordersize'};
$lc = "round";
$dash = "";
if ( cv ('autobridge') eq "1" ) {
# TODO bridge/tunnel
if ( $bridge == 1) {
$lc = "butt" ;
if(cv('autobridge')eq "1"){ # TODO bridge/tunnel
if($bridge == 1){ $lc = "butt";
$bs += 3; # TODO config value
}
elsif ( $tunnel == 1) {
$lc = "butt" ;
} elsif($tunnel == 1){ $lc = "butt";
$dash = "stroke-dasharray=\"10,10\" ";
$bs += 3;
}
}
# bottom (border)
if ( $bs > 0 ) {
$size = 2 * $bs + $$ruleRef{'size'} ;
} }
# bottom(border) if($bs > 0){ $size = 2 * $bs + $$ruleRef{'size'};
$color = $$ruleRef{'bordercolor'};
$svg2 = "stroke=\"$color\" stroke-width=\"$size\" stroke-linecap=\"$lc\" fill=\"none\" stroke-linejoin=\"$lj\" " . $dash;
$layer2 = $layer - 0.3 + $size / 100;
}
else {
$svg2 = "" ;
} else{ $svg2 = "";
$layer2 = 0;
}
}
return($svg1, $layer1, $svg2, $layer2);
}
# ---------------------------------------------------------------------------------
sub createDirectory {
my $directoryName ;
sub createDirectory{ my $directoryName;
my $dirFile;
$directoryName = cv('out');
$directoryName =~ s/\.svg/\_streets.txt/;
@ -370,25 +271,14 @@ sub createDirectory {
my $ref = getDirectory();
my %directory = %$ref;
if ( cv('grid') eq "0") {
foreach my $street (sort keys %directory) {
$street = replaceHTMLCode ( $street ) ;
if(cv('grid')eq "0"){ foreach my $street(sort keys %directory){ $street = replaceHTMLCode($street);
print $dirFile "$street\n";
}
}
else {
foreach my $street (sort keys %directory) {
my $streetSanitized = replaceHTMLCode ( $street ) ;
}} else{ foreach my $street(sort keys %directory){ my $streetSanitized = replaceHTMLCode($street);
print $dirFile "$streetSanitized\t";
foreach my $square (sort keys %{$directory{$street}}) {
print $dirFile "$square " ;
foreach my $square(sort keys %{$directory{$street}}){ print $dirFile "$square ";
} print $dirFile "\n";
}} close($dirFile);
}
print $dirFile "\n" ;
}
}
close ($dirFile) ;
}
1;