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

211
mw.pl Normal file → Executable file
View File

@ -1,13 +1,10 @@
# #
# PERL mapweaver by gary68 # PERL mapweaver by gary68 & atlas48
# #
# # Copyright(C)2011, Gerhard Schwanz
#
#
# 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 # This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3 of the License, or (at your option) any later version. # Free Software Foundation; either version 3 of the License, or(at your option)any later version.
# #
# This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or # This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
@ -15,170 +12,76 @@
# You should have received a copy of the GNU General Public License along with this program; if not, see <http://www.gnu.org/licenses/> # 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 # TODO
# -different tempfilenames # -different tempfilenames
my $version = "0.48" ; my $version = "0.48";
my $programName = "mapweaver" ; my $programName = "mapweaver";
use strict ; use strict; use warnings;
use warnings ; use OSM::osm;
use OSM::osm ; use mwConfig;
use mwConfig ; use mwMap;
use mwMap ; use mwRules;
use mwRules ; use mwFile;
use mwFile ; use mwNodes;
use mwNodes ; use mwWays;
use mwWays ; use mwRelations;
use mwRelations ; use mwMulti;
use mwMulti ; use mwMisc;
use mwMisc ; use mwOccupy;
use mwOccupy ; use mwGPX;
use mwGPX ;
my $time0 = time() ; my $time0 = time();
print "\n$programName $version by gary68\n\n";
print "\n$programName $version by gary68\n\n" ; initConfig;
getProgramOptions;
initConfig() ; readConfigFile cv('ini');
getProgramOptions() ; if(cv('help')eq "1"){ printConfigDescriptions;
printValidObjectProperties;
readConfigFile( cv('ini') ) ; 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" ) { if(cv('debug')eq "1"){ printNodeRules;
printConfig() ; printWayRules;
printAreaRules;
printRouteRules;
} }
readFile;
my $renderTime0 = time();
adaptRuleSizes;
readRules() ; unless(cv('multionly')){ processNodes;
createPoiDirectory()if cv('poi');
if ( cv('debug') eq "1" ) { initOneways;
printNodeRules() ; processWays;
printWayRules() ; createDirectory if cv('dir');
printAreaRules() ; createDirPdf if cv('dirpdf');
printRouteRules() ; processRoutes;
} }
processMultipolygons;
createLegend if cv('legend');
processPageNumbers if cv('pagenumbers');
processRectanglesif if cv('rectangles');
boxDrawOccupiedAreas if cv('test');
processGPXFile if cv('gpx');
readFile() ; writeMap;
my $renderTime0 = time() ; my $renderTime1 = time();
adaptRuleSizes() ;
if ( cv('multionly') eq "0" ) {
processNodes() ;
if ( cv('poi') eq "1") {
createPoiDirectory() ;
}
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() ;
my $renderTime1 = time() ;
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" ;
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";

548
mwCoastLines.pm
View File

@ -1,13 +1,10 @@
# #
# PERL mapweaver module by gary68 # PERL mapweaver module by gary68
# #
# # Copyright(C)2011, Gerhard Schwanz
#
#
# 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 # This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3 of the License, or (at your option) any later version. # Free Software Foundation; either version 3 of the License, or(at your option)any later version.
# #
# This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or # This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
@ -16,402 +13,257 @@
# #
package mwCoastLines ; package mwCoastLines;
use strict; use warnings;
use Math::Polygon; use List::Util qw[min max];
use strict ; use mwMap;
use warnings ; use mwFile;
use Math::Polygon ; use mwConfig;
use List::Util qw[min max] ; use mwMisc;
use mwMap ;
use mwFile ;
use mwConfig ;
use mwMisc ;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
require Exporter ; require Exporter;
@ISA = qw ( Exporter AutoLoader ) ; @ISA = qw(Exporter AutoLoader);
@EXPORT = qw ( processCoastLines @EXPORT = qw(processCoastLines
) ; );
sub nearestPoint { sub nearestPoint{#
#
# accepts x/y coordinates and returns nearest point on border of map to complete cut coast ways # accepts x/y coordinates and returns nearest point on border of map to complete cut coast ways
# #
my $ref = shift ; my $ref = shift;
my $x = $ref->[0] ; my $x = $ref->[0];
my $y = $ref->[1] ; my $y = $ref->[1];
my $xn ; my $yn ; my $xn; my $yn;
my $min = 99999 ; my $min = 99999;
# print " NP: initial $x $y\n" ; # print " NP: initial $x $y\n";
my ($xmax, $ymax) = getDimensions() ; my($xmax, $ymax)= getDimensions();
# print " NP: dimensions $xmax $ymax\n" ; # print " NP: dimensions $xmax $ymax\n";
if ( abs ($xmax-$x) < $min) { # right if(abs($xmax-$x)<$min){# right
$xn = $xmax ; $xn = $xmax;
$yn = $y ; $yn = $y;
$min = abs ($xmax-$x) ; $min = abs($xmax-$x);
} } if(abs($ymax-$y)<$min){# bottom
if ( abs ($ymax-$y) < $min) { # bottom $xn = $x;
$xn = $x ; $yn = $ymax;
$yn = $ymax ; $min = abs($ymax-$y);
$min = abs ($ymax-$y) ; } if(abs($x)<$min){# left
} $xn = 0;
if ( abs ($x) < $min) { # left $yn = $y;
$xn = 0 ; $min = abs($x);
$yn = $y ; } if(abs($y)< $min){# top
$min = abs ($x) ; $xn = $x;
} $yn = 0;
if ( abs ($y) < $min) { # top } # print " NP: final $xn $yn\n";
$xn = $x ; my @a =($xn, $yn);
$yn = 0 ; return \@a;
} }sub nextPointOnBorder{#
# print " NP: final $xn $yn\n" ;
my @a = ($xn, $yn) ;
return (\@a) ;
}
sub nextPointOnBorder {
#
# accepts x/y coordinates and returns next point on border - to complete coast rings with other polygons and corner points # 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 # hints if returned point is a corner
# #
# right turns # right turns
my ($x, $y) = @_ ; my($x, $y)= @_;
my ($xn, $yn) ; my($xn, $yn);
my $corner = 0 ; my $corner = 0;
my ($xmax, $ymax) = getDimensions() ; my($xmax, $ymax)= getDimensions();
if ($x == $xmax) { # right border if($x == $xmax){# right border
if ($y < $ymax) { if($y < $ymax){ $xn = $xmax; $yn = $y + 1;
$xn = $xmax ; $yn = $y + 1 ; } else{ $xn = $xmax - 1; $yn = $ymax;
} }} else{ if($x == 0){# left border
else { if($y > 0){ $xn = 0; $yn = $y - 1;
$xn = $xmax - 1 ; $yn = $ymax ; } else{ $xn = 1; $yn = 0;
} } } else{ if($y == $ymax){# bottom border
} if($x > 0){ $xn = $x - 1; $yn = $ymax;
else { } else{ $xn = 0; $yn = $ymax - 1;
if ($x == 0) { # left border } } else{ if($y == 0){# top border
if ($y > 0) { if($x < $xmax){ $xn = $x + 1; $yn = 0;
$xn = 0 ; $yn = $y - 1 ; } else{ $xn = $xmax; $yn = 1;
} } } } }} # print "NPOB: $x, $y --- finito $xn $yn\n";
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 == 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 ( ($xn == 0) and ($yn == $ymax) ) { $corner = 1 ; } return($xn, $yn, $corner);
if ( ($xn == $xmax) and ($yn == 0) ) { $corner = 1 ; }
if ( ($xn == $xmax) and ($yn == $ymax) ) { $corner = 1 ; }
return ($xn, $yn, $corner) ;
} }
# --------------------------------------------------------------------------------- # ---------------------------------------------------------------------------------
sub processCoastLines { sub processCoastLines{ print "check and process coastlines...\n";
#
#
#
print "check and process coastlines...\n" ;
my $ref = shift ; # ref to all coast ways my $ref = shift; # ref to all coast ways
my @allWays = @$ref ; my @allWays = @$ref;
if (cv('debug') eq "1") { if(cv('debug')){
print "COAST: " . scalar (@allWays) . " coast ways initially found.\n" ; print "COAST: " . scalar(@allWays). " coast ways initially found.\n";
print "COAST: ways: @allWays\n\n" ; print "COAST: ways: @allWays\n\n";
} }
my($lonRef, $latRef)= getNodePointers();
my ($lonRef, $latRef) = getNodePointers() ; my($nodesRef, $tagRef)= getWayPointers();
my ($nodesRef, $tagRef) = getWayPointers() ;
# check coast ways. eliminate invisible ways. eliminate points outside map. # check coast ways. eliminate invisible ways. eliminate points outside map.
my @newWays = () ; my @newWays =();
foreach my $w ( @allWays ) { foreach my $w(@allWays){ my @nodes = @{$$nodesRef{$w}};
my @nodes = @{ $$nodesRef{ $w } } ;
my $allIn = 1 ; my $allIn = 1;
my $allOut = 1 ; my $allOut = 1;
foreach my $n ( @nodes ) { foreach my $n(@nodes){ if(pointInMap($n)){ $allOut = 0;
if ( pointInMap ($n) ) { } else{ $allIn = 0;
$allOut = 0 ; } }
} if($allIn){ # use way as it is
else { push @newWays, $w;
$allIn = 0 ; 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
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
# eliminate outsides at start # eliminate outsides at start
while ( (scalar @nodes >= 1) and ( ! pointInMap ($nodes[0]) ) ) { shift @nodes while((scalar(@nodes)>= 1)and not pointInMap($nodes[0]));
shift @nodes ;
}
# eliminate outsides at end # eliminate outsides at end
while ( (scalar @nodes >= 1) and ( ! pointInMap ($nodes[-1]) ) ) { while((scalar @nodes >= 1)and not pointInMap($nodes[-1])){ pop @nodes;
pop @nodes ;
} }
if(scalar @nodes >= 2){ @{$$nodesRef{$w}}= @nodes;
if ( scalar @nodes >= 2 ) { push @newWays, $w;
@{ $$nodesRef{$w}} = @nodes ; 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";} } }
push @newWays, $w ; }
if ( cv ('debug') eq "1" ) { print "COAST: modified way $w will be used.\n" ; } @allWays = @newWays;
} if(cv('debug')eq "1"){
else { print "\nCOAST: " . scalar(@allWays). " coast ways will be used.\n";
if ( cv ('debug') eq "1" ) { print "COAST: way $w too short now.\n" ; } print "COAST: ways: @allWays\n\n";
} }
if(scalar @allWays > 0){ # build rings
} my($refWays, $refNodes)= buildRings(\@allWays, 0);
my @ringNodes = @$refNodes; # contains all nodes of rings // array of arrays !
} print "COAST: " . scalar(@ringNodes). " rings found.\n" if cv('debug');
@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
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" ; }
# convert rings to coordinate system # convert rings to coordinate system
my @ringCoordsOpen = () ; my @ringCoordsClosed = () ; my @ringCoordsOpen =(); my @ringCoordsClosed =();
for (my $i=0; $i<=$#ringNodes; $i++) { for(my $i=0; $i<=$#ringNodes; $i++){ # print "COAST: initial ring $i\n";
# print "COAST: initial ring $i\n" ; my @actualCoords =();
my @actualCoords = () ; foreach my $node(@{$ringNodes[$i]}){ push @actualCoords, [convert($$lonRef{$node}, $$latRef{$node})];
foreach my $node (@{$ringNodes[$i]}) { } if(${$ringNodes[$i]}[0] == ${$ringNodes[$i]}[-1]){ push @ringCoordsClosed, [@actualCoords]; # islands
push @actualCoords, [convert ($$lonRef{$node}, $$latRef{$node})] ; } else{ push @ringCoordsOpen, [@actualCoords];
} # printRingCoords(\@actualCoords);
my $num = scalar @actualCoords;
print "COAST: initial ring $i - $actualCoords[0]->[0],$actualCoords[0]->[1] -->> $actualCoords[-1]->[0],$actualCoords[-1]->[1] nodes: $num\n" if cv('debug');
} }
if (${$ringNodes[$i]}[0] == ${$ringNodes[$i]}[-1]) { if(cv('debug')eq "1"){print "COAST: add points on border...\n";} foreach my $ring(@ringCoordsOpen){ # print "COAST: ring $ring with border nodes\n";
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" ; }
}
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 # add first point on border
my $ref = nearestPoint ($ring->[0]) ; my $ref = nearestPoint($ring->[0]);
my @a = @$ref ; my @a = @$ref;
unshift @$ring, [@a] ; unshift @$ring, [@a];
# add last point on border # add last point on border
$ref = nearestPoint ($ring->[-1]) ; $ref = nearestPoint($ring->[-1]);
@a = @$ref ; @a = @$ref;
push @$ring, [@a] ; push @$ring, [@a];
# printRingCoords ($ring) ; # printRingCoords($ring);
} }
my @islandRings = @ringCoordsClosed;
my @islandRings = @ringCoordsClosed ; print "COAST: " . scalar(@islandRings). " islands found.\n" if cv('debug');
if (cv('debug') eq "1") { print "COAST: " . scalar (@islandRings) . " islands found.\n" ; } @ringCoordsClosed =();
@ringCoordsClosed = () ;
# process ringCoordsOpen # process ringCoordsOpen
# add other rings, corners... # add other rings, corners...
while (scalar @ringCoordsOpen > 0) { # as long as there are open rings 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 $ref = shift @ringCoordsOpen; # get start ring
my @actualRing = @$ref ; my @actualRing = @$ref;
my $closed = 0 ; # mark as not closed my $closed = 0; # mark as not closed
my $actualX = $actualRing[-1]->[0] ; my $actualX = $actualRing[-1]->[0];
my $actualY = $actualRing[-1]->[1] ; my $actualY = $actualRing[-1]->[1];
my $actualStartX = $actualRing[0]->[0] ; my $actualStartX = $actualRing[0]->[0];
my $actualStartY = $actualRing[0]->[1] ; 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 ; my $corner;
while (!$closed) { # as long as this ring is not closed while(!$closed){# as long as this ring is not closed
($actualX, $actualY, $corner) = nextPointOnBorder ($actualX, $actualY) ; ($actualX, $actualY, $corner)= nextPointOnBorder($actualX, $actualY);
# print " actual $actualX, $actualY\n" ; # print " actual $actualX, $actualY\n";
my $startFromOtherPolygon = -1 ; my $startFromOtherPolygon = -1;
# find matching ring if there is another ring # find matching ring if there is another ring
if (scalar @ringCoordsOpen > 0) { if(scalar(@ringCoordsOpen)> 0){ for(my $i=0; $i <= $#ringCoordsOpen; $i++){ my @test = @{$ringCoordsOpen[$i]};
for (my $i=0; $i <= $#ringCoordsOpen; $i++) { # print " test ring $i: ", $test[0]->[0], " " , $test[0]->[1] , "\n";
my @test = @{$ringCoordsOpen[$i]} ; if(($actualX == $test[0]->[0])and($actualY == $test[0]->[1])){ $startFromOtherPolygon = $i;
# print " test ring $i: ", $test[0]->[0], " " , $test[0]->[1] , "\n" ; print "COAST: matching start other polygon found i= $i\n" if cv('debug');
if ( ($actualX == $test[0]->[0]) and ($actualY == $test[0]->[1]) ) { } } } # process matching polygon, if present
$startFromOtherPolygon = $i ; if($startFromOtherPolygon != -1){# start from other polygon{ # append nodes
if (cv('debug') eq "1") { print "COAST: matching start other polygon found i= $i\n" ; } # print "ARRAY TO PUSH: @{$ringCoordsOpen[$startFromOtherPolygon]}\n";
} push @actualRing, @{$ringCoordsOpen[$startFromOtherPolygon]};
}
}
# 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 # set actual
$actualX = $actualRing[-1]->[0] ; $actualX = $actualRing[-1]->[0];
$actualY = $actualRing[-1]->[1] ; $actualY = $actualRing[-1]->[1];
# drop p2 from opens # drop p2 from opens
splice @ringCoordsOpen, $startFromOtherPolygon, 1 ; splice @ringCoordsOpen, $startFromOtherPolygon, 1;
if (cv('debug') eq "1") { print "COAST: openring $startFromOtherPolygon added to actual ring\n" ; } print "COAST: openring $startFromOtherPolygon added to actual ring\n" if cv('debug');
} } else{ if($corner){# add corner to actual ring
else { push @actualRing, [$actualX, $actualY];
if ($corner) { # add corner to actual ring print "COAST: corner $actualX, $actualY added to actual ring\n" if cv('debug');
push @actualRing, [$actualX, $actualY] ; } } # check if closed
if (cv('debug') eq "1") { print "COAST: corner $actualX, $actualY added to actual ring\n" ; } if(($actualX == $actualStartX)and($actualY == $actualStartY)){ $closed = 1;
} push @actualRing, [$actualX, $actualY];
} push @ringCoordsClosed, [@actualRing];
# check if closed print "COAST: ring now closed and moved to closed rings.\n" if cv('debug');
if ( ($actualX == $actualStartX) and ($actualY == $actualStartY) ) { } }# !closed
$closed = 1 ; }# open rings
push @actualRing, [$actualX, $actualY] ;
push @ringCoordsClosed, [@actualRing] ;
if (cv('debug') eq "1") { print "COAST: ring now closed and moved to closed rings.\n" ; }
}
} # !closed
} # open rings
my $color = cv('oceancolor') ; my $color = cv('oceancolor');
# build islandRings polygons # 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 = () ; my @islandPolygons =();
if (scalar @islandRings > 0) { if(scalar @islandRings > 0){ for(my $i=0; $i<=$#islandRings; $i++){ my @poly =();
for (my $i=0; $i<=$#islandRings; $i++) { foreach my $node(@{$islandRings[$i]}){ push @poly, [$node->[0], $node->[1]];
my @poly = () ; } my($p)= Math::Polygon->new(@poly);
foreach my $node ( @{$islandRings[$i]} ) { $islandPolygons[$i] = $p;
push @poly, [$node->[0], $node->[1]] ; } }
}
my ($p) = Math::Polygon->new(@poly) ;
$islandPolygons[$i] = $p ;
}
}
# build ocean ring polygons # build ocean ring polygons
if (cv('debug') eq "1") { print "OCEAN: building ocean polygons\n" ; } if(cv('debug')eq "1"){print "OCEAN: building ocean polygons\n";} my @oceanPolygons =();
my @oceanPolygons = () ; if(scalar(@ringCoordsClosed)> 0){ for(my $i=0; $i<=$#ringCoordsClosed; $i++){ my @poly =();
if (scalar @ringCoordsClosed > 0) { foreach my $node(@{$ringCoordsClosed[$i]}){ push @poly, [$node->[0], $node->[1]];
for (my $i=0; $i<=$#ringCoordsClosed; $i++) { } my($p)= Math::Polygon->new(@poly);
my @poly = () ; $oceanPolygons[$i] = $p;
foreach my $node ( @{$ringCoordsClosed[$i]} ) { } } else{ if(scalar(@islandRings)> 0){ if(cv('debug')eq "1"){print "OCEAN: build ocean rect\n";} my @ocean =();
push @poly, [$node->[0], $node->[1]] ; my($x, $y)= getDimensions();
} push @ocean, [0,0], [$x,0], [$x,$y], [0,$y], [0,0];
my ($p) = Math::Polygon->new(@poly) ; push @ringCoordsClosed, [@ocean];
$oceanPolygons[$i] = $p ; my($p)= Math::Polygon->new(@ocean);
} push @oceanPolygons, $p;
} } }
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 # finally create pathes for SVG
for (my $i=0; $i<=$#ringCoordsClosed; $i++) { for(my $i=0; $i<=$#ringCoordsClosed; $i++){ # foreach my $ring(@ringCoordsClosed){ my @ring = @{$ringCoordsClosed[$i]};
# foreach my $ring (@ringCoordsClosed) { my @array =();
my @ring = @{$ringCoordsClosed[$i]} ; my @coords =();
my @array = () ; foreach my $c(@ring){ push @coords, $c->[0], $c->[1];
my @coords = () ; } push @array, [@coords];
foreach my $c (@ring) { if(scalar @islandRings > 0){ for(my $j=0; $j<=$#islandRings; $j++){ # island in ring? 1:1 and coast on border?
push @coords, $c->[0], $c->[1] ; # 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 =();
push @array, [@coords] ; foreach my $c(@{$islandRings[$j]}){ push @coords, $c->[0], $c->[1];
if (scalar @islandRings > 0) { } push @array, [@coords];
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");
# drawAreaOcean ($color, \@array) ; }}}
my $svgText = "fill=\"$color\" " ; sub pointInMap{ my($n)= shift;
drawArea($svgText, "none", \@array, 0, "base") ; my($sizeX, $sizeY)= getDimensions();
my($lonRef, $latRef)= getNodePointers();
} my($x, $y)= convert($$lonRef{$n}, $$latRef{$n});
}
my $ok = 0;
if(($x >= 0)and
($x <= $sizeX)and
($y >= 0)and
($y <= $sizeY)){ $ok = 1;
} return $ok;
} }
1;
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
( $x <= $sizeX ) and
( $y >= 0 ) and
( $y <= $sizeY ) ) {
$ok = 1 ;
}
return $ok ;
}
1 ;

343
mwConfig.pm
View File

@ -1,13 +1,10 @@
# #
# PERL mapweaver module by gary68 # PERL mapweaver module by gary68
# #
# # Copyright(C)2011, Gerhard Schwanz
#
#
# 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 # This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3 of the License, or (at your option) any later version. # Free Software Foundation; either version 3 of the License, or(at your option)any later version.
# #
# This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or # This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
@ -16,31 +13,30 @@
# #
package mwConfig ; package mwConfig;
use strict ; use strict;
use warnings ; use warnings;
use Getopt::Long;
use Getopt::Long ;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
require Exporter ; require Exporter;
@ISA = qw ( Exporter AutoLoader ) ; @ISA = qw(Exporter AutoLoader);
@EXPORT = qw ( cv @EXPORT = qw(cv
initConfig initConfig
readConfigFile readConfigFile
setConfigValue setConfigValue
printConfig printConfig
printConfigDescriptions printConfigDescriptions
getProgramOptions getProgramOptions
) ; );
my @initial = ( ["verbose",0, "print some more information (CLO)", "misc"], my @initial =(["verbose",0, "print some more information(CLO)", "misc"],
["debug",0, "print debug information (CLO)", "misc"], ["debug",0, "print debug information(CLO)", "misc"],
["projection", "merc","Used projection", "map"], ["projection", "merc","Used projection", "map"],
["ellipsoid", "WGS84","Used ellipsoid", "map"], ["ellipsoid", "WGS84","Used ellipsoid", "map"],
@ -93,69 +89,69 @@ my @initial = ( ["verbose",0, "print some more information (CLO)", "misc"],
["elementFont","","DON'T USE", "map"], ["elementFont","","DON'T USE", "map"],
["elementFontFamily","sans-serif","default font family for map elements like title, scale, grid etc.", "map"], ["elementFontFamily","sans-serif","default font family for map elements like title, scale, grid etc.", "map"],
["in","map.osm","osm in file (CLO)", "job"], ["in","map.osm","osm in file(CLO)", "job"],
["srtm","","srtm in file (CLO)", "job"], ["srtm","","srtm in file(CLO)", "job"],
["overpass",0,"use overpass servers to get data (CLO)", "job"], ["overpass",0,"use overpass servers to get data(CLO)", "job"],
["near","","search only near this name (when using overpass) (CLO)", "job"], ["near","","search only near this name(when using overpass)(CLO)", "job"],
["overpassdistance",50000,"overpass distance for near search (CLO)", "job"], ["overpassdistance",50000,"overpass distance for near search(CLO)", "job"],
["overpassserver","http://www.overpass-api.de/api/","overpass server address (CLO)", "job"], ["overpassserver","http://www.overpass-api.de/api/","overpass server address(CLO)", "job"],
["gpx","","gpx file to overlay (CLO)", "map"], ["gpx","","gpx file to overlay(CLO)", "map"],
["gpxColor","black","color for gpx objects (CLO)", "map"], ["gpxColor","black","color for gpx objects(CLO)", "map"],
["gpxSize",10,"base size of gpx objects (CLO)", "map"], ["gpxSize",10,"base size of gpx objects(CLO)", "map"],
["ini","mwconfig.ini","file with configuration values (CLO)", "misc"], ["ini","mwconfig.ini","file with configuration values(CLO)", "misc"],
["out","mapweaver.svg","svg output name (CLO)", "job"], ["out","mapweaver.svg","svg output name(CLO)", "job"],
["style","mwStandardRules.txt","file with render rules (CLO)", "job"], ["style","mwStandardRules.txt","file with render rules(CLO)", "job"],
["svgname","mapweaver.svg","output file name for svg graphics (CLO)", "job"], ["svgname","mapweaver.svg","output file name for svg graphics(CLO)", "job"],
["size",2200,"size in pixels x axis, 300dpi (CLO)", "map"], ["size",2200,"size in pixels x axis, 300dpi(CLO)", "map"],
["maxTargetSize","","sizes w,h in cm [21,29.7] (CLO)", "map"], ["maxTargetSize","","sizes w,h in cm [21,29.7](CLO)", "map"],
["legend",0,"appearance and position of legend (CLO)", "map"], ["legend",0,"appearance and position of legend(CLO)", "map"],
["bgcolor","white","background color of map (CLO)", "map"], ["bgcolor","white","background color of map(CLO)", "map"],
["grid",0,"number of grid cells, 0 = no grid (CLO)", "map"], ["grid",0,"number of grid cells, 0 = no grid(CLO)", "map"],
["gridcolor","black","color of grid lines (CLO)", "map"], ["gridcolor","black","color of grid lines(CLO)", "map"],
["coords",0,"draw coordinate system (CLO)", "map"], ["coords",0,"draw coordinate system(CLO)", "map"],
["coordsexp",-2,"size of grid cells, exp 10 (CLO)", "map"], ["coordsexp",-2,"size of grid cells, exp 10(CLO)", "map"],
["coordscolor","black","color of coordinates grid lines (CLO)", "map"], ["coordscolor","black","color of coordinates grid lines(CLO)", "map"],
["clip",0," (CLO)", "job"], ["clip",0,"(CLO)", "job"],
["clipbbox",""," (CLO)", "job"], ["clipbbox","","(CLO)", "job"],
["pad",0," (CLO)", "job"], ["pad",0,"(CLO)", "job"],
["ppc",6.5,"points per character (CLO)", "misc", "map"], ["ppc",6.5,"points per character(CLO)", "misc", "map"],
["pdf",0,"convert output to pdf (CLO)", "job"], ["pdf",0,"convert output to pdf(CLO)", "job"],
["png",0,"convert output to png (CLO)", "job"], ["png",0,"convert output to png(CLO)", "job"],
["pngdpi",115,"png resolution (CLO)", "job"], ["pngdpi",115,"png resolution(CLO)", "job"],
["dir",0,"add directory (CLO)", "additional information"], ["dir",0,"add directory(CLO)", "additional information"],
["dirprg","mwDir.pl","program to create directory (CLO)", "additional information"], ["dirprg","mwDir.pl","program to create directory(CLO)", "additional information"],
["direxcludedefault", "no", "object default property for directory entries", "additional information"], ["direxcludedefault", "no", "object default property for directory entries", "additional information"],
["poi",0,"add POI directory (CLO)", "additional information"], ["poi",0,"add POI directory(CLO)", "additional information"],
["dirpdf",0,"create directory pdf (CLO)", "additional information"], ["dirpdf",0,"create directory pdf(CLO)", "additional information"],
["dircolnum",2,"number of text columns for directory pdf (CLO)", "additional information"], ["dircolnum",2,"number of text columns for directory pdf(CLO)", "additional information"],
["dirtitle","Directory","title for directory (CLO)", "additional information"], ["dirtitle","Directory","title for directory(CLO)", "additional information"],
["tagstat",0,"print tag statistics (CLO)", "misc"], ["tagstat",0,"print tag statistics(CLO)", "misc"],
["declutter",1," (CLO)", "map"], ["declutter",1,"(CLO)", "map"],
["allowIconMove",0," (CLO)", "map"], ["allowIconMove",0,"(CLO)", "map"],
["forceNodes",0," (CLO)", "map"], ["forceNodes",0,"(CLO)", "map"],
["lineDist",10,"distance between text lines in pixels", "map"], ["lineDist",10,"distance between text lines in pixels", "map"],
["maxCharPerLine",20,"maximum characters per line in node label", "map"], ["maxCharPerLine",20,"maximum characters per line in node label", "map"],
["help",0,"prints help texts (CLO)", "misc"], ["help",0,"prints help texts(CLO)", "misc"],
["oneways",0,"add oneway arrows (CLO)", "map"], ["oneways",0,"add oneway arrows(CLO)", "map"],
["onewayColor","white","color of oneway arrows (CLO)", "map"], ["onewayColor","white","color of oneway arrows(CLO)", "map"],
["onewaySize",20,"size of oneway arrows (CLO)", "map"], ["onewaySize",20,"size of oneway arrows(CLO)", "map"],
["onewayAutoSize",0,"auto size oneway arrows accordind way size; factor 0..100; 0=NOT AUTO; else percent of way size(CLO)", "map"], ["onewayAutoSize",0,"auto size oneway arrows accordind way size; factor 0..100; 0=NOT AUTO; else percent of way size(CLO)", "map"],
["autobridge",1,"automatically draw bridges and tunnels (CLO)", "map"], ["autobridge",1,"automatically draw bridges and tunnels(CLO)", "map"],
["noLabel",0,"", "map"], ["noLabel",0,"", "map"],
["place","","search for place name in osm file and create map (CLO)", "job"], ["place","","search for place name in osm file and create map(CLO)", "job"],
["placefile","","name of file containing only place information (CLO)", "job"], ["placefile","","name of file containing only place information(CLO)", "job"],
["lonrad",2,"radius lon in km for place map (CLO)", "job"], ["lonrad",2,"radius lon in km for place map(CLO)", "job"],
["latrad",2,"radius lat in km for place map (CLO)", "job"], ["latrad",2,"radius lat in km for place map(CLO)", "job"],
["ruler",0,"draw ruler; positions 1..4 (CLO)", "map"], ["ruler",0,"draw ruler; positions 1..4(CLO)", "map"],
["rulercolor","black","color of ruler (CLO)", "map"], ["rulercolor","black","color of ruler(CLO)", "map"],
["rulerbackground","none","background of ruler, none=transparent (CLO)", "map"], ["rulerbackground","none","background of ruler, none=transparent(CLO)", "map"],
["scale",0,"draw scale; positions 1..4 (CLO)", "map"], ["scale",0,"draw scale; positions 1..4(CLO)", "map"],
["scalecolor","black","color of scale (CLO)", "map"], ["scalecolor","black","color of scale(CLO)", "map"],
["scalebackground","none","color of scale background; none=transparent (CLO)", "map"], ["scalebackground","none","color of scale background; none=transparent(CLO)", "map"],
["scaleset",0,"set scale of map (i.e. 10000) (CLO)", "map"], ["scaleset",0,"set scale of map(i.e. 10000)(CLO)", "map"],
["rulescaleset",0,"set assumed scale for rules (CLO)", "map"], ["rulescaleset",0,"set assumed scale for rules(CLO)", "map"],
["routelabelcolor","black","", "routes"], ["routelabelcolor","black","", "routes"],
["routelabelsize",20,"", "routes"], ["routelabelsize",20,"", "routes"],
["routelabelfontfamily","sans-serif","font-family for route labels", "routes"], ["routelabelfontfamily","sans-serif","font-family for route labels", "routes"],
@ -164,136 +160,86 @@ my @initial = ( ["verbose",0, "print some more information (CLO)", "misc"],
["routeicondist",70,"", "routes"], ["routeicondist",70,"", "routes"],
["routeiconscale",1,"", "routes"], ["routeiconscale",1,"", "routes"],
["routeicondir","./routeicons","", "routes"], ["routeicondir","./routeicons","", "routes"],
["poifile","","name of external POI file (CLO)", "job"], ["poifile","","name of external POI file(CLO)", "job"],
["relid",0,"relation ID for hikingbook (CLO)", "misc"], ["relid",0,"relation ID for hikingbook(CLO)", "misc"],
["rectangles","","draw rectangles for hikingbook (CLO)", "misc"], ["rectangles","","draw rectangles for hikingbook(CLO)", "misc"],
["pagenumbers","","add page numbers to map (CLO)", "misc"], ["pagenumbers","","add page numbers to map(CLO)", "misc"],
["ra",0,"relation analyzer mode (CLO)", "misc"], ["ra",0,"relation analyzer mode(CLO)", "misc"],
["multionly",0,"draw only multipolygons (CLO)", "misc"], ["multionly",0,"draw only multipolygons(CLO)", "misc"],
["test",0,"test feature (CLO)", "misc"], ["test",0,"test feature(CLO)", "misc"],
["foot","mapweaver by gary68 - data by www.openstreetmap.org","text for footer (CLO)", "map"], ["foot","mapweaver by gary68 - data by www.openstreetmap.org","text for footer(CLO)", "map"],
["footcolor","black","color for footer (CLO)", "map"], ["footcolor","black","color for footer(CLO)", "map"],
["footbackground","none","background color for footer (CLO)", "map"], ["footbackground","none","background color for footer(CLO)", "map"],
["footsize",40,"font size for footer (CLO)", "map"], ["footsize",40,"font size for footer(CLO)", "map"],
["head","","text for header (CLO)", "map"], ["head","","text for header(CLO)", "map"],
["headcolor","black","color for header (CLO)", "map"], ["headcolor","black","color for header(CLO)", "map"],
["headbackground","none","background color for header (CLO)", "map"], ["headbackground","none","background color for header(CLO)", "map"],
["headsize",40,"font size for header (CLO)", "map"], ["headsize",40,"font size for header(CLO)", "map"],
["wns",0,"substitute unfitting way names by numbers; 0..4 1..4=positions in map; 5=file (CLO)", "map"], ["wns",0,"substitute unfitting way names by numbers; 0..4 1..4=positions in map; 5=file(CLO)", "map"],
["wnssize",20,"size of labels in wns legend", "map"], ["wnssize",20,"size of labels in wns legend", "map"],
["wnscolor","black","color of labels in wns legend", "map"], ["wnscolor","black","color of labels in wns legend", "map"],
["wnsbgcolor","white","color of background of wns legend", "map"], ["wnsbgcolor","white","color of background of wns legend", "map"],
["wnsunique",0,"wns will label each way only once (CLO)", "map"], ["wnsunique",0,"wns will label each way only once(CLO)", "map"],
["minAreaSize",400,"min size of area to be drawn on map", "map"], ["minAreaSize",400,"min size of area to be drawn on map", "map"],
["minAreaLabelSize",10000,"min size of area to be labeled on map", "map"], ["minAreaLabelSize",10000,"min size of area to be labeled on map", "map"],
["oceanColor","lightblue","color of ocean (CLO)", "map"], ["oceanColor","lightblue","color of ocean(CLO)", "map"],
["cIE",0,"osmosis clipIncompleteEntities instead of completeObjects (CLP)", "map"] ["cIE",0,"osmosis clipIncompleteEntities instead of completeObjects(CLP)", "map"]
) ; );
my %cv = () ; my %cv =();
my %explanation = () ; my %explanation =();
# -------------------------------------------------------------------------------- # --------------------------------------------------------------------------------
sub initConfig { 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];
}}
# set initial values according to program internal values from array @initial sub setConfigValue{ # allows any module to change a certain k/v pair
my($k, $v)= @_;
foreach my $kv (@initial) { $k = lc($k);
$cv{ lc( $kv->[0] ) } = $kv->[1] ; $cv{$k}= $v;
$explanation{ lc( $kv->[0] ) } = $kv->[2] ; 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});
} }
sub printConfig{ # print actual config to stdout
print "\nActual configuration\n";
my %cats =();
sub setConfigValue { foreach my $e(@initial){ $cats{$e->[3]}= 1;
# 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" ; }
} }
foreach my $cat(sort keys %cats){ my @entries =();
sub cv { foreach my $e(@initial){ if($e->[3] eq $cat){ push @entries, $e->[0];
} } print "\nCATEGORY $cat\n";
# access a value by key print "--------\n";
foreach my $e(sort{$a cmp $b}@entries){ printf "%-30s %-30s\n", $e, cv($e);
my $k = shift ; }} print "\n";
$k = lc ( $k ) ;
if ( ! defined $cv{ $k } ) { print "WARNING: requested config key $k not defined!\n" ; }
return ( $cv{ $k } ) ;
} }
sub readConfigFile{ # read ini file; initial k/v pairs might be changed
my $fileName = shift;
my $lc = 0;
sub printConfig { print "reading config file $fileName\n";
# print actual config to stdout open(my $file, "<", $fileName)or die("ERROR: could not open ini file $fileName\n");
my $line = "";
print "\nActual configuration\n" ; while($line = <$file>){ $lc++;
unless(grep(/^#/, $line)){ my($k, $v)=($line =~ /(.+?)=(.*)/);
my %cats = () ; if((! defined $k)or(! defined $v)){ print "WARNING: could not parse config line: $line";
foreach my $e (@initial) { } else{ $k = lc($k);
$cats{ $e->[3] } = 1 ; $cv{$k}= $v;
} } }} close $file;
print "$lc lines read.\n\n";
foreach my $cat (sort keys %cats) { }sub getProgramOptions{my $optResult = GetOptions("in=s" => \$cv{'in'}, # the in file, mandatory
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) ;
}
}
print "\n" ;
}
sub readConfigFile {
# read ini file; initial k/v pairs might be changed
my $fileName = shift ;
my $lc = 0 ;
print "reading config file $fileName\n" ;
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 ) ;
$cv{ $k } = $v ;
}
}
}
close ($file) ;
print "$lc lines read.\n\n" ;
}
# ---------------------------------------------------------------------------------------
sub getProgramOptions {
my $optResult = GetOptions ( "in=s" => \$cv{'in'}, # the in file, mandatory
"overpass" => \$cv{'overpass'}, "overpass" => \$cv{'overpass'},
"near:s" => \$cv{'near'}, "near:s" => \$cv{'near'},
"overpassdistance:i" => \$cv{'overpassdistance'}, "overpassdistance:i" => \$cv{'overpassdistance'},
@ -377,28 +323,15 @@ my $optResult = GetOptions ( "in=s" => \$cv{'in'}, # the in file, mandatory
"debug" => \$cv{'debug'}, # turns debug messages on "debug" => \$cv{'debug'}, # turns debug messages on
"cie" => \$cv{'cie'}, # turns debug messages on "cie" => \$cv{'cie'}, # turns debug messages on
"verbose" => \$cv{'verbose'}, # turns twitter on "verbose" => \$cv{'verbose'}, # turns twitter on
"test" => \$cv{'test'} ) ; # test "test" => \$cv{'test'}); # test
} }
sub printConfigDescriptions{ my @texts = @initial;
@texts = sort{$a->[0] cmp $b->[0]}@texts;
sub printConfigDescriptions { print "\nconfig value descriptions\n\n";
printf "%-25s %-50s %-20s\n" , "key" , "description", "default";
my @texts = @initial ; foreach my $t(@texts){ my $def = $t->[1];
$def = "<EMPTY>" unless $def;
@texts = sort {$a->[0] cmp $b->[0]} @texts ; printf "%-25s %-50s %-20s\n" , $t->[0] , $t->[2], $def;
} print "\n";
print "\nconfig value descriptions\n\n" ; }1;
printf "%-25s %-50s %-20s\n" , "key" , "description", "default" ;
foreach my $t (@texts) {
my $def = $t->[1] ;
if ($def eq "") { $def = "<EMPTY>" ; }
printf "%-25s %-50s %-20s\n" , $t->[0] , $t->[2], $def ;
}
print "\n" ;
}
1 ;

