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

554
mwCoastLines.pm
View File

@ -1,13 +1,10 @@
#
# 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
# 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
# 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 warnings ;
use Math::Polygon ;
use List::Util qw[min max] ;
use mwMap ;
use mwFile ;
use mwConfig ;
use mwMisc ;
use mwMap;
use mwFile;
use mwConfig;
use mwMisc;
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
#
my $ref = shift ;
my $x = $ref->[0] ;
my $y = $ref->[1] ;
my $xn ; my $yn ;
my $min = 99999 ;
# print " NP: initial $x $y\n" ;
my ($xmax, $ymax) = getDimensions() ;
# print " NP: dimensions $xmax $ymax\n" ;
if ( abs ($xmax-$x) < $min) { # right
$xn = $xmax ;
$yn = $y ;
$min = abs ($xmax-$x) ;
}
if ( abs ($ymax-$y) < $min) { # bottom
$xn = $x ;
$yn = $ymax ;
$min = abs ($ymax-$y) ;
}
if ( abs ($x) < $min) { # left
$xn = 0 ;
$yn = $y ;
$min = abs ($x) ;
}
if ( abs ($y) < $min) { # top
$xn = $x ;
$yn = 0 ;
}
# print " NP: final $xn $yn\n" ;
my @a = ($xn, $yn) ;
return (\@a) ;
}
sub nextPointOnBorder {
#
my $ref = shift;
my $x = $ref->[0];
my $y = $ref->[1];
my $xn; my $yn;
my $min = 99999;
# print " NP: initial $x $y\n";
my($xmax, $ymax)= getDimensions();
# print " NP: dimensions $xmax $ymax\n";
if(abs($xmax-$x)<$min){# right
$xn = $xmax;
$yn = $y;
$min = abs($xmax-$x);
} if(abs($ymax-$y)<$min){# bottom
$xn = $x;
$yn = $ymax;
$min = abs($ymax-$y);
} if(abs($x)<$min){# left
$xn = 0;
$yn = $y;
$min = abs($x);
} if(abs($y)< $min){# top
$xn = $x;
$yn = 0;
} # 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
# hints if returned point is a corner
#
# right turns
my ($x, $y) = @_ ;
my ($xn, $yn) ;
my $corner = 0 ;
my ($xmax, $ymax) = getDimensions() ;
if ($x == $xmax) { # right border
if ($y < $ymax) {
$xn = $xmax ; $yn = $y + 1 ;
}
else {
$xn = $xmax - 1 ; $yn = $ymax ;
}
}
else {
if ($x == 0) { # left border
if ($y > 0) {
$xn = 0 ; $yn = $y - 1 ;
}
else {
$xn = 1 ; $yn = 0 ;
}
}
else {
if ($y == $ymax) { # bottom border
if ($x > 0) {
$xn = $x - 1 ; $yn = $ymax ;
}
else {
$xn = 0 ; $yn = $ymax - 1 ;
}
}
else {
if ($y == 0) { # top border
if ($x < $xmax) {
$xn = $x + 1 ; $yn = 0 ;
}
else {
$xn = $xmax ; $yn = 1 ;
}
}
}
}
}
# print "NPOB: $x, $y --- finito $xn $yn\n" ;
my($x, $y)= @_;
my($xn, $yn);
my $corner = 0;
my($xmax, $ymax)= getDimensions();
if($x == $xmax){# right border
if($y < $ymax){ $xn = $xmax; $yn = $y + 1;
} else{ $xn = $xmax - 1; $yn = $ymax;
}} else{ if($x == 0){# left border
if($y > 0){ $xn = 0; $yn = $y - 1;
} else{ $xn = 1; $yn = 0;
} } else{ if($y == $ymax){# bottom border
if($x > 0){ $xn = $x - 1; $yn = $ymax;
} else{ $xn = 0; $yn = $ymax - 1;
} } else{ if($y == 0){# top border
if($x < $xmax){ $xn = $x + 1; $yn = 0;
} else{ $xn = $xmax; $yn = 1;
} } } }} # print "NPOB: $x, $y --- finito $xn $yn\n";
if ( ($xn == 0) and ($yn == 0) ) { $corner = 1 ; }
if ( ($xn == 0) and ($yn == $ymax) ) { $corner = 1 ; }
if ( ($xn == $xmax) and ($yn == 0) ) { $corner = 1 ; }
if ( ($xn == $xmax) and ($yn == $ymax) ) { $corner = 1 ; }
return ($xn, $yn, $corner) ;
if(($xn == 0)and($yn == 0)){$corner = 1;} if(($xn == 0)and($yn == $ymax)){$corner = 1;} if(($xn == $xmax)and($yn == 0)){$corner = 1;} if(($xn == $xmax)and($yn == $ymax)){$corner = 1;}
return($xn, $yn, $corner);
}
# ---------------------------------------------------------------------------------
sub processCoastLines {
#
#
#
print "check and process coastlines...\n" ;
sub processCoastLines{ print "check and process coastlines...\n";
my $ref = shift ; # ref to all coast ways
my @allWays = @$ref ;
my $ref = shift; # ref to all coast ways
my @allWays = @$ref;
if (cv('debug') eq "1") {
print "COAST: " . scalar (@allWays) . " coast ways initially found.\n" ;
print "COAST: ways: @allWays\n\n" ;
}
if(cv('debug')){
print "COAST: " . scalar(@allWays). " coast ways initially found.\n";
print "COAST: ways: @allWays\n\n";
}
my ($lonRef, $latRef) = getNodePointers() ;
my ($nodesRef, $tagRef) = getWayPointers() ;
my($lonRef, $latRef)= getNodePointers();
my($nodesRef, $tagRef)= getWayPointers();
# check coast ways. eliminate invisible ways. eliminate points outside map.
my @newWays = () ;
foreach my $w ( @allWays ) {
my @nodes = @{ $$nodesRef{ $w } } ;
my @newWays =();
foreach my $w(@allWays){ my @nodes = @{$$nodesRef{$w}};
my $allIn = 1 ;
my $allOut = 1 ;
foreach my $n ( @nodes ) {
if ( pointInMap ($n) ) {
$allOut = 0 ;
}
else {
$allIn = 0 ;
}
}
if ( $allIn ) {
# use way as it is
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
my $allIn = 1;
my $allOut = 1;
foreach my $n(@nodes){ if(pointInMap($n)){ $allOut = 0;
} else{ $allIn = 0;
} }
if($allIn){ # use way as it is
push @newWays, $w;
print "COAST: way $w will be used unmodified.\n" if cv('debug');
} elsif($allOut){ # do nothing
print "COAST: way $w will NOT be used. outside map.\n" if cv('debug');} } else{ # eliminate all outside nodes at start and end of way, then use new way
# eliminate outsides at start
while ( (scalar @nodes >= 1) and ( ! pointInMap ($nodes[0]) ) ) {
shift @nodes ;
}
shift @nodes while((scalar(@nodes)>= 1)and not pointInMap($nodes[0]));
# eliminate outsides at end
while ( (scalar @nodes >= 1) and ( ! pointInMap ($nodes[-1]) ) ) {
pop @nodes ;
}
if ( scalar @nodes >= 2 ) {
@{ $$nodesRef{$w}} = @nodes ;
push @newWays, $w ;
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" ; }
}
}
}
@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" ; }
while((scalar @nodes >= 1)and not pointInMap($nodes[-1])){ pop @nodes;
}
if(scalar @nodes >= 2){ @{$$nodesRef{$w}}= @nodes;
push @newWays, $w;
if(cv('debug')eq "1"){print "COAST: modified way $w will be used.\n";} } else{ if(cv('debug')eq "1"){print "COAST: way $w too short now.\n";} } }
}
@allWays = @newWays;
if(cv('debug')eq "1"){
print "\nCOAST: " . scalar(@allWays). " coast ways will be used.\n";
print "COAST: ways: @allWays\n\n";
}
if(scalar @allWays > 0){ # build rings
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');
# convert rings to coordinate system
my @ringCoordsOpen = () ; my @ringCoordsClosed = () ;
for (my $i=0; $i<=$#ringNodes; $i++) {
# print "COAST: initial ring $i\n" ;
my @actualCoords = () ;
foreach my $node (@{$ringNodes[$i]}) {
push @actualCoords, [convert ($$lonRef{$node}, $$latRef{$node})] ;
}
if (${$ringNodes[$i]}[0] == ${$ringNodes[$i]}[-1]) {
push @ringCoordsClosed, [@actualCoords] ; # islands
}
else {
push @ringCoordsOpen, [@actualCoords] ;
}
# printRingCoords (\@actualCoords) ;
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" ;
my @ringCoordsOpen =(); my @ringCoordsClosed =();
for(my $i=0; $i<=$#ringNodes; $i++){ # print "COAST: initial ring $i\n";
my @actualCoords =();
foreach my $node(@{$ringNodes[$i]}){ push @actualCoords, [convert($$lonRef{$node}, $$latRef{$node})];
} if(${$ringNodes[$i]}[0] == ${$ringNodes[$i]}[-1]){ push @ringCoordsClosed, [@actualCoords]; # islands
} else{ push @ringCoordsOpen, [@actualCoords];
} # printRingCoords(\@actualCoords);
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(cv('debug')eq "1"){print "COAST: add points on border...\n";} foreach my $ring(@ringCoordsOpen){ # print "COAST: ring $ring with border nodes\n";
# add first point on border
my $ref = nearestPoint ($ring->[0]) ;
my @a = @$ref ;
unshift @$ring, [@a] ;
my $ref = nearestPoint($ring->[0]);
my @a = @$ref;
unshift @$ring, [@a];
# add last point on border
$ref = nearestPoint ($ring->[-1]) ;
@a = @$ref ;
push @$ring, [@a] ;
# printRingCoords ($ring) ;
}
my @islandRings = @ringCoordsClosed ;
if (cv('debug') eq "1") { print "COAST: " . scalar (@islandRings) . " islands found.\n" ; }
@ringCoordsClosed = () ;
$ref = nearestPoint($ring->[-1]);
@a = @$ref;
push @$ring, [@a];
# printRingCoords($ring);
}
my @islandRings = @ringCoordsClosed;
print "COAST: " . scalar(@islandRings). " islands found.\n" if cv('debug');
@ringCoordsClosed =();
# process ringCoordsOpen
# add other rings, corners...
while (scalar @ringCoordsOpen > 0) { # as long as there are open rings
if (cv('debug') eq "1") { print "COAST: building ring...\n" ; }
my $ref = shift @ringCoordsOpen ; # get start ring
my @actualRing = @$ref ;
while(scalar @ringCoordsOpen > 0){# as long as there are open rings
print "COAST: building ring...\n" if(cv('debug');
my $ref = shift @ringCoordsOpen; # get start ring
my @actualRing = @$ref;
my $closed = 0 ; # mark as not closed
my $actualX = $actualRing[-1]->[0] ;
my $actualY = $actualRing[-1]->[1] ;
my $closed = 0; # mark as not closed
my $actualX = $actualRing[-1]->[0];
my $actualY = $actualRing[-1]->[1];
my $actualStartX = $actualRing[0]->[0] ;
my $actualStartY = $actualRing[0]->[1] ;
my $actualStartX = $actualRing[0]->[0];
my $actualStartY = $actualRing[0]->[1];
if (cv('debug') eq "1") { print "COAST: actual and actualStart $actualX, $actualY - $actualStartX, $actualStartY\n" ; }
print "COAST: actual and actualStart $actualX, $actualY - $actualStartX, $actualStartY\n" if cv('debug');
my $corner ;
while (!$closed) { # as long as this ring is not closed
($actualX, $actualY, $corner) = nextPointOnBorder ($actualX, $actualY) ;
# print " actual $actualX, $actualY\n" ;
my $startFromOtherPolygon = -1 ;
my $corner;
while(!$closed){# as long as this ring is not closed
($actualX, $actualY, $corner)= nextPointOnBorder($actualX, $actualY);
# print " actual $actualX, $actualY\n";
my $startFromOtherPolygon = -1;
# find matching ring if there is another ring
if (scalar @ringCoordsOpen > 0) {
for (my $i=0; $i <= $#ringCoordsOpen; $i++) {
my @test = @{$ringCoordsOpen[$i]} ;
# print " test ring $i: ", $test[0]->[0], " " , $test[0]->[1] , "\n" ;
if ( ($actualX == $test[0]->[0]) and ($actualY == $test[0]->[1]) ) {
$startFromOtherPolygon = $i ;
if (cv('debug') eq "1") { print "COAST: matching start other polygon found i= $i\n" ; }
}
}
}
# process matching polygon, if present
if ($startFromOtherPolygon != -1) { # start from other polygon {
# append nodes
# print "ARRAY TO PUSH: @{$ringCoordsOpen[$startFromOtherPolygon]}\n" ;
push @actualRing, @{$ringCoordsOpen[$startFromOtherPolygon]} ;
if(scalar(@ringCoordsOpen)> 0){ for(my $i=0; $i <= $#ringCoordsOpen; $i++){ my @test = @{$ringCoordsOpen[$i]};
# print " test ring $i: ", $test[0]->[0], " " , $test[0]->[1] , "\n";
if(($actualX == $test[0]->[0])and($actualY == $test[0]->[1])){ $startFromOtherPolygon = $i;
print "COAST: matching start other polygon found i= $i\n" if cv('debug');
} } } # process matching polygon, if present
if($startFromOtherPolygon != -1){# start from other polygon{ # append nodes
# print "ARRAY TO PUSH: @{$ringCoordsOpen[$startFromOtherPolygon]}\n";
push @actualRing, @{$ringCoordsOpen[$startFromOtherPolygon]};
# set actual
$actualX = $actualRing[-1]->[0] ;
$actualY = $actualRing[-1]->[1] ;
$actualX = $actualRing[-1]->[0];
$actualY = $actualRing[-1]->[1];
# drop p2 from opens
splice @ringCoordsOpen, $startFromOtherPolygon, 1 ;
if (cv('debug') eq "1") { print "COAST: openring $startFromOtherPolygon added to actual ring\n" ; }
}
else {
if ($corner) { # add corner to actual ring
push @actualRing, [$actualX, $actualY] ;
if (cv('debug') eq "1") { print "COAST: corner $actualX, $actualY added to actual ring\n" ; }
}
}
# check if closed
if ( ($actualX == $actualStartX) and ($actualY == $actualStartY) ) {
$closed = 1 ;
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
splice @ringCoordsOpen, $startFromOtherPolygon, 1;
print "COAST: openring $startFromOtherPolygon added to actual ring\n" if cv('debug');
} else{ if($corner){# add corner to actual ring
push @actualRing, [$actualX, $actualY];
print "COAST: corner $actualX, $actualY added to actual ring\n" if cv('debug');
} } # check if closed
if(($actualX == $actualStartX)and($actualY == $actualStartY)){ $closed = 1;
push @actualRing, [$actualX, $actualY];
push @ringCoordsClosed, [@actualRing];
print "COAST: ring now closed and moved to closed rings.\n" if cv('debug');
} }# !closed
}# open rings
my $color = cv('oceancolor') ;
my $color = cv('oceancolor');
# build islandRings polygons
if (cv('debug') eq "1") { print "OCEAN: building island polygons\n" ; }
my @islandPolygons = () ;
if (scalar @islandRings > 0) {
for (my $i=0; $i<=$#islandRings; $i++) {
my @poly = () ;
foreach my $node ( @{$islandRings[$i]} ) {
push @poly, [$node->[0], $node->[1]] ;
}
my ($p) = Math::Polygon->new(@poly) ;
$islandPolygons[$i] = $p ;
}
}
print "OCEAN: building island polygons\n" if cv('debug');
my @islandPolygons =();
if(scalar @islandRings > 0){ for(my $i=0; $i<=$#islandRings; $i++){ my @poly =();
foreach my $node(@{$islandRings[$i]}){ push @poly, [$node->[0], $node->[1]];
} my($p)= Math::Polygon->new(@poly);
$islandPolygons[$i] = $p;
} }
# build ocean ring polygons
if (cv('debug') eq "1") { print "OCEAN: building ocean polygons\n" ; }
my @oceanPolygons = () ;
if (scalar @ringCoordsClosed > 0) {
for (my $i=0; $i<=$#ringCoordsClosed; $i++) {
my @poly = () ;
foreach my $node ( @{$ringCoordsClosed[$i]} ) {
push @poly, [$node->[0], $node->[1]] ;
}
my ($p) = Math::Polygon->new(@poly) ;
$oceanPolygons[$i] = $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 ;
}
}
if(cv('debug')eq "1"){print "OCEAN: building ocean polygons\n";} my @oceanPolygons =();
if(scalar(@ringCoordsClosed)> 0){ for(my $i=0; $i<=$#ringCoordsClosed; $i++){ my @poly =();
foreach my $node(@{$ringCoordsClosed[$i]}){ push @poly, [$node->[0], $node->[1]];
} my($p)= Math::Polygon->new(@poly);
$oceanPolygons[$i] = $p;
} } else{ if(scalar(@islandRings)> 0){ if(cv('debug')eq "1"){print "OCEAN: build ocean rect\n";} my @ocean =();
my($x, $y)= getDimensions();
push @ocean, [0,0], [$x,0], [$x,$y], [0,$y], [0,0];
push @ringCoordsClosed, [@ocean];
my($p)= Math::Polygon->new(@ocean);
push @oceanPolygons, $p;
} }
# finally create pathes for SVG
for (my $i=0; $i<=$#ringCoordsClosed; $i++) {
# foreach my $ring (@ringCoordsClosed) {
my @ring = @{$ringCoordsClosed[$i]} ;
my @array = () ;
my @coords = () ;
foreach my $c (@ring) {
push @coords, $c->[0], $c->[1] ;
}
push @array, [@coords] ;
if (scalar @islandRings > 0) {
for (my $j=0; $j<=$#islandRings; $j++) {
# island in ring? 1:1 and coast on border?
# if (isIn ($islandPolygons[$j], $oceanPolygons[$i]) == 1) {
if ( (isIn ($islandPolygons[$j], $oceanPolygons[$i]) == 1) or
( (scalar @islandRings == 1) and (scalar @ringCoordsClosed == 1) ) ) {
if (cv('debug') eq "1") { print "OCEAN: island $j in ocean $i\n" ; }
my @coords = () ;
foreach my $c (@{$islandRings[$j]}) {
push @coords, $c->[0], $c->[1] ;
}
push @array, [@coords] ;
}
}
}
for(my $i=0; $i<=$#ringCoordsClosed; $i++){ # foreach my $ring(@ringCoordsClosed){ my @ring = @{$ringCoordsClosed[$i]};
my @array =();
my @coords =();
foreach my $c(@ring){ push @coords, $c->[0], $c->[1];
} push @array, [@coords];
if(scalar @islandRings > 0){ for(my $j=0; $j<=$#islandRings; $j++){ # island in ring? 1:1 and coast on border?
# if(isIn($islandPolygons[$j], $oceanPolygons[$i])== 1){ if((isIn($islandPolygons[$j], $oceanPolygons[$i])== 1)or
((scalar @islandRings == 1)and(scalar @ringCoordsClosed == 1))){ if(cv('debug')eq "1"){print "OCEAN: island $j in ocean $i\n";} my @coords =();
foreach my $c(@{$islandRings[$j]}){ push @coords, $c->[0], $c->[1];
} push @array, [@coords];
} } }
# drawAreaOcean($color, \@array);
my $svgText = "fill=\"$color\" ";
drawArea($svgText, "none", \@array, 0, "base");
# drawAreaOcean ($color, \@array) ;
my $svgText = "fill=\"$color\" " ;
drawArea($svgText, "none", \@array, 0, "base") ;
}}}
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;
}
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 ;
1;

343
mwConfig.pm
View File

@ -1,13 +1,10 @@
#
# 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
# 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
# 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 warnings ;
use strict;
use warnings;
use Getopt::Long ;
use Getopt::Long;
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
readConfigFile
setConfigValue
printConfig
printConfigDescriptions
getProgramOptions
) ;
);
my @initial = ( ["verbose",0, "print some more information (CLO)", "misc"],
["debug",0, "print debug information (CLO)", "misc"],
my @initial =(["verbose",0, "print some more information(CLO)", "misc"],
["debug",0, "print debug information(CLO)", "misc"],
["projection", "merc","Used projection", "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"],
["elementFontFamily","sans-serif","default font family for map elements like title, scale, grid etc.", "map"],
["in","map.osm","osm in file (CLO)", "job"],
["srtm","","srtm in file (CLO)", "job"],
["in","map.osm","osm in file(CLO)", "job"],
["srtm","","srtm in file(CLO)", "job"],
["overpass",0,"use overpass servers to get data (CLO)", "job"],
["near","","search only near this name (when using overpass) (CLO)", "job"],
["overpassdistance",50000,"overpass distance for near search (CLO)", "job"],
["overpassserver","http://www.overpass-api.de/api/","overpass server address (CLO)", "job"],
["overpass",0,"use overpass servers to get data(CLO)", "job"],
["near","","search only near this name(when using overpass)(CLO)", "job"],
["overpassdistance",50000,"overpass distance for near search(CLO)", "job"],
["overpassserver","http://www.overpass-api.de/api/","overpass server address(CLO)", "job"],
["gpx","","gpx file to overlay (CLO)", "map"],
["gpxColor","black","color for gpx objects (CLO)", "map"],
["gpxSize",10,"base size of gpx objects (CLO)", "map"],
["ini","mwconfig.ini","file with configuration values (CLO)", "misc"],
["out","mapweaver.svg","svg output name (CLO)", "job"],
["style","mwStandardRules.txt","file with render rules (CLO)", "job"],
["svgname","mapweaver.svg","output file name for svg graphics (CLO)", "job"],
["size",2200,"size in pixels x axis, 300dpi (CLO)", "map"],
["maxTargetSize","","sizes w,h in cm [21,29.7] (CLO)", "map"],
["legend",0,"appearance and position of legend (CLO)", "map"],
["bgcolor","white","background color of map (CLO)", "map"],
["grid",0,"number of grid cells, 0 = no grid (CLO)", "map"],
["gridcolor","black","color of grid lines (CLO)", "map"],
["coords",0,"draw coordinate system (CLO)", "map"],
["coordsexp",-2,"size of grid cells, exp 10 (CLO)", "map"],
["coordscolor","black","color of coordinates grid lines (CLO)", "map"],
["clip",0," (CLO)", "job"],
["clipbbox",""," (CLO)", "job"],
["pad",0," (CLO)", "job"],
["ppc",6.5,"points per character (CLO)", "misc", "map"],
["pdf",0,"convert output to pdf (CLO)", "job"],
["png",0,"convert output to png (CLO)", "job"],
["pngdpi",115,"png resolution (CLO)", "job"],
["dir",0,"add directory (CLO)", "additional information"],
["dirprg","mwDir.pl","program to create directory (CLO)", "additional information"],
["gpx","","gpx file to overlay(CLO)", "map"],
["gpxColor","black","color for gpx objects(CLO)", "map"],
["gpxSize",10,"base size of gpx objects(CLO)", "map"],
["ini","mwconfig.ini","file with configuration values(CLO)", "misc"],
["out","mapweaver.svg","svg output name(CLO)", "job"],
["style","mwStandardRules.txt","file with render rules(CLO)", "job"],
["svgname","mapweaver.svg","output file name for svg graphics(CLO)", "job"],
["size",2200,"size in pixels x axis, 300dpi(CLO)", "map"],
["maxTargetSize","","sizes w,h in cm [21,29.7](CLO)", "map"],
["legend",0,"appearance and position of legend(CLO)", "map"],
["bgcolor","white","background color of map(CLO)", "map"],
["grid",0,"number of grid cells, 0 = no grid(CLO)", "map"],
["gridcolor","black","color of grid lines(CLO)", "map"],
["coords",0,"draw coordinate system(CLO)", "map"],
["coordsexp",-2,"size of grid cells, exp 10(CLO)", "map"],
["coordscolor","black","color of coordinates grid lines(CLO)", "map"],
["clip",0,"(CLO)", "job"],
["clipbbox","","(CLO)", "job"],
["pad",0,"(CLO)", "job"],
["ppc",6.5,"points per character(CLO)", "misc", "map"],
["pdf",0,"convert output to pdf(CLO)", "job"],
["png",0,"convert output to png(CLO)", "job"],
["pngdpi",115,"png resolution(CLO)", "job"],
["dir",0,"add directory(CLO)", "additional information"],
["dirprg","mwDir.pl","program to create directory(CLO)", "additional information"],
["direxcludedefault", "no", "object default property for directory entries", "additional information"],
["poi",0,"add POI directory (CLO)", "additional information"],
["dirpdf",0,"create 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"],
["tagstat",0,"print tag statistics (CLO)", "misc"],
["declutter",1," (CLO)", "map"],
["allowIconMove",0," (CLO)", "map"],
["forceNodes",0," (CLO)", "map"],
["poi",0,"add POI directory(CLO)", "additional information"],
["dirpdf",0,"create 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"],
["tagstat",0,"print tag statistics(CLO)", "misc"],
["declutter",1,"(CLO)", "map"],
["allowIconMove",0,"(CLO)", "map"],
["forceNodes",0,"(CLO)", "map"],
["lineDist",10,"distance between text lines in pixels", "map"],
["maxCharPerLine",20,"maximum characters per line in node label", "map"],
["help",0,"prints help texts (CLO)", "misc"],
["oneways",0,"add oneway arrows (CLO)", "map"],
["onewayColor","white","color of oneway arrows (CLO)", "map"],
["onewaySize",20,"size of oneway arrows (CLO)", "map"],
["help",0,"prints help texts(CLO)", "misc"],
["oneways",0,"add oneway arrows(CLO)", "map"],
["onewayColor","white","color 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"],
["autobridge",1,"automatically draw bridges and tunnels (CLO)", "map"],
["autobridge",1,"automatically draw bridges and tunnels(CLO)", "map"],
["noLabel",0,"", "map"],
["place","","search for place name in osm file and create map (CLO)", "job"],
["placefile","","name of file containing only place information (CLO)", "job"],
["lonrad",2,"radius lon 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"],
["rulercolor","black","color of ruler (CLO)", "map"],
["rulerbackground","none","background of ruler, none=transparent (CLO)", "map"],
["scale",0,"draw scale; positions 1..4 (CLO)", "map"],
["scalecolor","black","color of scale (CLO)", "map"],
["scalebackground","none","color of scale background; none=transparent (CLO)", "map"],
["scaleset",0,"set scale of map (i.e. 10000) (CLO)", "map"],
["rulescaleset",0,"set assumed scale for rules (CLO)", "map"],
["place","","search for place name in osm file and create map(CLO)", "job"],
["placefile","","name of file containing only place information(CLO)", "job"],
["lonrad",2,"radius lon 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"],
["rulercolor","black","color of ruler(CLO)", "map"],
["rulerbackground","none","background of ruler, none=transparent(CLO)", "map"],
["scale",0,"draw scale; positions 1..4(CLO)", "map"],
["scalecolor","black","color of scale(CLO)", "map"],
["scalebackground","none","color of scale background; none=transparent(CLO)", "map"],
["scaleset",0,"set scale of map(i.e. 10000)(CLO)", "map"],
["rulescaleset",0,"set assumed scale for rules(CLO)", "map"],
["routelabelcolor","black","", "routes"],
["routelabelsize",20,"", "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"],
["routeiconscale",1,"", "routes"],
["routeicondir","./routeicons","", "routes"],
["poifile","","name of external POI file (CLO)", "job"],
["relid",0,"relation ID for hikingbook (CLO)", "misc"],
["rectangles","","draw rectangles for hikingbook (CLO)", "misc"],
["pagenumbers","","add page numbers to map (CLO)", "misc"],
["ra",0,"relation analyzer mode (CLO)", "misc"],
["multionly",0,"draw only multipolygons (CLO)", "misc"],
["test",0,"test feature (CLO)", "misc"],
["foot","mapweaver by gary68 - data by www.openstreetmap.org","text for footer (CLO)", "map"],
["footcolor","black","color for footer (CLO)", "map"],
["footbackground","none","background color for footer (CLO)", "map"],
["footsize",40,"font size for footer (CLO)", "map"],
["head","","text for header (CLO)", "map"],
["headcolor","black","color for header (CLO)", "map"],
["headbackground","none","background color for header (CLO)", "map"],
["headsize",40,"font size for header (CLO)", "map"],
["poifile","","name of external POI file(CLO)", "job"],
["relid",0,"relation ID for hikingbook(CLO)", "misc"],
["rectangles","","draw rectangles for hikingbook(CLO)", "misc"],
["pagenumbers","","add page numbers to map(CLO)", "misc"],
["ra",0,"relation analyzer mode(CLO)", "misc"],
["multionly",0,"draw only multipolygons(CLO)", "misc"],
["test",0,"test feature(CLO)", "misc"],
["foot","mapweaver by gary68 - data by www.openstreetmap.org","text for footer(CLO)", "map"],
["footcolor","black","color for footer(CLO)", "map"],
["footbackground","none","background color for footer(CLO)", "map"],
["footsize",40,"font size for footer(CLO)", "map"],
["head","","text for header(CLO)", "map"],
["headcolor","black","color for header(CLO)", "map"],
["headbackground","none","background color 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"],
["wnscolor","black","color of labels in 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"],
["minAreaLabelSize",10000,"min size of area to be labeled on map", "map"],
["oceanColor","lightblue","color of ocean (CLO)", "map"],
["cIE",0,"osmosis clipIncompleteEntities instead of completeObjects (CLP)", "map"]
["oceanColor","lightblue","color of ocean(CLO)", "map"],
["cIE",0,"osmosis clipIncompleteEntities instead of completeObjects(CLP)", "map"]
) ;
);
my %cv = () ;
my %explanation = () ;
my %cv =();
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) {
$cv{ lc( $kv->[0] ) } = $kv->[1] ;
$explanation{ lc( $kv->[0] ) } = $kv->[2] ;
}
$k = lc($k);
$cv{$k}= $v;
if($cv{"verbose"}> 1){print "config key $k. value changed to $v\n";}}
sub cv{ # access a value by key
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";
sub setConfigValue {
# allows any module to change a certain k/v pair
my ($k, $v) = @_ ;
$k = lc ( $k ) ;
$cv{$k} = $v ;
if ($cv{"verbose"} > 1) { print "config key $k. value changed to $v\n" ; }
my %cats =();
foreach my $e(@initial){ $cats{$e->[3]}= 1;
}
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 } ) ;
foreach my $cat(sort keys %cats){ my @entries =();
foreach my $e(@initial){ if($e->[3] eq $cat){ push @entries, $e->[0];
} } print "\nCATEGORY $cat\n";
print "--------\n";
foreach my $e(sort{$a cmp $b}@entries){ printf "%-30s %-30s\n", $e, cv($e);
}} print "\n";
}
sub printConfig {
# print actual config to stdout
print "\nActual configuration\n" ;
my %cats = () ;
foreach my $e (@initial) {
$cats{ $e->[3] } = 1 ;
}
foreach my $cat (sort keys %cats) {
my @entries = () ;
foreach my $e (@initial) {
if ($e->[3] eq $cat) {
push @entries, $e->[0] ;
}
}
print "\nCATEGORY $cat\n" ;
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 ;
sub readConfigFile{ # read ini file; initial k/v pairs might be changed
my $fileName = shift;
my $lc = 0;
print "reading config file $fileName\n" ;
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
open(my $file, "<", $fileName)or die("ERROR: could not open ini file $fileName\n");
my $line = "";
while($line = <$file>){ $lc++;
unless(grep(/^#/, $line)){ my($k, $v)=($line =~ /(.+?)=(.*)/);
if((! defined $k)or(! defined $v)){ print "WARNING: could not parse config line: $line";
} else{ $k = lc($k);
$cv{$k}= $v;
} }} close $file;
print "$lc lines read.\n\n";
}sub getProgramOptions{my $optResult = GetOptions("in=s" => \$cv{'in'}, # the in file, mandatory
"overpass" => \$cv{'overpass'},
"near:s" => \$cv{'near'},
"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
"cie" => \$cv{'cie'}, # turns debug messages 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 {
my @texts = @initial ;
@texts = sort {$a->[0] cmp $b->[0]} @texts ;
print "\nconfig value descriptions\n\n" ;
printf "%-25s %-50s %-20s\n" , "key" , "description", "default" ;
foreach my $t (@texts) {
my $def = $t->[1] ;
if ($def eq "") { $def = "<EMPTY>" ; }
printf "%-25s %-50s %-20s\n" , $t->[0] , $t->[2], $def ;
}
print "\n" ;
}
1 ;
print "\nconfig value descriptions\n\n";
printf "%-25s %-50s %-20s\n" , "key" , "description", "default";
foreach my $t(@texts){ my $def = $t->[1];
$def = "<EMPTY>" unless $def;
printf "%-25s %-50s %-20s\n" , $t->[0] , $t->[2], $def;
} print "\n";
}1;

180
mwDir.pl
View File

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

568
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
# 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
# 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 warnings ;
use strict;
use warnings;
use mwConfig ;
use mwMap ;
use mwLabel ;
use LWP::Simple ;
use mwConfig;
use mwMap;
use mwLabel;
use OSM::osm ;
use LWP::Simple;
use OSM::osm;
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
getWayPointers
getRelationPointers
) ;
);
my %lon ;
my %lat ;
my %memNodeTags ;
my %lon;
my %lat;
my %memWayNodes ;
my %memWayTags ;
my %memNodeTags;
my %memWayNodes;
my %memWayTags;
my %memRelationMembers;
my %memRelationTags;
my %memRelationMembers ;
my %memRelationTags ;
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" ;
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 {
my ($nodeId, $nodeLon, $nodeLat, $nodeUser, $aRef1, @nodeTags) ;
my ($wayId, $wayUser, $aRef2, @wayTags, @wayNodes) ;
my ($relationId, $relationUser, @relationTags, @relationMembers) ;
my %invalidWays ;
sub readFile{
my($nodeId, $nodeLon, $nodeLat, $nodeUser, $aRef1, @nodeTags);
my($wayId, $wayUser, $aRef2, @wayTags, @wayNodes);
my($relationId, $relationUser, @relationTags, @relationMembers);
my %invalidWays;
my $osmName ;
if (defined cv('in')) { $osmName = cv('in') ; }
my $osmName;
if(defined cv('in')){$osmName = cv('in');}
my $clipbbox = "";
if(defined cv('clipbbox')){$clipbbox = cv('clipbbox');}
if(cv('overpass')eq "1"){ if(cv('place')eq ""){die("ERROR: option place not specified.\n");}
my $overpassNear = cv('near');
my $overpassDistance = cv('overpassdistance');
my $overpassName = cv('place');
my $overpassUrl1 = cv('overpassserver'). $overpassSource1;
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 ;
if ( cv('near') eq "" ) {
$overpassUrl1 = cv('overpassserver') . $overpassSource0 ;
}
$overpassUrl1 =~ s/NEAR/$overpassNear/ ;
$overpassUrl1 =~ s/DIST/$overpassDistance/ ;
$overpassUrl1 =~ s/NAME/$overpassName/ ;
if ( cv('debug') eq "1" ) { print "Overpass Query1: $overpassUrl1 ...\n" ; }
print "Send Query 1 to overpass server..\n" ;
my $result1 = get ( $overpassUrl1 ) ;
if ( ! defined $result1 ) { die ("ERROR: bad overpass result!\n") ; }
if ( cv('debug') eq "1" ) { print "\n$result1\n\n" ; }
if(cv('near')eq ""){ $overpassUrl1 = cv('overpassserver'). $overpassSource0;
}
$overpassUrl1 =~ s/NEAR/$overpassNear/;
$overpassUrl1 =~ s/DIST/$overpassDistance/;
$overpassUrl1 =~ s/NAME/$overpassName/;
if(cv('debug')eq "1"){print "Overpass Query1: $overpassUrl1 ...\n";} print "Send Query 1 to overpass server..\n";
my $result1 = get($overpassUrl1);
if(! defined $result1){die("ERROR: bad overpass result!\n");}
if(cv('debug')eq "1"){print "\n$result1\n\n";}
# get lon, lat
my ($placeLon) = ( $result1 =~ /lon=\"([\d\.\-]+)/ ) ;
my ($placeLat) = ( $result1 =~ /lat=\"([\d\.\-]+)/ ) ;
my($placeLon)=($result1 =~ /lon=\"([\d\.\-]+)/);
my($placeLat)=($result1 =~ /lat=\"([\d\.\-]+)/);
if ((! defined $placeLon) or (! defined $placeLat)) { die ("ERROR: lon/lat could not be obtained from 1st overpass result.\n") ; }
print "place $overpassName found:\n" ;
print "lon= $placeLon\n" ;
print "lat= $placeLat\n" ;
if((! defined $placeLon)or(! defined $placeLat)){die("ERROR: lon/lat could not be obtained from 1st overpass result.\n");}
print "place $overpassName found:\n";
print "lon= $placeLon\n";
print "lat= $placeLat\n";
# calc bbox
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 $overTop = $placeLat + cv('latrad')/111.11 ;
my $overBottom = $placeLat - cv('latrad')/111.11 ;
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 $overTop = $placeLat + cv('latrad')/111.11;
my $overBottom = $placeLat - cv('latrad')/111.11;
my $overpassUrl2 = cv('overpassserver') . $overpassSource3 ;
$overpassUrl2 =~ s/LEFT/$overLeft/ ;
$overpassUrl2 =~ s/RIGHT/$overRight/ ;
$overpassUrl2 =~ s/TOP/$overTop/ ;
$overpassUrl2 =~ s/BOTTOM/$overBottom/ ;
my $overpassUrl2 = cv('overpassserver'). $overpassSource3;
$overpassUrl2 =~ s/LEFT/$overLeft/;
$overpassUrl2 =~ s/RIGHT/$overRight/;
$overpassUrl2 =~ s/TOP/$overTop/;
$overpassUrl2 =~ s/BOTTOM/$overBottom/;
if ( cv('debug') eq "1" ) { print "Overpass Query2: $overpassUrl2\n" ; }
print "Send Query 2 to overpass server..\n" ;
my $result2 = get ( $overpassUrl2 ) ;
if ( ! defined $result2 ) { die ("ERROR: bad overpass result!\n") ; }
if(cv('debug')eq "1"){print "Overpass Query2: $overpassUrl2\n";} print "Send Query 2 to overpass server..\n";
my $result2 = get($overpassUrl2);
if(! defined $result2){die("ERROR: bad overpass result!\n");}
# save
my $opFileName = "overpass.osm" ;
open (my $overFile, ">", $opFileName) ;
binmode($overFile, ":utf8") ;
print $overFile $result2 ;
close ( $overFile ) ;
my $opFileName = "overpass.osm";
open(my $overFile, ">", $opFileName);
binmode($overFile, ":utf8");
print $overFile $result2;
close($overFile);
setConfigValue ('in', $opFileName) ;
$osmName = $opFileName ;
# setConfigValue ('place', '') ;
setConfigValue('in', $opFileName);
$osmName = $opFileName;
# setConfigValue('place', '');
$clipbbox = "$overLeft,$overBottom,$overRight,$overTop" ;
if ( cv('debug') eq "1" ) { print "clipbox: $clipbbox\n" ; }
}
if ( grep /\.pbf/, $osmName ) {
my $newName = $osmName ;
$newName =~ s/\.pbf/\.osm/i ;
$clipbbox = "$overLeft,$overBottom,$overRight,$overTop";
if(cv('debug')eq "1"){print "clipbox: $clipbbox\n";}}
if(grep /\.pbf/, $osmName){ my $newName = $osmName;
$newName =~ s/\.pbf/\.osm/i;
# osmosis
print "call osmosis to convert pbf file to osm file.\n" ;
`osmosis --read-pbf $osmName --write-xml $newName` ;
print "call osmosis to convert pbf file to osm file.\n";
`osmosis --read-pbf $osmName --write-xml $newName`;
# change config
$osmName = $newName ;
setConfigValue ("in", $newName) ;
}
$osmName = $newName;
setConfigValue("in", $newName);
}
# -place given? look for place and call osmosis
my $left ;
my $right ;
my $top ;
my $bottom ;
my $left;
my $right;
my $top;
my $bottom;
my $placeFound = 0 ; my $placeLon ; my $placeLat ;
if ( ( cv('place') ne "") and (cv('overpass') ne "1" ) ) {
my ($placeId) = ( cv('place') =~ /([\d]+)/);
if (!defined $placeId) { $placeId = -999999999 ; }
print "looking for place...\n" ;
my $placeFound = 0; my $placeLon; my $placeLat;
if((cv('place')ne "")and(cv('overpass')ne "1")){ my($placeId)=(cv('place')=~ /([\d]+)/);
if(!defined $placeId){$placeId = -999999999;} print "looking for place...\n";
my $placeFileName = "" ;
if ( cv('placeFile') ne "" ) {
$placeFileName = cv('placeFile') ;
}
else {
$placeFileName = cv('in') ;
}
openOsmFile ($placeFileName) ;
($nodeId, $nodeLon, $nodeLat, $nodeUser, $aRef1) = getNode2 () ;
if ($nodeId != -1) {
@nodeTags = @$aRef1 ;
}
my $place = cv ('place') ;
while ( ($nodeId != -1) and ($placeFound == 0) ) {
my $placeNode = 0 ; my $placeName = 0 ;
foreach my $tag ( @nodeTags ) {
if ($tag->[0] eq "place") { $placeNode = 1 ; }
if ( ($tag->[0] eq "name") and (grep /$place/i, $tag->[1]) ){ $placeName = 1 ; }
}
if ( (($placeNode == 1) and ($placeName == 1)) or ($placeId == $nodeId) ) {
$placeFound = 1 ;
$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" ;
$osmName = "./temp.osm" ;
$clipbbox = "$left,$bottom,$right,$top" ;
}
else {
print "ERROR: place $place not found.\n" ;
die() ;
}
my $placeFileName = "";
if(cv('placeFile')ne ""){
$placeFileName = cv('placeFile');
} else{ $placeFileName = cv('in');
}
openOsmFile($placeFileName);
($nodeId, $nodeLon, $nodeLat, $nodeUser, $aRef1)= getNode2();
if($nodeId != -1){ @nodeTags = @$aRef1;
} my $place = cv('place');
while(($nodeId != -1)and($placeFound == 0)){ my $placeNode = 0; my $placeName = 0;
foreach my $tag(@nodeTags){ if($tag->[0] eq "place"){$placeNode = 1;} if(($tag->[0] eq "name")and(grep /$place/i, $tag->[1])){$placeName = 1;} } if((($placeNode == 1)and($placeName == 1))or($placeId == $nodeId)){ $placeFound = 1;
$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;
my $srtmFileName = cv('srtm') ;
if ( $srtmFileName ne "" ) {
print "call osmosis...\n";
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 ;
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";
print "call osmosis to merge SRTM data...\n$cmd\n" ;
$osmName = "./temp.osm";
$clipbbox = "$left,$bottom,$right,$top";
} else{ print "ERROR: place $place not found.\n";
die();
}}
`$cmd` ;
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\"";
$osmName = "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";
}
# STORE DATA
my $nr = 0 ; my $wr = 0 ; my $rr = 0 ;
print "reading osm file...\n" ;
my $nr = 0; my $wr = 0; my $rr = 0;
print "reading osm file...\n";
openOsmFile ($osmName) ;
($nodeId, $nodeLon, $nodeLat, $nodeUser, $aRef1) = getNode2 () ;
if ($nodeId != -1) {
@nodeTags = @$aRef1 ;
}
while ($nodeId != -1) {
$nr++ ;
$lon{$nodeId} = $nodeLon ; $lat{$nodeId} = $nodeLat ;
@{$memNodeTags{$nodeId}} = @nodeTags ;
openOsmFile($osmName);
($nodeId, $nodeLon, $nodeLat, $nodeUser, $aRef1)= getNode2();
if($nodeId != -1){ @nodeTags = @$aRef1;
} while($nodeId != -1){ $nr++;
$lon{$nodeId}= $nodeLon; $lat{$nodeId}= $nodeLat;
@{$memNodeTags{$nodeId}}= @nodeTags;
($nodeId, $nodeLon, $nodeLat, $nodeUser, $aRef1) = getNode2 () ;
if ($nodeId != -1) {
@nodeTags = @$aRef1 ;
}
}
($nodeId, $nodeLon, $nodeLat, $nodeUser, $aRef1)= getNode2();
if($nodeId != -1){ @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 () ;
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 ;
}
}
($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" ;
}
}
($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";
} }
#next
($relationId, $relationUser, $aRef1, $aRef2) = getRelation () ;
if ($relationId != -1) {
@relationMembers = @$aRef1 ;
@relationTags = @$aRef2 ;
}
}
($relationId, $relationUser, $aRef1, $aRef2)= getRelation();
if($relationId != -1){ @relationMembers = @$aRef1;
@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
my $lonMin = 999 ; my $lonMax = -999 ; my $latMin = 999 ; my $latMax = -999 ;
foreach my $key (keys %lon) {
if ($lon{$key} > $lonMax) { $lonMax = $lon{$key} ; }
if ($lon{$key} < $lonMin) { $lonMin = $lon{$key} ; }
if ($lat{$key} > $latMax) { $latMax = $lat{$key} ; }
if ($lat{$key} < $latMin) { $latMin = $lat{$key} ; }
}
my $lonMin = 999; my $lonMax = -999; my $latMin = 999; my $latMax = -999;
foreach my $key(keys %lon){ if($lon{$key}> $lonMax){$lonMax = $lon{$key};} if($lon{$key}< $lonMin){$lonMin = $lon{$key};} if($lat{$key}> $latMax){$latMax = $lat{$key};} if($lat{$key}< $latMin){$latMin = $lat{$key};}}
# clip picture if desired
if ($clipbbox ne "") {
my ($bbLeft, $bbBottom, $bbRight, $bbTop) = ($clipbbox =~ /([\d\-\.]+),([\d\-\.]+),([\d\-\.]+),([\d\-\.]+)/ ) ;
# print "$bbLeft, $bbBottom, $bbRight, $bbTop\n" ;
if (($bbLeft > $lonMax) or ($bbLeft < $lonMin)) { print "WARNING -clipbox left parameter outside data.\n" ; }
if (($bbRight > $lonMax) or ($bbRight < $lonMin)) { print "WARNING -clipbox right parameter outside data.\n" ; }
if (($bbBottom > $latMax) or ($bbBottom < $latMin)) { print "WARNING -clipbox bottom parameter outside data.\n" ; }
if (($bbTop > $latMax) or ($bbTop < $latMin)) { print "WARNING -clipbox top parameter outside data.\n" ; }
$lonMin = $bbLeft ;
$lonMax = $bbRight ;
$latMin = $bbBottom ;
$latMax = $bbTop ;
}
else {
if (defined cv('clip')) {
if ( (cv('clip') > 0) and (cv('clip') < 100) ) {
my $clip = cv('clip') ;
$clip = $clip / 100 ;
$lonMin += ($lonMax-$lonMin) * $clip ;
$lonMax -= ($lonMax-$lonMin) * $clip ;
$latMin += ($latMax-$latMin) * $clip ;
$latMax -= ($latMax-$latMin) * $clip ;
}
}
}
if($clipbbox ne ""){ my($bbLeft, $bbBottom, $bbRight, $bbTop)=($clipbbox =~ /([\d\-\.]+),([\d\-\.]+),([\d\-\.]+),([\d\-\.]+)/);
# print "$bbLeft, $bbBottom, $bbRight, $bbTop\n";
if(($bbLeft > $lonMax)or($bbLeft < $lonMin)){print "WARNING -clipbox left parameter outside data.\n";} if(($bbRight > $lonMax)or($bbRight < $lonMin)){print "WARNING -clipbox right parameter outside data.\n";} if(($bbBottom > $latMax)or($bbBottom < $latMin)){print "WARNING -clipbox bottom parameter outside data.\n";} if(($bbTop > $latMax)or($bbTop < $latMin)){print "WARNING -clipbox top parameter outside data.\n";} $lonMin = $bbLeft;
$lonMax = $bbRight;
$latMin = $bbBottom;
$latMax = $bbTop;
} else{ if(defined cv('clip')){ if((cv('clip')> 0)and(cv('clip')< 100)){
my $clip = cv('clip');
$clip = $clip / 100;
$lonMin +=($lonMax-$lonMin)* $clip;
$lonMax -=($lonMax-$lonMin)* $clip;
$latMin +=($latMax-$latMin)* $clip;
$latMax -=($latMax-$latMin)* $clip;
} }}
# pad picture if desired
if (defined cv('pad')) {
my $pad = cv('pad') ;
if ( ($pad > 0) and ($pad < 100) ) {
$pad = $pad / 100 ;
$lonMin -= ($lonMax-$lonMin) * $pad ;
$lonMax += ($lonMax-$lonMin) * $pad ;
$latMin -= ($latMax-$latMin) * $pad ;
$latMax += ($latMax-$latMin) * $pad ;
}
}
my $size = cv('size') ;
if(defined cv('pad')){ my $pad = cv('pad');
if(($pad > 0)and($pad < 100)){
$pad = $pad / 100;
$lonMin -=($lonMax-$lonMin)* $pad;
$lonMax +=($lonMax-$lonMin)* $pad;
$latMin -=($latMax-$latMin)* $pad;
$latMax +=($latMax-$latMin)* $pad;
}}
my $size = cv('size');
# calc pic size
if ( cv('scaleSet') != 0 ) {
my $dist = distance ($lonMin, $latMin, $lonMax, $latMin) ;
my $width = $dist / cv('scaleSet') * 1000 * 100 / 2.54 ; # inches
$size = int ($width * 300) ;
}
if(cv('scaleSet')!= 0){ my $dist = distance($lonMin, $latMin, $lonMax, $latMin);
my $width = $dist / cv('scaleSet')* 1000 * 100 / 2.54; # inches
$size = int($width * 300);
}
if(cv('maxTargetSize')ne ""){ my @a = split /,/, cv('maxTargetSize');
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 @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" ;
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) ;
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 {
return ( \%memWayNodes, \%memWayTags) ;
}
sub getRelationPointers {
return ( \%memRelationMembers, \%memRelationTags) ;
}
1 ;
1;

132
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
# 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
# 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 warnings ;
use strict;
use warnings;
use OSM::gpx ;
use OSM::gpx;
use mwConfig ;
use mwMap ;
use mwConfig;
use mwMap;
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 %rteHash = %$ref2 ;
my %trkHash = %$ref3 ;
my $size = cv('gpxsize') ;
my $color = cv('gpxcolor') ;
foreach my $wptNr ( sort { $a <=> $b } keys %wptHash) {
# print "WPT $wptNr: $wptHash{$wptNr}{'lon'} $wptHash{$wptNr}{'lat'}\n" ;
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 $size = cv('gpxsize');
my $color = cv('gpxcolor');
foreach my $wptNr(sort{$a <=> $b}keys %wptHash){ # print "WPT $wptNr: $wptHash{$wptNr}{'lon'}$wptHash{$wptNr}{'lat'}\n";
if(defined $wptHash{$wptNr}{'name'}){
# print " name: $wptHash{$wptNr}{'name'}\n";
} if(defined $wptHash{$wptNr}{'ele'}){
# print " ele: $wptHash{$wptNr}{'ele'}\n";
}
foreach my $rteNr ( sort { $a <=> $b } keys %rteHash) {
# print "RTE $rteNr\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 @coords = () ;
}
foreach my $rteNr(sort{$a <=> $b}keys %rteHash){ # print "RTE $rteNr\n";
foreach my $rteWptNr ( sort { $a <=> $b } keys %{$rteHash{$rteNr}}) {
# print " wpt $rteWptNr: $rteHash{$rteNr}{$rteWptNr}{'lon'} $rteHash{$rteNr}{$rteWptNr}{'lat'}\n" ;
my @coords =();
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') ;
foreach my $rteWptNr(sort{$a <=> $b}keys %{$rteHash{$rteNr}}){ # print " wpt $rteWptNr: $rteHash{$rteNr}{$rteWptNr}{'lon'}$rteHash{$rteNr}{$rteWptNr}{'lat'}\n";
my ($x, $y) = convert ($lon, $lat) ;
push @coords, $x, $y ;
}
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 $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) ;
my($x, $y)= convert($lon, $lat);
push @coords, $x, $y;
}
my $svgString = "";
foreach my $trkNr ( sort { $a <=> $b } keys %trkHash) {
# print "TRK $trkNr\n" ;
my %seg ;
%seg = %{ $trkHash{$trkNr} } ;
my $lc = "round";
my $lj = "round";
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" ;
$svgString = "stroke=\"$color\" stroke-width=\"$size\" stroke-linecap=\"$lc\" fill=\"none\" stroke-linejoin=\"$lj\" ";
my $svgString = "fill=\"$color\" stroke=\"none\" " ;
my $lon = $points{$ptNr}{'lon'} ;
my $lat = $points{$ptNr}{'lat'} ;
drawCircle ($lon, $lat, 1, $size, 0, $svgString, 'gpx') ;
}
}
}
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');
} }}
}
1 ;
1;

164
mwInteractive.pl
View File

@ -1,127 +1,111 @@
use strict ;
use warnings ;
use strict;
use warnings;
# mwInteractive.pl
my $sStyle = "mwStandardRules.txt" ;
my $tStyle = "mwTopoRules.txt" ;
my $sStyle = "mwStandardRules.txt";
my $tStyle = "mwTopoRules.txt";
my $place = "" ;
my $near = "" ;
my $dist = 50000 ;
my $lonrad = 2 ;
my $latrad = 2 ;
my $scaleset = 10000 ;
my $png = 0 ;
my $pdf = 1 ;
my $outName = "" ;
my $style = "" ;
my $place = "";
my $near = "";
my $dist = 50000;
my $lonrad = 2;
my $latrad = 2;
my $scaleset = 10000;
my $png = 0;
my $pdf = 1;
my $outName = "";
my $style = "";
print "Mapweaver interactive\n\n" ;
print "Mapweaver interactive\n\n";
while ($place eq "") {
print "Please enter exact place name:\n" ;
$place = <STDIN> ;
print "\n" ;
chomp $place ;
while($place eq ""){ print "Please enter exact place name:\n";
$place = <STDIN>;
print "\n";
chomp $place;
}
# ---
print "Please enter exact place name of bigger city i.e. in vicinity:\n";
$near = <STDIN>;
print "\n";
chomp $near;
# ---
print "Please enter exact place name of bigger city i.e. in vicinity:\n" ;
$near = <STDIN> ;
print "\n" ;
chomp $near ;
print "Please enter radius in m for vicinity search(defaults to 50.000):\n";
$dist = <STDIN>;
print "\n";
chomp $dist;
if($dist eq ""){$dist = 50000;}
# ---
print "Please enter radius in m for vicinity search (defaults to 50.000):\n" ;
$dist = <STDIN> ;
print "\n" ;
chomp $dist ;
if ($dist eq "") { $dist = 50000 ; }
print "Please enter radius in km for latitude(defaults to 2km):\n";
$latrad = <STDIN>;
print "\n";
chomp $latrad;
if($latrad eq ""){$latrad=2;}
# ---
print "Please enter radius in km for latitude (defaults to 2km):\n" ;
$latrad = <STDIN> ;
print "\n" ;
chomp $latrad ;
if ($latrad eq "") { $latrad=2 ; }
print "Please enter radius in km for longitude(defaults to 2km):\n";
$lonrad = <STDIN>;
print "\n";
chomp $lonrad;
if($lonrad eq ""){$lonrad=2;}
# ---
print "Please enter radius in km for longitude (defaults to 2km):\n" ;
$lonrad = <STDIN> ;
print "\n" ;
chomp $lonrad ;
if ($lonrad eq "") { $lonrad=2 ; }
print "Please enter scale of map(i.e. 10000 for 1:10.000):\n";
$scaleset = <STDIN>;
print "\n";
chomp $scaleset;
if($scaleset eq ""){$scaleset = 10000;}
# ---
print "Please enter scale of map (i.e. 10000 for 1:10.000):\n" ;
$scaleset = <STDIN> ;
print "\n" ;
chomp $scaleset ;
if ($scaleset eq "") { $scaleset = 10000 ; }
print "Output map in PDF format yes/no(defaults to yes):\n";
$pdf = <STDIN>;
print "\n";
chomp $pdf;
if(($pdf eq "")or(lc $pdf eq "yes")){$pdf = 1;}
# ---
print "Output map in PDF format yes/no (defaults to yes):\n" ;
$pdf = <STDIN> ;
print "\n" ;
chomp $pdf ;
if (($pdf eq "") or (lc $pdf eq "yes")) { $pdf = 1 ; }
print "Output map in PNG format yes/no(defaults to no):\n";
$png = <STDIN>;
print "\n";
chomp $png;
if(($png eq "")or(lc $png eq "no")){$png = 0;}if(lc $png eq "yes"){$png = 1;}
# ---
print "Output map in PNG format yes/no (defaults to no):\n" ;
$png = <STDIN> ;
print "\n" ;
chomp $png ;
if (($png eq "") or (lc $png eq "no")) { $png = 0 ; }
if (lc $png eq "yes") { $png = 1 ; }
$outName = $place . ".svg";
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" ;
$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" ; }
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 " ;
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` ;
`$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
# 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
# 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 warnings ;
use strict;
use warnings;
use mwConfig ;
use mwMap ;
# use mwMisc ;
use mwOccupy ;
use mwConfig;
use mwMap;
# use mwMisc;
use mwOccupy;
my $labelPathId = 0 ;
my $labelPathId = 0;
my @lines = () ;
my @lines =();
my $numIconsMoved = 0 ;
my $numLabels = 0 ;
my $numIcons = 0 ;
my $numLabelsOmitted = 0 ;
my $numLabelsMoved = 0 ;
my $numIconsOmitted = 0 ;
my $numIconsMoved = 0;
my $numLabels = 0;
my $numIcons = 0;
my $numLabelsOmitted = 0;
my $numLabelsMoved = 0;
my $numIconsOmitted = 0;
my %poiHash = () ;
my %poiHash =();
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
require Exporter ;
require Exporter;
@ISA = qw ( Exporter AutoLoader ) ;
@ISA = qw(Exporter AutoLoader);
@EXPORT = qw (
placeLabelAndIcon
@EXPORT = qw( placeLabelAndIcon
addToPoiHash
getPoiHash
) ;
);
sub placeLabelAndIcon {
#
sub placeLabelAndIcon{#
# 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 ($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') ;
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) ;
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") {
$numIcons++ ;
if($icon ne "none"){ $numIcons++;
# space for icon?
my $sizeX1 = $iconSizeX ; if ($sizeX1 == 0) { $sizeX1 = 20 ; }
my $sizeY1 = $iconSizeY ; if ($sizeY1 == 0) { $sizeY1 = 20 ; }
my $iconX = $x - $sizeX1/2 ; # top left corner
my $iconY = $y - $sizeY1/2 ;
my $sizeX1 = $iconSizeX; if($sizeX1 == 0){$sizeX1 = 20;} my $sizeY1 = $iconSizeY; if($sizeY1 == 0){$sizeY1 = 20;} my $iconX = $x - $sizeX1/2; # top left corner
my $iconY = $y - $sizeY1/2;
my @shifts = (0) ;
if ($allowIconMove eq "1") {
@shifts = ( 0, -15, 15 ) ;
}
my $posFound = 0 ; my $posCount = 0 ;
my ($iconAreaX1, $iconAreaY1, $iconAreaX2, $iconAreaY2) ;
LABAB: foreach my $xShift (@shifts) {
foreach my $yShift (@shifts) {
$posCount++ ;
if ( ( ! boxAreaOccupied ($iconX+$xShift, $iconY+$sizeY1+$yShift, $iconX+$sizeX1+$xShift, $iconY+$yShift) ) or ( cv('forcenodes') eq "1" ) ) {
placeIcon ($iconX+$xShift, $iconY+$yShift, $icon, $sizeX1, $sizeY1, "nodes") ;
$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) {
my @shifts =(0);
if($allowIconMove eq "1"){ @shifts =(0, -15, 15);
} my $posFound = 0; my $posCount = 0;
my($iconAreaX1, $iconAreaY1, $iconAreaX2, $iconAreaY2);
LABAB: foreach my $xShift(@shifts){ foreach my $yShift(@shifts){ $posCount++;
if((! boxAreaOccupied($iconX+$xShift, $iconY+$sizeY1+$yShift, $iconX+$sizeX1+$xShift, $iconY+$yShift))or(cv('forcenodes')eq "1")){ placeIcon($iconX+$xShift, $iconY+$yShift, $icon, $sizeX1, $sizeY1, "nodes");
$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){
# label text?
if ($text ne "") {
$numLabels++ ;
if($text ne ""){ $numLabels++;
$sizeX1 += 1 ; $sizeY1 += 1 ;
$sizeX1 += 1; $sizeY1 += 1;
my ($x1, $x2, $y1, $y2) ;
my($x1, $x2, $y1, $y2);
# $x, $y centered
# yes, check if space for label, choose position, draw
# no, count omitted text
my @positions = () ; my $positionFound = 0 ;
my @positions =(); my $positionFound = 0;
# pos 1 centered below
$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] ;
$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];
# 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" ;
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" ;
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";
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";
push @positions, [$x1, $x2, $y1, $y2, $orientation];
# pos 4 centered upon
$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] ;
$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];
# 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" ;
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" ;
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";
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";
push @positions, [$x1, $x2, $y1, $y2, $orientation];
# left normal, bottom, top
$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] ;
$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] ;
$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];
$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];
# left corners, bottom, top
$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] ;
$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] ;
$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];
$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];
$tries = 0 ;
LABB: foreach my $pos (@positions) {
$tries++ ;
$tries = 0;
LABB: foreach my $pos(@positions){ $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) {
last LABB ;
}
}
if ($positionFound == 0) { $numLabelsOmitted++ ; }
if ($tries > 1) { $numLabelsMoved++ ; }
} # label
if($positionFound == 1){ last LABB;
} } if($positionFound == 0){$numLabelsOmitted++;} if($tries > 1){$numLabelsMoved++;} }# label
boxOccupyArea ($iconAreaX1, $iconAreaY1, $iconAreaX2, $iconAreaY2, 0, 2) ;
} # pos found
else {
# no, count omitted
$numIconsOmitted++ ;
}
}
else { # only text
my ($x1, $x2, $y1, $y2) ;
boxOccupyArea($iconAreaX1, $iconAreaY1, $iconAreaX2, $iconAreaY2, 0, 2);
}# pos found
else{ # no, count omitted
$numIconsOmitted++;
} } else{# only text
my($x1, $x2, $y1, $y2);
# x1, x2, y1, y2
# left, right, bottom, top
# choose space for text, draw
# count omitted
$numLabels++ ;
my @positions = () ;
$x1 = $x + $thickness ; $x2 = $x + $thickness + $spaceTextX ; $y1 = $y ; $y2 = $y - $spaceTextY ; $orientation = "left" ;
push @positions, [$x1, $x2, $y1, $y2, $orientation] ;
$x1 = $x + $thickness ; $x2 = $x + $thickness + $spaceTextX ; $y1 = $y + $spaceTextY ; $y2 = $y ; $orientation = "left" ;
push @positions, [$x1, $x2, $y1, $y2, $orientation] ;
$numLabels++;
my @positions =();
$x1 = $x + $thickness; $x2 = $x + $thickness + $spaceTextX; $y1 = $y; $y2 = $y - $spaceTextY; $orientation = "left";
push @positions, [$x1, $x2, $y1, $y2, $orientation];
$x1 = $x + $thickness; $x2 = $x + $thickness + $spaceTextX; $y1 = $y + $spaceTextY; $y2 = $y; $orientation = "left";
push @positions, [$x1, $x2, $y1, $y2, $orientation];
$x1 = $x - ($thickness + $spaceTextX) ; $x2 = $x - $thickness ; $y1 = $y ; $y2 = $y - $spaceTextY ; $orientation = "right" ;
push @positions, [$x1, $x2, $y1, $y2, $orientation] ;
$x1 = $x - ($thickness + $spaceTextX) ; $x2 = $x - $thickness ; $y1 = $y ; $y2 = $y - $spaceTextY ; $orientation = "right" ;
push @positions, [$x1, $x2, $y1, $y2, $orientation] ;
$x1 = $x -($thickness + $spaceTextX); $x2 = $x - $thickness; $y1 = $y; $y2 = $y - $spaceTextY; $orientation = "right";
push @positions, [$x1, $x2, $y1, $y2, $orientation];
$x1 = $x -($thickness + $spaceTextX); $x2 = $x - $thickness; $y1 = $y; $y2 = $y - $spaceTextY; $orientation = "right";
push @positions, [$x1, $x2, $y1, $y2, $orientation];
$x1 = $x - $spaceTextX/2 ; $x2 = $x + $spaceTextX/2 ; $y1 = $y - $thickness ; $y2 = $y - ($thickness + $spaceTextY) ; $orientation = "centered" ;
push @positions, [$x1, $x2, $y1, $y2, $orientation] ;
$x1 = $x - $spaceTextX/2 ; $x2 = $x + $spaceTextX/2 ; $y1 = $y + $thickness + $spaceTextY ; $y2 = $y + $thickness ; $orientation = "centered" ;
push @positions, [$x1, $x2, $y1, $y2, $orientation] ;
$x1 = $x - $spaceTextX/2; $x2 = $x + $spaceTextX/2; $y1 = $y - $thickness; $y2 = $y -($thickness + $spaceTextY); $orientation = "centered";
push @positions, [$x1, $x2, $y1, $y2, $orientation];
$x1 = $x - $spaceTextX/2; $x2 = $x + $spaceTextX/2; $y1 = $y + $thickness + $spaceTextY; $y2 = $y + $thickness; $orientation = "centered";
push @positions, [$x1, $x2, $y1, $y2, $orientation];
my $positionFound = 0 ;
$tries = 0 ;
LABA: foreach my $pos (@positions) {
$tries++ ;
# print "$lines[0] $pos->[0], $pos->[1], $pos->[2], $pos->[3], $pos->[4], $numLines\n" ;
my $positionFound = 0;
$tries = 0;
LABA: foreach my $pos(@positions){ $tries++;
# print "$lines[0] $pos->[0], $pos->[1], $pos->[2], $pos->[3], $pos->[4], $numLines\n";
$positionFound = checkAndDrawText ($pos->[0], $pos->[1], $pos->[2], $pos->[3], $pos->[4], \@lines, $svgText, $layer) ;
$positionFound = checkAndDrawText($pos->[0], $pos->[1], $pos->[2], $pos->[3], $pos->[4], \@lines, $svgText, $layer);
if ($positionFound == 1) {
last LABA ;
}
}
if ($positionFound == 0) { $numLabelsOmitted++ ; }
if ($tries > 1) { $numLabelsMoved++ ; }
}
}
}
if($positionFound == 1){ last LABA;
} } if($positionFound == 0){$numLabelsOmitted++;} if($tries > 1){$numLabelsMoved++;} }}}
sub checkAndDrawText {
#
sub checkAndDrawText{#
# checks if area available and if so draws text
#
my ($x1, $x2, $y1, $y2, $orientation, $refLines, $svgText, $layer) = @_ ;
my($x1, $x2, $y1, $y2, $orientation, $refLines, $svgText, $layer)= @_;
if (cv('debug') eq "1") { print "CADT: $x1, $x2, $y1, $y2, $orientation, $refLines, $svgText, $layer\n" ; }
my @lines = @$refLines ;
my $numLines = scalar @lines ;
my $lineDist = cv ('linedist') ;
my ($size) = ( $svgText =~ /font-size=\"(\d+)\"/ ) ;
if ( ! defined $size ) { die ("ERROR: font size could not be determined from svg format string \"$svgText\"\n") ; }
if(cv('debug')eq "1"){print "CADT: $x1, $x2, $y1, $y2, $orientation, $refLines, $svgText, $layer\n";}
my @lines = @$refLines;
my $numLines = scalar @lines;
my $lineDist = cv('linedist');
my($size)=($svgText =~ /font-size=\"(\d+)\"/);
if(! defined $size){die("ERROR: font size could not be determined from svg format string \"$svgText\"\n");}
# WATCH for variable sequence!
if (
( ! boxAreaOccupied ($x1, $y1, $x2, $y2) ) or
( cv('forcenodes') eq "1" )
) {
if((! boxAreaOccupied($x1, $y1, $x2, $y2))or
(cv('forcenodes')eq "1")){
for(my $i=0; $i<=$#lines; $i++){
my @points =($x1, $y2+($i+1)*($size+$lineDist), $x2, $y2+($i+1)*($size+$lineDist));
my $pathName = "LabelPath" . $labelPathId;
$labelPathId++;
createPath($pathName, \@points, "definitions");
for (my $i=0; $i<=$#lines; $i++) {
my @points = ($x1, $y2+($i+1)*($size+$lineDist), $x2, $y2+($i+1)*($size+$lineDist)) ;
my $pathName = "LabelPath" . $labelPathId ;
$labelPathId++ ;
createPath ($pathName, \@points, "definitions") ;
if ($orientation eq "centered") {
pathText ($svgText, $lines[$i], $pathName, 0, "middle", 50, $layer)
}
if ($orientation eq "left") {
pathText ($svgText, $lines[$i], $pathName, 0, "start", 0, $layer)
}
if ($orientation eq "right") {
pathText ($svgText, $lines[$i], $pathName, 0, "end", 100, $layer)
}
}
boxOccupyArea ($x1, $y1, $x2, $y2, 0, 2) ;
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 {
#
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
#
my $text = shift ;
my @lines = split / /, $text ;
my $merged = 1 ;
while ($merged) {
$merged = 0 ;
LAB2: for (my $i=0; $i<$#lines; $i++) {
if (length ($lines[$i] . " " . $lines[$i+1]) <= cv ('maxcharperline') ) {
$lines[$i] = $lines[$i] . " " . $lines[$i+1] ;
splice (@lines, $i+1, 1) ;
$merged = 1 ;
last LAB2 ;
}
}
}
return (\@lines) ;
my $text = shift;
my @lines = split / /, $text;
my $merged = 1;
while($merged){ $merged = 0;
LAB2: for(my $i=0; $i<$#lines; $i++){ if(length($lines[$i] . " " . $lines[$i+1])<= cv('maxcharperline')){
$lines[$i] = $lines[$i] . " " . $lines[$i+1];
splice(@lines, $i+1, 1);
$merged = 1;
last LAB2;
} }} return(\@lines);
}
# ------------------------------------------------------------
sub addToPoiHash {
my ($name, $sq) = @_ ;
if (defined $sq) {
$poiHash{$name}{$sq} = 1 ;
}
else {
$poiHash{$name} = 1 ;
}
sub addToPoiHash{ my($name, $sq)= @_;
if(defined $sq){ $poiHash{$name}{$sq}= 1;
} else{ $poiHash{$name}= 1;
}}
sub getPoiHash{ return \%poiHash;
}
sub getPoiHash {
return \%poiHash ;
}
1 ;
1;

1565
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

522
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
# 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
# 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 warnings ;
use strict;
use warnings;
use mwMap ;
use mwMisc ;
use mwFile ;
use mwLabel ;
use mwConfig ;
use mwRules ;
use mwMap;
use mwMisc;
use mwFile;
use mwLabel;
use mwConfig;
use mwRules;
use Math::Polygon ;
use Math::Polygon;
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 %multiTags = () ;
my %multiPaths = () ;
my %multiNodes =();
my %multiTags =();
my %multiPaths =();
my %wayUsed = () ;
my %wayUsed =();
# -------------------------------------------------------------------------
sub processMultipolygons {
my $notDrawnMP = 0 ;
my $mp = 0 ;
my $mpLabels = 0 ;
my $mpNotDrawnLabels = 0 ;
print "draw multipolygons...\n" ;
sub processMultipolygons{ my $notDrawnMP = 0;
my $mp = 0;
my $mpLabels = 0;
my $mpNotDrawnLabels = 0;
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 = "";
my $icon = "";
if($$ruleRef{'icon'}ne "none"){ $icon = $$ruleRef{'icon'};
} else{ my $col = $$ruleRef{'color'};
$svgText = "fill=\"$col\" ";
}
my $ref = $multiPaths{$multiId}[0]; # first, outer way
my $size = areaSize($ref);
if (defined $ruleRef) {
my $svgText = "" ;
my $icon = "" ;
if ($$ruleRef{'icon'} ne "none") {
$icon = $$ruleRef{'icon'} ;
}
else {
my $col = $$ruleRef{'color'} ;
$svgText = "fill=\"$col\" " ;
}
my $ref = $multiPaths{$multiId}[0] ; # first, outer way
my $size = areaSize ( $ref ) ;
if ($size >= cv('minareasize') ) {
drawArea ($svgText, $icon, $multiPaths{$multiId}, 1, "multi") ;
$mp++ ;
if($size >= cv('minareasize')){ drawArea($svgText, $icon, $multiPaths{$multiId}, 1, "multi");
$mp++;
# LABELS
my $name = "" ; my $ref1 ;
if ( cv('ignorelabels') eq "0" ) {
($name, $ref1) = createLabel ( $multiTags{$multiId}, $$ruleRef{'label'}, 0, 0) ;
my $name = ""; my $ref1;
if(cv('ignorelabels')eq "0"){ ($name, $ref1)= createLabel($multiTags{$multiId}, $$ruleRef{'label'}, 0, 0);
if ( ( $$ruleRef{'label'} ne "none") and
( cv('nolabel') eq "1" ) and
($name eq "") )
{
$name = "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] ) ;
if(($$ruleRef{'label'}ne "none")and
(cv('nolabel')eq "1")and
($name eq "")) {
$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 $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) ;
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" ;
# $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
#
my ($wayNodesRef, $wayTagsRef) = getWayPointers() ;
my ($relationMembersRef, $relationTagsRef) = getRelationPointers() ;
my($wayNodesRef, $wayTagsRef)= getWayPointers();
my($relationMembersRef, $relationTagsRef)= getRelationPointers();
foreach my $relId (keys %$relationMembersRef) {
my $isMulti = 0 ;
foreach my $tag (@{$$relationTagsRef{$relId}}) {
if ( ($tag->[0] eq "type") and ($tag->[1] eq "multipolygon") ) { $isMulti = 1 ; }
}
if ($isMulti) {
if (cv('debug') eq "1") { print "\n---------------------------------------------------\n" ; }
if (cv('debug') eq "1") { print "\nRelation $relId is multipolygon!\n" ; }
foreach my $relId(keys %$relationMembersRef){ my $isMulti = 0;
foreach my $tag(@{$$relationTagsRef{$relId}}){ if(($tag->[0] eq "type")and($tag->[1] eq "multipolygon")){$isMulti = 1;} }
if($isMulti){ if(cv('debug')eq "1"){print "\n---------------------------------------------------\n";} if(cv('debug')eq "1"){print "\nRelation $relId is multipolygon!\n";}
# get inner and outer ways
my (@innerWays) = () ; my (@outerWays) = () ;
foreach my $member ( @{$$relationMembersRef{$relId}} ) {
if ( ($member->[0] eq "way") and ($member->[2] eq "outer") and (defined @{$$wayNodesRef{$member->[1]}} ) ) { push @outerWays, $member->[1] ; }
if ( ($member->[0] eq "way") and ($member->[2] eq "inner") and (defined @{$$wayNodesRef{$member->[1]}} )) { push @innerWays, $member->[1] ; }
}
if (cv('debug') eq "1") { print "OUTER WAYS: @outerWays\n" ; }
if (cv('debug') eq "1") { print "INNER WAYS: @innerWays\n" ; }
my ($ringsWaysRef, $ringsNodesRef) ;
my @ringWaysInner = () ; my @ringNodesInner = () ; my @ringTagsInner = () ;
my(@innerWays)=(); my(@outerWays)=();
foreach my $member(@{$$relationMembersRef{$relId}}){ if(($member->[0] eq "way")and($member->[2] eq "outer")and(defined @{$$wayNodesRef{$member->[1]}})){push @outerWays, $member->[1];} if(($member->[0] eq "way")and($member->[2] eq "inner")and(defined @{$$wayNodesRef{$member->[1]}})){push @innerWays, $member->[1];} } if(cv('debug')eq "1"){print "OUTER WAYS: @outerWays\n";} if(cv('debug')eq "1"){print "INNER WAYS: @innerWays\n";}
my($ringsWaysRef, $ringsNodesRef);
my @ringWaysInner =(); my @ringNodesInner =(); my @ringTagsInner =();
# build rings inner
if (scalar @innerWays > 0) {
($ringsWaysRef, $ringsNodesRef) = buildRings (\@innerWays, 1) ;
@ringWaysInner = @$ringsWaysRef ;
@ringNodesInner = @$ringsNodesRef ;
for (my $ring=0; $ring<=$#ringWaysInner; $ring++) {
if (cv('debug') eq "1") { print "INNER RING $ring: @{$ringWaysInner[$ring]}\n" ; }
my $firstWay = $ringWaysInner[$ring]->[0] ;
if (scalar @{$ringWaysInner[$ring]} == 1) {$wayUsed{$firstWay} = 1 ; } # way will be marked as used/drawn by multipolygon
@{$ringTagsInner[$ring]} = @{$$wayTagsRef{$firstWay}} ; # ring will be tagged like first contained way
if (cv('debug') eq "1") {
print "tags from first way...\n" ;
foreach my $tag (@{$$wayTagsRef{$firstWay}}) {
print " $tag->[0] - $tag->[1]\n" ;
}
}
if ( (scalar @{$$wayTagsRef{$firstWay}}) == 0 ) {
if (cv('debug') eq "1") { print "tags set to hole in mp.\n" ; }
push @{$ringTagsInner[$ring]}, ["multihole", "yes"] ;
}
}
}
if(scalar @innerWays > 0){ ($ringsWaysRef, $ringsNodesRef)= buildRings(\@innerWays, 1);
@ringWaysInner = @$ringsWaysRef;
@ringNodesInner = @$ringsNodesRef;
for(my $ring=0; $ring<=$#ringWaysInner; $ring++){ if(cv('debug')eq "1"){print "INNER RING $ring: @{$ringWaysInner[$ring]}\n";} my $firstWay = $ringWaysInner[$ring]->[0];
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"];
} } }
# build rings outer
my @ringWaysOuter = () ; my @ringNodesOuter = () ; my @ringTagsOuter = () ;
if (scalar @outerWays > 0) {
($ringsWaysRef, $ringsNodesRef) = buildRings (\@outerWays, 1) ;
@ringWaysOuter = @$ringsWaysRef ; # not necessary for outer
@ringNodesOuter = @$ringsNodesRef ;
for (my $ring=0; $ring<=$#ringWaysOuter; $ring++) {
if (cv('debug') eq "1") { print "OUTER RING $ring: @{$ringWaysOuter[$ring]}\n" ; }
my $firstWay = $ringWaysOuter[$ring]->[0] ;
if (scalar @{$ringWaysOuter[$ring]} == 1) {$wayUsed{$firstWay} = 1 ; }
@{$ringTagsOuter[$ring]} = @{$$relationTagsRef{$relId}} ; # tags from relation
if (cv('debug') eq "1") {
print "tags from relation...\n" ;
foreach my $tag (@{$$relationTagsRef{$relId}}) {
print " $tag->[0] - $tag->[1]\n" ;
}
}
if (scalar @{$$relationTagsRef{$relId}} == 1) {
@{$ringTagsOuter[$ring]} = @{$$wayTagsRef{$firstWay}} ; # ring will be tagged like first way
}
}
} # outer
my @ringWaysOuter =(); my @ringNodesOuter =(); my @ringTagsOuter =();
if(scalar @outerWays > 0){ ($ringsWaysRef, $ringsNodesRef)= buildRings(\@outerWays, 1);
@ringWaysOuter = @$ringsWaysRef; # not necessary for outer
@ringNodesOuter = @$ringsNodesRef;
for(my $ring=0; $ring<=$#ringWaysOuter; $ring++){ if(cv('debug')eq "1"){print "OUTER RING $ring: @{$ringWaysOuter[$ring]}\n";} my $firstWay = $ringWaysOuter[$ring]->[0];
if(scalar @{$ringWaysOuter[$ring]}== 1){$wayUsed{$firstWay}= 1;} @{$ringTagsOuter[$ring]}= @{$$relationTagsRef{$relId}}; # tags from relation
if(cv('debug')eq "1"){ print "tags from relation...\n";
foreach my $tag(@{$$relationTagsRef{$relId}}){ print " $tag->[0] - $tag->[1]\n";
} } if(scalar @{$$relationTagsRef{$relId}}== 1){ @{$ringTagsOuter[$ring]}= @{$$wayTagsRef{$firstWay}}; # ring will be tagged like first way
} } }# outer
my @ringNodesTotal = (@ringNodesInner, @ringNodesOuter) ;
my @ringWaysTotal = (@ringWaysInner, @ringWaysOuter) ;
my @ringTagsTotal = (@ringTagsInner, @ringTagsOuter) ;
my @ringNodesTotal =(@ringNodesInner, @ringNodesOuter);
my @ringWaysTotal =(@ringWaysInner, @ringWaysOuter);
my @ringTagsTotal =(@ringTagsInner, @ringTagsOuter);
processRings (\@ringNodesTotal, \@ringWaysTotal, \@ringTagsTotal) ;
} # multi
processRings(\@ringNodesTotal, \@ringWaysTotal, \@ringTagsTotal);
}# multi
} # relIds
}# relIds
}
# -----------------------------------------------------------------------------------------
sub processRings {
#
sub processRings{#
# process rings of multipolygons and create path data for svg
#
my ($ref1, $ref2, $ref3) = @_ ;
my @ringNodes = @$ref1 ;
my @ringWays = @$ref2 ;
my @ringTags = @$ref3 ;
my @polygon = () ;
my @polygonSize = () ;
my @ringIsIn = () ;
my @stack = () ; # all created stacks
my %selectedStacks = () ; # stacks selected for processing
my $actualLayer = 0 ; # for new tags
my($ref1, $ref2, $ref3)= @_;
my @ringNodes = @$ref1;
my @ringWays = @$ref2;
my @ringTags = @$ref3;
my @polygon =();
my @polygonSize =();
my @ringIsIn =();
my @stack =(); # all created stacks
my %selectedStacks =(); # stacks selected for processing
my $actualLayer = 0; # for new tags
# rings referenced by array index
my ($lonRef, $latRef) = getNodePointers() ;
my ($wayNodesRef, $wayTagsRef) = getWayPointers() ;
my($lonRef, $latRef)= getNodePointers();
my($wayNodesRef, $wayTagsRef)= getWayPointers();
# create polygons
if (cv('debug') eq "1") { print "CREATING POLYGONS\n" ; }
for (my $ring = 0 ; $ring <= $#ringWays; $ring++) {
my @poly = () ;
foreach my $node ( @{$ringNodes[$ring]} ) {
push @poly, [$$lonRef{$node}, $$latRef{$node}] ;
}
my ($p) = Math::Polygon->new(@poly) ;
$polygon[$ring] = $p ;
$polygonSize[$ring] = $p->area ;
if (cv('debug') eq "1") {
print " POLYGON $ring - created, size = $polygonSize[$ring] \n" ;
foreach my $tag (@{$ringTags[$ring]}) {
print " $tag->[0] - $tag->[1]\n" ;
}
}
}
# 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" ;
}
if(cv('debug')eq "1"){print "CREATING POLYGONS\n";} for(my $ring = 0; $ring <= $#ringWays; $ring++){ my @poly =();
foreach my $node(@{$ringNodes[$ring]}){ push @poly, [$$lonRef{$node}, $$latRef{$node}];
} my($p)= Math::Polygon->new(@poly);
$polygon[$ring] = $p;
$polygonSize[$ring] = $p->area;
if(cv('debug')eq "1"){
print " POLYGON $ring - created, size = $polygonSize[$ring] \n";
foreach my $tag(@{$ringTags[$ring]}){ print " $tag->[0] - $tag->[1]\n";
} }}
# 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
if (cv('debug') eq "1") { print "SORTING isIn\n" ; }
for (my $ring=0 ; $ring<=$#ringIsIn; $ring++) {
my @isIn = () ;
foreach my $ring2 (@{$ringIsIn[$ring]}) {
push @isIn, [$ring2, $polygonSize[$ring2]] ;
}
@isIn = sort { $a->[1] <=> $b->[1] } (@isIn) ; # sorted array
my @isIn2 = () ; # only ring numbers
foreach my $temp (@isIn) {
push @isIn2, $temp->[0] ;
}
@{$stack[$ring]} = reverse (@isIn2) ;
push @{$stack[$ring]}, $ring ; # sorted descending and ring self appended
if (cv('debug') eq "1") { print " stack ring $ring sorted: @{$stack[$ring]}\n" ; }
}
if(cv('debug')eq "1"){print "SORTING isIn\n";} for(my $ring=0; $ring<=$#ringIsIn; $ring++){ my @isIn =();
foreach my $ring2(@{$ringIsIn[$ring]}){ push @isIn, [$ring2, $polygonSize[$ring2]];
} @isIn = sort{$a->[1] <=> $b->[1]}(@isIn); # sorted array
my @isIn2 =(); # only ring numbers
foreach my $temp(@isIn){ push @isIn2, $temp->[0];
} @{$stack[$ring]}= reverse(@isIn2);
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
if (cv('debug') eq "1") { print "SELECTING STACKS\n" ; }
my $actualStack = 0 ;
for (my $stackNumber=0 ; $stackNumber<=$#stack; $stackNumber++) {
# look for top element
my $topElement = $stack[$stackNumber]->[(scalar @{$stack[$stackNumber]} - 1)] ;
my $found = 0 ;
for (my $stackNumber2=0 ; $stackNumber2<=$#stack; $stackNumber2++) {
if ($stackNumber != $stackNumber2) {
foreach my $ring (@{$stack[$stackNumber2]}) {
if ($ring == $topElement) {
$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" ; }
}
}
if(cv('debug')eq "1"){print "SELECTING STACKS\n";} my $actualStack = 0;
for(my $stackNumber=0; $stackNumber<=$#stack; $stackNumber++){ # look for top element
my $topElement = $stack[$stackNumber]->[(scalar @{$stack[$stackNumber]}- 1)];
my $found = 0;
for(my $stackNumber2=0; $stackNumber2<=$#stack; $stackNumber2++){ if($stackNumber != $stackNumber2){ foreach my $ring(@{$stack[$stackNumber2]}){ if($ring == $topElement){
$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
if (cv('debug') eq "1") { print "PROCESS SELECTED STACKS\n" ; }
# while stacks left
while (scalar (keys %selectedStacks) > 0) {
my (@k) = keys %selectedStacks ;
if (cv('debug') eq "1") { print " stacks available: @k\n" ; }
my @nodes = () ;
my @nodesOld ;
my @processedStacks = () ;
if(cv('debug')eq "1"){print "PROCESS SELECTED STACKS\n";} # while stacks left
while(scalar(keys %selectedStacks)> 0){ my(@k)= keys %selectedStacks;
if(cv('debug')eq "1"){print " stacks available: @k\n";} my @nodes =();
my @nodesOld;
my @processedStacks =();
# select one bottom element
my $key = $k[0] ; # key of first stack
if (cv('debug') eq "1") { print " stack nr $key selected\n" ; }
my $ringToDraw = $selectedStacks{$key}[0] ;
if (cv('debug') eq "1") { print " ring to draw: $ringToDraw\n" ; }
push @nodesOld, @{$ringNodes[$ringToDraw]} ; # outer polygon
push @nodes, [@{$ringNodes[$ringToDraw]}] ; # outer polygon as array
my $key = $k[0]; # key of first stack
if(cv('debug')eq "1"){print " stack nr $key selected\n";} my $ringToDraw = $selectedStacks{$key}[0];
if(cv('debug')eq "1"){print " ring to draw: $ringToDraw\n";}
push @nodesOld, @{$ringNodes[$ringToDraw]}; # outer polygon
push @nodes, [@{$ringNodes[$ringToDraw]}]; # outer polygon as array
# and remove ring from stacks; store processed stacks
foreach my $k2 (keys %selectedStacks) {
if ($selectedStacks{$k2}[0] == $ringToDraw) {
shift (@{$selectedStacks{$k2}}) ;
push @processedStacks, $k2 ;
if (scalar @{$selectedStacks{$k2}} == 0) { delete $selectedStacks{$k2} ; }
if (cv('debug') eq "1") { print " removed $ringToDraw from stack $k2\n" ; }
}
}
foreach my $k2(keys %selectedStacks){ if($selectedStacks{$k2}[0] == $ringToDraw){
shift(@{$selectedStacks{$k2}});
push @processedStacks, $k2;
if(scalar @{$selectedStacks{$k2}}== 0){delete $selectedStacks{$k2};} if(cv('debug')eq "1"){print " removed $ringToDraw from stack $k2\n";} }
}
# foreach stack in processed stacks
foreach my $k (@processedStacks) {
# if now bottom of a stack is hole, then add this polygon to points
if (defined $selectedStacks{$k}) {
my $tempRing = $selectedStacks{$k}[0] ;
my $temp = $ringTags[$tempRing]->[0]->[0] ;
if (cv('debug') eq "1") { print " testing for hole: stack $k, ring $tempRing, tag $temp\n" ; }
if ($ringTags[$tempRing]->[0]->[0] eq "multihole") {
push @nodesOld, @{$ringNodes[$tempRing]} ;
push @nodes, [@{$ringNodes[$tempRing]}] ;
# print " nodes so far: @nodes\n" ;
foreach my $k(@processedStacks){ # if now bottom of a stack is hole, then add this polygon to points
if(defined $selectedStacks{$k}){ my $tempRing = $selectedStacks{$k}[0];
my $temp = $ringTags[$tempRing]->[0]->[0];
if(cv('debug')eq "1"){print " testing for hole: stack $k, ring $tempRing, tag $temp\n";} if($ringTags[$tempRing]->[0]->[0] eq "multihole"){ push @nodesOld, @{$ringNodes[$tempRing]};
push @nodes, [@{$ringNodes[$tempRing]}];
# print " nodes so far: @nodes\n";
# and remove this element from stack
shift @{$selectedStacks{$k}} ;
if (scalar @{$selectedStacks{$k}} == 0) { delete $selectedStacks{$k} ; }
if (cv('debug') eq "1") { print " ring $tempRing identified as hole\n" ; }
}
}
}
shift @{$selectedStacks{$k}};
if(scalar @{$selectedStacks{$k}}== 0){delete $selectedStacks{$k};} if(cv('debug')eq "1"){print " ring $tempRing identified as hole\n";} } } }
# add way
@{$multiNodes{$newId}} = @nodesOld ;
@{$multiTags{$newId}} = @{$ringTags[$ringToDraw]} ;
@{$multiPaths{$newId}} = @nodes ;
@{$multiNodes{$newId}}= @nodesOld;
@{$multiTags{$newId}}= @{$ringTags[$ringToDraw]};
@{$multiPaths{$newId}}= @nodes;
push @{$$wayTagsRef{$newId}}, ["layer", $actualLayer] ;
$actualLayer++ ;
push @{$$wayTagsRef{$newId}}, ["layer", $actualLayer];
$actualLayer++;
if (cv('debug') eq "1") {
print " DRAWN: $ringToDraw, wayId $newId\n" ;
foreach my $tag (@{$ringTags[$ringToDraw]}) {
print " k/v $tag->[0] - $tag->[1]\n" ;
}
}
if(cv('debug')eq "1"){
print " DRAWN: $ringToDraw, wayId $newId\n";
foreach my $tag(@{$ringTags[$ringToDraw]}){ print " k/v $tag->[0] - $tag->[1]\n";
} }
$newId++;
$newId++ ;
}#(while)}
} # (while)
}
1 ;
1;

228
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
# 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
# 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 warnings ;
use strict;
use warnings;
use OSM::osm 8.21 ;
use OSM::osm 8.21;
use mwConfig ;
use mwFile ;
use mwRules ;
use mwMap ;
use mwMisc ;
use mwLabel ;
use mwConfig;
use mwFile;
use mwRules;
use mwMap;
use mwMisc;
use mwLabel;
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
) ;
);
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 ;
($lonRef, $latRef, $tagRef) = getNodePointers () ;
foreach my $nodeId (keys %$lonRef) {
my @tags = @{ $$tagRef{$nodeId} } ;
my $tagsString = "" ;
my $ruleRef = getNodeRule (\@tags) ;
if (defined $ruleRef) {
foreach my $nodeId(keys %$lonRef){ my @tags = @{$$tagRef{$nodeId}};
my $tagsString = "";
my $ruleRef = getNodeRule(\@tags);
if(defined $ruleRef){
# draw disc first !
if (grep /yes/, $$ruleRef{'disc'}) {
my $svgString = "" ;
if ( $$ruleRef{'discsvgstring'} ne "" ) {
$svgString = $$ruleRef{'discsvgstring'} ;
}
else {
$svgString = "fill=\"$$ruleRef{'disccolor'}\" stroke=\"none\" fill-opacity=\"$$ruleRef{'discopacity'}\"" ;
}
drawCircle ($$lonRef{$nodeId}, $$latRef{$nodeId}, 1, $$ruleRef{'discradius'}, 1, $svgString, 'nodes') ;
if(grep /yes/, $$ruleRef{'disc'}){ my $svgString = "";
if($$ruleRef{'discsvgstring'}ne ""){ $svgString = $$ruleRef{'discsvgstring'};
} else{ $svgString = "fill=\"$$ruleRef{'disccolor'}\" stroke=\"none\" fill-opacity=\"$$ruleRef{'discopacity'}\"";
} drawCircle($$lonRef{$nodeId}, $$latRef{$nodeId}, 1, $$ruleRef{'discradius'}, 1, $svgString, 'nodes');
}
if(grep /yes/, $$ruleRef{'circle'}){ my $svgString = "";
if($$ruleRef{'circlesvgstring'}ne ""){ $svgString = $$ruleRef{'circlesvgstring'};
} else{ $svgString = "fill=\"none\" stroke=\"$$ruleRef{'circlecolor'}\" stroke-width=\"$$ruleRef{'circlethickness'}\"";
} drawCircle($$lonRef{$nodeId}, $$latRef{$nodeId}, 1, $$ruleRef{'circleradius'}, 1, $svgString, 'nodes');
}
if(($$ruleRef{'size'}> 0)and($$ruleRef{'icon'}eq "none")){ my $svgString = "";
if($$ruleRef{'svgstring'}ne ""){ $svgString = $$ruleRef{'svgstring'};
} else{ $svgString = "fill=\"$$ruleRef{'color'}\"";
}
if($$ruleRef{'shape'}eq "circle"){ drawCircle($$lonRef{$nodeId}, $$latRef{$nodeId}, 1, $$ruleRef{'size'}, 0, $svgString, 'nodes');
} elsif($$ruleRef{'shape'}eq "square"){ drawSquare($$lonRef{$nodeId}, $$latRef{$nodeId}, 1, $$ruleRef{'size'}, 0, $svgString, 'nodes');
} elsif($$ruleRef{'shape'}eq "triangle"){ drawTriangle($$lonRef{$nodeId}, $$latRef{$nodeId}, 1, $$ruleRef{'size'}, 0, $svgString, 'nodes');
} elsif($$ruleRef{'shape'}eq "diamond"){ drawDiamond($$lonRef{$nodeId}, $$latRef{$nodeId}, 1, $$ruleRef{'size'}, 0, $svgString, 'nodes');
} }
if(($$ruleRef{'label'}ne "none")or($$ruleRef{'icon'}ne "none")){ my($labelText, $ref)= createLabel(\@tags, $$ruleRef{'label'}, $$lonRef{$nodeId}, $$latRef{$nodeId});
$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 $svgString = "" ;
if ( $$ruleRef{'circlesvgstring'} ne "" ) {
$svgString = $$ruleRef{'circlesvgstring'} ;
}
else {
$svgString = "fill=\"none\" stroke=\"$$ruleRef{'circlecolor'}\" stroke-width=\"$$ruleRef{'circlethickness'}\"" ;
}
drawCircle ($$lonRef{$nodeId}, $$latRef{$nodeId}, 1, $$ruleRef{'circleradius'}, 1, $svgString, 'nodes') ;
}
if ( ($$ruleRef{'size'} > 0) and ($$ruleRef{'icon'} eq "none") ) {
my $svgString = "" ;
if ( $$ruleRef{'svgstring'} ne "" ) {
$svgString = $$ruleRef{'svgstring'} ;
}
else {
$svgString = "fill=\"$$ruleRef{'color'}\"" ;
}
if ( $$ruleRef{'shape'} eq "circle") {
drawCircle ($$lonRef{$nodeId}, $$latRef{$nodeId}, 1, $$ruleRef{'size'}, 0, $svgString, 'nodes') ;
}
elsif ( $$ruleRef{'shape'} eq "square") {
drawSquare ($$lonRef{$nodeId}, $$latRef{$nodeId}, 1, $$ruleRef{'size'}, 0, $svgString, 'nodes') ;
}
elsif ( $$ruleRef{'shape'} eq "triangle") {
drawTriangle ($$lonRef{$nodeId}, $$latRef{$nodeId}, 1, $$ruleRef{'size'}, 0, $svgString, 'nodes') ;
}
elsif ( $$ruleRef{'shape'} eq "diamond") {
drawDiamond ($$lonRef{$nodeId}, $$latRef{$nodeId}, 1, $$ruleRef{'size'}, 0, $svgString, 'nodes') ;
}
}
if ( ($$ruleRef{'label'} ne "none") or ($$ruleRef{'icon'} ne "none") ) {
my ($labelText, $ref) = createLabel (\@tags, $$ruleRef{'label'}, $$lonRef{$nodeId}, $$latRef{$nodeId}) ;
$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") ;
}
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
my $thing0 = $$ruleRef{'keyvalue'} ;
my ($thing) = ( $thing0 =~ /.+=(.+)/ ) ;
my $thing0 = $$ruleRef{'keyvalue'};
my($thing)=($thing0 =~ /.+=(.+)/);
my $dirName = getValue ("name", $$tagRef{$nodeId} ) ;
if ( ( cv('poi') eq "1" ) and
( defined $dirName ) and
( $$ruleRef{'direxclude'} eq "no")
) {
$dirName .= " ($thing)" ;
if ( cv('grid') > 0) {
my $sq = gridSquare($$lonRef{$nodeId}, $$latRef{$nodeId}, cv('grid')) ;
if (defined $sq) {
addToPoiHash ($dirName, $sq) ;
}
}
else {
# $poiHash{$dirName} = 1 ;
addToPoiHash ($dirName, undef) ;
}
}
} # defined ruleref
}
my $dirName = getValue("name", $$tagRef{$nodeId});
if((cv('poi')eq "1")and
(defined $dirName)and
($$ruleRef{'direxclude'}eq "no") ){ $dirName .= "($thing)";
if(cv('grid')> 0){ my $sq = gridSquare($$lonRef{$nodeId}, $$latRef{$nodeId}, cv('grid'));
if(defined $sq){ addToPoiHash($dirName, $sq);
} } else{ # $poiHash{$dirName}= 1;
addToPoiHash($dirName, undef);
} }
}# defined ruleref
}
}
# ------------------------------------------------------------------------------------
sub createPoiDirectory {
my $poiName ;
my $poiFile ;
$poiName = cv ('out') ;
$poiName =~ s/\.svg/\_pois.txt/ ;
setConfigValue("poiname", $poiName) ;
print "creating poi file $poiName ...\n" ;
open ($poiFile, ">", $poiName) or die ("can't open poi file $poiName\n") ;
sub createPoiDirectory{ my $poiName;
my $poiFile;
$poiName = cv('out');
$poiName =~ s/\.svg/\_pois.txt/;
setConfigValue("poiname", $poiName);
print "creating poi file $poiName ...\n";
open($poiFile, ">", $poiName)or die("can't open poi file $poiName\n");
my $ref = getPoiHash() ;
my %poiHash = %$ref ;
my $ref = getPoiHash();
my %poiHash = %$ref;
if ( cv('grid') eq "0") {
foreach my $poi (sort keys %poiHash) {
$poi = replaceHTMLCode ( $poi ) ;
print $poiFile "$poi\n" ;
}
}
else {
foreach my $poi (sort keys %poiHash) {
$poi = replaceHTMLCode ( $poi ) ;
print $poiFile "$poi\t" ;
foreach my $square (sort keys %{$poiHash{$poi}}) {
print $poiFile "$square " ;
}
print $poiFile "\n" ;
}
}
close ($poiFile) ;
if(cv('grid')eq "0"){ foreach my $poi(sort keys %poiHash){ $poi = replaceHTMLCode($poi);
print $poiFile "$poi\n";
}} else{ foreach my $poi(sort keys %poiHash){ $poi = replaceHTMLCode($poi);
print $poiFile "$poi\t";
foreach my $square(sort keys %{$poiHash{$poi}}){ print $poiFile "$square ";
} print $poiFile "\n";
}} close($poiFile);
}
1 ;
1;

401
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
# 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
# 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 warnings ;
use strict;
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);
require Exporter ;
require Exporter;
@ISA = qw ( Exporter AutoLoader ) ;
@ISA = qw(Exporter AutoLoader);
@EXPORT = qw ( boxOccupyLines
@EXPORT = qw(boxOccupyLines
boxOccupyArea
boxLinesOccupied
boxAreaOccupied
boxDrawOccupiedAreas
) ;
);
my $boxSize = 5 ;
my $boxSize = 5;
my %box = () ;
my %box =();
# -------------------------------------------------------------
sub boxOccupyLines {
my ($refCoords, $buffer, $value) = @_ ;
my @coordinates = @$refCoords ;
my @lines = () ;
sub boxOccupyLines{ my($refCoords, $buffer, $value)= @_;
my @coordinates = @$refCoords;
my @lines =();
for ( my $i = 0; $i < $#coordinates-2; $i += 2 ) {
push @lines, [$coordinates[$i], $coordinates[$i+1], $coordinates[$i+2], $coordinates[$i+3]] ;
}
foreach my $line ( @lines ) {
my $x1 = $line->[0] ;
my $y1 = $line->[1] ;
my $x2 = $line->[2] ;
my $y2 = $line->[3] ;
for(my $i = 0; $i < $#coordinates-2; $i += 2){ push @lines, [$coordinates[$i], $coordinates[$i+1], $coordinates[$i+2], $coordinates[$i+3]];
}
foreach my $line(@lines){ my $x1 = $line->[0];
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) {
my $m = ($y2 - $y1) / ($x2 - $x1) ;
my $b = $y1 - $m * $x1 ;
if ( abs ( $x1 - $x2 ) > abs ( $y1 - $y2 ) ) {
if($x1 != $x2){
my $m =($y2 - $y1)/($x2 - $x1);
my $b = $y1 - $m * $x1;
if(abs($x1 - $x2)> abs($y1 - $y2)){
# calc points on x axis
my $x = $x1 ;
my $stepX = $boxSize ;
if ( $x2 < $x1 ) { $stepX = - $boxSize ; }
while ( ( $x >= min ($x1, $x2) ) and ( $x <= max ($x1, $x2) ) ) {
my $y = $m * $x + $b ;
my $x = $x1;
my $stepX = $boxSize;
if($x2 < $x1){$stepX = - $boxSize;} while(($x >= min($x1, $x2))and($x <= max($x1, $x2))){
my $y = $m * $x + $b;
# ACTUAL COORDINATE $x, $y
my $ax1 = $x - $buffer ;
my $ax2 = $x + $buffer ;
my $ay1 = $y - $buffer ;
my $ay2 = $y + $buffer ;
boxOccupyArea ($ax1, $ay1, $ax2, $ay2, 0, $value) ;
$x += $stepX ;
}
my $ax1 = $x - $buffer;
my $ax2 = $x + $buffer;
my $ay1 = $y - $buffer;
my $ay2 = $y + $buffer;
boxOccupyArea($ax1, $ay1, $ax2, $ay2, 0, $value);
$x += $stepX;
}
else {
} else{
# calc points on y axis
my $y = $y1 ;
my $stepY = $boxSize ;
if ( $y2 < $y1 ) { $stepY = - $boxSize ; }
while ( ( $y >= min ($y1, $y2) ) and ( $y <= max ($y1, $y2) ) ) {
my $x = ($y - $b) / $m ;
my $y = $y1;
my $stepY = $boxSize;
if($y2 < $y1){$stepY = - $boxSize;} while(($y >= min($y1, $y2))and($y <= max($y1, $y2))){
my $x =($y - $b)/ $m;
# ACTUAL COORDINATE $x, $y
my $ax1 = $x - $buffer ;
my $ax2 = $x + $buffer ;
my $ay1 = $y - $buffer ;
my $ay2 = $y + $buffer ;
boxOccupyArea ($ax1, $ay1, $ax2, $ay2, 0, $value) ;
my $ax1 = $x - $buffer;
my $ax2 = $x + $buffer;
my $ay1 = $y - $buffer;
my $ay2 = $y + $buffer;
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
my $y = $y1 ;
my $stepY = $boxSize ;
if ( $y2 < $y1 ) { $stepY = - $boxSize ; }
while ( ( $y >= min ($y1, $y2) ) and ( $y <= max ($y1, $y2) ) ) {
my $y = $y1;
my $stepY = $boxSize;
if($y2 < $y1){$stepY = - $boxSize;} while(($y >= min($y1, $y2))and($y <= max($y1, $y2))){
# ACTUAL COORDINATE $x, $y
my $ax1 = $x - $buffer ;
my $ax2 = $x + $buffer ;
my $ay1 = $y - $buffer ;
my $ay2 = $y + $buffer ;
boxOccupyArea ($ax1, $ay1, $ax2, $ay2, 0, $value) ;
my $ax1 = $x - $buffer;
my $ax2 = $x + $buffer;
my $ay1 = $y - $buffer;
my $ay2 = $y + $buffer;
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 {
my ($refCoords, $buffer) = @_ ;
my @coordinates = @$refCoords ;
my @lines = () ;
my $result = 0 ;
# print "$x1, $y1, $x2, $y2\n";
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] ;
# 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($x1 != $x2){
my $m =($y2 - $y1)/($x2 - $x1);
my $b = $y1 - $m * $x1;
if(abs($x1 - $x2)> abs($y1 - $y2)){
# calc points on x axis
my $x = $x1 ;
my $stepX = $boxSize ;
if ( $x2 < $x1 ) { $stepX = - $boxSize ; }
while ( ( $x >= min ($x1, $x2) ) and ( $x <= max ($x1, $x2) ) ) {
my $y = $m * $x + $b ;
my $x = $x1;
my $stepX = $boxSize;
if($x2 < $x1){$stepX = - $boxSize;} while(($x >= min($x1, $x2))and($x <= max($x1, $x2))){
my $y = $m * $x + $b;
# ACTUAL COORDINATE $x, $y
my $ax1 = $x - $buffer ;
my $ax2 = $x + $buffer ;
my $ay1 = $y - $buffer ;
my $ay2 = $y + $buffer ;
my $tmp = boxAreaOccupied ($ax1, $ay1, $ax2, $ay2) ;
if ($tmp > $result) { $result = $tmp ; }
$x += $stepX ;
}
my $ax1 = $x - $buffer;
my $ax2 = $x + $buffer;
my $ay1 = $y - $buffer;
my $ay2 = $y + $buffer;
my $tmp = boxAreaOccupied($ax1, $ay1, $ax2, $ay2);
if($tmp > $result){$result = $tmp;} $x += $stepX;
}
else {
} else{
# calc points on y axis
my $y = $y1 ;
my $stepY = $boxSize ;
if ( $y2 < $y1 ) { $stepY = - $boxSize ; }
while ( ( $y >= min ($y1, $y2) ) and ( $y <= max ($y1, $y2) ) ) {
my $x = ($y - $b) / $m ;
my $y = $y1;
my $stepY = $boxSize;
if($y2 < $y1){$stepY = - $boxSize;} while(($y >= min($y1, $y2))and($y <= max($y1, $y2))){
my $x =($y - $b)/ $m;
# ACTUAL COORDINATE $x, $y
my $ax1 = $x - $buffer ;
my $ax2 = $x + $buffer ;
my $ay1 = $y - $buffer ;
my $ay2 = $y + $buffer ;
my $tmp = boxAreaOccupied ($ax1, $ay1, $ax2, $ay2) ;
if ($tmp > $result) { $result = $tmp ; }
my $ax1 = $x - $buffer;
my $ax2 = $x + $buffer;
my $ay1 = $y - $buffer;
my $ay2 = $y + $buffer;
my $tmp = boxAreaOccupied($ax1, $ay1, $ax2, $ay2);
if($tmp > $result){$result = $tmp;}
$y += $stepY;
}
}# abs
$y += $stepY ;
}
} # abs
}
else {
my $x = $x1 ;
} else{ my $x = $x1;
# calc points on y axis
my $y = $y1 ;
my $stepY = $boxSize ;
if ( $y2 < $y1 ) { $stepY = - $boxSize ; }
while ( ( $y >= min ($y1, $y2) ) and ( $y <= max ($y1, $y2) ) ) {
my $y = $y1;
my $stepY = $boxSize;
if($y2 < $y1){$stepY = - $boxSize;} while(($y >= min($y1, $y2))and($y <= max($y1, $y2))){
# ACTUAL COORDINATE $x, $y
my $ax1 = $x - $buffer ;
my $ax2 = $x + $buffer ;
my $ay1 = $y - $buffer ;
my $ay2 = $y + $buffer ;
my $tmp = boxAreaOccupied ($ax1, $ay1, $ax2, $ay2) ;
if ($tmp > $result) { $result = $tmp ; }
my $ax1 = $x - $buffer;
my $ax2 = $x + $buffer;
my $ay1 = $y - $buffer;
my $ay2 = $y + $buffer;
my $tmp = boxAreaOccupied($ax1, $ay1, $ax2, $ay2);
if($tmp > $result){$result = $tmp;}
$y += $stepY;
} }
$y += $stepY ;
}
}
}
return $result ;
} return $result;
}
# -------------------------------------------------------------
sub boxOccupyArea {
my ($x1, $y1, $x2, $y2, $buffer, $value) = @_ ;
sub boxOccupyArea{ my($x1, $y1, $x2, $y2, $buffer, $value)= @_;
if ( $x2 < $x1) {
my $tmp = $x1 ;
$x1 = $x2 ;
$x2 = $tmp ;
}
if ( $y2 < $y1) {
my $tmp = $y1 ;
$y1 = $y2 ;
$y2 = $tmp ;
}
if($x2 < $x1){ my $tmp = $x1;
$x1 = $x2;
$x2 = $tmp;
} if($y2 < $y1){ my $tmp = $y1;
$y1 = $y2;
$y2 = $tmp;
}
$x1 -= $buffer;
$x2 += $buffer;
$y1 -= $buffer;
$y2 += $buffer;
$x1 -= $buffer ;
$x2 += $buffer ;
$y1 -= $buffer ;
$y2 += $buffer ;
for ( my $x = $x1; $x <= $x2; $x += $boxSize) {
for ( my $y = $y1; $y <= $y2; $y += $boxSize) {
my $bx = int ( $x / $boxSize ) ;
my $by = int ( $y / $boxSize ) ;
$box{$bx}{$by} = $value ;
# print "box $bx, $by occupied\n" ;
}
}
return ;
for(my $x = $x1; $x <= $x2; $x += $boxSize){ for(my $y = $y1; $y <= $y2; $y += $boxSize){ my $bx = int($x / $boxSize);
my $by = int($y / $boxSize);
$box{$bx}{$by}= $value;
# print "box $bx, $by occupied\n";
}}
return;
}
sub boxAreaOccupied{ my($x1, $y1, $x2, $y2)= @_;
my $result = 0;
sub boxAreaOccupied {
my ($x1, $y1, $x2, $y2) = @_ ;
my $result = 0 ;
if ( $x2 < $x1) {
my $tmp = $x1 ;
$x1 = $x2 ;
$x2 = $tmp ;
}
if ( $y2 < $y1) {
my $tmp = $y1 ;
$y1 = $y2 ;
$y2 = $tmp ;
}
for ( my $x = $x1; $x <= $x2; $x += $boxSize) {
my $bx = int ($x / $boxSize) ;
for ( my $y = $y1; $y <= $y2; $y += $boxSize) {
my $by = int ($y / $boxSize) ;
# 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 ;
if($x2 < $x1){ my $tmp = $x1;
$x1 = $x2;
$x2 = $tmp;
} if($y2 < $y1){ my $tmp = $y1;
$y1 = $y2;
$y2 = $tmp;
}
for(my $x = $x1; $x <= $x2; $x += $boxSize){ my $bx = int($x / $boxSize);
for(my $y = $y1; $y <= $y2; $y += $boxSize){ my $by = int($y / $boxSize);
# 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 {
my $format1 = "fill=\"red\" fill-opacity=\"0.3\" " ;
my $format2 = "fill=\"blue\" fill-opacity=\"0.3\" " ;
my $format3 = "fill=\"green\" fill-opacity=\"0.5\" " ;
foreach my $bx ( sort {$a <=> $b} keys %box ) {
foreach my $by ( sort {$a <=> $b} keys %{$box{$bx}} ) {
my $x1 = $bx * $boxSize ;
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" ;
}
}
sub boxDrawOccupiedAreas{ my $format1 = "fill=\"red\" fill-opacity=\"0.3\" ";
my $format2 = "fill=\"blue\" fill-opacity=\"0.3\" ";
my $format3 = "fill=\"green\" fill-opacity=\"0.5\" ";
foreach my $bx(sort{$a <=> $b}keys %box){ foreach my $by(sort{$a <=> $b}keys %{$box{$bx}}){ my $x1 = $bx * $boxSize;
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";
}}
}
1 ;
1;

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

1119
mwRules.pm
View File

File diff suppressed because it is too large Load Diff

763
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
# 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
# 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 warnings ;
use strict;
use warnings;
use mwConfig ;
use mwFile ;
use mwMisc ;
use mwMap ;
use mwLabel ;
use mwOccupy ;
use mwConfig;
use mwFile;
use mwMisc;
use mwMap;
use mwLabel;
use mwOccupy;
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
addWayLabel
preprocessWayLabels
createWayLabels
) ;
);
my %directory = () ;
my %wayLabels = () ;
my @labelCandidates = () ;
my %ruleRefs = () ;
my $pathNumber = 0 ;
my %directory =();
my %wayLabels =();
my @labelCandidates =();
my %ruleRefs =();
my $pathNumber = 0;
my $numWayLabelsOmitted = 0 ;
my $wnsNumber = 1 ;
my @wns =() ;
my $numWayLabelsOmitted = 0;
my $wnsNumber = 1;
my @wns =();
# ------------------------------------------------------------------------
sub addToDirectory {
my ($name, $square) = @_ ;
if ( ! defined $square ) {
$directory { $name } = 1 ;
}
else {
$directory { $name } { $square } = 1 ;
}
sub addToDirectory{ my($name, $square)= @_;
if(! defined $square){ $directory{$name}= 1;
} else{ $directory{$name}{$square}= 1;
}}
sub getDirectory{ return \%directory;
}
sub getDirectory {
return \%directory ;
}
sub addWayLabel {
#
sub addWayLabel{#
# collect all way label data before actual labeling
#
my ($wayId, $name, $ruleRef) = @_ ;
push @{ $wayLabels{$ruleRef}{$name} }, $wayId ;
$ruleRefs{$ruleRef} = $ruleRef ;
if ( cv ('debug') eq "1" ) {
print "AWL: $wayId, $name, $ruleRef\n" ;
}
}
sub preprocessWayLabels {
#
my($wayId, $name, $ruleRef)= @_;
push @{$wayLabels{$ruleRef}{$name}}, $wayId;
$ruleRefs{$ruleRef}= $ruleRef;
if(cv('debug')eq "1"){ print "AWL: $wayId, $name, $ruleRef\n";
}}
sub preprocessWayLabels{#
# preprocess way labels collected so far
# combine ways with same rule and name
# split ways where direction in longitude changes so labels will be readable later
# store result in @labelCandidates
#
my ($lonRef, $latRef) = getNodePointers() ;
my ($memWayNodesRef, $memWayTagsRef) = getWayPointers() ;
my($lonRef, $latRef)= getNodePointers();
my($memWayNodesRef, $memWayTagsRef)= getWayPointers();
foreach my $rule (keys %wayLabels) {
my $ruleRef = $ruleRefs{ $rule } ;
# print "PPWL: ruleNum $rule\n" ;
foreach my $name (keys %{$wayLabels{$rule}}) {
my (@ways) = @{$wayLabels{$rule}{$name}} ;
# print "PPWL: processing name $name, " . scalar (@ways) . " ways\n" ;
my ($waysRef, $nodesRef) = buildRings (\@ways, 0) ;
my @segments = @$nodesRef ;
# print "PPWL: processing name $name, " . scalar (@segments) . " segments\n" ;
foreach my $rule(keys %wayLabels){ my $ruleRef = $ruleRefs{$rule};
# print "PPWL: ruleNum $rule\n";
foreach my $name(keys %{$wayLabels{$rule}}){ my(@ways)= @{$wayLabels{$rule}{$name}};
# print "PPWL: processing name $name, " . scalar(@ways). " ways\n";
my($waysRef, $nodesRef)= buildRings(\@ways, 0);
my @segments = @$nodesRef;
# print "PPWL: processing name $name, " . scalar(@segments). " segments\n";
if ( ! grep /shield:/i, $name) {
my @newSegments = () ;
foreach my $segment (@segments) {
my @actual = @$segment ;
# print "PPWL: Actual segment @actual\n" ;
my $found = 1 ;
while ($found) {
$found = 0 ; my $sp = 0 ;
if(! grep /shield:/i, $name){
my @newSegments =();
foreach my $segment(@segments){ my @actual = @$segment;
# print "PPWL: Actual segment @actual\n";
my $found = 1;
while($found){ $found = 0; my $sp = 0;
# look for splitting point
LABSP: for (my $i=1; $i<$#actual; $i++) {
if ( (($$lonRef{$actual[$i-1]} > $$lonRef{$actual[$i]}) and ($$lonRef{$actual[$i+1]} > $$lonRef{$actual[$i]})) or
(($$lonRef{$actual[$i-1]} < $$lonRef{$actual[$i]}) and ($$lonRef{$actual[$i+1]} < $$lonRef{$actual[$i]})) ) {
$found = 1 ;
$sp = $i ;
last LABSP ;
}
}
if ($found == 1) {
# print "\nname $name --- sp: $sp\n" ;
# print "ACTUAL BEFORE: @actual\n" ;
LABSP: for(my $i=1; $i<$#actual; $i++){ if((($$lonRef{$actual[$i-1]}> $$lonRef{$actual[$i]})and($$lonRef{$actual[$i+1]}> $$lonRef{$actual[$i]}))or
(($$lonRef{$actual[$i-1]}< $$lonRef{$actual[$i]})and($$lonRef{$actual[$i+1]}< $$lonRef{$actual[$i]}))){ $found = 1;
$sp = $i;
last LABSP;
} } if($found == 1){ # print "\nname $name --- sp: $sp\n";
# print "ACTUAL BEFORE: @actual\n";
# create new seg
my @newSegment = @actual[0..$sp] ;
push @newSegments, [@newSegment] ;
# print "NEW: @newSegment\n" ;
my @newSegment = @actual[0..$sp];
push @newSegments, [@newSegment];
# print "NEW: @newSegment\n";
# splice actual
splice @actual, 0, $sp ;
# print "ACTUAL AFTER: @actual\n\n" ;
}
}
@$segment = @actual ;
}
push @segments, @newSegments ;
splice @actual, 0, $sp;
# print "ACTUAL AFTER: @actual\n\n";
} } @$segment = @actual;
}
push @segments, @newSegments;
foreach my $segment (@segments) {
my (@wayNodes) = @$segment ;
my @points = () ;
if ($$lonRef{$wayNodes[0]} > $$lonRef{$wayNodes[-1]}) {
if ( ( ! grep /motorway/, $$ruleRef{'keyvalue'}) and ( ! grep /trunk/, $$ruleRef{'keyvalue'} ) ) {
@wayNodes = reverse @wayNodes ;
}
}
foreach my $node (@wayNodes) {
push @points, convert ($$lonRef{$node}, $$latRef{$node}) ;
}
# print "PPWL: segment @wayNodes\n" ;
# 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" ;
}
}
}
}
}
foreach my $segment(@segments){ my(@wayNodes)= @$segment;
my @points =();
sub subWay {
#
if($$lonRef{$wayNodes[0]}> $$lonRef{$wayNodes[-1]}){ if((! grep /motorway/, $$ruleRef{'keyvalue'})and(! grep /trunk/, $$ruleRef{'keyvalue'})){ @wayNodes = reverse @wayNodes;
} }
foreach my $node(@wayNodes){ push @points, convert($$lonRef{$node}, $$latRef{$node});
} # print "PPWL: segment @wayNodes\n";
# print "PPWL: segment @points\n";
my($segmentLengthPixels)= 0;
for(my $i=0; $i<$#wayNodes; $i++){ my($x1, $y1)= convert($$lonRef{$wayNodes[$i]}, $$latRef{$wayNodes[$i]});
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
# also calculates total angles / bends
#
my ($ref, $labLen, $alignment, $position) = @_ ;
my @coordinates = @$ref ;
my @points ;
my @dists ;
my @angles = () ;
my($ref, $labLen, $alignment, $position)= @_;
my @coordinates = @$ref;
my @points;
my @dists;
my @angles =();
for (my $i=0; $i < $#coordinates; $i+=2) {
push @points, [$coordinates[$i],$coordinates[$i+1]] ;
}
$dists[0] = 0 ;
my $dist = 0 ;
if (scalar @points > 1) {
for (my $i=1;$i<=$#points; $i++) {
$dist = $dist + sqrt ( ($points[$i-1]->[0]-$points[$i]->[0])**2 + ($points[$i-1]->[1]-$points[$i]->[1])**2 ) ;
$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) ;
for(my $i=0; $i < $#coordinates; $i+=2){ push @points, [$coordinates[$i],$coordinates[$i+1]];
}
$dists[0] = 0;
my $dist = 0;
if(scalar @points > 1){ for(my $i=1;$i<=$#points; $i++){ $dist = $dist + sqrt(($points[$i-1]->[0]-$points[$i]->[0])**2 +($points[$i-1]->[1]-$points[$i]->[1])**2);
$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
#
my %wnsUnique = () ;
print "placing way labels...\n" ;
my %wnsUnique =();
print "placing way labels...\n";
my %notDrawnLabels = () ;
my %drawnLabels = () ;
my %notDrawnLabels =();
my %drawnLabels =();
# calc ratio to label ways first where label just fits
# these will be drawn first
foreach my $candidate (@labelCandidates) {
my $wLen = $candidate->[2] ;
my $lLen = $candidate->[3] ;
if ($wLen == 0) { $wLen = 1 ; }
if ($lLen == 0) { $lLen = 1 ; }
$candidate->[5] = $lLen / $wLen ;
foreach my $candidate(@labelCandidates){ my $wLen = $candidate->[2];
my $lLen = $candidate->[3];
if($wLen == 0){$wLen = 1;} if($lLen == 0){$lLen = 1;} $candidate->[5] = $lLen / $wLen;
} @labelCandidates = sort{$b->[5] <=> $a->[5]}@labelCandidates;
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?
if ( ($lLen > $wLen * 0.95) and ( cv('wns') > 0 ) ) {
if ( ( $toLabel != 0 ) and ( ! grep /shield:/i, $name) and ( wayVisible( \@points ) ) ) {
if ( ! defined $wnsUnique{$name} ) {
my $oldName = $name ;
$wnsUnique{$name} = 1 ;
push @wns, [ $wnsNumber, $name] ;
$name = $wnsNumber ;
$lLen = cv('ppc') / 10 * $$ruleRef{'labelsize'} * length ($name) ;
# print "WNS: $oldName - $name\n" ;
$wnsNumber++ ;
}
}
}
if(($lLen > $wLen * 0.95)and(cv('wns')> 0)){ if(($toLabel != 0)and(! grep /shield:/i, $name)and(wayVisible(\@points))){ if(! defined $wnsUnique{$name}){ my $oldName = $name;
$wnsUnique{$name}= 1;
push @wns, [ $wnsNumber, $name];
$name = $wnsNumber;
$lLen = cv('ppc')/ 10 * $$ruleRef{'labelsize'}* length($name);
# print "WNS: $oldName - $name\n";
$wnsNumber++;
} } }
if(($lLen > $wLen*0.95)or($toLabel == 0)){ # label too long
$numWayLabelsOmitted++;
$notDrawnLabels{$name}= 1;
if ( ($lLen > $wLen*0.95) or ($toLabel == 0) ) {
# label too long
$numWayLabelsOmitted++ ;
$notDrawnLabels { $name } = 1 ;
} else{
if(grep /shield:/i, $name){
createShield($name, $$ruleRef{'labelsize'});
}
else {
my $shieldMaxSize = getMaxShieldSize($name);
if (grep /shield:/i, $name) {
my $numShields = int($wLen /($shieldMaxSize * 12));
# if($numShields > 4){$numShields = 4;}
createShield ($name, $$ruleRef{'labelsize'} ) ;
my $shieldMaxSize = getMaxShieldSize ($name) ;
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($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
my ($ssx, $ssy) = getShieldSizes($name) ;
my($ssx, $ssy)= getShieldSizes($name);
my $x2 = int ($x - $ssx / 2) ;
my $y2 = int ($y - $ssy / 2) ;
my $x2 = int($x - $ssx / 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) ;
addToLayer ("shields", "<use xlink:href=\"#$id\" x=\"$x2\" y=\"$y2\" />") ;
mwLabel::boxOccupyArea($x2, $y2+$ssy, $x2+$ssx, $y2, 0, 3);
} }
$position += $step;
} }
}# shield
mwLabel::boxOccupyArea ($x2, $y2+$ssy, $x2+$ssx, $y2, 0, 3) ;
}
}
else{
$position += $step ;
}
}
} # shield
else {
# print "$wLen - $name - $lLen\n" ;
my $numLabels = int ($wLen / (4 * $lLen)) ;
if ($numLabels < 1) { $numLabels = 1 ; }
if ($numLabels > 4) { $numLabels = 4 ; }
if ($numLabels == 1) {
# print "LA: $name *1*\n" ;
my $spare = 0.95 * $wLen - $lLen ;
my $sparePercentHalf = $spare / ($wLen*0.95) *100 / 2 ;
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
my $step = ($endOffset - $startOffset) / 5 ;
my @positions = () ;
my $actual = $startOffset ;
my $size = $$ruleRef{'labelsize'} ;
while ($actual <= $endOffset) {
my ($ref, $angle) = subWay (\@points, $lLen, "middle", $actual) ;
my @way = @$ref ;
# my ($col) = lineCrossings (\@way) ;
my ($col) = boxLinesOccupied (\@way, $size/2) ;
my $step =($endOffset - $startOffset)/ 5;
my @positions =();
my $actual = $startOffset;
my $size = $$ruleRef{'labelsize'};
while($actual <= $endOffset){ my($ref, $angle)= subWay(\@points, $lLen, "middle", $actual);
my @way = @$ref;
# my($col)= lineCrossings(\@way);
my($col)= boxLinesOccupied(\@way, $size/2);
# calc quality of position. distance from middle and bend angles
my $quality = $angle + abs (50 - $actual) ;
if ($col == 0) { push @positions, ["middle", $actual, $quality] ; }
$actual += $step ;
}
if (scalar @positions > 0) {
$drawnLabels { $name } = 1 ;
my $quality = $angle + abs(50 - $actual);
if($col == 0){push @positions, ["middle", $actual, $quality];} $actual += $step;
} if(scalar @positions > 0){ $drawnLabels{$name}= 1;
# sort by quality and take best one
@positions = sort {$a->[2] <=> $b->[2]} @positions ;
my ($pos) = shift @positions ;
my ($ref, $angle) = subWay (\@points, $lLen, $pos->[0], $pos->[1]) ;
my @finalWay = @$ref ;
@positions = sort{$a->[2] <=> $b->[2]}@positions;
my($pos)= shift @positions;
my($ref, $angle)= subWay(\@points, $lLen, $pos->[0], $pos->[1]);
my @finalWay = @$ref;
# TODO IF INSIDE
# print "final way @finalWay\n" ;
# print "final way @finalWay\n";
if ( ! coordsOut (@finalWay) ) {
my $pathName = "Path" . $pathNumber ; $pathNumber++ ;
createPath ($pathName, \@finalWay, "definitions") ;
if(! coordsOut(@finalWay)){ my $pathName = "Path" . $pathNumber; $pathNumber++;
createPath($pathName, \@finalWay, "definitions");
my $size = $$ruleRef{'labelsize'} ;
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 $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 $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], 50, "text") ;
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], 50, "text");
boxOccupyLines (\@finalWay, $size/2, 3) ;
}
}
else {
$numWayLabelsOmitted++ ;
}
}
else { # more than one label
# print "LA: $name *X*\n" ;
my $labelDrawn = 0 ;
my $interval = int (100 / ($numLabels + 1)) ;
my @positions = () ;
for (my $i=1; $i<=$numLabels; $i++) {
push @positions, $i * $interval ;
}
foreach my $position (@positions) {
my ($refFinal, $angle) = subWay (\@points, $lLen, "middle", $position) ;
my (@finalWay) = @$refFinal ;
# my ($collision) = lineCrossings (\@finalWay) ;
boxOccupyLines(\@finalWay, $size/2, 3);
} } else{ $numWayLabelsOmitted++;
} } else{# more than one label
# print "LA: $name *X*\n";
my $labelDrawn = 0;
my $interval = int(100 /($numLabels + 1));
my @positions =();
for(my $i=1; $i<=$numLabels; $i++){ push @positions, $i * $interval;
}
foreach my $position(@positions){ my($refFinal, $angle)= subWay(\@points, $lLen, "middle", $position);
my(@finalWay)= @$refFinal;
# my($collision)= lineCrossings(\@finalWay);
my $size = $$ruleRef{'labelsize'} ;
my ($collision) = boxLinesOccupied (\@finalWay, $size/2 ) ;
my $size = $$ruleRef{'labelsize'};
my($collision)= boxLinesOccupied(\@finalWay, $size/2);
if ($collision == 0) {
$labelDrawn = 1 ;
$drawnLabels { $name } = 1 ;
my $pathName = "Path" . $pathNumber ; $pathNumber++ ;
if($collision == 0){ $labelDrawn = 1;
$drawnLabels{$name}= 1;
my $pathName = "Path" . $pathNumber; $pathNumber++;
# createPath ($pathName, \@points, "definitions") ;
createPath ($pathName, \@finalWay, "definitions") ;
# createPath($pathName, \@points, "definitions");
createPath($pathName, \@finalWay, "definitions");
my $size = $$ruleRef{'labelsize'} ;
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 $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 $svgText = createTextSVG ( $fontFamily, $font, $labelBold, $labelItalic, $size, $color, $labelHalo, $labelHaloColor) ;
pathText ($svgText, $name, $pathName, $$ruleRef{'labeloffset'}, "middle", 50, "text") ;
my $svgText = createTextSVG($fontFamily, $font, $labelBold, $labelItalic, $size, $color, $labelHalo, $labelHaloColor);
pathText($svgText, $name, $pathName, $$ruleRef{'labeloffset'}, "middle", 50, "text");
boxOccupyLines (\@finalWay, $size/2, 3) ;
boxOccupyLines(\@finalWay, $size/2, 3);
}
else {
# print "INFO: $name labeled less often than desired.\n" ;
}
}
if ($labelDrawn == 0) {
$notDrawnLabels { $name } = 1 ;
}
}
}
}
}
my $labelFileName = cv('out') ;
$labelFileName =~ s/\.svg/_NotDrawnLabels.txt/ ;
my $labelFile ;
open ($labelFile, ">", $labelFileName) or die ("couldn't open label file $labelFileName") ;
print $labelFile "Not drawn labels\n\n" ;
foreach my $labelName (sort keys %notDrawnLabels) {
if (!defined $drawnLabels { $labelName } ) {
print $labelFile "$labelName\n" ;
}
}
close ($labelFile) ;
} else{ # print "INFO: $name labeled less often than desired.\n";
} } if($labelDrawn == 0){ $notDrawnLabels{$name}= 1;
} } } }} my $labelFileName = cv('out');
$labelFileName =~ s/\.svg/_NotDrawnLabels.txt/;
my $labelFile;
open($labelFile, ">", $labelFileName)or die("couldn't open label file $labelFileName");
print $labelFile "Not drawn labels\n\n";
foreach my $labelName(sort keys %notDrawnLabels){ if(!defined $drawnLabels{$labelName}){ print $labelFile "$labelName\n";
}} close($labelFile);
# way name substitutes legend?
if ( cv('wns') > 0 ) {
createWNSLegend() ;
}
if(cv('wns')> 0){ createWNSLegend();
}
}
# ------------------------------------------------------------
sub createWNSLegend {
my $size = cv('wnssize') ;
my $color = cv('wnscolor') ;
sub createWNSLegend{ my $size = cv('wnssize');
my $color = cv('wnscolor');
# TODO max len auto size
my $maxLen = 0 ;
foreach my $e ( @wns ) {
if ( length $e->[1] > $maxLen ) { $maxLen = length $e->[1] ; }
}
my $maxLen = 0;
foreach my $e(@wns){ if(length $e->[1] > $maxLen){$maxLen = length $e->[1];}}
my $sy = 2 * $size;
my $sx =(4 + $maxLen)* $size / 10 * cv('ppc');
my $tx = 4 * $size / 10 * cv('ppc');
my $nx = 1 * $size / 10 * cv('ppc');
my $ty = 1.5 * $size;
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 $sizeX = $sx ;
my $sizeY = $sy * scalar @wns ;
my $sizeX = $sx;
my $sizeY = $sy * scalar @wns;
# 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
my $bg = cv('wnsbgcolor') ;
my $svgString = "fill=\"$bg\"" ;
drawRect (0, 0, $sizeX, $sizeY, 0, $svgString, "definitions") ;
my $bg = cv('wnsbgcolor');
my $svgString = "fill=\"$bg\"";
drawRect(0, 0, $sizeX, $sizeY, 0, $svgString, "definitions");
$svgString = createTextSVG ( cv('elementFontFamily'), cv('elementFont'), undef, undef, cv('wnssize'), cv('wnscolor'), undef, undef) ;
foreach my $e ( @wns ) {
my $y = $actualLine * $sy + $ty ;
drawText ($nx, $y, 0, $e->[0], $svgString, "definitions") ;
drawText ($tx, $y, 0, $e->[1], $svgString, "definitions") ;
$svgString = createTextSVG(cv('elementFontFamily'), cv('elementFont'), undef, undef, cv('wnssize'), cv('wnscolor'), undef, undef);
foreach my $e(@wns){ my $y = $actualLine * $sy + $ty;
drawText($nx, $y, 0, $e->[0], $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
($sizeX, $sizeY) = getDimensions() ;
$sy = $sy * scalar @wns ;
($sizeX, $sizeY)= getDimensions();
$sy = $sy * scalar @wns;
if ( cv('wns') eq "2") {
$posX = $sizeX - $sx ;
$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 "2"){ $posX = $sizeX - $sx;
$posY = 0;
}
1 ;
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");
}}
1;

522
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
# 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
# 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 warnings ;
use strict;
use warnings;
use OSM::osm 8.3 ;
use OSM::osm 8.3;
use mwConfig ;
use mwFile ;
use mwRules ;
use mwMap ;
use mwMisc ;
use mwWayLabel ;
use mwCoastLines ;
use mwConfig;
use mwFile;
use mwRules;
use mwMap;
use mwMisc;
use mwWayLabel;
use mwCoastLines;
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
createDirectory
) ;
);
my $areasOmitted = 0 ;
my $areasDrawn = 0 ;
my $areasOmitted = 0;
my $areasDrawn = 0;
my $areaLabels = 0 ;
my $areaLabelsOmitted = 0 ;
my $areaLabels = 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 ;
($nodesRef, $tagRef) = getWayPointers () ;
my ($lonRef, $latRef, $nodeTagRef) = getNodePointers() ;
foreach my $wayId (keys %$nodesRef) {
my @tags = @{ $$tagRef{$wayId} } ;
my $tagsString = "" ;
foreach my $wayId(keys %$nodesRef){ my @tags = @{$$tagRef{$wayId}};
my $tagsString = "";
# coast
my $v = getValue ("natural", \@tags) ;
if ( (defined $v) and ($v eq "coastline") ) {
push @coastWays, $wayId ;
}
my $v = getValue("natural", \@tags);
if((defined $v)and($v eq "coastline")){ push @coastWays, $wayId;
}
# WAYS
my $ruleRef = getWayRule (\@tags) ;
if (defined $ruleRef) {
my @nodes = @{ $$nodesRef{ $wayId } } ;
my $layer = getValue ("layer", $$tagRef{$wayId}) ;
if ( ! defined $layer ) { $layer = 0 ; }
my $ruleRef = getWayRule(\@tags);
if(defined $ruleRef){ my @nodes = @{$$nodesRef{$wayId}};
my $layer = getValue("layer", $$tagRef{$wayId});
if(! defined $layer){$layer = 0;}
# TODO check for numeric!!!
my $direction = 0 ;
my $ow = getValue("oneway", $$tagRef{$wayId}) ;
if (defined $ow) {
if (($ow eq "yes") or ($ow eq "true") or ($ow eq "1")) { $direction = 1 ; }
if ($ow eq "-1") { $direction = -1 ; }
}
my $direction = 0;
my $ow = getValue("oneway", $$tagRef{$wayId});
if(defined $ow){ if(($ow eq "yes")or($ow eq "true")or($ow eq "1")){$direction = 1;} if($ow eq "-1"){$direction = -1;} }
my $bridge = getValue("bridge", $$tagRef{$wayId});
if(defined $bridge){ if(($bridge eq "yes")or($bridge eq "true")){$bridge = 1;}else{$bridge = 0;} } else{$bridge = 0;}
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);
my $bridge = getValue("bridge", $$tagRef{$wayId}) ;
if (defined $bridge) {
if (($bridge eq "yes") or ($bridge eq "true")) { $bridge = 1 ; } else { $bridge = 0 ; }
}
else { $bridge = 0 ; }
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
if ( cv('ignorelabels') eq "0" ) {
if ($$ruleRef{'label'} ne "none") {
my $name = "" ; my $ref1 ; my @names ;
if (grep /shield/i, $$ruleRef{'label'} ) {
($name, $ref1) = createLabel (\@tags, "ref",0, 0) ;
my $ref = $name ;
if (grep /;/, $ref) {
my @a = split /;/, $ref ;
$ref = $a[0] ;
}
if ($ref ne "") {
@names = ($ref) ;
$name = $$ruleRef{'label'} . ":$ref" ;
# print "DRAW WAY: name set to $name\n" ;
}
else {
@names = () ;
$name = "" ;
}
# print "WAY: name for shield >$name<\n" ;
}
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
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
if(cv('ignorelabels')eq "0"){ if($$ruleRef{'label'}ne "none"){
my $name = ""; my $ref1; my @names;
if(grep /shield/i, $$ruleRef{'label'}){ ($name, $ref1)= createLabel(\@tags, "ref",0, 0);
my $ref = $name;
if(grep /;/, $ref){ my @a = split /;/, $ref;
$ref = $a[0];
}
if($ref ne ""){ @names =($ref);
$name = $$ruleRef{'label'}. ":$ref";
# print "DRAW WAY: name set to $name\n";
} else{ @names =();
$name = "";
}
# print "WAY: name for shield >$name<\n";
} 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
$ruleRef = getAreaRule (\@tags) ;
my @nodes = @{ $$nodesRef{ $wayId } } ;
if ( (defined $ruleRef) and ($nodes[0] == $nodes[-1]) ) {
my $color = $$ruleRef{'color'} ;
my $icon = $$ruleRef{'icon'} ;
my $base = $$ruleRef{'base'} ;
my $svgString = $$ruleRef{'svgstring'} ;
my $size = areaSize (\@nodes) ;
my @ways = [@nodes] ;
$ruleRef = getAreaRule(\@tags);
my @nodes = @{$$nodesRef{$wayId}};
if((defined $ruleRef)and($nodes[0] == $nodes[-1])){ my $color = $$ruleRef{'color'};
my $icon = $$ruleRef{'icon'};
my $base = $$ruleRef{'base'};
my $svgString = $$ruleRef{'svgstring'};
my $size = areaSize(\@nodes);
my @ways = [@nodes];
if ( ($svgString eq "") and ($icon eq "none") ) {
$svgString = "fill=\"$color\" " ;
}
if ($size > cv('minareasize') ) {
if ($base eq "yes") {
drawArea ($svgString, $icon, \@ways, 1, "base") ;
}
else {
drawArea ($svgString, $icon, \@ways, 1, "area") ;
}
$areasDrawn++ ;
if(($svgString eq "")and($icon eq "none")){ $svgString = "fill=\"$color\" ";
}
if($size > cv('minareasize')){ if($base eq "yes"){ drawArea($svgString, $icon, \@ways, 1, "base");
} else{ drawArea($svgString, $icon, \@ways, 1, "area");
} $areasDrawn++;
# DRAW label
if ( $$ruleRef{'label'} ne "none" ) {
$areaLabels++ ;
if ($size > cv('minarealabelsize') ) {
# text
my ($name, $ref1) = createLabel (\@tags, $$ruleRef{'label'},0, 0) ;
$name = labelTransform ($name, $$ruleRef{'labeltransform'}) ;
if($$ruleRef{'label'}ne "none"){ $areaLabels++;
if($size > cv('minarealabelsize')){ # text
my($name, $ref1)= createLabel(\@tags, $$ruleRef{'label'},0, 0);
$name = labelTransform($name, $$ruleRef{'labeltransform'});
# pos
my ($lon, $lat) = areaCenter ( $$nodesRef{$wayId} ) ;
my($lon, $lat)= areaCenter($$nodesRef{$wayId});
# draw
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 $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) ;
my $svgText = createTextSVG($labelFontFamily, $labelFont, $labelBold, $labelItalic, $labelSize, $color, $labelHalo, $labelHaloColor);
mwLabel::placeLabelAndIcon ($lon, $lat, 0, 0, $name, $svgText, "none", 0, 0, "arealabels") ;
}
else {
$areaLabelsOmitted++ ;
}
}
mwLabel::placeLabelAndIcon($lon, $lat, 0, 0, $name, $svgText, "none", 0, 0, "arealabels");
} else{ $areaLabelsOmitted++;
} }
}
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) ;
}
} 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);
}}
# ----------------------------------------------------------------------------
sub createWayParameters {
my ($ruleRef, $layer, $bridge, $tunnel) = @_ ;
sub createWayParameters{ my($ruleRef, $layer, $bridge, $tunnel)= @_;
my $svg1 = "" ; my $layer1 = 0 ;
my $svg2 = "" ; my $layer2 = 0 ;
my $svg1 = ""; my $layer1 = 0;
my $svg2 = ""; my $layer2 = 0;
my %dashDefinition = () ;
@{$dashDefinition {1} } = ("round", "20,20") ;
@{$dashDefinition {2} } = ("round", "44,20") ;
@{$dashDefinition {3} } = ("round", "28,20") ;
@{$dashDefinition {4} } = ("round", "12,20") ;
my %dashDefinition =();
@{$dashDefinition{1}}=("round", "20,20");
@{$dashDefinition{2}}=("round", "44,20");
@{$dashDefinition{3}}=("round", "28,20");
@{$dashDefinition{4}}=("round", "12,20");
@{$dashDefinition {10} } = ("round", "8,8") ;
@{$dashDefinition {11} } = ("round", "16,16") ;
@{$dashDefinition {12} } = ("round", "24,24") ;
@{$dashDefinition {13} } = ("round", "32,32") ;
@{$dashDefinition {14} } = ("round", "40,40") ;
@{$dashDefinition{10}}=("round", "8,8");
@{$dashDefinition{11}}=("round", "16,16");
@{$dashDefinition{12}}=("round", "24,24");
@{$dashDefinition{13}}=("round", "32,32");
@{$dashDefinition{14}}=("round", "40,40");
@{$dashDefinition {20} } = ("round", "0,8,0,16") ;
@{$dashDefinition {21} } = ("round", "0,16,0,32") ;
@{$dashDefinition {22} } = ("round", "0,24,0,48") ;
@{$dashDefinition {23} } = ("round", "0,32,0,48") ;
@{$dashDefinition{20}}=("round", "0,8,0,16");
@{$dashDefinition{21}}=("round", "0,16,0,32");
@{$dashDefinition{22}}=("round", "0,24,0,48");
@{$dashDefinition{23}}=("round", "0,32,0,48");
@{$dashDefinition {30} } = ("butt", "4,4") ;
@{$dashDefinition {31} } = ("butt", "8,8") ;
@{$dashDefinition {32} } = ("butt", "12,12") ;
@{$dashDefinition {33} } = ("butt", "4,12") ;
@{$dashDefinition {34} } = ("butt", "4,20") ;
@{$dashDefinition {35} } = ("butt", "8,20") ;
@{$dashDefinition{30}}=("butt", "4,4");
@{$dashDefinition{31}}=("butt", "8,8");
@{$dashDefinition{32}}=("butt", "12,12");
@{$dashDefinition{33}}=("butt", "4,12");
@{$dashDefinition{34}}=("butt", "4,20");
@{$dashDefinition{35}}=("butt", "8,20");
if ( cv ('autobridge') eq "0" ) {
$layer = 0 ;
}
if ( ( $$ruleRef{'svgstringtop'} ne "" ) or ( $$ruleRef{'svgstringbottom'} ne "" ) ) {
$svg1 = $$ruleRef{'svgstringtop'} ;
$svg2 = $$ruleRef{'svgstringbottom'} ;
if(cv('autobridge')eq "0"){ $layer = 0;
}
if(($$ruleRef{'svgstringtop'}ne "")or($$ruleRef{'svgstringbottom'}ne "")){
$svg1 = $$ruleRef{'svgstringtop'};
$svg2 = $$ruleRef{'svgstringbottom'};
# TODO layer
$layer1 = $layer ;
$layer2 = $layer ;
$layer1 = $layer;
$layer2 = $layer;
} else{
my $size = $$ruleRef{'size'};
my $color = $$ruleRef{'color'};
my $lc = "round";
my $lj = "round";
my $dash = "";
if($$ruleRef{'dash'}ne ""){ if(! grep /,/, $$ruleRef{'dash'}){ my @ds = @{$dashDefinition{$$ruleRef{'dash'}}};
$lc = $ds[0];
my $style = $ds[1];
$dash = "stroke-dasharray=\"$style\" ";
} else{ $lc = $$ruleRef{'dashcap'};
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 $bs = $$ruleRef{'bordersize'};
$lc = "round";
$dash = "";
if(cv('autobridge')eq "1"){ # TODO bridge/tunnel
if($bridge == 1){ $lc = "butt";
$bs += 3; # TODO config value
} 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;
}
else {
my $size = $$ruleRef{'size'} ;
my $color = $$ruleRef{'color'} ;
my $lc = "round" ;
my $lj = "round" ;
my $dash = "" ;
if ( $$ruleRef{'dash'} ne "" ) {
if ( ! grep /,/, $$ruleRef{'dash'}) {
my @ds = @{$dashDefinition{ $$ruleRef{'dash'} } } ;
$lc = $ds[0] ;
my $style = $ds[1] ;
$dash = "stroke-dasharray=\"$style\" " ;
}
else {
$lc = $$ruleRef{'dashcap'} ;
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 $bs = $$ruleRef{'bordersize'} ;
$lc = "round" ;
$dash = "" ;
if ( cv ('autobridge') eq "1" ) {
# TODO bridge/tunnel
if ( $bridge == 1) {
$lc = "butt" ;
$bs += 3 ; # TODO config value
}
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 {
my $directoryName ;
my $dirFile ;
$directoryName = cv ('out') ;
$directoryName =~ s/\.svg/\_streets.txt/ ;
setConfigValue("directoryname", $directoryName) ;
print "creating dir file $directoryName ...\n" ;
open ($dirFile, ">", $directoryName) or die ("can't open dir file $directoryName\n") ;
sub createDirectory{ my $directoryName;
my $dirFile;
$directoryName = cv('out');
$directoryName =~ s/\.svg/\_streets.txt/;
setConfigValue("directoryname", $directoryName);
print "creating dir file $directoryName ...\n";
open($dirFile, ">", $directoryName)or die("can't open dir file $directoryName\n");
my $ref = getDirectory() ;
my %directory = %$ref ;
my $ref = getDirectory();
my %directory = %$ref;
if ( cv('grid') eq "0") {
foreach my $street (sort keys %directory) {
$street = replaceHTMLCode ( $street ) ;
print $dirFile "$street\n" ;
}
}
else {
foreach my $street (sort keys %directory) {
my $streetSanitized = replaceHTMLCode ( $street ) ;
print $dirFile "$streetSanitized\t" ;
foreach my $square (sort keys %{$directory{$street}}) {
print $dirFile "$square " ;
}
print $dirFile "\n" ;
}
}
close ($dirFile) ;
if(cv('grid')eq "0"){ foreach my $street(sort keys %directory){ $street = replaceHTMLCode($street);
print $dirFile "$street\n";
}} else{ foreach my $street(sort keys %directory){ my $streetSanitized = replaceHTMLCode($street);
print $dirFile "$streetSanitized\t";
foreach my $square(sort keys %{$directory{$street}}){ print $dirFile "$square ";
} print $dirFile "\n";
}} close($dirFile);
}
1 ;
1;