172
mwDir.pl
View File

@ -1,119 +1,119 @@
use strict ; use strict;
use warnings ; use warnings;
use OSM::osm 8.3 ; use OSM::osm 8.3;
my $version = "1.00" ; my $version = "1.00";
my $streetFileName ; my $streetFileName;
my $poiFileName ; my $poiFileName;
my $pdfFileName ; my $pdfFileName;
my $texFileName ; my $texFileName;
my $titleText ; my $titleText;
my $numColumns ; my $numColumns;
my $streetFile ; my $streetFile;
my $poiFile ; my $poiFile;
my $texFile ; my $texFile;
($streetFileName, $poiFileName, $titleText, $pdfFileName, $numColumns) = @ARGV ; ($streetFileName, $poiFileName, $titleText, $pdfFileName, $numColumns)= @ARGV;
print "mwDir.pl: $streetFileName, $poiFileName, $titleText, $pdfFileName, $numColumns\n" ; print "mwDir.pl: $streetFileName, $poiFileName, $titleText, $pdfFileName, $numColumns\n";
$texFileName = $pdfFileName ; $texFileName = $pdfFileName;
$texFileName =~ s/.pdf/.tex/ ; $texFileName =~ s/.pdf/.tex/;
open ($texFile, ">", $texFileName) or die ("can't open tex output file") ; open($texFile, ">", $texFileName)or die("can't open tex output file");
print $texFile "\\documentclass[a4paper,12pt]{book}\n" ; print $texFile "\\documentclass[a4paper,12pt]{book}\n";
print $texFile "\\usepackage{multicol}\n" ; print $texFile "\\usepackage{multicol}\n";
print $texFile "\\usepackage[utf8]{inputenc}\n" ; print $texFile "\\usepackage[utf8]{inputenc}\n";
print $texFile "\\usepackage[top=2.5cm,bottom=2cm,left=3cm,right=2cm]{geometry}\n" ; print $texFile "\\usepackage[top=2.5cm,bottom=2cm,left=3cm,right=2cm]{geometry}\n";
print $texFile "\\columnsep7mm\n" ; print $texFile "\\columnsep7mm\n";
print $texFile "\\begin{document}\n" ; print $texFile "\\begin{document}\n";
print $texFile "\\section*{$titleText}\n" ; print $texFile "\\section*{$titleText}\n";
print $texFile "\n" ; print $texFile "\n";
print $texFile "\\tiny\n" ; print $texFile "\\tiny\n";
print $texFile "Data CC-BY-SA www.openstreetmap.org\n" ; print $texFile "Data CC-BY-SA www.openstreetmap.org\n";
print $texFile "\\normalsize\n\n" ; print $texFile "\\normalsize\n\n";
# streets # streets
if ($streetFileName ne "none") { if($streetFileName ne "none"){
my $result = open ($streetFile, "<", $streetFileName) ; my $result = open($streetFile, "<", $streetFileName);
if ($result) { if($result){
my $line ; my $line;
print $texFile "\\begin{multicols}{$numColumns}[\\subsubsection*{Streets}]\n" ; print $texFile "\\begin{multicols}{$numColumns}[\\subsubsection*{Streets}]\n";
print $texFile "\\tiny\n" ; print $texFile "\\tiny\n";
while ($line = <$streetFile>) { while($line = <$streetFile>){
$line = convertToLatex ($line) ; $line = convertToLatex($line);
my (@entry) = split /\t/, $line ; my(@entry)= split /\t/, $line;
print $texFile $entry[0] ; print $texFile $entry[0];
print $texFile " \\dotfill " ; print $texFile " \\dotfill ";
print $texFile $entry[1], " \\\\\n" ; print $texFile $entry[1], " \\\\\n";
}
close ($streetFile) ;
print $texFile "\\normalsize\n" ;
print $texFile "\\end{multicols}\n" ;
}
else {
print "WARNING: street file $streetFile could not be opened." ;
} }
close($streetFile);
print $texFile "\\normalsize\n";
print $texFile "\\end{multicols}\n";
}
else{
print "WARNING: street file $streetFile could not be opened.";
}
} }
# POIs # POIs
if ($poiFileName ne "none") { if($poiFileName ne "none"){
my $result = open ($poiFile, "<", $poiFileName) ; my $result = open($poiFile, "<", $poiFileName);
if ($result) { if($result){
my $line ; my $line;
print $texFile "\\begin{multicols}{$numColumns}[\\subsubsection*{Points of interest}]\n" ; print $texFile "\\begin{multicols}{$numColumns}[\\subsubsection*{Points of interest}]\n";
print $texFile "\\tiny\n" ; print $texFile "\\tiny\n";
while ($line = <$poiFile>) { while($line = <$poiFile>){
$line = convertToLatex ($line) ; $line = convertToLatex($line);
my @entry = split /\t/, $line ; my @entry = split /\t/, $line;
print $texFile $entry[0] ; print $texFile $entry[0];
print $texFile " \\dotfill " ; print $texFile " \\dotfill ";
print $texFile $entry[1], "\\\\\n" ; print $texFile $entry[1], "\\\\\n";
}
close ($poiFile) ;
print $texFile "\\normalsize\n" ;
print $texFile "\\end{multicols}\n" ;
}
else {
print "WARNING: POI file $poiFile could not be opened." ;
} }
close($poiFile);
print $texFile "\\normalsize\n";
print $texFile "\\end{multicols}\n";
}
else{
print "WARNING: POI file $poiFile could not be opened.";
}
} }
print $texFile "\\end{document}\n" ; print $texFile "\\end{document}\n";
close ($texFile) ; close($texFile);
print "directory tex file created.\n" ; print "directory tex file created.\n";
my $dviFileName = $pdfFileName ; my $dviFileName = $pdfFileName;
$dviFileName =~ s/.pdf/.dvi/ ; $dviFileName =~ s/.pdf/.dvi/;
my $psFileName = $pdfFileName ; my $psFileName = $pdfFileName;
$psFileName =~ s/.pdf/.ps/ ; $psFileName =~ s/.pdf/.ps/;
`latex $texFileName` ; `latex $texFileName`;
print "directory dvi file created.\n" ; print "directory dvi file created.\n";
`dvips -D600 $dviFileName -o` ; `dvips -D600 $dviFileName -o`;
print "directory ps file created.\n" ; print "directory ps file created.\n";
`ps2pdf $psFileName $pdfFileName` ; `ps2pdf $psFileName $pdfFileName`;
print "directory pdf file created.\n" ; print "directory pdf file created.\n";
`rm *.dvi` ; `rm *.dvi`;
`rm *.tex` ; `rm *.tex`;
`rm *.ps` ; `rm *.ps`;
`rm *.aux` ; `rm *.aux`;
`rm *.log` ; `rm *.log`;
print "directory FINISHED.\n" ; print "directory FINISHED.\n";

572
mwFile.pm
View File

@ -4,10 +4,10 @@
# #
# #
# #
# Copyright (C) 2011, Gerhard Schwanz # 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 # This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3 of the License, or (at your option) any later version. # Free Software Foundation; either version 3 of the License, or(at your option)any later version.
# #
# This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or # This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
@ -16,419 +16,305 @@
# #
package mwFile ; package mwFile;
use strict ; use strict;
use warnings ; use warnings;
use mwConfig ; use mwConfig;
use mwMap ; use mwMap;
use mwLabel ; use mwLabel;
use LWP::Simple ;
use OSM::osm ; use LWP::Simple;
use OSM::osm;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
require Exporter ; require Exporter;
@ISA = qw ( Exporter AutoLoader ) ; @ISA = qw(Exporter AutoLoader);
@EXPORT = qw ( readFile @EXPORT = qw(readFile
getNodePointers getNodePointers
getWayPointers getWayPointers
getRelationPointers getRelationPointers
) ; );
my %lon ; my %lon;
my %lat ; my %lat;
my %memNodeTags ;
my %memWayNodes ; my %memNodeTags;
my %memWayTags ; my %memWayNodes;
my %memWayTags;
my %memRelationMembers;
my %memRelationTags;
my %memRelationMembers ; my $overpassSource0 = "interpreter?data=node%5B%22name%22%3D%22NAME%22%5D%3Bout%20body%3B%0A";
my %memRelationTags ; my $overpassSource1 = "interpreter?data=node%5B%22name%22%3D%22NEAR%22%5D%3Bnode%28around%3ADIST%29%5B%22name%22%3D%22NAME%22%5D%3Bout%3B";
my $overpassSource3 = "interpreter?data=%28node%28BOTTOM%2CLEFT%2CTOP%2CRIGHT%29%3B%3C%3B%3E%3B%29%3Bout%20meta%3B";
my $overpassSource0 = "interpreter?data=node%5B%22name%22%3D%22NAME%22%5D%3Bout%20body%3B%0A" ;
my $overpassSource1 = "interpreter?data=node%5B%22name%22%3D%22NEAR%22%5D%3Bnode%28around%3ADIST%29%5B%22name%22%3D%22NAME%22%5D%3Bout%3B" ;
my $overpassSource3 = "interpreter?data=%28node%28BOTTOM%2CLEFT%2CTOP%2CRIGHT%29%3B%3C%3B%3E%3B%29%3Bout%20meta%3B" ;
sub readFile { sub readFile{
my($nodeId, $nodeLon, $nodeLat, $nodeUser, $aRef1, @nodeTags);
my ($nodeId, $nodeLon, $nodeLat, $nodeUser, $aRef1, @nodeTags) ; my($wayId, $wayUser, $aRef2, @wayTags, @wayNodes);
my ($wayId, $wayUser, $aRef2, @wayTags, @wayNodes) ; my($relationId, $relationUser, @relationTags, @relationMembers);
my ($relationId, $relationUser, @relationTags, @relationMembers) ; my %invalidWays;
my %invalidWays ;
my $osmName ; my $osmName;
if (defined cv('in')) { $osmName = cv('in') ; } 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");}
my $overpassNear = cv('near');
my $overpassDistance = cv('overpassdistance');
my $overpassName = cv('place');
my $overpassUrl1 = cv('overpassserver'). $overpassSource1;
my $clipbbox = "" ; if(cv('near')eq ""){ $overpassUrl1 = cv('overpassserver'). $overpassSource0;
if (defined cv('clipbbox')) { $clipbbox = cv('clipbbox') ; }
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 ;
} }
$overpassUrl1 =~ s/NEAR/$overpassNear/;
$overpassUrl1 =~ s/DIST/$overpassDistance/;
$overpassUrl1 =~ s/NAME/$overpassName/;
$overpassUrl1 =~ s/NEAR/$overpassNear/ ; if(cv('debug')eq "1"){print "Overpass Query1: $overpassUrl1 ...\n";} print "Send Query 1 to overpass server..\n";
$overpassUrl1 =~ s/DIST/$overpassDistance/ ; my $result1 = get($overpassUrl1);
$overpassUrl1 =~ s/NAME/$overpassName/ ; if(! defined $result1){die("ERROR: bad overpass result!\n");}
if(cv('debug')eq "1"){print "\n$result1\n\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 # get lon, lat
my ($placeLon) = ( $result1 =~ /lon=\"([\d\.\-]+)/ ) ; my($placeLon)=($result1 =~ /lon=\"([\d\.\-]+)/);
my ($placeLat) = ( $result1 =~ /lat=\"([\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") ; } 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 "place $overpassName found:\n" ; print "lon= $placeLon\n";
print "lon= $placeLon\n" ; print "lat= $placeLat\n";
print "lat= $placeLat\n" ;
# calc bbox # calc bbox
my $overLeft = $placeLon - cv('lonrad')/(111.11 * cos ( $placeLat / 360 * 3.14 * 2 ) ) ; my $overLeft = $placeLon - cv('lonrad')/(111.11 * cos($placeLat / 360 * 3.14 * 2));
my $overRight = $placeLon + cv('lonrad')/(111.11 * cos ( $placeLat / 360 * 3.14 * 2 ) ) ; my $overRight = $placeLon + cv('lonrad')/(111.11 * cos($placeLat / 360 * 3.14 * 2));
my $overTop = $placeLat + cv('latrad')/111.11 ; my $overTop = $placeLat + cv('latrad')/111.11;
my $overBottom = $placeLat - cv('latrad')/111.11 ; my $overBottom = $placeLat - cv('latrad')/111.11;
my $overpassUrl2 = cv('overpassserver') . $overpassSource3 ; my $overpassUrl2 = cv('overpassserver'). $overpassSource3;
$overpassUrl2 =~ s/LEFT/$overLeft/ ; $overpassUrl2 =~ s/LEFT/$overLeft/;
$overpassUrl2 =~ s/RIGHT/$overRight/ ; $overpassUrl2 =~ s/RIGHT/$overRight/;
$overpassUrl2 =~ s/TOP/$overTop/ ; $overpassUrl2 =~ s/TOP/$overTop/;
$overpassUrl2 =~ s/BOTTOM/$overBottom/ ; $overpassUrl2 =~ s/BOTTOM/$overBottom/;
if ( cv('debug') eq "1" ) { print "Overpass Query2: $overpassUrl2\n" ; } if(cv('debug')eq "1"){print "Overpass Query2: $overpassUrl2\n";} print "Send Query 2 to overpass server..\n";
print "Send Query 2 to overpass server..\n" ; my $result2 = get($overpassUrl2);
my $result2 = get ( $overpassUrl2 ) ; if(! defined $result2){die("ERROR: bad overpass result!\n");}
if ( ! defined $result2 ) { die ("ERROR: bad overpass result!\n") ; }
# save # save
my $opFileName = "overpass.osm" ; my $opFileName = "overpass.osm";
open (my $overFile, ">", $opFileName) ; open(my $overFile, ">", $opFileName);
binmode($overFile, ":utf8") ; binmode($overFile, ":utf8");
print $overFile $result2 ; print $overFile $result2;
close ( $overFile ) ; close($overFile);
setConfigValue ('in', $opFileName) ; setConfigValue('in', $opFileName);
$osmName = $opFileName ; $osmName = $opFileName;
# setConfigValue ('place', '') ; # setConfigValue('place', '');
$clipbbox = "$overLeft,$overBottom,$overRight,$overTop" ; $clipbbox = "$overLeft,$overBottom,$overRight,$overTop";
if ( cv('debug') eq "1" ) { print "clipbox: $clipbbox\n" ; } if(cv('debug')eq "1"){print "clipbox: $clipbbox\n";}}
} if(grep /\.pbf/, $osmName){ my $newName = $osmName;
$newName =~ s/\.pbf/\.osm/i;
if ( grep /\.pbf/, $osmName ) {
my $newName = $osmName ;
$newName =~ s/\.pbf/\.osm/i ;
# osmosis # osmosis
print "call osmosis to convert pbf file to osm file.\n" ; print "call osmosis to convert pbf file to osm file.\n";
`osmosis --read-pbf $osmName --write-xml $newName` ; `osmosis --read-pbf $osmName --write-xml $newName`;
# change config # change config
$osmName = $newName ; $osmName = $newName;
setConfigValue ("in", $newName) ; setConfigValue("in", $newName);
} }
# -place given? look for place and call osmosis # -place given? look for place and call osmosis
my $left ; my $left;
my $right ; my $right;
my $top ; my $top;
my $bottom ; my $bottom;
my $placeFound = 0 ; my $placeLon ; my $placeLat ; my $placeFound = 0; my $placeLon; my $placeLat;
if ( ( cv('place') ne "") and (cv('overpass') ne "1" ) ) { if((cv('place')ne "")and(cv('overpass')ne "1")){ my($placeId)=(cv('place')=~ /([\d]+)/);
my ($placeId) = ( cv('place') =~ /([\d]+)/); if(!defined $placeId){$placeId = -999999999;} print "looking for place...\n";
if (!defined $placeId) { $placeId = -999999999 ; }
print "looking for place...\n" ;
my $placeFileName = "" ; my $placeFileName = "";
if ( cv('placeFile') ne "" ) { if(cv('placeFile')ne ""){
$placeFileName = cv('placeFile') ; $placeFileName = cv('placeFile');
} else{ $placeFileName = cv('in');
} }
else { openOsmFile($placeFileName);
$placeFileName = cv('in') ; ($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;
$placeLon = $nodeLon;
$placeLat = $nodeLat;
} ($nodeId, $nodeLon, $nodeLat, $nodeUser, $aRef1)= getNode2();
if($nodeId != -1){ @nodeTags = @$aRef1;
} }
closeOsmFile();
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));
$right = $placeLon + cv('lonrad')/(111.11 * cos($placeLat / 360 * 3.14 * 2));
$top = $placeLat + cv('latrad')/111.11;
$bottom = $placeLat - cv('latrad')/111.11;
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";
`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";
`osmosis --read-xml $osmName --bounding-box clipIncompleteEntities=yes bottom=$bottom top=$top left=$left right=$right --write-xml ./temp.osm`;
} }
print "osmosis done.\n";
openOsmFile ($placeFileName) ; $osmName = "./temp.osm";
($nodeId, $nodeLon, $nodeLat, $nodeUser, $aRef1) = getNode2 () ; $clipbbox = "$left,$bottom,$right,$top";
if ($nodeId != -1) { } else{ print "ERROR: place $place not found.\n";
@nodeTags = @$aRef1 ; die();
} }}
my $place = cv ('place') ;
while ( ($nodeId != -1) and ($placeFound == 0) ) { my $srtmFileName = cv('srtm');
my $placeNode = 0 ; my $placeName = 0 ; if($srtmFileName ne ""){
foreach my $tag ( @nodeTags ) { 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\"";
if ($tag->[0] eq "place") { $placeNode = 1 ; } 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\"";
if ( ($tag->[0] eq "name") and (grep /$place/i, $tag->[1]) ){ $placeName = 1 ; }
} my $cmd = "";
if ( (($placeNode == 1) and ($placeName == 1)) or ($placeId == $nodeId) ) { if(grep /\.pbf/, $srtmFileName){ $cmd = $cmdP;
$placeFound = 1 ; } else{ $cmd = $cmdX;
$placeLon = $nodeLon ;
$placeLat = $nodeLat ;
}
($nodeId, $nodeLon, $nodeLat, $nodeUser, $aRef1) = getNode2 () ;
if ($nodeId != -1) {
@nodeTags = @$aRef1 ;
}
} }
print "call osmosis to merge SRTM data...\n$cmd\n";
closeOsmFile() ; `$cmd`;
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 ) ) ;
$right = $placeLon + cv('lonrad')/(111.11 * cos ( $placeLat / 360 * 3.14 * 2 ) ) ;
$top = $placeLat + cv('latrad')/111.11 ;
$bottom = $placeLat - cv('latrad')/111.11 ;
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" ;
`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" ;
`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" ;
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 ;
}
else {
$cmd = $cmdX ;
}
print "call osmosis to merge SRTM data...\n$cmd\n" ;
`$cmd` ;
$osmName = "temp2.osm" ;
}
$osmName = "temp2.osm";
}
# STORE DATA # STORE DATA
my $nr = 0 ; my $wr = 0 ; my $rr = 0 ; my $nr = 0; my $wr = 0; my $rr = 0;
print "reading osm file...\n" ; print "reading osm file...\n";
openOsmFile ($osmName) ; openOsmFile($osmName);
($nodeId, $nodeLon, $nodeLat, $nodeUser, $aRef1) = getNode2 () ; ($nodeId, $nodeLon, $nodeLat, $nodeUser, $aRef1)= getNode2();
if ($nodeId != -1) { if($nodeId != -1){ @nodeTags = @$aRef1;
@nodeTags = @$aRef1 ; } while($nodeId != -1){ $nr++;
} $lon{$nodeId}= $nodeLon; $lat{$nodeId}= $nodeLat;
while ($nodeId != -1) { @{$memNodeTags{$nodeId}}= @nodeTags;
$nr++ ;
$lon{$nodeId} = $nodeLon ; $lat{$nodeId} = $nodeLat ;
@{$memNodeTags{$nodeId}} = @nodeTags ;
($nodeId, $nodeLon, $nodeLat, $nodeUser, $aRef1) = getNode2 () ; ($nodeId, $nodeLon, $nodeLat, $nodeUser, $aRef1)= getNode2();
if ($nodeId != -1) { if($nodeId != -1){ @nodeTags = @$aRef1;
@nodeTags = @$aRef1 ; }}
} ($wayId, $wayUser, $aRef1, $aRef2)= getWay2();
if($wayId != -1){ @wayNodes = @$aRef1;
@wayTags = @$aRef2;
} 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";
} } } else{ $invalidWays{$wayId}= 1;
} }
($wayId, $wayUser, $aRef1, $aRef2)= getWay2();
if($wayId != -1){ @wayNodes = @$aRef1;
@wayTags = @$aRef2;
}}
($wayId, $wayUser, $aRef1, $aRef2) = getWay2 () ; ($relationId, $relationUser, $aRef1, $aRef2)= getRelation();
if ($wayId != -1) { if($relationId != -1){ @relationMembers = @$aRef1;
@wayNodes = @$aRef1 ; @relationTags = @$aRef2;
@wayTags = @$aRef2 ; }
} while($relationId != -1){ $rr++;
while ($wayId != -1) { @{$memRelationTags{$relationId}}= @relationTags;
$wr++ ; @{$memRelationMembers{$relationId}}= @relationMembers;
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" ;
}
}
}
else {
$invalidWays{$wayId} = 1 ;
}
($wayId, $wayUser, $aRef1, $aRef2) = getWay2 () ;
if ($wayId != -1) {
@wayNodes = @$aRef1 ;
@wayTags = @$aRef2 ;
}
}
($relationId, $relationUser, $aRef1, $aRef2) = getRelation () ;
if ($relationId != -1) {
@relationMembers = @$aRef1 ;
@relationTags = @$aRef2 ;
}
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 #next
($relationId, $relationUser, $aRef1, $aRef2) = getRelation () ; ($relationId, $relationUser, $aRef1, $aRef2)= getRelation();
if ($relationId != -1) { if($relationId != -1){ @relationMembers = @$aRef1;
@relationMembers = @$aRef1 ; @relationTags = @$aRef2;
@relationTags = @$aRef2 ; }}
} closeOsmFile();
}
closeOsmFile () ; print "read: $nr nodes, $wr ways and $rr relations.\n\n";
print "read: $nr nodes, $wr ways and $rr relations.\n\n" ;
# calc area of pic and init graphics # calc area of pic and init graphics
my $lonMin = 999 ; my $lonMax = -999 ; my $latMin = 999 ; my $latMax = -999 ; my $lonMin = 999; my $lonMax = -999; my $latMin = 999; my $latMax = -999;
foreach my $key (keys %lon) { 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};}}
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 # clip picture if desired
if ($clipbbox ne "") { if($clipbbox ne ""){ my($bbLeft, $bbBottom, $bbRight, $bbTop)=($clipbbox =~ /([\d\-\.]+),([\d\-\.]+),([\d\-\.]+),([\d\-\.]+)/);
my ($bbLeft, $bbBottom, $bbRight, $bbTop) = ($clipbbox =~ /([\d\-\.]+),([\d\-\.]+),([\d\-\.]+),([\d\-\.]+)/ ) ; # print "$bbLeft, $bbBottom, $bbRight, $bbTop\n";
# 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" ; } $lonMax = $bbRight;
if (($bbRight > $lonMax) or ($bbRight < $lonMin)) { print "WARNING -clipbox right parameter outside data.\n" ; } $latMin = $bbBottom;
if (($bbBottom > $latMax) or ($bbBottom < $latMin)) { print "WARNING -clipbox bottom parameter outside data.\n" ; } $latMax = $bbTop;
if (($bbTop > $latMax) or ($bbTop < $latMin)) { print "WARNING -clipbox top parameter outside data.\n" ; } } else{ if(defined cv('clip')){ if((cv('clip')> 0)and(cv('clip')< 100)){
$lonMin = $bbLeft ; my $clip = cv('clip');
$lonMax = $bbRight ; $clip = $clip / 100;
$latMin = $bbBottom ; $lonMin +=($lonMax-$lonMin)* $clip;
$latMax = $bbTop ; $lonMax -=($lonMax-$lonMin)* $clip;
} $latMin +=($latMax-$latMin)* $clip;
else { $latMax -=($latMax-$latMin)* $clip;
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 # pad picture if desired
if (defined cv('pad')) { if(defined cv('pad')){ my $pad = cv('pad');
my $pad = cv('pad') ; if(($pad > 0)and($pad < 100)){
if ( ($pad > 0) and ($pad < 100) ) { $pad = $pad / 100;
$pad = $pad / 100 ; $lonMin -=($lonMax-$lonMin)* $pad;
$lonMin -= ($lonMax-$lonMin) * $pad ; $lonMax +=($lonMax-$lonMin)* $pad;
$lonMax += ($lonMax-$lonMin) * $pad ; $latMin -=($latMax-$latMin)* $pad;
$latMin -= ($latMax-$latMin) * $pad ; $latMax +=($latMax-$latMin)* $pad;
$latMax += ($latMax-$latMin) * $pad ; }}
} my $size = cv('size');
}
my $size = cv('size') ;
# calc pic size # calc pic size
if ( cv('scaleSet') != 0 ) { if(cv('scaleSet')!= 0){ my $dist = distance($lonMin, $latMin, $lonMax, $latMin);
my $dist = distance ($lonMin, $latMin, $lonMax, $latMin) ; my $width = $dist / cv('scaleSet')* 1000 * 100 / 2.54; # inches
my $width = $dist / cv('scaleSet') * 1000 * 100 / 2.54 ; # inches $size = int($width * 300);
$size = int ($width * 300) ; }
} if(cv('maxTargetSize')ne ""){ my @a = split /,/, cv('maxTargetSize');
my $targetWidth = $a[0];
my $targetHeight = $a[1];
# print "TS: $targetWidth, $targetHeight [cm]\n";
my $distLon = distance($lonMin, $latMin, $lonMax, $latMin);
my $distLat = distance($lonMin, $latMin, $lonMin, $latMax);
# print "TS: $distLon, $distLat [km]\n";
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 ( cv('maxTargetSize') ne "" ) { my $width = $distLon / $targetScale * 1000 * 100 / 2.54; # inches
my @a = split /,/, cv('maxTargetSize') ; $size = int($width * 300);
my $targetWidth = $a[0] ; print "Map width now $size [px] due to maxTargetSize parameter\n";
my $targetHeight = $a[1] ; }
# print "TS: $targetWidth, $targetHeight [cm]\n" ; mwMap::initGraph($size, $lonMin, $latMin, $lonMax, $latMax);
my $distLon = distance ($lonMin, $latMin, $lonMax, $latMin) ;
my $distLat = distance ($lonMin, $latMin, $lonMin, $latMax) ;
# print "TS: $distLon, $distLat [km]\n" ;
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" ;
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 getRelationPointers{
return(\%memRelationMembers, \%memRelationTags);
} }
sub getWayPointers { 1;
return ( \%memWayNodes, \%memWayTags) ;
}
sub getRelationPointers {
return ( \%memRelationMembers, \%memRelationTags) ;
}
1 ;

136
mwGPX.pm
View File

@ -4,10 +4,10 @@
# #
# #
# #
# Copyright (C) 2011, Gerhard Schwanz # 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 # This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3 of the License, or (at your option) any later version. # Free Software Foundation; either version 3 of the License, or(at your option)any later version.
# #
# This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or # This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
@ -16,108 +16,92 @@
# #
package mwGPX ; package mwGPX;
use strict ; use strict;
use warnings ; use warnings;
use OSM::gpx ; use OSM::gpx;
use mwConfig ; use mwConfig;
use mwMap ; use mwMap;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
require Exporter ; require Exporter;
@ISA = qw ( Exporter AutoLoader ) ; @ISA = qw(Exporter AutoLoader);
@EXPORT = qw ( processGPXFile @EXPORT = qw(processGPXFile
) ; );
sub processGPXFile { sub processGPXFile{
my($ref1, $ref2, $ref3)= readGPXFile(cv('gpx'));
my ($ref1, $ref2, $ref3) = readGPXFile ( cv('gpx') ) ; my %wptHash = %$ref1;
my %rteHash = %$ref2;
my %trkHash = %$ref3;
my %wptHash = %$ref1 ; my $size = cv('gpxsize');
my %rteHash = %$ref2 ; my $color = cv('gpxcolor');
my %trkHash = %$ref3 ;
my $size = cv('gpxsize') ; foreach my $wptNr(sort{$a <=> $b}keys %wptHash){ # print "WPT $wptNr: $wptHash{$wptNr}{'lon'}$wptHash{$wptNr}{'lat'}\n";
my $color = cv('gpxcolor') ; if(defined $wptHash{$wptNr}{'name'}){
# print " name: $wptHash{$wptNr}{'name'}\n";
foreach my $wptNr ( sort { $a <=> $b } keys %wptHash) { } if(defined $wptHash{$wptNr}{'ele'}){
# print "WPT $wptNr: $wptHash{$wptNr}{'lon'} $wptHash{$wptNr}{'lat'}\n" ; # print " ele: $wptHash{$wptNr}{'ele'}\n";
if (defined $wptHash{$wptNr}{'name'}) {
# print " name: $wptHash{$wptNr}{'name'}\n" ;
}
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');
my $svgString = "fill=\"$color\" stroke=\"none\" " ; }
my $lon = $wptHash{$wptNr}{'lon'} ; foreach my $rteNr(sort{$a <=> $b}keys %rteHash){ # print "RTE $rteNr\n";
my $lat = $wptHash{$wptNr}{'lat'} ;
drawCircle ($lon, $lat, 1, 3*$size, 0, $svgString, 'gpx') ;
my @coords =();
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'};
my $lat = $rteHash{$rteNr}{$rteWptNr}{'lat'};
drawCircle($lon, $lat, 1, 2*$size, 0, $svgString, 'gpx');
my($x, $y)= convert($lon, $lat);
push @coords, $x, $y;
} }
my $svgString = "";
foreach my $rteNr ( sort { $a <=> $b } keys %rteHash) { my $lc = "round";
# print "RTE $rteNr\n" ; my $lj = "round";
my @coords = () ; $svgString = "stroke=\"$color\" stroke-width=\"$size\" stroke-linecap=\"$lc\" fill=\"none\" stroke-linejoin=\"$lj\" ";
foreach my $rteWptNr ( sort { $a <=> $b } keys %{$rteHash{$rteNr}}) { drawWay(\@coords, 0, $svgString, "gpx", undef);
# print " wpt $rteWptNr: $rteHash{$rteNr}{$rteWptNr}{'lon'} $rteHash{$rteNr}{$rteWptNr}{'lat'}\n" ; }
foreach my $trkNr(sort{$a <=> $b}keys %trkHash){ # print "TRK $trkNr\n";
my %seg;
%seg = %{$trkHash{$trkNr}};
my $svgString = "fill=\"$color\" stroke=\"none\" " ; foreach my $segNr(sort{$a <=> $b}keys %seg){ # print " SEG $segNr\n";
my $lon = $rteHash{$rteNr}{$rteWptNr}{'lon'} ; my %points;
my $lat = $rteHash{$rteNr}{$rteWptNr}{'lat'} ; %points = %{$seg{$segNr}};
drawCircle ($lon, $lat, 1, 2*$size, 0, $svgString, 'gpx') ; foreach my $ptNr(sort{$a <=> $b}keys %points){ # print " trkpt $ptNr: $points{$ptNr}{'lon'}$points{$ptNr}{'lat'}\n";
my ($x, $y) = convert ($lon, $lat) ;
push @coords, $x, $y ;
}
my $svgString = "" ;
my $lc = "round" ;
my $lj = "round" ;
$svgString = "stroke=\"$color\" stroke-width=\"$size\" stroke-linecap=\"$lc\" fill=\"none\" stroke-linejoin=\"$lj\" " ;
drawWay (\@coords, 0, $svgString, "gpx", undef) ;
}
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" ;
my %points ;
%points = %{ $seg{$segNr}} ;
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') ;
}
}
}
my $svgString = "fill=\"$color\" stroke=\"none\" ";
my $lon = $points{$ptNr}{'lon'};
my $lat = $points{$ptNr}{'lat'};
drawCircle($lon, $lat, 1, $size, 0, $svgString, 'gpx');
} }}
} }
1;
1 ;

164
mwInteractive.pl
View File

@ -1,127 +1,111 @@
use strict ; use strict;
use warnings ; use warnings;
# mwInteractive.pl # mwInteractive.pl
my $sStyle = "mwStandardRules.txt" ; my $sStyle = "mwStandardRules.txt";
my $tStyle = "mwTopoRules.txt" ; my $tStyle = "mwTopoRules.txt";
my $place = "" ; my $place = "";
my $near = "" ; my $near = "";
my $dist = 50000 ; my $dist = 50000;
my $lonrad = 2 ; my $lonrad = 2;
my $latrad = 2 ; my $latrad = 2;
my $scaleset = 10000 ; my $scaleset = 10000;
my $png = 0 ; my $png = 0;
my $pdf = 1 ; my $pdf = 1;
my $outName = "" ; my $outName = "";
my $style = "" ; my $style = "";
print "Mapweaver interactive\n\n" ; print "Mapweaver interactive\n\n";
while ($place eq "") { while($place eq ""){ print "Please enter exact place name:\n";
print "Please enter exact place name:\n" ; $place = <STDIN>;
$place = <STDIN> ; print "\n";
print "\n" ; chomp $place;
chomp $place ;
} }
# ---
print "Please enter exact place name of bigger city i.e. in vicinity:\n";
$near = <STDIN>;
print "\n";
chomp $near;
# --- # ---
print "Please enter exact place name of bigger city i.e. in vicinity:\n" ; print "Please enter radius in m for vicinity search(defaults to 50.000):\n";
$near = <STDIN> ; $dist = <STDIN>;
print "\n" ; print "\n";
chomp $near ; chomp $dist;
if($dist eq ""){$dist = 50000;}
# --- # ---
print "Please enter radius in m for vicinity search (defaults to 50.000):\n" ; print "Please enter radius in km for latitude(defaults to 2km):\n";
$dist = <STDIN> ; $latrad = <STDIN>;
print "\n" ; print "\n";
chomp $dist ; chomp $latrad;
if($latrad eq ""){$latrad=2;}
if ($dist eq "") { $dist = 50000 ; }
# --- # ---
print "Please enter radius in km for latitude (defaults to 2km):\n" ; print "Please enter radius in km for longitude(defaults to 2km):\n";
$latrad = <STDIN> ; $lonrad = <STDIN>;
print "\n" ; print "\n";
chomp $latrad ; chomp $lonrad;
if ($latrad eq "") { $latrad=2 ; } if($lonrad eq ""){$lonrad=2;}
# --- # ---
print "Please enter radius in km for longitude (defaults to 2km):\n" ; print "Please enter scale of map(i.e. 10000 for 1:10.000):\n";
$lonrad = <STDIN> ; $scaleset = <STDIN>;
print "\n" ; print "\n";
chomp $lonrad ; chomp $scaleset;
if ($lonrad eq "") { $lonrad=2 ; } if($scaleset eq ""){$scaleset = 10000;}
# --- # ---
print "Please enter scale of map (i.e. 10000 for 1:10.000):\n" ; print "Output map in PDF format yes/no(defaults to yes):\n";
$scaleset = <STDIN> ; $pdf = <STDIN>;
print "\n" ; print "\n";
chomp $scaleset ; chomp $pdf;
if ($scaleset eq "") { $scaleset = 10000 ; } if(($pdf eq "")or(lc $pdf eq "yes")){$pdf = 1;}
# --- # ---
print "Output map in PDF format yes/no (defaults to yes):\n" ; print "Output map in PNG format yes/no(defaults to no):\n";
$pdf = <STDIN> ; $png = <STDIN>;
print "\n" ; print "\n";
chomp $pdf ; chomp $png;
if (($pdf eq "") or (lc $pdf eq "yes")) { $pdf = 1 ; } if(($png eq "")or(lc $png eq "no")){$png = 0;}if(lc $png eq "yes"){$png = 1;}
# --- # ---
print "Output map in PNG format yes/no (defaults to no):\n" ; $outName = $place . ".svg";
$png = <STDIN> ;
print "\n" ;
chomp $png ;
if (($png eq "") or (lc $png eq "no")) { $png = 0 ; }
if (lc $png eq "yes") { $png = 1 ; }
print "Output name(defaults to $outName):\n";
$outName = <STDIN>;
print "\n";
chomp $outName;
if($outName eq ""){$outName = $place . ".svg";}if(! grep /\.svg$/, $outName){$outName .= ".svg";}
# --- # ---
$outName = $place . ".svg" ; print "Select map style from list:\n";
print "1 - standard rules(default)\n";
print "2 - topo rules\n";
$style = <STDIN>;
print "\n";
chomp $style;
print "Output name (defaults to $outName):\n" ; if($style eq "2"){$style = "mwTopoRules.txt";}else{$style = "mwStandardRules.txt";}
$outName = <STDIN> ;
print "\n" ;
chomp $outName ;
if ($outName eq "") { $outName = $place . ".svg" ; }
if (! grep /\.svg$/, $outName) { $outName .= ".svg" ; }
# ---
print "Select map style from list:\n" ;
print "1 - standard rules (default)\n" ;
print "2 - topo rules\n" ;
$style = <STDIN> ;
print "\n" ;
chomp $style ;
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 ";}
print "call mw.pl: $cmd\n";
my $cmd = "perl mw.pl -place=\"$place\" -overpass -style=\"$style\" -out=\"$outName\" -scaleset=$scaleset " ; `$cmd`;
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` ;

382
mwLabel.pm
View File

@ -4,10 +4,10 @@
# #
# #
# #
# Copyright (C) 2011, Gerhard Schwanz # 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 # This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3 of the License, or (at your option) any later version. # Free Software Foundation; either version 3 of the License, or(at your option)any later version.
# #
# This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or # This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
@ -16,313 +16,237 @@
# #
package mwLabel ; package mwLabel;
use strict ; use strict;
use warnings ; use warnings;
use mwConfig ; use mwConfig;
use mwMap ; use mwMap;
# use mwMisc ; # use mwMisc;
use mwOccupy ; use mwOccupy;
my $labelPathId = 0 ; my $labelPathId = 0;
my @lines = () ; my @lines =();
my $numIconsMoved = 0 ; my $numIconsMoved = 0;
my $numLabels = 0 ; my $numLabels = 0;
my $numIcons = 0 ; my $numIcons = 0;
my $numLabelsOmitted = 0 ; my $numLabelsOmitted = 0;
my $numLabelsMoved = 0 ; my $numLabelsMoved = 0;
my $numIconsOmitted = 0 ; my $numIconsOmitted = 0;
my %poiHash = () ; my %poiHash =();
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
require Exporter ; require Exporter;
@ISA = qw ( Exporter AutoLoader ) ; @ISA = qw(Exporter AutoLoader);
@EXPORT = qw ( @EXPORT = qw( placeLabelAndIcon
placeLabelAndIcon
addToPoiHash addToPoiHash
getPoiHash getPoiHash
) ; );
sub placeLabelAndIcon { sub placeLabelAndIcon{#
#
# intelligent icon and label placement alg. # intelligent icon and label placement alg.
# #
my ($lon, $lat, $offset, $thickness, $text, $svgText, $icon, $iconSizeX, $iconSizeY, $layer) = @_ ; 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" ; } 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 !
my ($x, $y) = mwMap::convert ($lon, $lat) ; # center ! if(! coordsOut($x, $y)){
$y = $y + $offset;
if ( ! coordsOut ($x, $y) ) { my($ref)= splitLabel($text);
my(@lines)= @$ref;
my $numLines = scalar @lines;
my $maxTextLenPix = 0;
my $orientation = "";
my $lineDist = cv('linedist');;
my $tries = 0;
my $allowIconMove = cv('allowiconmove');
$y = $y + $offset ; my($textSize)=($svgText =~ /font-size=\"(\d+)\"/);
if(! defined $textSize){die("ERROR: font size could not be determined from svg format string \"$svgText\"\n");}
my ($ref) = splitLabel ($text) ; foreach my $line(@lines){ my $len = length($line)* cv('ppc')/ 10 * $textSize; # in pixels
my (@lines) = @$ref ; if($len > $maxTextLenPix){$maxTextLenPix = $len;} } my $spaceTextX = $maxTextLenPix;
my $numLines = scalar @lines ; my $spaceTextY = $numLines *($lineDist+$textSize);
my $maxTextLenPix = 0 ;
my $orientation = "" ;
my $lineDist = cv ('linedist') ; ;
my $tries = 0 ;
my $allowIconMove = cv ('allowiconmove') ;
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 ;
my $spaceTextY = $numLines * ($lineDist+$textSize) ;
if ($icon ne "none") { if($icon ne "none"){ $numIcons++;
$numIcons++ ;
# space for icon? # space for icon?
my $sizeX1 = $iconSizeX ; if ($sizeX1 == 0) { $sizeX1 = 20 ; } 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 $sizeY1 = $iconSizeY ; if ($sizeY1 == 0) { $sizeY1 = 20 ; } my $iconY = $y - $sizeY1/2;
my $iconX = $x - $sizeX1/2 ; # top left corner
my $iconY = $y - $sizeY1/2 ;
my @shifts = (0) ; my @shifts =(0);
if ($allowIconMove eq "1") { if($allowIconMove eq "1"){ @shifts =(0, -15, 15);
@shifts = ( 0, -15, 15 ) ; } my $posFound = 0; my $posCount = 0;
} my($iconAreaX1, $iconAreaY1, $iconAreaX2, $iconAreaY2);
my $posFound = 0 ; my $posCount = 0 ; LABAB: foreach my $xShift(@shifts){ foreach my $yShift(@shifts){ $posCount++;
my ($iconAreaX1, $iconAreaY1, $iconAreaX2, $iconAreaY2) ; 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) { $iconAreaX1 = $iconX+$xShift;
foreach my $yShift (@shifts) { $iconAreaY1 = $iconY+$sizeY1+$yShift;
$posCount++ ; $iconAreaX2 = $iconX+$sizeX1+$xShift;
if ( ( ! boxAreaOccupied ($iconX+$xShift, $iconY+$sizeY1+$yShift, $iconX+$sizeX1+$xShift, $iconY+$yShift) ) or ( cv('forcenodes') eq "1" ) ) { $iconAreaY2 = $iconY+$yShift;
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
$iconY = $iconY + $yShift ;
last LABAB ;
}
}
}
if ($posFound == 1) {
$posFound = 1;
if($posCount > 1){$numIconsMoved++;} $iconX = $iconX + $xShift; # for later use with label
$iconY = $iconY + $yShift;
last LABAB;
} } } if($posFound == 1){
# label text? # label text?
if ($text ne "") { if($text ne ""){ $numLabels++;
$numLabels++ ;
$sizeX1 += 1 ; $sizeY1 += 1 ; $sizeX1 += 1; $sizeY1 += 1;
my ($x1, $x2, $y1, $y2) ; my($x1, $x2, $y1, $y2);
# $x, $y centered # $x, $y centered
# yes, check if space for label, choose position, draw # yes, check if space for label, choose position, draw
# no, count omitted text # no, count omitted text
my @positions = () ; my $positionFound = 0 ; my @positions =(); my $positionFound = 0;
# pos 1 centered below # pos 1 centered below
$x1 = $x - $spaceTextX/2 ; $x2 = $x + $spaceTextX/2 ; $y1 = $y + $sizeY1/2 + $spaceTextY ; $y2 = $y + $sizeY1/2 ; $orientation = "centered" ; $x1 = $x - $spaceTextX/2; $x2 = $x + $spaceTextX/2; $y1 = $y + $sizeY1/2 + $spaceTextY; $y2 = $y + $sizeY1/2; $orientation = "centered";
push @positions, [$x1, $x2, $y1, $y2, $orientation] ; push @positions, [$x1, $x2, $y1, $y2, $orientation];
# pos 2/3 to the right, bottom, top # pos 2/3 to the right, bottom, top
$x1 = $x + $sizeX1/2 ; $x2 = $x + $sizeX1/2 + $spaceTextX ; $y1 = $y + $sizeY1/2 ; $y2 = $y1 - $spaceTextY ; $orientation = "left" ; $x1 = $x + $sizeX1/2; $x2 = $x + $sizeX1/2 + $spaceTextX; $y1 = $y + $sizeY1/2; $y2 = $y1 - $spaceTextY; $orientation = "left";
push @positions, [$x1, $x2, $y1, $y2, $orientation] ; push @positions, [$x1, $x2, $y1, $y2, $orientation];
$x1 = $x + $sizeX1/2 ; $x2 = $x + $sizeX1/2 + $spaceTextX ; $y2 = $y - $sizeY1/2 ; $y1 = $y2 + $spaceTextY ; $orientation = "left" ; $x1 = $x + $sizeX1/2; $x2 = $x + $sizeX1/2 + $spaceTextX; $y2 = $y - $sizeY1/2; $y1 = $y2 + $spaceTextY; $orientation = "left";
push @positions, [$x1, $x2, $y1, $y2, $orientation] ; push @positions, [$x1, $x2, $y1, $y2, $orientation];
# pos 4 centered upon # pos 4 centered upon
$x1 = $x - $spaceTextX/2 ; $x2 = $x + $spaceTextX/2 ; $y1 = $y - $sizeY1/2 ; $y2 = $y - $sizeY1/2 - $spaceTextY ; $orientation = "centered" ; $x1 = $x - $spaceTextX/2; $x2 = $x + $spaceTextX/2; $y1 = $y - $sizeY1/2; $y2 = $y - $sizeY1/2 - $spaceTextY; $orientation = "centered";
push @positions, [$x1, $x2, $y1, $y2, $orientation] ; push @positions, [$x1, $x2, $y1, $y2, $orientation];
# pos 5/6 to the right, below and upon # pos 5/6 to the right, below and upon
$x1 = $x + $sizeX1/2 ; $x2 = $x + $sizeX1/2 + $spaceTextX ; $y2 = $y + $sizeY1/2 ; $y1 = $y2 + $spaceTextY ; $orientation = "left" ; $x1 = $x + $sizeX1/2; $x2 = $x + $sizeX1/2 + $spaceTextX; $y2 = $y + $sizeY1/2; $y1 = $y2 + $spaceTextY; $orientation = "left";
push @positions, [$x1, $x2, $y1, $y2, $orientation] ; push @positions, [$x1, $x2, $y1, $y2, $orientation];
$x1 = $x + $sizeX1/2 ; $x2 = $x + $sizeX1/2 + $spaceTextX ; $y1 = $y - $sizeY1/2 ; $y2 = $y1 - $spaceTextY ; $orientation = "left" ; $x1 = $x + $sizeX1/2; $x2 = $x + $sizeX1/2 + $spaceTextX; $y1 = $y - $sizeY1/2; $y2 = $y1 - $spaceTextY; $orientation = "left";
push @positions, [$x1, $x2, $y1, $y2, $orientation] ; push @positions, [$x1, $x2, $y1, $y2, $orientation];
# left normal, bottom, top # left normal, bottom, top
$x1 = $x - $sizeX1/2 - $spaceTextX ; $x2 = $x - $sizeX1/2 ; $y1 = $y + $sizeY1/2 ; $y2 = $y1 - $spaceTextY ; $orientation = "right" ; $x1 = $x - $sizeX1/2 - $spaceTextX; $x2 = $x - $sizeX1/2; $y1 = $y + $sizeY1/2; $y2 = $y1 - $spaceTextY; $orientation = "right";
push @positions, [$x1, $x2, $y1, $y2, $orientation] ; push @positions, [$x1, $x2, $y1, $y2, $orientation];
$x1 = $x - $sizeX1/2 - $spaceTextX ; $x2 = $x - $sizeX1/2 ; $y2 = $y - $sizeY1/2 ; $y1 = $y2 + $spaceTextY ; $orientation = "right" ; $x1 = $x - $sizeX1/2 - $spaceTextX; $x2 = $x - $sizeX1/2; $y2 = $y - $sizeY1/2; $y1 = $y2 + $spaceTextY; $orientation = "right";
push @positions, [$x1, $x2, $y1, $y2, $orientation] ; push @positions, [$x1, $x2, $y1, $y2, $orientation];
# left corners, bottom, top # left corners, bottom, top
$x1 = $x - $sizeX1/2 - $spaceTextX ; $x2 = $x - $sizeX1/2 ; $y2 = $y + $sizeY1/2 ; $y1 = $y2 + $spaceTextY ; $orientation = "right" ; $x1 = $x - $sizeX1/2 - $spaceTextX; $x2 = $x - $sizeX1/2; $y2 = $y + $sizeY1/2; $y1 = $y2 + $spaceTextY; $orientation = "right";
push @positions, [$x1, $x2, $y1, $y2, $orientation] ; push @positions, [$x1, $x2, $y1, $y2, $orientation];
$x1 = $x - $sizeX1/2 - $spaceTextX ; $x2 = $x - $sizeX1/2 ; $y1 = $y - $sizeY1/2 ; $y2 = $y1 - $spaceTextY ; $orientation = "right" ; $x1 = $x - $sizeX1/2 - $spaceTextX; $x2 = $x - $sizeX1/2; $y1 = $y - $sizeY1/2; $y2 = $y1 - $spaceTextY; $orientation = "right";
push @positions, [$x1, $x2, $y1, $y2, $orientation] ; push @positions, [$x1, $x2, $y1, $y2, $orientation];
$tries = 0 ; $tries = 0;
LABB: foreach my $pos (@positions) { LABB: foreach my $pos(@positions){ $tries++;
$tries++ ;
$positionFound = checkAndDrawText ($pos->[0], $pos->[1], $pos->[2], $pos->[3], $pos->[4], \@lines, $svgText, $layer) ; $positionFound = checkAndDrawText($pos->[0], $pos->[1], $pos->[2], $pos->[3], $pos->[4], \@lines, $svgText, $layer);
if ($positionFound == 1) { if($positionFound == 1){ last LABB;
last LABB ; } } if($positionFound == 0){$numLabelsOmitted++;} if($tries > 1){$numLabelsMoved++;} }# label
}
}
if ($positionFound == 0) { $numLabelsOmitted++ ; }
if ($tries > 1) { $numLabelsMoved++ ; }
} # label
boxOccupyArea ($iconAreaX1, $iconAreaY1, $iconAreaX2, $iconAreaY2, 0, 2) ; boxOccupyArea($iconAreaX1, $iconAreaY1, $iconAreaX2, $iconAreaY2, 0, 2);
} # pos found }# pos found
else { else{ # no, count omitted
# no, count omitted $numIconsOmitted++;
$numIconsOmitted++ ; } } else{# only text
} my($x1, $x2, $y1, $y2);
}
else { # only text
my ($x1, $x2, $y1, $y2) ;
# x1, x2, y1, y2 # x1, x2, y1, y2
# left, right, bottom, top # left, right, bottom, top
# choose space for text, draw # choose space for text, draw
# count omitted # count omitted
$numLabels++ ; $numLabels++;
my @positions = () ; my @positions =();
$x1 = $x + $thickness ; $x2 = $x + $thickness + $spaceTextX ; $y1 = $y ; $y2 = $y - $spaceTextY ; $orientation = "left" ; $x1 = $x + $thickness; $x2 = $x + $thickness + $spaceTextX; $y1 = $y; $y2 = $y - $spaceTextY; $orientation = "left";
push @positions, [$x1, $x2, $y1, $y2, $orientation] ; push @positions, [$x1, $x2, $y1, $y2, $orientation];
$x1 = $x + $thickness ; $x2 = $x + $thickness + $spaceTextX ; $y1 = $y + $spaceTextY ; $y2 = $y ; $orientation = "left" ; $x1 = $x + $thickness; $x2 = $x + $thickness + $spaceTextX; $y1 = $y + $spaceTextY; $y2 = $y; $orientation = "left";
push @positions, [$x1, $x2, $y1, $y2, $orientation] ; push @positions, [$x1, $x2, $y1, $y2, $orientation];
$x1 = $x - ($thickness + $spaceTextX) ; $x2 = $x - $thickness ; $y1 = $y ; $y2 = $y - $spaceTextY ; $orientation = "right" ; $x1 = $x -($thickness + $spaceTextX); $x2 = $x - $thickness; $y1 = $y; $y2 = $y - $spaceTextY; $orientation = "right";
push @positions, [$x1, $x2, $y1, $y2, $orientation] ; push @positions, [$x1, $x2, $y1, $y2, $orientation];
$x1 = $x - ($thickness + $spaceTextX) ; $x2 = $x - $thickness ; $y1 = $y ; $y2 = $y - $spaceTextY ; $orientation = "right" ; $x1 = $x -($thickness + $spaceTextX); $x2 = $x - $thickness; $y1 = $y; $y2 = $y - $spaceTextY; $orientation = "right";
push @positions, [$x1, $x2, $y1, $y2, $orientation] ; push @positions, [$x1, $x2, $y1, $y2, $orientation];
$x1 = $x - $spaceTextX/2 ; $x2 = $x + $spaceTextX/2 ; $y1 = $y - $thickness ; $y2 = $y - ($thickness + $spaceTextY) ; $orientation = "centered" ; $x1 = $x - $spaceTextX/2; $x2 = $x + $spaceTextX/2; $y1 = $y - $thickness; $y2 = $y -($thickness + $spaceTextY); $orientation = "centered";
push @positions, [$x1, $x2, $y1, $y2, $orientation] ; push @positions, [$x1, $x2, $y1, $y2, $orientation];
$x1 = $x - $spaceTextX/2 ; $x2 = $x + $spaceTextX/2 ; $y1 = $y + $thickness + $spaceTextY ; $y2 = $y + $thickness ; $orientation = "centered" ; $x1 = $x - $spaceTextX/2; $x2 = $x + $spaceTextX/2; $y1 = $y + $thickness + $spaceTextY; $y2 = $y + $thickness; $orientation = "centered";
push @positions, [$x1, $x2, $y1, $y2, $orientation] ; push @positions, [$x1, $x2, $y1, $y2, $orientation];
my $positionFound = 0 ; my $positionFound = 0;
$tries = 0 ; $tries = 0;
LABA: foreach my $pos (@positions) { LABA: foreach my $pos(@positions){ $tries++;
$tries++ ; # print "$lines[0] $pos->[0], $pos->[1], $pos->[2], $pos->[3], $pos->[4], $numLines\n";
# 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) ; $positionFound = checkAndDrawText($pos->[0], $pos->[1], $pos->[2], $pos->[3], $pos->[4], \@lines, $svgText, $layer);
if ($positionFound == 1) { if($positionFound == 1){ last LABA;
last LABA ; } } if($positionFound == 0){$numLabelsOmitted++;} if($tries > 1){$numLabelsMoved++;} }}}
}
}
if ($positionFound == 0) { $numLabelsOmitted++ ; }
if ($tries > 1) { $numLabelsMoved++ ; }
}
}
}
sub checkAndDrawText{#
sub checkAndDrawText {
#
# checks if area available and if so draws text # checks if area available and if so draws text
# #
my ($x1, $x2, $y1, $y2, $orientation, $refLines, $svgText, $layer) = @_ ; 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" ; } if(cv('debug')eq "1"){print "CADT: $x1, $x2, $y1, $y2, $orientation, $refLines, $svgText, $layer\n";}
my @lines = @$refLines;
my @lines = @$refLines ; my $numLines = scalar @lines;
my $numLines = scalar @lines ; my $lineDist = cv('linedist');
my $lineDist = cv ('linedist') ;
my ($size) = ( $svgText =~ /font-size=\"(\d+)\"/ ) ;
if ( ! defined $size ) { die ("ERROR: font size could not be determined from svg format string \"$svgText\"\n") ; }
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! # WATCH for variable sequence!
if ( if((! boxAreaOccupied($x1, $y1, $x2, $y2))or
( ! boxAreaOccupied ($x1, $y1, $x2, $y2) ) or (cv('forcenodes')eq "1")){
( 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");
for (my $i=0; $i<=$#lines; $i++) { 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);
my @points = ($x1, $y2+($i+1)*($size+$lineDist), $x2, $y2+($i+1)*($size+$lineDist)) ; return(1);
my $pathName = "LabelPath" . $labelPathId ; } else{ return 0;
$labelPathId++ ; }}
createPath ($pathName, \@points, "definitions") ; sub splitLabel{#
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 {
#
# split label text at space locations and then merge new parts if new part will be smaller than XX chars # split label text at space locations and then merge new parts if new part will be smaller than XX chars
# #
my $text = shift ; my $text = shift;
my @lines = split / /, $text ; my @lines = split / /, $text;
my $merged = 1 ; my $merged = 1;
while ($merged) { while($merged){ $merged = 0;
$merged = 0 ; LAB2: for(my $i=0; $i<$#lines; $i++){ if(length($lines[$i] . " " . $lines[$i+1])<= cv('maxcharperline')){
LAB2: for (my $i=0; $i<$#lines; $i++) { $lines[$i] = $lines[$i] . " " . $lines[$i+1];
if (length ($lines[$i] . " " . $lines[$i+1]) <= cv ('maxcharperline') ) { splice(@lines, $i+1, 1);
$lines[$i] = $lines[$i] . " " . $lines[$i+1] ; $merged = 1;
splice (@lines, $i+1, 1) ; last LAB2;
$merged = 1 ; } }} return(\@lines);
last LAB2 ;
}
}
}
return (\@lines) ;
} }
# ------------------------------------------------------------ # ------------------------------------------------------------
sub addToPoiHash { sub addToPoiHash{ my($name, $sq)= @_;
my ($name, $sq) = @_ ; if(defined $sq){ $poiHash{$name}{$sq}= 1;
if (defined $sq) { } else{ $poiHash{$name}= 1;
$poiHash{$name}{$sq} = 1 ; }}
}
else { sub getPoiHash{ return \%poiHash;
$poiHash{$name} = 1 ;
}
} }
1;
sub getPoiHash {
return \%poiHash ;
}
1 ;

1551
mwMap.pm
View File

File diff suppressed because it is too large Load Diff

1024
mwMisc.pm
View File

File diff suppressed because it is too large Load Diff

534
mwMulti.pm
View File

@ -4,10 +4,10 @@
# #
# #
# #
# Copyright (C) 2011, Gerhard Schwanz # 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 # This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3 of the License, or (at your option) any later version. # Free Software Foundation; either version 3 of the License, or(at your option)any later version.
# #
# This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or # This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
@ -16,405 +16,273 @@
# #
package mwMulti ; package mwMulti;
use strict ; use strict;
use warnings ; use warnings;
use mwMap ; use mwMap;
use mwMisc ; use mwMisc;
use mwFile ; use mwFile;
use mwLabel ; use mwLabel;
use mwConfig ; use mwConfig;
use mwRules ; use mwRules;
use Math::Polygon ; use Math::Polygon;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
require Exporter ; require Exporter;
@ISA = qw ( Exporter AutoLoader ) ; @ISA = qw(Exporter AutoLoader);
@EXPORT = qw ( processMultipolygons @EXPORT = qw(processMultipolygons
) ; );
my $newId = 0 ; my $newId = 0;
my %multiNodes = () ; my %multiNodes =();
my %multiTags = () ; my %multiTags =();
my %multiPaths = () ; my %multiPaths =();
my %wayUsed = () ; my %wayUsed =();
# ------------------------------------------------------------------------- # -------------------------------------------------------------------------
sub processMultipolygons { sub processMultipolygons{ my $notDrawnMP = 0;
my $notDrawnMP = 0 ; my $mp = 0;
my $mp = 0 ; my $mpLabels = 0;
my $mpLabels = 0 ; my $mpNotDrawnLabels = 0;
my $mpNotDrawnLabels = 0 ; print "draw multipolygons...\n";
print "draw multipolygons...\n" ;
preprocessMultipolygons() ; preprocessMultipolygons();
foreach my $multiId (keys %multiTags) { foreach my $multiId(keys %multiTags){
my $ruleRef = getAreaRule(\@{$multiTags{$multiId}});
my $ruleRef = getAreaRule ( \@{$multiTags{$multiId}} ) ; if(defined $ruleRef){
my $svgText = "";
if (defined $ruleRef) { my $icon = "";
if($$ruleRef{'icon'}ne "none"){ $icon = $$ruleRef{'icon'};
my $svgText = "" ; } else{ my $col = $$ruleRef{'color'};
my $icon = "" ; $svgText = "fill=\"$col\" ";
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);
my $ref = $multiPaths{$multiId}[0] ; # first, outer way if($size >= cv('minareasize')){ drawArea($svgText, $icon, $multiPaths{$multiId}, 1, "multi");
my $size = areaSize ( $ref ) ; $mp++;
if ($size >= cv('minareasize') ) {
drawArea ($svgText, $icon, $multiPaths{$multiId}, 1, "multi") ;
$mp++ ;
# LABELS # LABELS
my $name = "" ; my $ref1 ; my $name = ""; my $ref1;
if ( cv('ignorelabels') eq "0" ) { if(cv('ignorelabels')eq "0"){ ($name, $ref1)= createLabel($multiTags{$multiId}, $$ruleRef{'label'}, 0, 0);
($name, $ref1) = createLabel ( $multiTags{$multiId}, $$ruleRef{'label'}, 0, 0) ;
if ( ( $$ruleRef{'label'} ne "none") and if(($$ruleRef{'label'}ne "none")and
( cv('nolabel') eq "1" ) and (cv('nolabel')eq "1")and
($name eq "") ) ($name eq "")) {
{ $name = "NO LABEL";
$name = "NO LABEL" ; } }
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]);
my $labelFont = $$ruleRef{'labelfont'};
my $labelFontFamily = $$ruleRef{'labelfontfamily'};
my $labelSize = $$ruleRef{'labelsize'};
my $color = $$ruleRef{'labelcolor'};
my $labelBold = $$ruleRef{'labelbold'};
my $labelItalic = $$ruleRef{'labelitalic'};
my $labelHalo = $$ruleRef{'labelhalo'};
my $labelHaloColor = $$ruleRef{'labelhalocolor'};
my $svgText = createTextSVG($labelFontFamily, $labelFont, $labelBold, $labelItalic, $labelSize, $color, $labelHalo, $labelHaloColor);
# $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 size
else{ $mpNotDrawnLabels++;
} } else{
} } else{ $notDrawnMP++;
} }
} }# if rule
}# foreach multi
if ($name ne "") { print "$mp multipolygon areas drawn, $notDrawnMP not drawn because they were too small.\n";
if ($size >= cv('minarealabelsize') ) { print "$mpLabels multipolygon labels drawn, $mpNotDrawnLabels not drawn because belonging areas were too small.\n";
$mpLabels++ ;
if (cv('debug') eq "1") { print "MP LABEL: $name, size: $$ruleRef{'labelsize'}, color: $$ruleRef{'labelcolor'}\n" ; }
my ($x, $y) = areaCenter ( $multiPaths{$multiId}[0] ) ;
my $labelFont = $$ruleRef{'labelfont'} ;
my $labelFontFamily = $$ruleRef{'labelfontfamily'} ;
my $labelSize = $$ruleRef{'labelsize'} ;
my $color = $$ruleRef{'labelcolor'} ;
my $labelBold = $$ruleRef{'labelbold'} ;
my $labelItalic = $$ruleRef{'labelitalic'} ;
my $labelHalo = $$ruleRef{'labelhalo'} ;
my $labelHaloColor = $$ruleRef{'labelhalocolor'} ;
my $svgText = createTextSVG ( $labelFontFamily, $labelFont, $labelBold, $labelItalic, $labelSize, $color, $labelHalo, $labelHaloColor) ;
# $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 size
else {
$mpNotDrawnLabels++ ;
}
}
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 # preprecess all multipolygons
# #
my ($wayNodesRef, $wayTagsRef) = getWayPointers() ; my($wayNodesRef, $wayTagsRef)= getWayPointers();
my ($relationMembersRef, $relationTagsRef) = getRelationPointers() ; 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 # get inner and outer ways
my (@innerWays) = () ; my (@outerWays) = () ; my(@innerWays)=(); my(@outerWays)=();
foreach my $member ( @{$$relationMembersRef{$relId}} ) { 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";}
if ( ($member->[0] eq "way") and ($member->[2] eq "outer") and (defined @{$$wayNodesRef{$member->[1]}} ) ) { push @outerWays, $member->[1] ; } my($ringsWaysRef, $ringsNodesRef);
if ( ($member->[0] eq "way") and ($member->[2] eq "inner") and (defined @{$$wayNodesRef{$member->[1]}} )) { push @innerWays, $member->[1] ; } my @ringWaysInner =(); my @ringNodesInner =(); my @ringTagsInner =();
}
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 # build rings inner
if (scalar @innerWays > 0) { if(scalar @innerWays > 0){ ($ringsWaysRef, $ringsNodesRef)= buildRings(\@innerWays, 1);
($ringsWaysRef, $ringsNodesRef) = buildRings (\@innerWays, 1) ; @ringWaysInner = @$ringsWaysRef;
@ringWaysInner = @$ringsWaysRef ; @ringNodesInner = @$ringsNodesRef;
@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(scalar @{$ringWaysInner[$ring]}== 1){$wayUsed{$firstWay}= 1;}# way will be marked as used/drawn by multipolygon
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"] ;
}
}
}
@{$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"];
} } }
# build rings outer # build rings outer
my @ringWaysOuter = () ; my @ringNodesOuter = () ; my @ringTagsOuter = () ; my @ringWaysOuter =(); my @ringNodesOuter =(); my @ringTagsOuter =();
if (scalar @outerWays > 0) { if(scalar @outerWays > 0){ ($ringsWaysRef, $ringsNodesRef)= buildRings(\@outerWays, 1);
($ringsWaysRef, $ringsNodesRef) = buildRings (\@outerWays, 1) ; @ringWaysOuter = @$ringsWaysRef; # not necessary for outer
@ringWaysOuter = @$ringsWaysRef ; # not necessary for outer @ringNodesOuter = @$ringsNodesRef;
@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];
for (my $ring=0; $ring<=$#ringWaysOuter; $ring++) { if(scalar @{$ringWaysOuter[$ring]}== 1){$wayUsed{$firstWay}= 1;} @{$ringTagsOuter[$ring]}= @{$$relationTagsRef{$relId}}; # tags from relation
if (cv('debug') eq "1") { print "OUTER RING $ring: @{$ringWaysOuter[$ring]}\n" ; } if(cv('debug')eq "1"){ print "tags from relation...\n";
my $firstWay = $ringWaysOuter[$ring]->[0] ; foreach my $tag(@{$$relationTagsRef{$relId}}){ print " $tag->[0] - $tag->[1]\n";
if (scalar @{$ringWaysOuter[$ring]} == 1) {$wayUsed{$firstWay} = 1 ; } } } if(scalar @{$$relationTagsRef{$relId}}== 1){ @{$ringTagsOuter[$ring]}= @{$$wayTagsRef{$firstWay}}; # ring will be tagged like first way
@{$ringTagsOuter[$ring]} = @{$$relationTagsRef{$relId}} ; # tags from relation } } }# outer
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 @ringNodesTotal =(@ringNodesInner, @ringNodesOuter);
my @ringWaysTotal = (@ringWaysInner, @ringWaysOuter) ; my @ringWaysTotal =(@ringWaysInner, @ringWaysOuter);
my @ringTagsTotal = (@ringTagsInner, @ringTagsOuter) ; my @ringTagsTotal =(@ringTagsInner, @ringTagsOuter);
processRings (\@ringNodesTotal, \@ringWaysTotal, \@ringTagsTotal) ; processRings(\@ringNodesTotal, \@ringWaysTotal, \@ringTagsTotal);
} # multi }# multi
} # relIds }# relIds
} }
# ----------------------------------------------------------------------------------------- # -----------------------------------------------------------------------------------------
sub processRings { sub processRings{#
#
# process rings of multipolygons and create path data for svg # process rings of multipolygons and create path data for svg
# #
my ($ref1, $ref2, $ref3) = @_ ; my($ref1, $ref2, $ref3)= @_;
my @ringNodes = @$ref1 ; my @ringNodes = @$ref1;
my @ringWays = @$ref2 ; my @ringWays = @$ref2;
my @ringTags = @$ref3 ; my @ringTags = @$ref3;
my @polygon = () ; my @polygon =();
my @polygonSize = () ; my @polygonSize =();
my @ringIsIn = () ; my @ringIsIn =();
my @stack = () ; # all created stacks my @stack =(); # all created stacks
my %selectedStacks = () ; # stacks selected for processing my %selectedStacks =(); # stacks selected for processing
my $actualLayer = 0 ; # for new tags my $actualLayer = 0; # for new tags
# rings referenced by array index # rings referenced by array index
my ($lonRef, $latRef) = getNodePointers() ; my($lonRef, $latRef)= getNodePointers();
my ($wayNodesRef, $wayTagsRef) = getWayPointers() ; my($wayNodesRef, $wayTagsRef)= getWayPointers();
# create polygons # create polygons
if (cv('debug') eq "1") { print "CREATING POLYGONS\n" ; } if(cv('debug')eq "1"){print "CREATING POLYGONS\n";} for(my $ring = 0; $ring <= $#ringWays; $ring++){ my @poly =();
for (my $ring = 0 ; $ring <= $#ringWays; $ring++) { foreach my $node(@{$ringNodes[$ring]}){ push @poly, [$$lonRef{$node}, $$latRef{$node}];
my @poly = () ; } my($p)= Math::Polygon->new(@poly);
foreach my $node ( @{$ringNodes[$ring]} ) { $polygon[$ring] = $p;
push @poly, [$$lonRef{$node}, $$latRef{$node}] ; $polygonSize[$ring] = $p->area;
} if(cv('debug')eq "1"){
my ($p) = Math::Polygon->new(@poly) ; print " POLYGON $ring - created, size = $polygonSize[$ring] \n";
$polygon[$ring] = $p ; foreach my $tag(@{$ringTags[$ring]}){ print " $tag->[0] - $tag->[1]\n";
$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" ;
}
}
}
# 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 ($res == 1) {
push @{$ringIsIn[$ring1]}, $ring2 ;
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 "IS IN LIST\n" ;
for (my $ring1=0 ; $ring1<=$#ringNodes; $ring1++) {
if (defined @{$ringIsIn[$ring1]}) {
print " ring $ring1 isIn - @{$ringIsIn[$ring1]}\n" ;
}
}
print "\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($res == 1){
push @{$ringIsIn[$ring1]}, $ring2;
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 "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 # sort is_in list, biggest first
if (cv('debug') eq "1") { print "SORTING isIn\n" ; } if(cv('debug')eq "1"){print "SORTING isIn\n";} for(my $ring=0; $ring<=$#ringIsIn; $ring++){ my @isIn =();
for (my $ring=0 ; $ring<=$#ringIsIn; $ring++) { foreach my $ring2(@{$ringIsIn[$ring]}){ push @isIn, [$ring2, $polygonSize[$ring2]];
my @isIn = () ; } @isIn = sort{$a->[1] <=> $b->[1]}(@isIn); # sorted array
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) ;
push @{$stack[$ring]}, $ring ; # sorted descending and ring self appended
if (cv('debug') eq "1") { print " stack ring $ring sorted: @{$stack[$ring]}\n" ; }
}
my @isIn2 =(); # only ring numbers
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";}}
# find tops and select stacks # find tops and select stacks
if (cv('debug') eq "1") { print "SELECTING STACKS\n" ; } if(cv('debug')eq "1"){print "SELECTING STACKS\n";} my $actualStack = 0;
my $actualStack = 0 ; for(my $stackNumber=0; $stackNumber<=$#stack; $stackNumber++){ # look for top element
for (my $stackNumber=0 ; $stackNumber<=$#stack; $stackNumber++) { my $topElement = $stack[$stackNumber]->[(scalar @{$stack[$stackNumber]}- 1)];
# look for top element my $found = 0;
my $topElement = $stack[$stackNumber]->[(scalar @{$stack[$stackNumber]} - 1)] ; for(my $stackNumber2=0; $stackNumber2<=$#stack; $stackNumber2++){ if($stackNumber != $stackNumber2){ foreach my $ring(@{$stack[$stackNumber2]}){ if($ring == $topElement){
my $found = 0 ; $found = 1;
for (my $stackNumber2=0 ; $stackNumber2<=$#stack; $stackNumber2++) { if(cv('debug')eq "1"){print " element also found in stack $stackNumber2\n";} } } } }
if ($stackNumber != $stackNumber2) { if($found == 0){ @{$selectedStacks{$actualStack}}= @{$stack[$stackNumber]};
foreach my $ring (@{$stack[$stackNumber2]}) { $actualStack++;
if ($ring == $topElement) { if(cv('debug')eq "1"){print " stack $stackNumber has been selected.\n";} }
$found = 1 ; }
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" ; }
}
}
# process selected stacks # process selected stacks
if (cv('debug') eq "1") { print "PROCESS SELECTED STACKS\n" ; } if(cv('debug')eq "1"){print "PROCESS SELECTED STACKS\n";} # while stacks left
# while stacks left while(scalar(keys %selectedStacks)> 0){ my(@k)= keys %selectedStacks;
while (scalar (keys %selectedStacks) > 0) { if(cv('debug')eq "1"){print " stacks available: @k\n";} my @nodes =();
my (@k) = keys %selectedStacks ; my @nodesOld;
if (cv('debug') eq "1") { print " stacks available: @k\n" ; } my @processedStacks =();
my @nodes = () ;
my @nodesOld ;
my @processedStacks = () ;
# select one bottom element # select one bottom element
my $key = $k[0] ; # key of first stack my $key = $k[0]; # key of first stack
if (cv('debug') eq "1") { print " stack nr $key selected\n" ; } if(cv('debug')eq "1"){print " stack nr $key selected\n";} my $ringToDraw = $selectedStacks{$key}[0];
my $ringToDraw = $selectedStacks{$key}[0] ; if(cv('debug')eq "1"){print " ring to draw: $ringToDraw\n";}
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
push @nodesOld, @{$ringNodes[$ringToDraw]} ; # outer polygon
push @nodes, [@{$ringNodes[$ringToDraw]}] ; # outer polygon as array
# and remove ring from stacks; store processed stacks # and remove ring from stacks; store processed stacks
foreach my $k2 (keys %selectedStacks) { foreach my $k2(keys %selectedStacks){ if($selectedStacks{$k2}[0] == $ringToDraw){
if ($selectedStacks{$k2}[0] == $ringToDraw) { shift(@{$selectedStacks{$k2}});
shift (@{$selectedStacks{$k2}}) ; push @processedStacks, $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 stack in processed stacks
foreach my $k (@processedStacks) { foreach my $k(@processedStacks){ # if now bottom of a stack is hole, then add this polygon to points
# if now bottom of a stack is hole, then add this polygon to points if(defined $selectedStacks{$k}){ my $tempRing = $selectedStacks{$k}[0];
if (defined $selectedStacks{$k}) { my $temp = $ringTags[$tempRing]->[0]->[0];
my $tempRing = $selectedStacks{$k}[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]};
my $temp = $ringTags[$tempRing]->[0]->[0] ; push @nodes, [@{$ringNodes[$tempRing]}];
if (cv('debug') eq "1") { print " testing for hole: stack $k, ring $tempRing, tag $temp\n" ; } # print " nodes so far: @nodes\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 # and remove this element from stack
shift @{$selectedStacks{$k}} ; shift @{$selectedStacks{$k}};
if (scalar @{$selectedStacks{$k}} == 0) { delete $selectedStacks{$k} ; } if(scalar @{$selectedStacks{$k}}== 0){delete $selectedStacks{$k};} if(cv('debug')eq "1"){print " ring $tempRing identified as hole\n";} } } }
if (cv('debug') eq "1") { print " ring $tempRing identified as hole\n" ; }
}
}
}
# add way # add way
@{$multiNodes{$newId}} = @nodesOld ; @{$multiNodes{$newId}}= @nodesOld;
@{$multiTags{$newId}} = @{$ringTags[$ringToDraw]} ; @{$multiTags{$newId}}= @{$ringTags[$ringToDraw]};
@{$multiPaths{$newId}} = @nodes ; @{$multiPaths{$newId}}= @nodes;
push @{$$wayTagsRef{$newId}}, ["layer", $actualLayer] ; push @{$$wayTagsRef{$newId}}, ["layer", $actualLayer];
$actualLayer++ ; $actualLayer++;
if (cv('debug') eq "1") { if(cv('debug')eq "1"){
print " DRAWN: $ringToDraw, wayId $newId\n" ; print " DRAWN: $ringToDraw, wayId $newId\n";
foreach my $tag (@{$ringTags[$ringToDraw]}) { foreach my $tag(@{$ringTags[$ringToDraw]}){ print " k/v $tag->[0] - $tag->[1]\n";
print " k/v $tag->[0] - $tag->[1]\n" ; } }
} $newId++;
}
$newId++ ; }#(while)}
} # (while) 1;
}
1 ;

222
mwNodes.pm
View File

@ -4,10 +4,10 @@
# #
# #
# #
# Copyright (C) 2011, Gerhard Schwanz # 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 # This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3 of the License, or (at your option) any later version. # Free Software Foundation; either version 3 of the License, or(at your option)any later version.
# #
# This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or # This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
@ -16,172 +16,118 @@
# #
package mwNodes ; package mwNodes;
use strict ; use strict;
use warnings ; use warnings;
use OSM::osm 8.21 ; use OSM::osm 8.21;
use mwConfig ; use mwConfig;
use mwFile ; use mwFile;
use mwRules ; use mwRules;
use mwMap ; use mwMap;
use mwMisc ; use mwMisc;
use mwLabel ; use mwLabel;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
require Exporter ; require Exporter;
@ISA = qw ( Exporter AutoLoader ) ; @ISA = qw(Exporter AutoLoader);
@EXPORT = qw ( processNodes @EXPORT = qw(processNodes
createPoiDirectory createPoiDirectory
) ; );
sub processNodes { sub processNodes{
print "drawing nodes...\n";
print "drawing nodes...\n" ; my $lonRef; my $latRef; my $tagRef;
($lonRef, $latRef, $tagRef)= getNodePointers();
my $lonRef; my $latRef; my $tagRef ; foreach my $nodeId(keys %$lonRef){ my @tags = @{$$tagRef{$nodeId}};
($lonRef, $latRef, $tagRef) = getNodePointers () ; my $tagsString = "";
foreach my $nodeId (keys %$lonRef) {
my @tags = @{ $$tagRef{$nodeId} } ;
my $tagsString = "" ;
my $ruleRef = getNodeRule (\@tags) ;
if (defined $ruleRef) {
my $ruleRef = getNodeRule(\@tags);
if(defined $ruleRef){
# draw disc first ! # draw disc first !
if (grep /yes/, $$ruleRef{'disc'}) { if(grep /yes/, $$ruleRef{'disc'}){ my $svgString = "";
my $svgString = "" ; if($$ruleRef{'discsvgstring'}ne ""){ $svgString = $$ruleRef{'discsvgstring'};
if ( $$ruleRef{'discsvgstring'} ne "" ) { } else{ $svgString = "fill=\"$$ruleRef{'disccolor'}\" stroke=\"none\" fill-opacity=\"$$ruleRef{'discopacity'}\"";
$svgString = $$ruleRef{'discsvgstring'} ; } drawCircle($$lonRef{$nodeId}, $$latRef{$nodeId}, 1, $$ruleRef{'discradius'}, 1, $svgString, 'nodes');
} }
else { if(grep /yes/, $$ruleRef{'circle'}){ my $svgString = "";
$svgString = "fill=\"$$ruleRef{'disccolor'}\" stroke=\"none\" fill-opacity=\"$$ruleRef{'discopacity'}\"" ; 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($$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'};
my $labelFont = $$ruleRef{'labelfont'};
my $labelFontFamily = $$ruleRef{'labelfontfamily'};
my $labelBold = $$ruleRef{'labelbold'};
my $labelItalic = $$ruleRef{'labelitalic'};
my $labelHalo = $$ruleRef{'labelhalo'};
my $labelHaloColor = $$ruleRef{'labelhalocolor'};
my $icon = $$ruleRef{'icon'};
my $iconSize = $$ruleRef{'iconsize'};
if (grep /yes/, $$ruleRef{'circle'}) { my $svgText = createTextSVG($labelFontFamily, $labelFont, $labelBold, $labelItalic, $labelSize, $labelColor, $labelHalo, $labelHaloColor);
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") ) { placeLabelAndIcon($$lonRef{$nodeId}, $$latRef{$nodeId}, 0, $$ruleRef{'size'}, $labelText, $svgText, $icon, $iconSize, $iconSize, "nodes");
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}) ;
$labelText = labelTransform ($labelText, $$ruleRef{'labeltransform'}) ;
my $labelSize = $$ruleRef{'labelsize'} ;
my $labelColor = $$ruleRef{'labelcolor'} ;
my $labelFont = $$ruleRef{'labelfont'} ;
my $labelFontFamily = $$ruleRef{'labelfontfamily'} ;
my $labelBold = $$ruleRef{'labelbold'} ;
my $labelItalic = $$ruleRef{'labelitalic'} ;
my $labelHalo = $$ruleRef{'labelhalo'} ;
my $labelHaloColor = $$ruleRef{'labelhalocolor'} ;
my $icon = $$ruleRef{'icon'} ;
my $iconSize = $$ruleRef{'iconsize'} ;
my $svgText = createTextSVG ( $labelFontFamily, $labelFont, $labelBold, $labelItalic, $labelSize, $labelColor, $labelHalo, $labelHaloColor) ;
placeLabelAndIcon($$lonRef{$nodeId}, $$latRef{$nodeId}, 0, $$ruleRef{'size'}, $labelText, $svgText, $icon, $iconSize, $iconSize, "nodes") ;
}
# fill poi directory # fill poi directory
my $thing0 = $$ruleRef{'keyvalue'} ; my $thing0 = $$ruleRef{'keyvalue'};
my ($thing) = ( $thing0 =~ /.+=(.+)/ ) ; my($thing)=($thing0 =~ /.+=(.+)/);
my $dirName = getValue ("name", $$tagRef{$nodeId} ) ; my $dirName = getValue("name", $$tagRef{$nodeId});
if ( ( cv('poi') eq "1" ) and if((cv('poi')eq "1")and
( defined $dirName ) and (defined $dirName)and
( $$ruleRef{'direxclude'} eq "no") ($$ruleRef{'direxclude'}eq "no") ){ $dirName .= "($thing)";
) { if(cv('grid')> 0){ my $sq = gridSquare($$lonRef{$nodeId}, $$latRef{$nodeId}, cv('grid'));
$dirName .= " ($thing)" ; if(defined $sq){ addToPoiHash($dirName, $sq);
if ( cv('grid') > 0) { } } else{ # $poiHash{$dirName}= 1;
my $sq = gridSquare($$lonRef{$nodeId}, $$latRef{$nodeId}, cv('grid')) ; addToPoiHash($dirName, undef);
if (defined $sq) { } }
addToPoiHash ($dirName, $sq) ;
}
}
else {
# $poiHash{$dirName} = 1 ;
addToPoiHash ($dirName, undef) ;
}
}
} # defined ruleref
}
}# defined ruleref
}
} }
# ------------------------------------------------------------------------------------ # ------------------------------------------------------------------------------------
sub createPoiDirectory { sub createPoiDirectory{ my $poiName;
my $poiName ; my $poiFile;
my $poiFile ; $poiName = cv('out');
$poiName = cv ('out') ; $poiName =~ s/\.svg/\_pois.txt/;
$poiName =~ s/\.svg/\_pois.txt/ ; setConfigValue("poiname", $poiName);
setConfigValue("poiname", $poiName) ; print "creating poi file $poiName ...\n";
print "creating poi file $poiName ...\n" ; open($poiFile, ">", $poiName)or die("can't open poi file $poiName\n");
open ($poiFile, ">", $poiName) or die ("can't open poi file $poiName\n") ;
my $ref = getPoiHash() ; my $ref = getPoiHash();
my %poiHash = %$ref ; my %poiHash = %$ref;
if ( cv('grid') eq "0") { if(cv('grid')eq "0"){ foreach my $poi(sort keys %poiHash){ $poi = replaceHTMLCode($poi);
foreach my $poi (sort keys %poiHash) { print $poiFile "$poi\n";
$poi = replaceHTMLCode ( $poi ) ; }} else{ foreach my $poi(sort keys %poiHash){ $poi = replaceHTMLCode($poi);
print $poiFile "$poi\n" ; print $poiFile "$poi\t";
} foreach my $square(sort keys %{$poiHash{$poi}}){ print $poiFile "$square ";
} } print $poiFile "\n";
else { }} close($poiFile);
foreach my $poi (sort keys %poiHash) {
$poi = replaceHTMLCode ( $poi ) ;
print $poiFile "$poi\t" ;
foreach my $square (sort keys %{$poiHash{$poi}}) {
print $poiFile "$square " ;
}
print $poiFile "\n" ;
}
}
close ($poiFile) ;
} }
1;
1 ;

397
mwOccupy.pm
View File

@ -4,10 +4,10 @@
# #
# #
# #
# Copyright (C) 2011, Gerhard Schwanz # 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 # This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3 of the License, or (at your option) any later version. # Free Software Foundation; either version 3 of the License, or(at your option)any later version.
# #
# This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or # This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
@ -16,317 +16,238 @@
# #
package mwOccupy ; package mwOccupy;
use strict ; use strict;
use warnings ; use warnings;
use List::Util qw[min max] ; use List::Util qw[min max];
use mwMap ; use mwMap;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
require Exporter ; require Exporter;
@ISA = qw ( Exporter AutoLoader ) ; @ISA = qw(Exporter AutoLoader);
@EXPORT = qw ( boxOccupyLines @EXPORT = qw(boxOccupyLines
boxOccupyArea boxOccupyArea
boxLinesOccupied boxLinesOccupied
boxAreaOccupied boxAreaOccupied
boxDrawOccupiedAreas boxDrawOccupiedAreas
) ; );
my $boxSize = 5 ; my $boxSize = 5;
my %box = () ; my %box =();
# ------------------------------------------------------------- # -------------------------------------------------------------
sub boxOccupyLines { sub boxOccupyLines{ my($refCoords, $buffer, $value)= @_;
my ($refCoords, $buffer, $value) = @_ ; my @coordinates = @$refCoords;
my @coordinates = @$refCoords ; my @lines =();
my @lines = () ;
for ( my $i = 0; $i < $#coordinates-2; $i += 2 ) { for(my $i = 0; $i < $#coordinates-2; $i += 2){ push @lines, [$coordinates[$i], $coordinates[$i+1], $coordinates[$i+2], $coordinates[$i+3]];
push @lines, [$coordinates[$i], $coordinates[$i+1], $coordinates[$i+2], $coordinates[$i+3]] ; }
} foreach my $line(@lines){ my $x1 = $line->[0];
my $y1 = $line->[1];
foreach my $line ( @lines ) { my $x2 = $line->[2];
my $x1 = $line->[0] ; my $y2 = $line->[3];
my $y1 = $line->[1] ;
my $x2 = $line->[2] ;
my $y2 = $line->[3] ;
# print "$x1, $y1, $x2, $y2\n" ; # print "$x1, $y1, $x2, $y2\n";
if ( $x1 != $x2) { if($x1 != $x2){
my $m =($y2 - $y1)/($x2 - $x1);
my $m = ($y2 - $y1) / ($x2 - $x1) ; my $b = $y1 - $m * $x1;
my $b = $y1 - $m * $x1 ;
if ( abs ( $x1 - $x2 ) > abs ( $y1 - $y2 ) ) {
if(abs($x1 - $x2)> abs($y1 - $y2)){
# calc points on x axis # calc points on x axis
my $x = $x1 ; my $x = $x1;
my $stepX = $boxSize ; my $stepX = $boxSize;
if ( $x2 < $x1 ) { $stepX = - $boxSize ; } if($x2 < $x1){$stepX = - $boxSize;} while(($x >= min($x1, $x2))and($x <= max($x1, $x2))){
while ( ( $x >= min ($x1, $x2) ) and ( $x <= max ($x1, $x2) ) ) { my $y = $m * $x + $b;
my $y = $m * $x + $b ;
# ACTUAL COORDINATE $x, $y # ACTUAL COORDINATE $x, $y
my $ax1 = $x - $buffer ; my $ax1 = $x - $buffer;
my $ax2 = $x + $buffer ; my $ax2 = $x + $buffer;
my $ay1 = $y - $buffer ; my $ay1 = $y - $buffer;
my $ay2 = $y + $buffer ; my $ay2 = $y + $buffer;
boxOccupyArea ($ax1, $ay1, $ax2, $ay2, 0, $value) ; boxOccupyArea($ax1, $ay1, $ax2, $ay2, 0, $value);
$x += $stepX ; $x += $stepX;
} }
} else{
}
else {
# calc points on y axis # calc points on y axis
my $y = $y1 ; my $y = $y1;
my $stepY = $boxSize ; my $stepY = $boxSize;
if ( $y2 < $y1 ) { $stepY = - $boxSize ; } if($y2 < $y1){$stepY = - $boxSize;} while(($y >= min($y1, $y2))and($y <= max($y1, $y2))){
while ( ( $y >= min ($y1, $y2) ) and ( $y <= max ($y1, $y2) ) ) { my $x =($y - $b)/ $m;
my $x = ($y - $b) / $m ;
# ACTUAL COORDINATE $x, $y # ACTUAL COORDINATE $x, $y
my $ax1 = $x - $buffer ; my $ax1 = $x - $buffer;
my $ax2 = $x + $buffer ; my $ax2 = $x + $buffer;
my $ay1 = $y - $buffer ; my $ay1 = $y - $buffer;
my $ay2 = $y + $buffer ; my $ay2 = $y + $buffer;
boxOccupyArea ($ax1, $ay1, $ax2, $ay2, 0, $value) ; boxOccupyArea($ax1, $ay1, $ax2, $ay2, 0, $value);
$y += $stepY ; $y += $stepY;
} }
}# abs
} # abs } else{ my $x = $x1;
}
else {
my $x = $x1 ;
# calc points on y axis # calc points on y axis
my $y = $y1 ; my $y = $y1;
my $stepY = $boxSize ; my $stepY = $boxSize;
if ( $y2 < $y1 ) { $stepY = - $boxSize ; } if($y2 < $y1){$stepY = - $boxSize;} while(($y >= min($y1, $y2))and($y <= max($y1, $y2))){
while ( ( $y >= min ($y1, $y2) ) and ( $y <= max ($y1, $y2) ) ) {
# ACTUAL COORDINATE $x, $y # ACTUAL COORDINATE $x, $y
my $ax1 = $x - $buffer ; my $ax1 = $x - $buffer;
my $ax2 = $x + $buffer ; my $ax2 = $x + $buffer;
my $ay1 = $y - $buffer ; my $ay1 = $y - $buffer;
my $ay2 = $y + $buffer ; my $ay2 = $y + $buffer;
boxOccupyArea ($ax1, $ay1, $ax2, $ay2, 0, $value) ; boxOccupyArea($ax1, $ay1, $ax2, $ay2, 0, $value);
$y += $stepY ; $y += $stepY;
} } }
}
} }}
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]];
} }
foreach my $line(@lines){ my $x1 = $line->[0];
my $y1 = $line->[1];
my $x2 = $line->[2];
my $y2 = $line->[3];
sub boxLinesOccupied { # print "$x1, $y1, $x2, $y2\n";
my ($refCoords, $buffer) = @_ ;
my @coordinates = @$refCoords ;
my @lines = () ;
my $result = 0 ;
for ( my $i = 0; $i < $#coordinates-2; $i += 2 ) { if($x1 != $x2){
push @lines, [$coordinates[$i], $coordinates[$i+1], $coordinates[$i+2], $coordinates[$i+3]] ; my $m =($y2 - $y1)/($x2 - $x1);
} my $b = $y1 - $m * $x1;
foreach my $line ( @lines ) {
my $x1 = $line->[0] ;
my $y1 = $line->[1] ;
my $x2 = $line->[2] ;
my $y2 = $line->[3] ;
# 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 ) ) {
if(abs($x1 - $x2)> abs($y1 - $y2)){
# calc points on x axis # calc points on x axis
my $x = $x1 ; my $x = $x1;
my $stepX = $boxSize ; my $stepX = $boxSize;
if ( $x2 < $x1 ) { $stepX = - $boxSize ; } if($x2 < $x1){$stepX = - $boxSize;} while(($x >= min($x1, $x2))and($x <= max($x1, $x2))){
while ( ( $x >= min ($x1, $x2) ) and ( $x <= max ($x1, $x2) ) ) { my $y = $m * $x + $b;
my $y = $m * $x + $b ;
# ACTUAL COORDINATE $x, $y # ACTUAL COORDINATE $x, $y
my $ax1 = $x - $buffer ; my $ax1 = $x - $buffer;
my $ax2 = $x + $buffer ; my $ax2 = $x + $buffer;
my $ay1 = $y - $buffer ; my $ay1 = $y - $buffer;
my $ay2 = $y + $buffer ; my $ay2 = $y + $buffer;
my $tmp = boxAreaOccupied ($ax1, $ay1, $ax2, $ay2) ; my $tmp = boxAreaOccupied($ax1, $ay1, $ax2, $ay2);
if ($tmp > $result) { $result = $tmp ; } if($tmp > $result){$result = $tmp;} $x += $stepX;
$x += $stepX ;
} }
} else{
}
else {
# calc points on y axis # calc points on y axis
my $y = $y1 ; my $y = $y1;
my $stepY = $boxSize ; my $stepY = $boxSize;
if ( $y2 < $y1 ) { $stepY = - $boxSize ; } if($y2 < $y1){$stepY = - $boxSize;} while(($y >= min($y1, $y2))and($y <= max($y1, $y2))){
while ( ( $y >= min ($y1, $y2) ) and ( $y <= max ($y1, $y2) ) ) { my $x =($y - $b)/ $m;
my $x = ($y - $b) / $m ;
# ACTUAL COORDINATE $x, $y # ACTUAL COORDINATE $x, $y
my $ax1 = $x - $buffer ; my $ax1 = $x - $buffer;
my $ax2 = $x + $buffer ; my $ax2 = $x + $buffer;
my $ay1 = $y - $buffer ; my $ay1 = $y - $buffer;
my $ay2 = $y + $buffer ; my $ay2 = $y + $buffer;
my $tmp = boxAreaOccupied ($ax1, $ay1, $ax2, $ay2) ; my $tmp = boxAreaOccupied($ax1, $ay1, $ax2, $ay2);
if ($tmp > $result) { $result = $tmp ; } if($tmp > $result){$result = $tmp;}
$y += $stepY;
$y += $stepY ;
} }
}# abs
} # abs } else{ my $x = $x1;
}
else {
my $x = $x1 ;
# calc points on y axis # calc points on y axis
my $y = $y1 ; my $y = $y1;
my $stepY = $boxSize ; my $stepY = $boxSize;
if ( $y2 < $y1 ) { $stepY = - $boxSize ; } if($y2 < $y1){$stepY = - $boxSize;} while(($y >= min($y1, $y2))and($y <= max($y1, $y2))){
while ( ( $y >= min ($y1, $y2) ) and ( $y <= max ($y1, $y2) ) ) {
# ACTUAL COORDINATE $x, $y # ACTUAL COORDINATE $x, $y
my $ax1 = $x - $buffer ; my $ax1 = $x - $buffer;
my $ax2 = $x + $buffer ; my $ax2 = $x + $buffer;
my $ay1 = $y - $buffer ; my $ay1 = $y - $buffer;
my $ay2 = $y + $buffer ; my $ay2 = $y + $buffer;
my $tmp = boxAreaOccupied ($ax1, $ay1, $ax2, $ay2) ; my $tmp = boxAreaOccupied($ax1, $ay1, $ax2, $ay2);
if ($tmp > $result) { $result = $tmp ; } if($tmp > $result){$result = $tmp;}
$y += $stepY;
} }
$y += $stepY ; } return $result;
}
}
}
return $result ;
} }
# ------------------------------------------------------------- # -------------------------------------------------------------
sub boxOccupyArea { sub boxOccupyArea{ my($x1, $y1, $x2, $y2, $buffer, $value)= @_;
my ($x1, $y1, $x2, $y2, $buffer, $value) = @_ ;
if ( $x2 < $x1) { if($x2 < $x1){ my $tmp = $x1;
my $tmp = $x1 ; $x1 = $x2;
$x1 = $x2 ; $x2 = $tmp;
$x2 = $tmp ; } if($y2 < $y1){ my $tmp = $y1;
} $y1 = $y2;
if ( $y2 < $y1) { $y2 = $tmp;
my $tmp = $y1 ; }
$y1 = $y2 ; $x1 -= $buffer;
$y2 = $tmp ; $x2 += $buffer;
} $y1 -= $buffer;
$y2 += $buffer;
$x1 -= $buffer ; for(my $x = $x1; $x <= $x2; $x += $boxSize){ for(my $y = $y1; $y <= $y2; $y += $boxSize){ my $bx = int($x / $boxSize);
$x2 += $buffer ; my $by = int($y / $boxSize);
$y1 -= $buffer ; $box{$bx}{$by}= $value;
$y2 += $buffer ; # print "box $bx, $by occupied\n";
}}
for ( my $x = $x1; $x <= $x2; $x += $boxSize) { return;
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)= @_;
my $result = 0;
sub boxAreaOccupied { if($x2 < $x1){ my $tmp = $x1;
my ($x1, $y1, $x2, $y2) = @_ ; $x1 = $x2;
my $result = 0 ; $x2 = $tmp;
} if($y2 < $y1){ my $tmp = $y1;
if ( $x2 < $x1) { $y1 = $y2;
my $tmp = $x1 ; $y2 = $tmp;
$x1 = $x2 ; }
$x2 = $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);
if ( $y2 < $y1) { # print " $bx, $by\n";
my $tmp = $y1 ; if(defined $box{$bx}{$by}){ if($box{$bx}{$by}> $result){ # print "check box $bx, $by\n";
$y1 = $y2 ; $result = $box{$bx}{$by};
$y2 = $tmp ; } } }} return $result;
}
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" ;
$result = $box{$bx}{$by} ;
}
}
}
}
return $result ;
} }
# ------------------------------------------------------------- # -------------------------------------------------------------
sub boxDrawOccupiedAreas { sub boxDrawOccupiedAreas{ my $format1 = "fill=\"red\" fill-opacity=\"0.3\" ";
my $format1 = "fill=\"red\" fill-opacity=\"0.3\" " ; my $format2 = "fill=\"blue\" fill-opacity=\"0.3\" ";
my $format2 = "fill=\"blue\" fill-opacity=\"0.3\" " ; my $format3 = "fill=\"green\" fill-opacity=\"0.5\" ";
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 ) { my $x2 = $x1 + $boxSize;
foreach my $by ( sort {$a <=> $b} keys %{$box{$bx}} ) { my $y1 = $by * $boxSize;
my $x1 = $bx * $boxSize ; my $y2 = $y1 + $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") ;
}
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" ;
}
}
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";
}}
} }
1;
1 ;

378
mwRelations.pm
View File

@ -4,10 +4,10 @@
# #
# #
# #
# Copyright (C) 2011, Gerhard Schwanz # 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 # This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3 of the License, or (at your option) any later version. # Free Software Foundation; either version 3 of the License, or(at your option)any later version.
# #
# This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or # This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
@ -16,311 +16,231 @@
# #
package mwRelations ; package mwRelations;
use strict ; use strict;
use warnings ; use warnings;
use mwMap ; use mwMap;
use mwRules ; use mwRules;
use mwFile ; use mwFile;
use mwMisc ; use mwMisc;
use mwLabel ; use mwLabel;
use mwConfig ; use mwConfig;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
require Exporter ; require Exporter;
@ISA = qw ( Exporter AutoLoader ) ; @ISA = qw(Exporter AutoLoader);
@EXPORT = qw ( processRoutes @EXPORT = qw(processRoutes
) ; );
my $pathNumber = 0 ; my $pathNumber = 0;
my %iconSizeX = () ; my %iconSizeX =();
my %iconSizeY = () ; my %iconSizeY =();
# -------------------------------------------------------------------------- # --------------------------------------------------------------------------
sub processRoutes { sub processRoutes{#
#
# process route data # process route data
# #
my %routeColors = () ; # will point to arrays of colors per route type my %routeColors =(); # will point to arrays of colors per route type
my %actualColorIndex = () ; # which color is next my %actualColorIndex =(); # which color is next
my %colorNumber = () ; # number of colors per route type my %colorNumber =(); # number of colors per route type
my %wayRouteLabels = () ; # labels to be used per way my %wayRouteLabels =(); # labels to be used per way
my %wayRouteIcons = () ; # icons to be used per way my %wayRouteIcons =(); # icons to be used per way
my (%iconSizeX, %iconSizeY) ; my(%iconSizeX, %iconSizeY);
print "processing routes...\n" ; print "processing routes...\n";
# init before relation processing # init before relation processing
# get colors per type and set actual index # get colors per type and set actual index
my $ref = getRouteColors() ; my $ref = getRouteColors();
%routeColors = %$ref ; %routeColors = %$ref;
foreach my $type (keys %routeColors) { foreach my $type(keys %routeColors){ $colorNumber{$type}= scalar @{$routeColors{$type}};
$colorNumber{$type} = scalar @{$routeColors{$type}} ; $actualColorIndex{$type}= 0;
$actualColorIndex{$type} = 0 ; }
} my($lonRef, $latRef)= getNodePointers();
my($wayNodesRef, $wayTagsRef)= getWayPointers();
my($relationMembersRef, $relationTagsRef)= getRelationPointers();
my ($lonRef, $latRef) = getNodePointers() ; foreach my $relId(keys %$relationTagsRef){ my $relationType = getValue("type", $$relationTagsRef{$relId});
my ($wayNodesRef, $wayTagsRef) = getWayPointers() ; if(! defined $relationType){$relationType = "";}
my ($relationMembersRef, $relationTagsRef) = getRelationPointers() ; if(($relationType eq "route")and((cv('relid')== $relId)or(cv('relid')== 0))){
my $ruleRef = getRouteRule($$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) {
if(defined $ruleRef){
# new route detected # new route detected
if (cv('debug') eq "1" ) { print "ROUTE: rule found for $relId, $$ruleRef{'type'}.\n" ; } if(cv('debug')eq "1"){print "ROUTE: rule found for $relId, $$ruleRef{'type'}.\n";}
# try to get color from relation tags first # try to get color from relation tags first
# #
my $color = getValue ("color", $$relationTagsRef{$relId} ) ; my $color = getValue("color", $$relationTagsRef{$relId});
if ( ! defined $color) { if(! defined $color){ $color = getValue("colour", $$relationTagsRef{$relId});
$color = getValue ("colour", $$relationTagsRef{$relId} ) ;
} }
# no color yet, then get color from rule # no color yet, then get color from rule
# #
if ( ! defined $color) { if(! defined $color){
if (cv('debug') eq "1" ) { print "ROUTE: actual color index: $actualColorIndex{ $$ruleRef{'type'} }\n" ; } if(cv('debug')eq "1"){print "ROUTE: actual color index: $actualColorIndex{$$ruleRef{'type'}}\n";} $color = $routeColors{$$ruleRef{'type'}}[$actualColorIndex{$$ruleRef{'type'}}];
$color = $routeColors{ $$ruleRef{'type'} }[$actualColorIndex{ $$ruleRef{'type'} }] ; $actualColorIndex{$$ruleRef{'type'}}=($actualColorIndex{$$ruleRef{'type'}}+ 1)% $colorNumber{$$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 # find icon
my $iconName = getValue ("ref", $$relationTagsRef{$relId} ) ; my $iconName = getValue("ref", $$relationTagsRef{$relId});
if ( ! defined $iconName ) { if(! defined $iconName){ getValue("name", $$relationTagsRef{$relId}) } if(! defined $iconName){$iconName = "";}
getValue ("name", $$relationTagsRef{$relId} )
}
if ( ! defined $iconName) { $iconName = "" ; }
# look for route icon. svg first, then png # look for route icon. svg first, then png
my $file ; my $file;
$iconName = cv('routeicondir') . $$ruleRef{'type'} . "-" . $iconName . ".svg" ; $iconName = cv('routeicondir'). $$ruleRef{'type'}. "-" . $iconName . ".svg";
my $iconResult = open ($file, "<", $iconName) ; my $iconResult = open($file, "<", $iconName);
# print " trying $iconName\n" ; # print " trying $iconName\n";
if ($iconResult) { if($iconResult){
if (cv('debug') eq "1") { print "ROUTE: icon $iconName found!\n" ; } if(cv('debug')eq "1"){print "ROUTE: icon $iconName found!\n";} close($file);
close ($file) ;
} }
if ( ! $iconResult) { if(! $iconResult){ $iconName =~ s/.svg/.png/;
$iconName =~ s/.svg/.png/ ; # print " trying $iconName\n";
# print " trying $iconName\n" ; $iconResult = open($file, "<", $iconName);
$iconResult = open ($file, "<", $iconName) ; if($iconResult){
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 ($iconResult) { if(grep /.svg/, $iconName){ ($x, $y)= sizeSVG($iconName);
my ($x, $y) ; undef $x ; undef $y ; if(($x == 0)or($y == 0)){
if (grep /.svg/, $iconName) { $x = 32; $y = 32;
($x, $y) = sizeSVG ($iconName) ; print "WARNING: size of file $iconName could not be determined. Set to 32px x 32px\n";
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;
$iconSizeX{$iconName} = $x ; $iconSizeY{$iconName}= $y;
$iconSizeY{$iconName} = $y ;
} }
my($label, $ref)= createLabel($$relationTagsRef{$relId}, $$ruleRef{'label'});
my ($label, $ref) = createLabel ( $$relationTagsRef{$relId}, $$ruleRef{'label'} ) ; my $printIcon = ""; if($iconResult){$printIcon = $iconName;}
if(cv('verbose')eq "1"){
my $printIcon = "" ; if ($iconResult) { $printIcon = $iconName ; } printf "ROUTE: route %10s %10s %10s %30s %40s\n", $relId, $$ruleRef{'type'}, $color, $label, $printIcon;
if (cv('verbose') eq "1" ) {
printf "ROUTE: route %10s %10s %10s %30s %40s\n", $relId, $$ruleRef{'type'}, $color, $label, $printIcon ;
} }
# collect ways # collect ways
my $mRef = getAllMembers ($relId, 0) ; my $mRef = getAllMembers($relId, 0);
my @tempMembers = @$mRef ; 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] ; }
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];}
# TODO diversions, shortcuts? # TODO diversions, shortcuts?
# stops # stops
if ( (grep /stop/, $member->[2]) and ($member->[0] eq "node") ) { 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 ( ( $$ruleRef{'nodesize'} > 0) and (defined $$latRef{$member->[1]}) and (defined $$lonRef{$member->[1]}) ) { drawCircle($$lonRef{$member->[1]}, $$latRef{$member->[1]}, 1, $$ruleRef{'nodesize'}, 0, $svgString, 'routes');
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 (cv('debug') eq "1" ) { print "ROUTE: ways: @relWays\n" ; } drawWay($$wayNodesRef{$w}, 1, $svgString, "routes", undef);
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 ;
drawWay ($$wayNodesRef{$w}, 1, $svgString, "routes", undef) ;
# collect labels and icons per way # collect labels and icons per way
# #
$wayRouteLabels{$w}{$label} = 1 ; $wayRouteLabels{$w}{$label}= 1;
if ($iconResult) { if($iconResult){
$wayRouteIcons{$w}{$iconName} = 1 ; $wayRouteIcons{$w}{$iconName}= 1;
} } }
} }# rule found
if(cv('debug')eq "1"){print "\n";} }# rel route
} # rule found }# relation
if (cv('debug') eq "1") { print "\n" ; }
} # rel route
} # relation
# label route ways after all relations have been processed # label route ways after all relations have been processed
foreach my $w (keys %wayRouteLabels) { foreach my $w(keys %wayRouteLabels){ if((defined $$wayNodesRef{$w})and(scalar @{$$wayNodesRef{$w}}> 1)){ my $label = "";
if ( (defined $$wayNodesRef{$w}) and (scalar @{$$wayNodesRef{$w}} > 1) ) { foreach my $l(keys %{$wayRouteLabels{$w}}){ $label .= $l . " ";
my $label = "" ;
foreach my $l (keys %{$wayRouteLabels{$w}}) {
$label .= $l . " " ;
} }
my @way = @{$$wayNodesRef{$w}} ; my @way = @{$$wayNodesRef{$w}};
if ($$lonRef{$way[0]} > $$lonRef{$way[-1]}) { if($$lonRef{$way[0]}> $$lonRef{$way[-1]}){ @way = reverse(@way);
@way = reverse (@way) ;
} }
if(labelFitsWay(\@way, $label, cv('routelabelfont'), cv('routelabelsize'))){ my $pathName = "RoutePath" . $pathNumber;
$pathNumber++;
if (labelFitsWay ( \@way, $label, cv('routelabelfont'), cv('routelabelsize') ) ) { my @points = nodes2Coordinates(@way);
my $pathName = "RoutePath" . $pathNumber ;
$pathNumber++ ;
my @points = nodes2Coordinates( @way ) ; if(! coordsOut(@points)){
createPath($pathName, \@points, "definitions");
if ( ! coordsOut (@points) ) { my $size = cv('routelabelsize');
my $font = cv('routelabelfont');
createPath ($pathName, \@points, "definitions") ; my $fontFamily = cv('routelabelfontfamily');
my $color = cv('routelabelcolor');
my $size = cv('routelabelsize') ;
my $font = cv('routelabelfont') ;
my $fontFamily = cv('routelabelfontfamily') ;
my $color = cv('routelabelcolor') ;
my $svgText = createTextSVG ( $fontFamily, $font, $size, $color, undef, undef) ;
pathText ($svgText, $label, $pathName, cv('routelabeloffset'), "middle", 50, "routes") ;
}
}
}
}
my $svgText = createTextSVG($fontFamily, $font, $size, $color, undef, undef);
pathText($svgText, $label, $pathName, cv('routelabeloffset'), "middle", 50, "routes");
} } }}
# place icons # place icons
foreach my $w (keys %wayRouteIcons) { foreach my $w(keys %wayRouteIcons){ my $offset = 0;
my $offset = 0 ; my $nodeNumber = scalar @{$$wayNodesRef{$w}};
my $nodeNumber = scalar @{$$wayNodesRef{$w}} ; if($nodeNumber > 1){ my $node = $$wayNodesRef{$w}[int($nodeNumber / 2)];
if ($nodeNumber > 1) { my $num = scalar(keys %{$wayRouteIcons{$w}});
my $node = $$wayNodesRef{$w}[int ($nodeNumber / 2)] ; $offset = int(-($num-1)* cv('routeicondist')/ 2);
my $num = scalar (keys %{$wayRouteIcons{$w}}) ;
$offset = int (-($num-1)* cv('routeicondist') / 2) ;
foreach my $iconName (keys %{$wayRouteIcons{$w}}) { foreach my $iconName(keys %{$wayRouteIcons{$w}}){
my $size = 40;
my $size = 40 ; placeLabelAndIcon($$lonRef{$node}, $$latRef{$node}, $offset, $size, "", "", $iconName, $iconSizeX{$iconName}, $iconSizeY{$iconName}, "routes");
placeLabelAndIcon ($$lonRef{$node}, $$latRef{$node}, $offset, $size, "", "", $iconName, $iconSizeX{$iconName}, $iconSizeY{$iconName}, "routes") ;
$offset += cv('routeicondist') ;
}
}
}
}
$offset += cv('routeicondist');
} }}}
# -------------------------------------------------------------------------- # --------------------------------------------------------------------------
sub getAllMembers { sub getAllMembers{#
#
# get all members of a relation recursively # get all members of a relation recursively
# takes rel id and nesting level # takes rel id and nesting level
# retruns ref to array with all members # retruns ref to array with all members
# #
my ($relId, $nestingLevel) = @_ ; my($relId, $nestingLevel)= @_;
my @allMembers = () ; my @allMembers =();
my $maxNestingLevel = 20 ; my $maxNestingLevel = 20;
my ($relationMembersRef, $relationTagsRef) = getRelationPointers() ; my($relationMembersRef, $relationTagsRef)= getRelationPointers();
if ($nestingLevel > $maxNestingLevel) { if($nestingLevel > $maxNestingLevel){
print "ERROR/WARNING nesting level of relations too deep. recursion stopped at depth $maxNestingLevel! relId=$relId\n" ; 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;
else { } if($member->[0] eq "relation"){ my $ref = getAllMembers($member->[1], $nestingLevel+1);
foreach my $member ( @{$$relationMembersRef{$relId}} ) { push @allMembers, @$ref;
if ( ($member->[0] eq "way") or ($member->[0] eq "node") ) { } }
push @allMembers, $member ; } return \@allMembers;
}
if ( $member->[0] eq "relation" ) {
my $ref = getAllMembers ($member->[1], $nestingLevel+1) ;
push @allMembers, @$ref ;
}
}
}
return \@allMembers ;
} }
sub labelFitsWay{ my($refWayNodes, $text, $font, $size)= @_;
my @wayNodes = @$refWayNodes;
sub labelFitsWay { my($lonRef, $latRef)= getNodePointers();
my ($refWayNodes, $text, $font, $size) = @_ ;
my @wayNodes = @$refWayNodes ;
my ($lonRef, $latRef) = getNodePointers() ;
# calc waylen # calc waylen
my $wayLength = 0 ; # in pixels my $wayLength = 0; # in pixels
for (my $i=0; $i<$#wayNodes; $i++) { for(my $i=0; $i<$#wayNodes; $i++){ my($x1, $y1)= convert($$lonRef{$wayNodes[$i]}, $$latRef{$wayNodes[$i]});
my ($x1, $y1) = convert ($$lonRef{$wayNodes[$i]}, $$latRef{$wayNodes[$i]}) ; my($x2, $y2)= convert($$lonRef{$wayNodes[$i+1]}, $$latRef{$wayNodes[$i+1]});
my ($x2, $y2) = convert ($$lonRef{$wayNodes[$i+1]}, $$latRef{$wayNodes[$i+1]}) ; $wayLength += sqrt(($x2-$x1)**2 +($y2-$y1)**2);
$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 ;
}
} }
# calc label len
my $labelLength = length($text)* cv('ppc')/ 10 * $size; # in pixels
1 ; 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;
}}
1;

1127
mwRules.pm
View File

File diff suppressed because it is too large Load Diff

755
mwWayLabel.pm
View File

@ -4,10 +4,10 @@
# #
# #
# #
# Copyright (C) 2011, Gerhard Schwanz # 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 # This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3 of the License, or (at your option) any later version. # Free Software Foundation; either version 3 of the License, or(at your option)any later version.
# #
# This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or # This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
@ -16,563 +16,420 @@
# #
package mwWayLabel ; package mwWayLabel;
use strict ; use strict;
use warnings ; use warnings;
use mwConfig ; use mwConfig;
use mwFile ; use mwFile;
use mwMisc ; use mwMisc;
use mwMap ; use mwMap;
use mwLabel ; use mwLabel;
use mwOccupy ; use mwOccupy;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
require Exporter ; require Exporter;
@ISA = qw ( Exporter AutoLoader ) ; @ISA = qw(Exporter AutoLoader);
@EXPORT = qw ( addToDirectory @EXPORT = qw(addToDirectory
getDirectory getDirectory
addWayLabel addWayLabel
preprocessWayLabels preprocessWayLabels
createWayLabels createWayLabels
) ; );
my %directory = () ; my %directory =();
my %wayLabels = () ; my %wayLabels =();
my @labelCandidates = () ; my @labelCandidates =();
my %ruleRefs = () ; my %ruleRefs =();
my $pathNumber = 0 ; my $pathNumber = 0;
my $numWayLabelsOmitted = 0 ; my $numWayLabelsOmitted = 0;
my $wnsNumber = 1 ; my $wnsNumber = 1;
my @wns =() ; my @wns =();
# ------------------------------------------------------------------------ # ------------------------------------------------------------------------
sub addToDirectory { sub addToDirectory{ my($name, $square)= @_;
my ($name, $square) = @_ ; if(! defined $square){ $directory{$name}= 1;
if ( ! defined $square ) { } else{ $directory{$name}{$square}= 1;
$directory { $name } = 1 ; }}
} sub getDirectory{ return \%directory;
else {
$directory { $name } { $square } = 1 ;
}
} }
sub addWayLabel{#
sub getDirectory {
return \%directory ;
}
sub addWayLabel {
#
# collect all way label data before actual labeling # collect all way label data before actual labeling
# #
my ($wayId, $name, $ruleRef) = @_ ; my($wayId, $name, $ruleRef)= @_;
push @{ $wayLabels{$ruleRef}{$name} }, $wayId ; push @{$wayLabels{$ruleRef}{$name}}, $wayId;
$ruleRefs{$ruleRef} = $ruleRef ; $ruleRefs{$ruleRef}= $ruleRef;
if ( cv ('debug') eq "1" ) { if(cv('debug')eq "1"){ print "AWL: $wayId, $name, $ruleRef\n";
print "AWL: $wayId, $name, $ruleRef\n" ; }}
} sub preprocessWayLabels{#
}
sub preprocessWayLabels {
#
# preprocess way labels collected so far # preprocess way labels collected so far
# combine ways with same rule and name # combine ways with same rule and name
# split ways where direction in longitude changes so labels will be readable later # split ways where direction in longitude changes so labels will be readable later
# store result in @labelCandidates # store result in @labelCandidates
# #
my ($lonRef, $latRef) = getNodePointers() ; my($lonRef, $latRef)= getNodePointers();
my ($memWayNodesRef, $memWayTagsRef) = getWayPointers() ; my($memWayNodesRef, $memWayTagsRef)= getWayPointers();
foreach my $rule (keys %wayLabels) { foreach my $rule(keys %wayLabels){ my $ruleRef = $ruleRefs{$rule};
my $ruleRef = $ruleRefs{ $rule } ; # print "PPWL: ruleNum $rule\n";
# print "PPWL: ruleNum $rule\n" ; foreach my $name(keys %{$wayLabels{$rule}}){ my(@ways)= @{$wayLabels{$rule}{$name}};
foreach my $name (keys %{$wayLabels{$rule}}) { # print "PPWL: processing name $name, " . scalar(@ways). " ways\n";
my (@ways) = @{$wayLabels{$rule}{$name}} ; my($waysRef, $nodesRef)= buildRings(\@ways, 0);
# print "PPWL: processing name $name, " . scalar (@ways) . " ways\n" ; my @segments = @$nodesRef;
my ($waysRef, $nodesRef) = buildRings (\@ways, 0) ; # print "PPWL: processing name $name, " . scalar(@segments). " segments\n";
my @segments = @$nodesRef ;
# print "PPWL: processing name $name, " . scalar (@segments) . " segments\n" ;
if ( ! grep /shield:/i, $name) { if(! grep /shield:/i, $name){
my @newSegments =();
my @newSegments = () ; foreach my $segment(@segments){ my @actual = @$segment;
foreach my $segment (@segments) { # print "PPWL: Actual segment @actual\n";
my @actual = @$segment ; my $found = 1;
# print "PPWL: Actual segment @actual\n" ; while($found){ $found = 0; my $sp = 0;
my $found = 1 ;
while ($found) {
$found = 0 ; my $sp = 0 ;
# look for splitting point # look for splitting point
LABSP: for (my $i=1; $i<$#actual; $i++) { 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
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;
(($$lonRef{$actual[$i-1]} < $$lonRef{$actual[$i]}) and ($$lonRef{$actual[$i+1]} < $$lonRef{$actual[$i]})) ) { $sp = $i;
$found = 1 ; last LABSP;
$sp = $i ; } } if($found == 1){ # print "\nname $name --- sp: $sp\n";
last LABSP ; # print "ACTUAL BEFORE: @actual\n";
}
}
if ($found == 1) {
# print "\nname $name --- sp: $sp\n" ;
# print "ACTUAL BEFORE: @actual\n" ;
# create new seg # create new seg
my @newSegment = @actual[0..$sp] ; my @newSegment = @actual[0..$sp];
push @newSegments, [@newSegment] ; push @newSegments, [@newSegment];
# print "NEW: @newSegment\n" ; # print "NEW: @newSegment\n";
# splice actual # splice actual
splice @actual, 0, $sp ; splice @actual, 0, $sp;
# print "ACTUAL AFTER: @actual\n\n" ; # print "ACTUAL AFTER: @actual\n\n";
} } @$segment = @actual;
} }
} push @segments, @newSegments;
@$segment = @actual ;
}
push @segments, @newSegments ;
} }
foreach my $segment(@segments){ my(@wayNodes)= @$segment;
my @points =();
foreach my $segment (@segments) { if($$lonRef{$wayNodes[0]}> $$lonRef{$wayNodes[-1]}){ if((! grep /motorway/, $$ruleRef{'keyvalue'})and(! grep /trunk/, $$ruleRef{'keyvalue'})){ @wayNodes = reverse @wayNodes;
my (@wayNodes) = @$segment ; } }
my @points = () ; foreach my $node(@wayNodes){ push @points, convert($$lonRef{$node}, $$latRef{$node});
} # print "PPWL: segment @wayNodes\n";
# print "PPWL: segment @points\n";
if ($$lonRef{$wayNodes[0]} > $$lonRef{$wayNodes[-1]}) { my($segmentLengthPixels)= 0;
if ( ( ! grep /motorway/, $$ruleRef{'keyvalue'}) and ( ! grep /trunk/, $$ruleRef{'keyvalue'} ) ) {
@wayNodes = reverse @wayNodes ;
} 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";
my $labelLengthPixels = 0;
if(grep /shield/i, $$ruleRef{'label'}){ $labelLengthPixels = $$ruleRef{'labelsize'};
# print "PPWL: len = $labelLengthPixels\n";
} 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";
foreach my $node (@wayNodes) { push @labelCandidates, [$rule, $name, $segmentLengthPixels, $labelLengthPixels, [@points]];
push @points, convert ($$lonRef{$node}, $$latRef{$node}) ; if(cv('debug')eq "1"){ print "PLC: $rule, $name, $segmentLengthPixels, $labelLengthPixels\n";
} } } }}}
# print "PPWL: segment @wayNodes\n" ; sub subWay{#
# 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]}) ;
my ($x2, $y2) = convert ($$lonRef{$wayNodes[$i+1]}, $$latRef{$wayNodes[$i+1]}) ;
$segmentLengthPixels += sqrt ( ($x2-$x1)**2 + ($y2-$y1)**2 ) ;
}
# print "$rule, $wayIndexLabelSize\n" ;
my $labelLengthPixels = 0 ;
if (grep /shield/i, $$ruleRef{'label'} ) {
$labelLengthPixels = $$ruleRef{'labelsize'} ;
# print "PPWL: len = $labelLengthPixels\n" ;
}
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 {
#
# takes coordinates and label information and creates new way/path # takes coordinates and label information and creates new way/path
# also calculates total angles / bends # also calculates total angles / bends
# #
my ($ref, $labLen, $alignment, $position) = @_ ; my($ref, $labLen, $alignment, $position)= @_;
my @coordinates = @$ref ; my @coordinates = @$ref;
my @points ; my @points;
my @dists ; my @dists;
my @angles = () ; my @angles =();
for (my $i=0; $i < $#coordinates; $i+=2) { for(my $i=0; $i < $#coordinates; $i+=2){ push @points, [$coordinates[$i],$coordinates[$i+1]];
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 ) ;
$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]) ;
}
}
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
$labelEnd = $refPoint ;
$labelStart = $labelEnd - $labLen ;
}
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 ; }
}
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++) {
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) ;
} }
$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);
$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]);
}
}
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
$labelEnd = $refPoint;
$labelStart = $labelEnd - $labLen;
} 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;}}
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;
sub createWayLabels { 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{#
# finally take all way label candidates and try to label them # finally take all way label candidates and try to label them
# #
my %wnsUnique = () ; my %wnsUnique =();
print "placing way labels...\n" ; print "placing way labels...\n";
my %notDrawnLabels = () ; my %notDrawnLabels =();
my %drawnLabels = () ; my %drawnLabels =();
# calc ratio to label ways first where label just fits # calc ratio to label ways first where label just fits
# these will be drawn first # these will be drawn first
foreach my $candidate (@labelCandidates) { foreach my $candidate(@labelCandidates){ my $wLen = $candidate->[2];
my $wLen = $candidate->[2] ; my $lLen = $candidate->[3];
my $lLen = $candidate->[3] ; if($wLen == 0){$wLen = 1;} if($lLen == 0){$lLen = 1;} $candidate->[5] = $lLen / $wLen;
if ($wLen == 0) { $wLen = 1 ; } } @labelCandidates = sort{$b->[5] <=> $a->[5]}@labelCandidates;
if ($lLen == 0) { $lLen = 1 ; }
$candidate->[5] = $lLen / $wLen ; foreach my $candidate(@labelCandidates){ my $ruleRef = $ruleRefs{$candidate->[0]};
my $name = $candidate->[1];
my $wLen = $candidate->[2];
my $lLen = $candidate->[3];
my @points = @{$candidate->[4]};
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;
} }
@labelCandidates = sort { $b->[5] <=> $a->[5] } @labelCandidates ;
foreach my $candidate (@labelCandidates) {
my $ruleRef = $ruleRefs{ $candidate->[0] } ;
my $name = $candidate->[1] ;
my $wLen = $candidate->[2] ;
my $lLen = $candidate->[3] ;
my @points = @{$candidate->[4]} ;
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 ;
}
# wns? # wns?
if ( ($lLen > $wLen * 0.95) and ( cv('wns') > 0 ) ) { 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 ( ( $toLabel != 0 ) and ( ! grep /shield:/i, $name) and ( wayVisible( \@points ) ) ) { $wnsUnique{$name}= 1;
if ( ! defined $wnsUnique{$name} ) { push @wns, [ $wnsNumber, $name];
my $oldName = $name ; $name = $wnsNumber;
$wnsUnique{$name} = 1 ; $lLen = cv('ppc')/ 10 * $$ruleRef{'labelsize'}* length($name);
push @wns, [ $wnsNumber, $name] ; # print "WNS: $oldName - $name\n";
$name = $wnsNumber ; $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
$numWayLabelsOmitted++;
$notDrawnLabels{$name}= 1;
if ( ($lLen > $wLen*0.95) or ($toLabel == 0) ) { } else{
# label too long if(grep /shield:/i, $name){
$numWayLabelsOmitted++ ; createShield($name, $$ruleRef{'labelsize'});
$notDrawnLabels { $name } = 1 ;
} my $shieldMaxSize = getMaxShieldSize($name);
else {
if (grep /shield:/i, $name) { my $numShields = int($wLen /($shieldMaxSize * 12));
# if($numShields > 4){$numShields = 4;}
createShield ($name, $$ruleRef{'labelsize'} ) ; if($numShields > 0){ my $step = $wLen /($numShields + 1);
my $position = $step;
my $shieldMaxSize = getMaxShieldSize ($name) ; while($position < $wLen){ my($x, $y)= getPointOfWay(\@points, $position);
# print "XY: $x, $y\n";
my $numShields = int ($wLen / ($shieldMaxSize * 12) ) ;
# if ($numShields > 4) { $numShields = 4 ; }
if ($numShields > 0) {
my $step = $wLen / ($numShields + 1) ;
my $position = $step ;
while ($position < $wLen) {
my ($x, $y) = getPointOfWay (\@points, $position) ;
# print "XY: $x, $y\n" ;
if ( ! coordsOut ($x, $y) ) {
if(! coordsOut($x, $y)){
# place shield if not occupied # place shield if not occupied
my ($ssx, $ssy) = getShieldSizes($name) ; my($ssx, $ssy)= getShieldSizes($name);
my $x2 = int ($x - $ssx / 2) ; my $x2 = int($x - $ssx / 2);
my $y2 = int ($y - $ssy / 2) ; my $y2 = int($y - $ssy / 2);
# print "AREA: $x2, $y2, $x2+$lLen, $y2+$lLen\n" ; # print "AREA: $x2, $y2, $x2+$lLen, $y2+$lLen\n";
if ( ! mwLabel::boxAreaOccupied ($x2, $y2+$ssy, $x2+$ssx, $y2) ) { if(! mwLabel::boxAreaOccupied($x2, $y2+$ssy, $x2+$ssx, $y2)){
my $id = getShieldId($name);
addToLayer("shields", "<use xlink:href=\"#$id\" x=\"$x2\" y=\"$y2\" />");
my $id = getShieldId ($name) ; mwLabel::boxOccupyArea($x2, $y2+$ssy, $x2+$ssx, $y2, 0, 3);
addToLayer ("shields", "<use xlink:href=\"#$id\" x=\"$x2\" y=\"$y2\" />") ; } }
$position += $step;
} }
}# shield
mwLabel::boxOccupyArea ($x2, $y2+$ssy, $x2+$ssx, $y2, 0, 3) ; else{
}
}
$position += $step ; # 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";
} # shield my $spare = 0.95 * $wLen - $lLen;
my $sparePercentHalf = $spare /($wLen*0.95)*100 / 2;
else { my $startOffset = 50 - $sparePercentHalf;
my $endOffset = 50 + $sparePercentHalf;
# 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" ;
my $spare = 0.95 * $wLen - $lLen ;
my $sparePercentHalf = $spare / ($wLen*0.95) *100 / 2 ;
my $startOffset = 50 - $sparePercentHalf ;
my $endOffset = 50 + $sparePercentHalf ;
# five possible positions per way # five possible positions per way
my $step = ($endOffset - $startOffset) / 5 ; my $step =($endOffset - $startOffset)/ 5;
my @positions = () ; my @positions =();
my $actual = $startOffset ; my $actual = $startOffset;
my $size = $$ruleRef{'labelsize'} ; my $size = $$ruleRef{'labelsize'};
while ($actual <= $endOffset) { while($actual <= $endOffset){ my($ref, $angle)= subWay(\@points, $lLen, "middle", $actual);
my ($ref, $angle) = subWay (\@points, $lLen, "middle", $actual) ; my @way = @$ref;
my @way = @$ref ; # my($col)= lineCrossings(\@way);
# my ($col) = lineCrossings (\@way) ; my($col)= boxLinesOccupied(\@way, $size/2);
my ($col) = boxLinesOccupied (\@way, $size/2) ;
# calc quality of position. distance from middle and bend angles # calc quality of position. distance from middle and bend angles
my $quality = $angle + abs (50 - $actual) ; my $quality = $angle + abs(50 - $actual);
if ($col == 0) { push @positions, ["middle", $actual, $quality] ; } if($col == 0){push @positions, ["middle", $actual, $quality];} $actual += $step;
$actual += $step ; } if(scalar @positions > 0){ $drawnLabels{$name}= 1;
}
if (scalar @positions > 0) {
$drawnLabels { $name } = 1 ;
# sort by quality and take best one # sort by quality and take best one
@positions = sort {$a->[2] <=> $b->[2]} @positions ; @positions = sort{$a->[2] <=> $b->[2]}@positions;
my ($pos) = shift @positions ; my($pos)= shift @positions;
my ($ref, $angle) = subWay (\@points, $lLen, $pos->[0], $pos->[1]) ; my($ref, $angle)= subWay(\@points, $lLen, $pos->[0], $pos->[1]);
my @finalWay = @$ref ; my @finalWay = @$ref;
# TODO IF INSIDE # TODO IF INSIDE
# print "final way @finalWay\n" ; # print "final way @finalWay\n";
if ( ! coordsOut (@finalWay) ) { if(! coordsOut(@finalWay)){ my $pathName = "Path" . $pathNumber; $pathNumber++;
my $pathName = "Path" . $pathNumber ; $pathNumber++ ; createPath($pathName, \@finalWay, "definitions");
createPath ($pathName, \@finalWay, "definitions") ;
my $size = $$ruleRef{'labelsize'} ; my $size = $$ruleRef{'labelsize'};
my $color = $$ruleRef{'labelcolor'} ; my $color = $$ruleRef{'labelcolor'};
my $font = $$ruleRef{'labelfont'} ; my $font = $$ruleRef{'labelfont'};
my $fontFamily = $$ruleRef{'labelfontfamily'} ; my $fontFamily = $$ruleRef{'labelfontfamily'};
my $labelBold = $$ruleRef{'labelbold'} ; my $labelBold = $$ruleRef{'labelbold'};
my $labelItalic = $$ruleRef{'labelitalic'} ; my $labelItalic = $$ruleRef{'labelitalic'};
my $labelHalo = $$ruleRef{'labelhalo'} ; my $labelHalo = $$ruleRef{'labelhalo'};
my $labelHaloColor = $$ruleRef{'labelhalocolor'} ; my $labelHaloColor = $$ruleRef{'labelhalocolor'};
my $svgText = createTextSVG ( $fontFamily, $font, $labelBold, $labelItalic, $size, $color, $labelHalo, $labelHaloColor) ; my $svgText = createTextSVG($fontFamily, $font, $labelBold, $labelItalic, $size, $color, $labelHalo, $labelHaloColor);
# pathText ($svgText, $name, $pathName, $$ruleRef{'labeloffset'}, $pos->[0], $pos->[1], "text") ; # pathText($svgText, $name, $pathName, $$ruleRef{'labeloffset'}, $pos->[0], $pos->[1], "text");
pathText ($svgText, $name, $pathName, $$ruleRef{'labeloffset'}, $pos->[0], 50, "text") ; pathText($svgText, $name, $pathName, $$ruleRef{'labeloffset'}, $pos->[0], 50, "text");
boxOccupyLines (\@finalWay, $size/2, 3) ; boxOccupyLines(\@finalWay, $size/2, 3);
} } } else{ $numWayLabelsOmitted++;
} } } else{# more than one label
else { # print "LA: $name *X*\n";
$numWayLabelsOmitted++ ; my $labelDrawn = 0;
} my $interval = int(100 /($numLabels + 1));
} my @positions =();
else { # more than one label for(my $i=1; $i<=$numLabels; $i++){ push @positions, $i * $interval;
# 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 ;
} }
foreach my $position(@positions){ my($refFinal, $angle)= subWay(\@points, $lLen, "middle", $position);
my(@finalWay)= @$refFinal;
# my($collision)= lineCrossings(\@finalWay);
foreach my $position (@positions) { my $size = $$ruleRef{'labelsize'};
my ($refFinal, $angle) = subWay (\@points, $lLen, "middle", $position) ; my($collision)= boxLinesOccupied(\@finalWay, $size/2);
my (@finalWay) = @$refFinal ;
# my ($collision) = lineCrossings (\@finalWay) ;
my $size = $$ruleRef{'labelsize'} ; if($collision == 0){ $labelDrawn = 1;
my ($collision) = boxLinesOccupied (\@finalWay, $size/2 ) ; $drawnLabels{$name}= 1;
my $pathName = "Path" . $pathNumber; $pathNumber++;
if ($collision == 0) { # createPath($pathName, \@points, "definitions");
$labelDrawn = 1 ; createPath($pathName, \@finalWay, "definitions");
$drawnLabels { $name } = 1 ;
my $pathName = "Path" . $pathNumber ; $pathNumber++ ;
# createPath ($pathName, \@points, "definitions") ; my $size = $$ruleRef{'labelsize'};
createPath ($pathName, \@finalWay, "definitions") ; my $color = $$ruleRef{'labelcolor'};
my $font = $$ruleRef{'labelfont'};
my $fontFamily = $$ruleRef{'labelfontfamily'};
my $labelBold = $$ruleRef{'labelbold'};
my $labelItalic = $$ruleRef{'labelitalic'};
my $labelHalo = $$ruleRef{'labelhalo'};
my $labelHaloColor = $$ruleRef{'labelhalocolor'};
my $size = $$ruleRef{'labelsize'} ; my $svgText = createTextSVG($fontFamily, $font, $labelBold, $labelItalic, $size, $color, $labelHalo, $labelHaloColor);
my $color = $$ruleRef{'labelcolor'} ; pathText($svgText, $name, $pathName, $$ruleRef{'labeloffset'}, "middle", 50, "text");
my $font = $$ruleRef{'labelfont'} ;
my $fontFamily = $$ruleRef{'labelfontfamily'} ;
my $labelBold = $$ruleRef{'labelbold'} ;
my $labelItalic = $$ruleRef{'labelitalic'} ;
my $labelHalo = $$ruleRef{'labelhalo'} ;
my $labelHaloColor = $$ruleRef{'labelhalocolor'} ;
my $svgText = createTextSVG ( $fontFamily, $font, $labelBold, $labelItalic, $size, $color, $labelHalo, $labelHaloColor) ; boxOccupyLines(\@finalWay, $size/2, 3);
pathText ($svgText, $name, $pathName, $$ruleRef{'labeloffset'}, "middle", 50, "text") ;
boxOccupyLines (\@finalWay, $size/2, 3) ;
} } else{ # print "INFO: $name labeled less often than desired.\n";
else { } } if($labelDrawn == 0){ $notDrawnLabels{$name}= 1;
# print "INFO: $name labeled less often than desired.\n" ; } } } }} my $labelFileName = cv('out');
} $labelFileName =~ s/\.svg/_NotDrawnLabels.txt/;
} my $labelFile;
if ($labelDrawn == 0) { open($labelFile, ">", $labelFileName)or die("couldn't open label file $labelFileName");
$notDrawnLabels { $name } = 1 ; print $labelFile "Not drawn labels\n\n";
} foreach my $labelName(sort keys %notDrawnLabels){ if(!defined $drawnLabels{$labelName}){ print $labelFile "$labelName\n";
} }} close($labelFile);
}
}
}
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) ;
# way name substitutes legend? # way name substitutes legend?
if ( cv('wns') > 0 ) { if(cv('wns')> 0){ createWNSLegend();
createWNSLegend() ; }
}
} }
# ------------------------------------------------------------ # ------------------------------------------------------------
sub createWNSLegend { sub createWNSLegend{ my $size = cv('wnssize');
my $size = cv('wnssize') ; my $color = cv('wnscolor');
my $color = cv('wnscolor') ;
# TODO max len auto size # TODO max len auto size
my $maxLen = 0 ; my $maxLen = 0;
foreach my $e ( @wns ) { foreach my $e(@wns){ if(length $e->[1] > $maxLen){$maxLen = length $e->[1];}}
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');
my $nx = 1 * $size / 10 * cv('ppc');
my $ty = 1.5 * $size;
my $sy = 2 * $size ; my $sizeX = $sx;
my $sx = (4 + $maxLen) * $size / 10 * cv('ppc') ; my $sizeY = $sy * scalar @wns;
my $tx = 4 * $size / 10 * cv('ppc') ;
my $nx = 1 * $size / 10 * cv('ppc') ;
my $ty = 1.5 * $size ;
my $sizeX = $sx ;
my $sizeY = $sy * scalar @wns ;
# defs # defs
my $actualLine = 0 ; my $actualLine = 0;
addToLayer ("definitions", "<g id=\"wnsdef\" width=\"$sizeX\" height=\"$sizeY\" >") ; addToLayer("definitions", "<g id=\"wnsdef\" width=\"$sizeX\" height=\"$sizeY\" >");
# bg # bg
my $bg = cv('wnsbgcolor') ; my $bg = cv('wnsbgcolor');
my $svgString = "fill=\"$bg\"" ; my $svgString = "fill=\"$bg\"";
drawRect (0, 0, $sizeX, $sizeY, 0, $svgString, "definitions") ; drawRect(0, 0, $sizeX, $sizeY, 0, $svgString, "definitions");
$svgString = createTextSVG ( cv('elementFontFamily'), cv('elementFont'), undef, undef, cv('wnssize'), cv('wnscolor'), undef, undef) ; $svgString = createTextSVG(cv('elementFontFamily'), cv('elementFont'), undef, undef, cv('wnssize'), cv('wnscolor'), undef, undef);
foreach my $e ( @wns ) { foreach my $e(@wns){ my $y = $actualLine * $sy + $ty;
my $y = $actualLine * $sy + $ty ; drawText($nx, $y, 0, $e->[0], $svgString, "definitions");
drawText ($nx, $y, 0, $e->[0], $svgString, "definitions") ; drawText($tx, $y, 0, $e->[1], $svgString, "definitions");
drawText ($tx, $y, 0, $e->[1], $svgString, "definitions") ;
$actualLine++ ; $actualLine++;
} }
addToLayer("definitions", "</g>");
addToLayer ("definitions", "</g>") ; my $posX = 0;
my $posY = 0;
my $posX = 0 ;
my $posY = 0 ;
# reset some variables # reset some variables
($sizeX, $sizeY) = getDimensions() ; ($sizeX, $sizeY)= getDimensions();
$sy = $sy * scalar @wns ; $sy = $sy * scalar @wns;
if ( cv('wns') eq "2") { if(cv('wns')eq "2"){ $posX = $sizeX - $sx;
$posX = $sizeX - $sx ; $posY = 0;
$posY = 0 ;
}
if ( cv('wns') eq "3") {
$posX = 0 ;
$posY = $sizeY - $sy ;
}
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') eq "5") {
createLegendFile ($sx, $sy, "_wns", "#wnsdef") ;
}
} }
if(cv('wns')eq "3"){ $posX = 0;
1 ; $posY = $sizeY - $sy;
}
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')eq "5"){ createLegendFile($sx, $sy, "_wns", "#wnsdef");
}}
1;

496
mwWays.pm
View File

@ -4,10 +4,10 @@
# #
# #
# #
# Copyright (C) 2011, Gerhard Schwanz # 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 # This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3 of the License, or (at your option) any later version. # Free Software Foundation; either version 3 of the License, or(at your option)any later version.
# #
# This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or # This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. # FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
@ -16,379 +16,269 @@
# #
package mwWays ; package mwWays;
use strict ; use strict;
use warnings ; use warnings;
use OSM::osm 8.3 ; use OSM::osm 8.3;
use mwConfig ; use mwConfig;
use mwFile ; use mwFile;
use mwRules ; use mwRules;
use mwMap ; use mwMap;
use mwMisc ; use mwMisc;
use mwWayLabel ; use mwWayLabel;
use mwCoastLines ; use mwCoastLines;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
require Exporter ; require Exporter;
@ISA = qw ( Exporter AutoLoader ) ; @ISA = qw(Exporter AutoLoader);
@EXPORT = qw ( processWays @EXPORT = qw(processWays
getCoastWays getCoastWays
createDirectory createDirectory
) ; );
my $areasOmitted = 0 ; my $areasOmitted = 0;
my $areasDrawn = 0 ; my $areasDrawn = 0;
my $areaLabels = 0 ; my $areaLabels = 0;
my $areaLabelsOmitted = 0 ; my $areaLabelsOmitted = 0;
my @coastWays = () ; my @coastWays =();
sub processWays { sub processWays{
print "drawing ways/areas...\n";
print "drawing ways/areas...\n" ; my $nodesRef; my $tagRef;
($nodesRef, $tagRef)= getWayPointers();
my($lonRef, $latRef, $nodeTagRef)= getNodePointers();
my $nodesRef; my $tagRef ; foreach my $wayId(keys %$nodesRef){ my @tags = @{$$tagRef{$wayId}};
($nodesRef, $tagRef) = getWayPointers () ; my $tagsString = "";
my ($lonRef, $latRef, $nodeTagRef) = getNodePointers() ;
foreach my $wayId (keys %$nodesRef) {
my @tags = @{ $$tagRef{$wayId} } ;
my $tagsString = "" ;
# coast # coast
my $v = getValue ("natural", \@tags) ; my $v = getValue("natural", \@tags);
if ( (defined $v) and ($v eq "coastline") ) { if((defined $v)and($v eq "coastline")){ push @coastWays, $wayId;
push @coastWays, $wayId ;
} }
# WAYS # WAYS
my $ruleRef = getWayRule (\@tags) ; my $ruleRef = getWayRule(\@tags);
if (defined $ruleRef) { if(defined $ruleRef){ my @nodes = @{$$nodesRef{$wayId}};
my @nodes = @{ $$nodesRef{ $wayId } } ;
my $layer = getValue ("layer", $$tagRef{$wayId}) ;
if ( ! defined $layer ) { $layer = 0 ; }
my $layer = getValue("layer", $$tagRef{$wayId});
if(! defined $layer){$layer = 0;}
# TODO check for numeric!!! # TODO check for numeric!!!
my $direction = 0 ; my $direction = 0;
my $ow = getValue("oneway", $$tagRef{$wayId}) ; my $ow = getValue("oneway", $$tagRef{$wayId});
if (defined $ow) { if(defined $ow){ if(($ow eq "yes")or($ow eq "true")or($ow eq "1")){$direction = 1;} if($ow eq "-1"){$direction = -1;} }
if (($ow eq "yes") or ($ow eq "true") or ($ow eq "1")) { $direction = 1 ; } my $bridge = getValue("bridge", $$tagRef{$wayId});
if ($ow eq "-1") { $direction = -1 ; } 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;}
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);
} }
my $size = $$ruleRef{'size'};
my $bridge = getValue("bridge", $$tagRef{$wayId}) ; if((cv('oneways')eq "1")and($direction != 0)){ addOnewayArrows(\@nodes, $direction, $size, $layer);
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 ; }
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 ) ;
}
my $size = $$ruleRef{'size'} ;
if ( ( cv('oneways') eq "1" ) and ($direction != 0) ) {
addOnewayArrows (\@nodes, $direction, $size, $layer) ;
}
# LABEL WAY # LABEL WAY
if ( cv('ignorelabels') eq "0" ) { if(cv('ignorelabels')eq "0"){ if($$ruleRef{'label'}ne "none"){
if ($$ruleRef{'label'} ne "none") { my $name = ""; my $ref1; my @names;
my $name = "" ; my $ref1 ; my @names ; if(grep /shield/i, $$ruleRef{'label'}){ ($name, $ref1)= createLabel(\@tags, "ref",0, 0);
my $ref = $name;
if (grep /shield/i, $$ruleRef{'label'} ) { if(grep /;/, $ref){ my @a = split /;/, $ref;
($name, $ref1) = createLabel (\@tags, "ref",0, 0) ; $ref = $a[0];
my $ref = $name ;
if (grep /;/, $ref) {
my @a = split /;/, $ref ;
$ref = $a[0] ;
} }
if($ref ne ""){ @names =($ref);
if ($ref ne "") { $name = $$ruleRef{'label'}. ":$ref";
@names = ($ref) ; # print "DRAW WAY: name set to $name\n";
$name = $$ruleRef{'label'} . ":$ref" ; } else{ @names =();
# print "DRAW WAY: name set to $name\n" ; $name = "";
} }
else { # print "WAY: name for shield >$name<\n";
@names = () ; } else{ ($name, $ref1)= createLabel(\@tags, $$ruleRef{'label'}, 0, 0);
$name = "" ; @names = @$ref1;
$name = labelTransform($name, $$ruleRef{'labeltransform'});
} }
if((cv('nolabel')eq "1")and($name eq "")){$name = "NO LABEL";}
# print "WAY: name for shield >$name<\n" ; 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
}# ignorelabels
} }
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
} # ignorelabels
}
# AREAS # AREAS
$ruleRef = getAreaRule (\@tags) ; $ruleRef = getAreaRule(\@tags);
my @nodes = @{ $$nodesRef{ $wayId } } ; my @nodes = @{$$nodesRef{$wayId}};
if ( (defined $ruleRef) and ($nodes[0] == $nodes[-1]) ) { if((defined $ruleRef)and($nodes[0] == $nodes[-1])){ my $color = $$ruleRef{'color'};
my $color = $$ruleRef{'color'} ; my $icon = $$ruleRef{'icon'};
my $icon = $$ruleRef{'icon'} ; my $base = $$ruleRef{'base'};
my $base = $$ruleRef{'base'} ; my $svgString = $$ruleRef{'svgstring'};
my $svgString = $$ruleRef{'svgstring'} ; my $size = areaSize(\@nodes);
my $size = areaSize (\@nodes) ; my @ways = [@nodes];
my @ways = [@nodes] ;
if ( ($svgString eq "") and ($icon eq "none") ) { if(($svgString eq "")and($icon eq "none")){ $svgString = "fill=\"$color\" ";
$svgString = "fill=\"$color\" " ;
} }
if($size > cv('minareasize')){ if($base eq "yes"){ drawArea($svgString, $icon, \@ways, 1, "base");
if ($size > cv('minareasize') ) { } else{ drawArea($svgString, $icon, \@ways, 1, "area");
if ($base eq "yes") { } $areasDrawn++;
drawArea ($svgString, $icon, \@ways, 1, "base") ;
}
else {
drawArea ($svgString, $icon, \@ways, 1, "area") ;
}
$areasDrawn++ ;
# DRAW label # DRAW label
if ( $$ruleRef{'label'} ne "none" ) { if($$ruleRef{'label'}ne "none"){ $areaLabels++;
$areaLabels++ ; if($size > cv('minarealabelsize')){ # text
if ($size > cv('minarealabelsize') ) { my($name, $ref1)= createLabel(\@tags, $$ruleRef{'label'},0, 0);
# text $name = labelTransform($name, $$ruleRef{'labeltransform'});
my ($name, $ref1) = createLabel (\@tags, $$ruleRef{'label'},0, 0) ;
$name = labelTransform ($name, $$ruleRef{'labeltransform'}) ;
# pos # pos
my ($lon, $lat) = areaCenter ( $$nodesRef{$wayId} ) ; my($lon, $lat)= areaCenter($$nodesRef{$wayId});
# draw # draw
my $labelFont = $$ruleRef{'labelfont'} ; my $labelFont = $$ruleRef{'labelfont'};
my $labelFontFamily = $$ruleRef{'labelfontfamily'} ; my $labelFontFamily = $$ruleRef{'labelfontfamily'};
my $labelSize = $$ruleRef{'labelsize'} ; my $labelSize = $$ruleRef{'labelsize'};
my $color = $$ruleRef{'labelcolor'} ; my $color = $$ruleRef{'labelcolor'};
my $labelBold = $$ruleRef{'labelbold'} ; my $labelBold = $$ruleRef{'labelbold'};
my $labelItalic = $$ruleRef{'labelitalic'} ; my $labelItalic = $$ruleRef{'labelitalic'};
my $labelHalo = $$ruleRef{'labelhalo'} ; my $labelHalo = $$ruleRef{'labelhalo'};
my $labelHaloColor = $$ruleRef{'labelhalocolor'} ; my $labelHaloColor = $$ruleRef{'labelhalocolor'};
my $svgText = createTextSVG ( $labelFontFamily, $labelFont, $labelBold, $labelItalic, $labelSize, $color, $labelHalo, $labelHaloColor) ; my $svgText = createTextSVG($labelFontFamily, $labelFont, $labelBold, $labelItalic, $labelSize, $color, $labelHalo, $labelHaloColor);
mwLabel::placeLabelAndIcon ($lon, $lat, 0, 0, $name, $svgText, "none", 0, 0, "arealabels") ; 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) ;
} }
}# 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);
}}
# ---------------------------------------------------------------------------- # ----------------------------------------------------------------------------
sub createWayParameters { sub createWayParameters{ my($ruleRef, $layer, $bridge, $tunnel)= @_;
my ($ruleRef, $layer, $bridge, $tunnel) = @_ ;
my $svg1 = "" ; my $layer1 = 0 ; my $svg1 = ""; my $layer1 = 0;
my $svg2 = "" ; my $layer2 = 0 ; my $svg2 = ""; my $layer2 = 0;
my %dashDefinition = () ; my %dashDefinition =();
@{$dashDefinition {1} } = ("round", "20,20") ; @{$dashDefinition{1}}=("round", "20,20");
@{$dashDefinition {2} } = ("round", "44,20") ; @{$dashDefinition{2}}=("round", "44,20");
@{$dashDefinition {3} } = ("round", "28,20") ; @{$dashDefinition{3}}=("round", "28,20");
@{$dashDefinition {4} } = ("round", "12,20") ; @{$dashDefinition{4}}=("round", "12,20");
@{$dashDefinition {10} } = ("round", "8,8") ; @{$dashDefinition{10}}=("round", "8,8");
@{$dashDefinition {11} } = ("round", "16,16") ; @{$dashDefinition{11}}=("round", "16,16");
@{$dashDefinition {12} } = ("round", "24,24") ; @{$dashDefinition{12}}=("round", "24,24");
@{$dashDefinition {13} } = ("round", "32,32") ; @{$dashDefinition{13}}=("round", "32,32");
@{$dashDefinition {14} } = ("round", "40,40") ; @{$dashDefinition{14}}=("round", "40,40");
@{$dashDefinition {20} } = ("round", "0,8,0,16") ; @{$dashDefinition{20}}=("round", "0,8,0,16");
@{$dashDefinition {21} } = ("round", "0,16,0,32") ; @{$dashDefinition{21}}=("round", "0,16,0,32");
@{$dashDefinition {22} } = ("round", "0,24,0,48") ; @{$dashDefinition{22}}=("round", "0,24,0,48");
@{$dashDefinition {23} } = ("round", "0,32,0,48") ; @{$dashDefinition{23}}=("round", "0,32,0,48");
@{$dashDefinition {30} } = ("butt", "4,4") ; @{$dashDefinition{30}}=("butt", "4,4");
@{$dashDefinition {31} } = ("butt", "8,8") ; @{$dashDefinition{31}}=("butt", "8,8");
@{$dashDefinition {32} } = ("butt", "12,12") ; @{$dashDefinition{32}}=("butt", "12,12");
@{$dashDefinition {33} } = ("butt", "4,12") ; @{$dashDefinition{33}}=("butt", "4,12");
@{$dashDefinition {34} } = ("butt", "4,20") ; @{$dashDefinition{34}}=("butt", "4,20");
@{$dashDefinition {35} } = ("butt", "8,20") ; @{$dashDefinition{35}}=("butt", "8,20");
if ( cv ('autobridge') eq "0" ) { if(cv('autobridge')eq "0"){ $layer = 0;
$layer = 0 ; }
} if(($$ruleRef{'svgstringtop'}ne "")or($$ruleRef{'svgstringbottom'}ne "")){
$svg1 = $$ruleRef{'svgstringtop'};
if ( ( $$ruleRef{'svgstringtop'} ne "" ) or ( $$ruleRef{'svgstringbottom'} ne "" ) ) { $svg2 = $$ruleRef{'svgstringbottom'};
$svg1 = $$ruleRef{'svgstringtop'} ;
$svg2 = $$ruleRef{'svgstringbottom'} ;
# TODO layer # TODO layer
$layer1 = $layer ; $layer1 = $layer;
$layer2 = $layer ; $layer2 = $layer;
} } else{
else { my $size = $$ruleRef{'size'};
my $color = $$ruleRef{'color'};
my $size = $$ruleRef{'size'} ; my $lc = "round";
my $color = $$ruleRef{'color'} ; my $lj = "round";
my $lc = "round" ; my $dash = "";
my $lj = "round" ; 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'};
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;
$layer1 = $layer + $size / 100;
my $dash = "" ; my $bs = $$ruleRef{'bordersize'};
if ( $$ruleRef{'dash'} ne "" ) { $lc = "round";
if ( ! grep /,/, $$ruleRef{'dash'}) { $dash = "";
my @ds = @{$dashDefinition{ $$ruleRef{'dash'} } } ;
$lc = $ds[0] ;
my $style = $ds[1] ;
$dash = "stroke-dasharray=\"$style\" " ;
}
else {
$lc = $$ruleRef{'dashcap'} ;
my $style = $$ruleRef{'dash'} ;
$dash = "stroke-dasharray=\"$style\"" ;
}
}
# top (actual way) if(cv('autobridge')eq "1"){ # TODO bridge/tunnel
$svg1 = "stroke=\"$color\" stroke-width=\"$size\" stroke-linecap=\"$lc\" fill=\"none\" stroke-linejoin=\"$lj\" " . $dash ; if($bridge == 1){ $lc = "butt";
$layer1 = $layer + $size / 100 ; $bs += 3; # TODO config value
} elsif($tunnel == 1){ $lc = "butt";
my $bs = $$ruleRef{'bordersize'} ; $dash = "stroke-dasharray=\"10,10\" ";
$lc = "round" ; $bs += 3;
$dash = "" ; } }
# bottom(border) if($bs > 0){ $size = 2 * $bs + $$ruleRef{'size'};
if ( cv ('autobridge') eq "1" ) { $color = $$ruleRef{'bordercolor'};
# TODO bridge/tunnel $svg2 = "stroke=\"$color\" stroke-width=\"$size\" stroke-linecap=\"$lc\" fill=\"none\" stroke-linejoin=\"$lj\" " . $dash;
if ( $bridge == 1) { $layer2 = $layer - 0.3 + $size / 100;
$lc = "butt" ; } else{ $svg2 = "";
$bs += 3 ; # TODO config value $layer2 = 0;
} }
elsif ( $tunnel == 1) {
$lc = "butt" ;
$dash = "stroke-dasharray=\"10,10\" " ;
$bs += 3 ;
}
}
# 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 = "" ;
$layer2 = 0 ;
}
}
return ($svg1, $layer1, $svg2, $layer2) ;
} }
return($svg1, $layer1, $svg2, $layer2);
}
# --------------------------------------------------------------------------------- # ---------------------------------------------------------------------------------
sub createDirectory { sub createDirectory{ my $directoryName;
my $directoryName ; my $dirFile;
my $dirFile ; $directoryName = cv('out');
$directoryName = cv ('out') ; $directoryName =~ s/\.svg/\_streets.txt/;
$directoryName =~ s/\.svg/\_streets.txt/ ; setConfigValue("directoryname", $directoryName);
setConfigValue("directoryname", $directoryName) ; print "creating dir file $directoryName ...\n";
print "creating dir file $directoryName ...\n" ; open($dirFile, ">", $directoryName)or die("can't open dir file $directoryName\n");
open ($dirFile, ">", $directoryName) or die ("can't open dir file $directoryName\n") ;
my $ref = getDirectory() ; my $ref = getDirectory();
my %directory = %$ref ; my %directory = %$ref;
if ( cv('grid') eq "0") { if(cv('grid')eq "0"){ foreach my $street(sort keys %directory){ $street = replaceHTMLCode($street);
foreach my $street (sort keys %directory) { print $dirFile "$street\n";
$street = replaceHTMLCode ( $street ) ; }} else{ foreach my $street(sort keys %directory){ my $streetSanitized = replaceHTMLCode($street);
print $dirFile "$street\n" ; print $dirFile "$streetSanitized\t";
} foreach my $square(sort keys %{$directory{$street}}){ print $dirFile "$square ";
} } print $dirFile "\n";
else { }} close($dirFile);
foreach my $street (sort keys %directory) {
my $streetSanitized = replaceHTMLCode ( $street ) ;
print $dirFile "$streetSanitized\t" ;
foreach my $square (sort keys %{$directory{$street}}) {
print $dirFile "$square " ;
}
print $dirFile "\n" ;
}
}
close ($dirFile) ;
} }
1;
1 ;