source: subversion/applications/utils/gary68/mapgen.pl @ 20564

Last change on this file since 20564 was 20564, checked in by gary68, 10 years ago

mapgen 0.14

  • Property svn:executable set to *
File size: 66.0 KB
Line 
1#! /usr/bin/perl
2#
3# mapgen.pl
4#
5# Copyright (C) 2010, Gerhard Schwanz
6#
7# This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the
8# Free Software Foundation; either version 3 of the License, or (at your option) any later version.
9#
10# This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
11# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
12#
13# You should have received a copy of the GNU General Public License along with this program; if not, see <http://www.gnu.org/licenses/>
14#
15
16# 0.09 _lon and _lat for labes
17#      [-coords] coordinates grid
18#      display routes
19#      automatic label fit for labels on roads; [-ppc] replaces [-minlen]
20#      stops for routes
21# 0.10 icons for routes (routeicons dir)
22#      [-routeicondist]
23#      [-poi]
24# 0.11 from and to scale added to style file and read routines
25#      getXYRule incl. scale     
26#      scale range for rules
27#      area tile patterns implemented
28#      error checking for osm file implemented
29# 0.12 show only elements in legend that are shown in current scale
30#      larger legend symbols
31#      support for asterisk (wild card) in way and node rules (enter * for value)
32#      more intelligent icon placement, 9 different positions around actual position
33#      ppc changed to 5.7?
34#      draw text pos new
35# 0.13 tagstat changed to consider sub k/v
36#      remark (COMMENT) lines for style file
37#      [-rulescaleset]
38#      way borders
39#      tagstat separated for nodes and ways
40# 0.14 [-pad]
41#      ocean rendering
42#      [-allowiconmove]
43#
44# TODO
45# check rendering of route symbols, rectangles?
46# ------------------
47# determine svg file size differently and faster?
48# [ ] reading rule check for right number of keys and values ! else ERROR
49# [ ] eliminate rules not needed when scale is present. remove ifs in getXYZRules
50# grid distance in meters
51# -viewpng -viewpdf -viewsvg
52# STDERR outputs
53# module for style file reading and error handling
54# style file check, color check, error messages, array for regex? Defaults
55# nested relations for multipolygons?
56# see wiki
57# maybe prevent double labels in vicinity of each other?
58
59use strict ;
60use warnings ;
61
62use Math::Polygon ;
63use Getopt::Long ;
64use OSM::osm ;
65use OSM::mapgen 0.14 ;
66use OSM::mapgenRules 0.14 ;
67
68my $programName = "mapgen.pl" ;
69my $version = "0.14" ;
70
71my $usage = <<"END23" ;
72perl mapgen.pl
73-help
74-in=file.osm
75-style=style.csv (original can be kept and maintained in OO sheet or MS Excel)
76-out=file.svg (png and pdf names are automatic, DEFAULT=mapgen.svg)
77
78-bgcolor=TEXT (color for background)
79-size=<integer> (in pixels for x axis, DEFAULT=1024)
80-clip=<integer> (percent data to be clipped on each side, 0=no clipping, DEFAULT=0)
81-pad=<INTEGER> (percent of white space around data in osm file, DEFAULT=0)
82
83-place=TEXT (Place to draw automatically; quotation marks can be used if necessary; OSMOSIS REQUIRED!)
84-lonrad=FLOAT (radius for place width in km, DEFAULT=2)
85-latrad=FLOAT (radius for place width in km, DEFAULT=2)
86
87-declutter (declutter text; WARNING: some labels might be omitted; motorway and trunk will only be labeled in one direction)
88-allowiconmove (allows icons to be moved if they don't fit the exact position)
89
90-oneways (add oneway arrows)
91-onewaycolor=TEXT (color for oneway arrows)
92
93-grid=<integer> (number parts for grid, 0=no grid, DEFAULT=0)
94-gridcolor=TEXT (color for grid lines and labels (DEFAULT=black)
95-coords (turn on coordinates grid)
96-coordsexp=INTEGER (degrees to the power of ten for grid distance; DEFAULT=-2 equals 0.01 degrees)
97-coordscolor=TEXT (set color of coordinates grid)
98-dir (create street directory in separate file. if grid is enabled, grid squares will be added)
99-poi (create list of pois)
100-tagstat (lists keys and values used in osm file; program filters list to keep them short!!! see code array noListTags)
101
102-routelabelcolor=TEXT (color for labels of routes)
103-routelabelsize=INTEGER (DEFAULT=8)
104-routelabelfont=TEXT (DEFAULT=sans-serif)
105-routelabeloffset=INTEGER (DEFAULT=10)
106-icondir=TEXT (dir for icons for routes; ./icondir/ i.e.; DEFAULT=./routeicons/ )
107-routeicondist=INTEGER (dist in y direction for route icons on same route; DEFAULT=25)
108
109-legend=INT (0=no legend; 1=legend; DEFAULT=1)
110-ruler=INT (0=no ruler; 1=draw ruler; DEFAULT=1)
111-rulercolor=TEXT (DEFAULT=black)
112-scale (print scale)
113-scalecolor=TEXT (set scale color; DEFAULT = black)
114-scaleset=INTEGER (1:x preset for map scale; overrides -size=INTEGER! set correct printer options!)
115-scaledpi=INTEGER (print resolution; DEFAULT = 300 dpi)
116-rulescaleset=INTEGER (determines the scale used to select rules; DEFAULT=0, meaning actual map scale is used to select rules)
117
118-ppc=<float> (pixels needed per character using font size 10; DEFAULT=5.5)
119
120-png (also produce png, inkscape must be installed, very big)
121-pdf (also produce pdf, inkscape must be installed)
122
123-verbose
124-multionly (draws only areas of multipolygons; for test purposes)
125END23
126
127# command line things
128my $optResult ;
129my $verbose = 0 ;
130my $multiOnly = 0 ;
131my $grid = 0 ;
132my $gridColor = "black" ;
133my $clip = 0 ;
134my $pad = 0 ;
135my $legendOpt = 1 ;
136my $size = 1024 ; # default pic size longitude in pixels
137my $bgColor = "white" ;
138my $osmName = "" ;
139my $csvName = "" ;
140my $dirName = "" ;
141my $svgName = "mapgen.svg" ;
142my $pdfOpt = 0 ;
143my $pngOpt = 0 ;
144my $dirOpt = 0 ;
145my $poiOpt = 0 ;
146my $ppc = 6 ;
147my $place = "" ;
148my $lonrad = 2 ;
149my $latrad = 2 ;
150my $helpOpt = 0 ;
151my $tagStatOpt = 0 ;
152my $declutterOpt = 0 ;
153my $allowIconMoveOpt = 0 ;
154# my $declutterMinX = 100 ;
155# my $declutterMinY = 10 ;
156my $rulerOpt = 1 ;
157my $rulerColor = "black" ;
158my $scaleOpt = 0 ;
159my $scaleDpi = 300 ;
160my $scaleColor = "black" ;
161my $scaleSet = 0 ;
162my $ruleScaleSet = 0 ;
163my $coordsOpt = 0 ;
164my $coordsExp = -2 ;
165my $coordsColor = "black" ;
166my $routeLabelColor = "black" ;
167my $routeLabelSize = 8 ;
168my $routeLabelFont = "sans-serif" ;
169my $routeLabelOffset = 10 ;
170my $iconDir = "./routeicons/" ;
171my $routeIconDist = 25 ;
172my $onewayOpt = 0 ;
173my $onewayColor = "white" ;
174
175# keys from tags listed here will not be shown in tag stat
176my @noListTags = sort qw (name width url source ref note phone operator opening_hours maxspeed maxheight maxweight layer is_in TODO addr:city addr:housenumber addr:country addr:housename addr:interpolation addr:postcode addr:street created_by description ele fixme FIXME website bridge tunnel time openGeoDB:auto_update  openGeoDB:community_identification_number openGeoDB:is_in openGeoDB:is_in_loc_id openGeoDB:layer openGeoDB:license_plate_code openGeoDB:loc_id openGeoDB:location openGeoDB:name openGeoDB:population openGeoDB:postal_codes openGeoDB:sort_name openGeoDB:telephone_area_code openGeoDB:type openGeoDB:version opengeodb:lat opengeodb:lon int_ref population postal_code wikipedia) ;
177
178# NODES; column indexes for style file
179my $nodeIndexTag = 0 ;
180my $nodeIndexValue = 1 ;
181my $nodeIndexColor = 2 ;
182my $nodeIndexThickness = 3 ;
183my $nodeIndexLabel = 4 ;
184my $nodeIndexLabelColor = 5 ;
185my $nodeIndexLabelSize = 6 ;
186my $nodeIndexLabelFont = 7 ;
187my $nodeIndexLabelOffset = 8 ;
188my $nodeIndexLegend = 9 ;
189my $nodeIndexIcon = 10 ;
190my $nodeIndexIconSize = 11 ;
191my $nodeIndexFromScale = 12 ;
192my $nodeIndexToScale = 13 ;
193my @nodes = () ;
194
195
196# WAYS and small AREAS, as well as base layer info when flagged; column indexes for style file
197my $wayIndexTag = 0 ;
198my $wayIndexValue = 1 ;
199my $wayIndexColor = 2 ;
200my $wayIndexThickness = 3 ;
201my $wayIndexDash = 4 ;
202my $wayIndexBorderColor =  5 ;
203my $wayIndexBorderThickness = 6 ;
204my $wayIndexFilled = 7 ;
205my $wayIndexLabel = 8 ;
206my $wayIndexLabelColor = 9 ;
207my $wayIndexLabelSize = 10 ;
208my $wayIndexLabelFont = 11 ;
209my $wayIndexLabelOffset = 12 ;
210my $wayIndexLegend = 13 ;
211my $wayIndexBaseLayer = 14 ;
212my $wayIndexIcon = 15 ;
213my $wayIndexFromScale = 16 ;
214my $wayIndexToScale = 17 ;
215my @ways = () ;
216
217my $routeIndexRoute = 0 ;
218my $routeIndexColor = 1 ; # colorSet!!! default if route doesn't have own color
219my $routeIndexThickness = 2 ;
220my $routeIndexDash = 3 ;
221my $routeIndexOpacity = 4 ; # stroke opacity, values 0-100; 100 = fully blocking; 0 = transparent
222my $routeIndexLabel = 5 ;
223my $routeIndexStopThickness = 6 ;
224my $routeIndexFromScale = 7 ;
225my $routeIndexToScale = 8 ;
226my @routes = () ;
227
228# read data from file
229my $wayId ;
230my $wayUser ;
231my @wayNodes ;
232my @wayTags ;
233my $nodeId ;
234my $nodeUser ;
235my $nodeLat ;
236my $nodeLon ;
237my @nodeTags ;
238my $aRef1 ;
239my $aRef2 ;
240my $relationId ;
241my $relationUser ;
242my @relationTags ;
243my @relationMembers ;
244
245
246# storage of data
247my %memNodeTags ;
248my %memWayTags ;
249my %memWayNodes ;
250my %invalidWays ;
251my %memRelationTags ;
252my %memRelationMembers ;
253my %memWayPaths = () ;
254
255# my %usedTags = () ; # for stats
256my %wayUsed = () ; # used in multipolygon? then dont use again
257my %directory = () ; # street list
258my %poiHash = () ;
259
260my %lon ; my %lat ;
261
262my $lonMin ; my $latMin ; my $lonMax ; my $latMax ;
263
264my $newId = -100000000; # global ! for multipolygon data (ways)
265
266my $time0 ; my $time1 ;
267
268# get parameter
269
270$optResult = GetOptions (       "in=s"          => \$osmName,           # the in file, mandatory
271                                "style=s"       => \$csvName,           # the style file, mandatory
272                                "out:s"         => \$svgName,           # outfile name or default
273                                "size:i"        => \$size,              # specifies pic size longitude in pixels
274                                "legend:i"      => \$legendOpt,         # legend?
275                                "bgcolor:s"     => \$bgColor,           # background color
276                                "grid:i"        => \$grid,              # specifies grid, number of parts
277                                "gridcolor:s"   => \$gridColor,         # color used for grid and labels
278                                "coords"        => \$coordsOpt,         #
279                                "coordsexp:i"   => \$coordsExp,         #
280                                "coordscolor:s" => \$coordsColor,               #
281                                "clip:i"        => \$clip,              # specifies how many percent data to clip on each side
282                                "pad:i"         => \$pad,               # specifies how many percent data to pad on each side
283                                "ppc:f"         => \$ppc,               # pixels needed per label char in font size 10
284                                "pdf"           => \$pdfOpt,            # specifies if pdf will be created
285                                "png"           => \$pngOpt,            # specifies if png will be created
286                                "dir"           => \$dirOpt,            # specifies if directory of streets will be created
287                                "poi"           => \$poiOpt,            # specifies if directory of pois will be created
288                                "tagstat"       => \$tagStatOpt,        # lists k/v used in osm file
289                                "declutter"     => \$declutterOpt,
290                                "allowiconmove" => \$allowIconMoveOpt,
291                                "help"          => \$helpOpt,           #
292                                "oneways"       => \$onewayOpt,
293                                "onewaycolor:s" => \$onewayColor,
294                                "place:s"       => \$place,             # place to draw
295                                "lonrad:f"      => \$lonrad,
296                                "latrad:f"      => \$latrad,
297                                "ruler:i"       => \$rulerOpt,
298                                "rulercolor:s"  => \$rulerColor,
299                                "scale"         => \$scaleOpt,
300                                "scaledpi:i"    => \$scaleDpi,
301                                "scalecolor:s"  => \$scaleColor,
302                                "scaleset:i"    => \$scaleSet,
303                                "rulescaleset:i" => \$ruleScaleSet,
304                                "routelabelcolor:s"     => \$routeLabelColor,           
305                                "routelabelsize:i"      => \$routeLabelSize,           
306                                "routelabelfont:s"      => \$routeLabelFont,           
307                                "routelabeloffset:i"    => \$routeLabelOffset,         
308                                "routeicondist:i"       => \$routeIconDist,
309                                "icondir:s"             => \$iconDir,
310                                "multionly"     => \$multiOnly,         # draw only areas from multipolygons
311                                "verbose"       => \$verbose) ;         # turns twitter on
312
313
314if ($helpOpt eq "1") {
315        print "\nINFO on http://wiki.openstreetmap.org/wiki/Mapgen.pl\n\n" ;
316        print $usage . "\n" ;
317        die() ;
318}
319
320if ($grid > 26) { 
321        $grid = 26 ; 
322        print "WARNING: grid set to 26 parts\n" ;
323}
324if ($grid < 0) { 
325        $grid = 0 ; 
326        print "WARNING: grid set to 0\n" ;
327}
328if ( ($clip <0) or ($clip > 100) ) { 
329        $clip = 0 ; 
330        print "WARNING: clip set to 0 percent\n" ;
331}
332
333print "\n$programName $version\n" ;
334print "\n" ;
335print "infile    = $osmName\n" ;
336print "style     = $csvName\n" ;
337print "outfile   = $svgName\n" ;
338print "size      = $size (pixels)\n\n" ;
339
340print "legend    = $legendOpt\n" ;
341print "ruler     = $rulerOpt\n" ;
342print "scaleOpt  = $scaleOpt\n" ;
343print "scaleCol  = $scaleColor\n" ;
344print "scaleDpi  = $scaleDpi\n" ;
345print "scaleSet  = $scaleSet\n" ;
346print "ruleScaleSet  = $ruleScaleSet\n\n" ;
347
348print "clip        = $clip (percent)\n" ;
349print "pad         = $pad (percent)\n" ;
350print "grid        = $grid (number)\n" ;
351print "gridcolor   = $gridColor\n" ;
352print "coordsOpt   = $coordsOpt\n" ;
353print "coordsExp   = $coordsExp\n" ;
354print "coordsColor = $coordsColor\n\n" ;
355
356print "dir       = $dirOpt\n" ;
357print "poiOpt    = $poiOpt\n" ;
358print "ppc       = $ppc (pixels needed per character font size 10)\n" ;
359print "declutter = $declutterOpt\n" ;
360print "alloIconMoveOpt = $allowIconMoveOpt\n" ;
361
362print "place     = $place\n" ;
363print "lonrad    = $lonrad (km)\n" ;
364print "latrad    = $latrad (km)\n\n" ;
365
366print "routeLabelColor  = $routeLabelColor \n" ; 
367print "routeLabelSize   = $routeLabelSize \n" ; 
368print "routeLabelFont   = $routeLabelFont \n" ; 
369print "routeLabelOffset = $routeLabelOffset\n" ; 
370print "iconDir          = $iconDir\n" ; 
371print "routeIconDist    = $routeIconDist\n\n" ; 
372
373print "pdf       = $pdfOpt\n" ;
374print "png       = $pngOpt\n\n" ;
375
376print "multionly = $multiOnly\n" ;
377print "verbose   = $verbose\n\n" ;
378
379$time0 = time() ;
380
381my ($ref1, $ref2, $ref3) = readRules ($csvName) ;
382@nodes = @$ref1 ;
383@ways = @$ref2 ;
384@routes = @$ref3 ;
385
386if ($verbose eq "1") {
387        printRules() ;
388}
389
390# -place given? look for place and call osmosis
391my $placeFound = 0 ; my $placeLon ; my $placeLat ;
392if ($place ne "") {
393        print "looking for place...\n" ;
394        openOsmFile ($osmName) ;
395        ($nodeId, $nodeLon, $nodeLat, $nodeUser, $aRef1) = getNode2 () ;
396        if ($nodeId != -1) {
397                @nodeTags = @$aRef1 ;
398        }
399        while ( ($nodeId != -1) and ($placeFound == 0) ) {
400                my $placeNode = 0 ; my $placeName = 0 ;
401                foreach my $tag (@nodeTags) {
402                        if ($tag->[0] eq "place") { $placeNode = 1 ; }
403                        if ( ($tag->[0] eq "name") and (grep /$place/i, $tag->[1]) ){ $placeName = 1 ; }
404                }
405                if ( ($placeNode == 1) and ($placeName == 1) ) {
406                        $placeFound = 1 ;
407                        $placeLon = $nodeLon ;
408                        $placeLat = $nodeLat ;
409                }
410
411                ($nodeId, $nodeLon, $nodeLat, $nodeUser, $aRef1) = getNode2 () ;
412                if ($nodeId != -1) {
413                        @nodeTags = @$aRef1 ;
414                }
415        }
416        closeOsmFile() ;
417        if ($placeFound == 1) {
418                print "place $place found at.\n" ;
419                print "lon: $placeLon\n" ;
420                print "lat: $placeLat\n" ;
421                my $left = $placeLon - $lonrad/(111.11 * cos ( $placeLat / 360 * 3.14 * 2 ) ) ; 
422                my $right = $placeLon + $lonrad/(111.11 * cos ( $placeLat / 360 * 3.14 * 2 ) ) ; 
423                my $top = $placeLat + $latrad/111.11 ; 
424                my $bottom = $placeLat - $latrad/111.11 ;
425
426
427                if ($verbose >= 1) { print "left $left\n" ; }
428                if ($verbose >= 1) { print "right $right\n" ; }
429                if ($verbose >= 1) { print "top $top\n" ; }
430                if ($verbose >= 1) { print "bottom $bottom\n" ; }
431                print "OSMOSIS STRING: --bounding-box-0.6 clipIncompleteEntities=true bottom=$bottom top=$top left=$left right=$right --write-xml-0.6\n" ;
432                print "call osmosis...\n" ;
433                `osmosis --read-xml-0.6 $osmName  --bounding-box-0.6 clipIncompleteEntities=true bottom=$bottom top=$top left=$left right=$right --write-xml-0.6 ./temp.osm` ;
434                print "osmosis done.\n" ;
435                $osmName = "./temp.osm" ;
436        }
437        else {
438                print "ERROR: place $place not found.\n" ;
439                die() ;
440        }
441}
442
443
444
445
446# STORE DATA
447print "reading osm file...\n" ;
448
449openOsmFile ($osmName) ;
450($nodeId, $nodeLon, $nodeLat, $nodeUser, $aRef1) = getNode2 () ;
451if ($nodeId != -1) {
452        @nodeTags = @$aRef1 ;
453}
454while ($nodeId != -1) {
455
456        $lon{$nodeId} = $nodeLon ; $lat{$nodeId} = $nodeLat ;   
457        @{$memNodeTags{$nodeId}} = @nodeTags ;
458
459        ($nodeId, $nodeLon, $nodeLat, $nodeUser, $aRef1) = getNode2 () ;
460        if ($nodeId != -1) {
461                @nodeTags = @$aRef1 ;
462        }
463}
464
465($wayId, $wayUser, $aRef1, $aRef2) = getWay2 () ;
466if ($wayId != -1) {
467        @wayNodes = @$aRef1 ;
468        @wayTags = @$aRef2 ;
469}
470while ($wayId != -1) {
471
472        if (scalar (@wayNodes) > 1) {
473                @{$memWayTags{$wayId}} = @wayTags ;
474                @{$memWayNodes{$wayId}} = @wayNodes ;
475                foreach my $node (@wayNodes) {
476                        if (!defined $lon{$node}) {
477                                print "  ERROR: way $wayId references node $node, which is not present!\n" ;
478                        }
479                }
480        }
481        else {
482                $invalidWays{$wayId} = 1 ;
483        }
484
485       
486        ($wayId, $wayUser, $aRef1, $aRef2) = getWay2 () ;
487        if ($wayId != -1) {
488                @wayNodes = @$aRef1 ;
489                @wayTags = @$aRef2 ;
490        }
491}
492
493
494($relationId, $relationUser, $aRef1, $aRef2) = getRelation () ;
495if ($relationId != -1) {
496        @relationMembers = @$aRef1 ;
497        @relationTags = @$aRef2 ;
498}
499
500while ($relationId != -1) {
501        @{$memRelationTags{$relationId}} = @relationTags ;
502        @{$memRelationMembers{$relationId}} = @relationMembers ;
503
504        foreach my $member (@relationMembers) {
505                if ( ($member->[0] eq "node") and (!defined $lon{$member->[1]}) ) {
506                        print "  ERROR: relation $relationId references node $member->[1] which is not present!\n" ;
507                }
508                if ( ($member->[0] eq "way") and (!defined $memWayNodes{$member->[1]} ) and (!defined $invalidWays{$member->[1]}) ) {
509                        print "  ERROR: relation $relationId references way $member->[1] which is not present!\n" ;
510                }
511        }
512
513        #next
514        ($relationId, $relationUser, $aRef1, $aRef2) = getRelation () ;
515        if ($relationId != -1) {
516                @relationMembers = @$aRef1 ;
517                @relationTags = @$aRef2 ;
518        }
519}
520
521closeOsmFile () ;
522
523
524
525# calc area of pic and init
526
527$lonMin = 999 ; $lonMax = -999 ; $latMin = 999 ; $latMax = -999 ;
528my $key ;
529foreach $key (keys %lon) {
530        if ($lon{$key} > $lonMax) { $lonMax = $lon{$key} ; }
531        if ($lon{$key} < $lonMin) { $lonMin = $lon{$key} ; }
532        if ($lat{$key} > $latMax) { $latMax = $lat{$key} ; }
533        if ($lat{$key} < $latMin) { $latMin = $lat{$key} ; }
534}
535
536if ( ($clip > 0) and ($clip < 100) ) { 
537        $clip = $clip / 100 ;
538        $lonMin += ($lonMax-$lonMin) * $clip ;
539        $lonMax -= ($lonMax-$lonMin) * $clip ;
540        $latMin += ($latMax-$latMin) * $clip ;
541        $latMax -= ($latMax-$latMin) * $clip ;
542}
543
544if ( ($pad > 0) and ($pad < 100) ) { 
545        $pad = $pad / 100 ;
546        $lonMin -= ($lonMax-$lonMin) * $pad ;
547        $lonMax += ($lonMax-$lonMin) * $pad ;
548        $latMin -= ($latMax-$latMin) * $pad ;
549        $latMax += ($latMax-$latMin) * $pad ;
550}
551
552
553
554if ($scaleSet != 0) {
555        my $dist = distance ($lonMin, $latMin, $lonMax, $latMin) ;
556        print "INFO: distX (km) = $dist\n" ;
557        my $width = $dist / $scaleSet * 1000 * 100 / 2.54 ; # inches
558        print "INFO: width (in) = $width\n" ;
559        $size = int ($width * $scaleDpi) ;
560        print "INFO: sizeX set to $size pixels.\n" ;
561        print "INFO: set print resolution to $scaleDpi dpi!\n\n" ;
562}
563
564initGraph ($size, $lonMin, $latMin, $lonMax, $latMax, $bgColor) ;
565if ($onewayOpt eq "1") { initOneways ($onewayColor) ; }
566
567my ($paper, $w, $h) = fitsPaper ($scaleDpi) ;
568print "\nINFO: map fits paper $paper using $scaleDpi dpi.\n" ;
569printf "INFO: map width : %4.1f (cm)\n", $w ;
570printf "INFO: map height: %4.1f (cm)\n", $h ;
571my $scaleValue = getScale ($scaleDpi) ;
572print "INFO: map scale 1 : $scaleValue\n\n" ;
573
574if ($ruleScaleSet == 0) { 
575        $ruleScaleSet = $scaleValue ; 
576}
577else {
578        print "INFO: using map rules for scale = $ruleScaleSet\n\n" ;
579}
580
581processCoastLines() ;
582
583processRoutes () ;
584
585processMultipolygons () ; # multipolygons, (routes)
586
587# BG AREAS
588
589print "draw background areas...\n" ;
590foreach my $wayId (sort {$a <=>$b} keys %memWayTags) {
591        if ($wayId>-100000000) {
592
593                my $test = getWayRule (\@{$memWayTags{$wayId}}, \@ways, $ruleScaleSet) ;
594                if (defined $test) {
595                        if ($test->[$wayIndexBaseLayer] != 1) { undef $test ; }
596                }
597                if (defined $test) {
598                        if ( ($memWayNodes{$wayId}[0] == $memWayNodes{$wayId}[-1]) and (!defined $wayUsed{$wayId}) )  {
599                                if ( $multiOnly == 0) {
600                                        drawArea ($test->[$wayIndexColor], $test->[$wayIndexIcon], nodes2Coordinates( @{$memWayNodes{$wayId}} ) ) ;
601                                        # LABELS
602                                        my $name = "" ; my $ref1 ;
603                                        ($name, $ref1) = createLabel (\@{$memWayTags{$wayId}}, $test->[$wayIndexLabel], 0, 0) ;
604                                        if ($name ne "") {
605                                                my ($x, $y) = center (nodes2Coordinates(@{$memWayNodes{$wayId}})) ;
606                                                #print "AREA name $name $x $y\n" ;
607                                                #print "$x, $y, 0, 0, $name, $test->[$wayIndexLabelColor], $test->[$wayIndexLabelSize], $test->[$wayIndexLabelFont]\n" ;
608                                                # drawTextPos ($x, $y, 0, 0, $name, $test->[$wayIndexLabelColor], $test->[$wayIndexLabelSize], $test->[$wayIndexLabelFont], $declutterOpt, $ppc) ;
609                                                placeLabelAndIcon ($x, $y, 0, $name, $test->[$wayIndexLabelColor], $test->[$wayIndexLabelSize], $test->[$wayIndexLabelFont], $ppc, "none", 0, 0, $allowIconMoveOpt) ;
610                                        }
611                                }
612                        }
613                }
614        }
615}
616
617print "draw multipolygons...\n" ;
618foreach my $wayId (sort {$a <=>$b} keys %memWayTags) {
619        if ($wayId <= -100000000) {
620                my $test = getWayRule (\@{$memWayTags{$wayId}}, \@ways, $ruleScaleSet) ;
621                if (defined $test) {
622                        drawAreaMP ($test->[$wayIndexColor], $test->[$wayIndexIcon], \@{$memWayPaths{$wayId}}, \%lon, \%lat  ) ;
623                        # LABELS
624                        my $name = "" ; my $ref1 ;
625                        ($name, $ref1) = createLabel (\@{$memWayTags{$wayId}}, $test->[$wayIndexLabel], 0, 0) ;
626                        if ($name ne "") {
627                                my ($x, $y) = center (nodes2Coordinates(@{$memWayNodes{$wayId}})) ;
628                                #print "MP name $name $x $y\n" ;
629                                # drawTextPos ($x, $y, 0, 0, $name, $test->[$wayIndexLabelColor], $test->[$wayIndexLabelSize], $test->[$wayIndexLabelFont], $declutterOpt, $ppc) ;
630                                placeLabelAndIcon ($x,$y, 0, $name, $test->[$wayIndexLabelColor], $test->[$wayIndexLabelSize], $test->[$wayIndexLabelFont], $ppc, "none", 0, 0, $allowIconMoveOpt) ;
631                        }
632                } #if
633        } # if
634} # foreach
635
636
637if ($multiOnly eq "1") {        # clear all data so nothing else will be drawn
638        %memNodeTags = () ;
639        %memWayTags = () ;
640        %memWayNodes = () ;
641}
642
643# NODES
644
645print "draw nodes...\n" ;
646foreach my $nodeId (keys %memNodeTags) {
647
648        my $test = getNodeRule (\@{$memNodeTags{$nodeId}}, \@nodes, $ruleScaleSet) ;
649        if (defined $test) {
650                $dirName = getValue ("name", \@{$memNodeTags{$nodeId}}) ;
651                if ( ($poiOpt eq "1") and ($dirName ne "") ){
652                        if ($grid > 0) {
653                                $poiHash{$dirName}{gridSquare($lon{$nodeId}, $lat{$nodeId}, $grid)} = 1 ;
654                        }
655                        else {
656                                $poiHash{$dirName} = 1 ;
657                        }
658                }
659
660                if ($test->[$nodeIndexThickness] > 0) {
661                        drawNodeDot ($lon{$nodeId}, $lat{$nodeId}, $test->[$nodeIndexColor], $test->[$nodeIndexThickness]) ;
662                }
663                if ( ($test->[$nodeIndexLabel] ne "none") or ($test->[$nodeIndexIcon] ne "none") ) {
664                        my $name = "" ; my $ref1 ;
665                        ($name, $ref1) = createLabel (\@{$memNodeTags{$nodeId}}, $test->[$nodeIndexLabel], $lon{$nodeId}, $lat{$nodeId}) ;
666                        my @names = @$ref1 ;
667
668                        placeLabelAndIcon ($lon{$nodeId}, $lat{$nodeId}, $test->[$nodeIndexThickness], $name, $test->[$nodeIndexLabelColor], $test->[$nodeIndexLabelSize], $test->[$nodeIndexLabelFont], $ppc, 
669                                $test->[$nodeIndexIcon], $test->[$nodeIndexIconSize], $test->[$nodeIndexIconSize], $allowIconMoveOpt) ;
670                }
671        } # defined $test
672} # nodes
673
674
675# WAYS
676
677print "draw ways...\n" ;
678foreach my $wayId (keys %memWayTags) {
679        # print "wayid: $wayId\n" ;
680        my $text = "" ; 
681
682        # tunnels, bridges and layers
683        my $tunnel = "no" ; my $bridge = "no" ; my $layer = 0 ; my $oneway = 0 ;
684        foreach my $tag (@{$memWayTags{$wayId}}) {
685                if ($tag->[0] eq "tunnel") { $tunnel = $tag->[1] ; }
686                if ($tag->[0] eq "bridge") { $bridge = $tag->[1] ; }
687                if ($tag->[0] eq "layer") { $layer = $tag->[1] ; }
688                if (($tag->[0] eq "oneway") and (($tag->[1] eq "yes") or ($tag->[1] eq "true") or ($tag->[1] eq "1") ) ){ $oneway = 1 ; }
689                if (($tag->[0] eq "oneway") and ($tag->[1] eq "-1") ){ $oneway = -1 ; }
690        }
691
692        # test variables for correct content
693        if ($tunnel ne "yes") { $tunnel = "no" ; }
694        if ($bridge ne "yes") { $bridge = "no" ; }
695        my $found = 0 ;
696        foreach (-5,-4,-3,-2,-1,0,1,2,3,4,5) { if ($layer == $_) { $found = 1 ; } }
697        if ($found == 0) { $layer = 0 ; }
698
699        my $test = getWayRule (\@{$memWayTags{$wayId}}, \@ways, $ruleScaleSet) ;
700        if (defined $test) {
701                #print "    tag/scale match\n" ;
702                if ($test->[$wayIndexFilled] eq "0") {
703                        #print "      drawing way $test->[$wayIndexColor], $test->[$wayIndexThickness] ...\n" ;
704
705                        if ( ($test->[$wayIndexBorderThickness] > 0) and ($test->[$wayIndexBorderColor ne "none"]) and ($tunnel ne "yes") and ($bridge ne "yes") ) {
706                                drawWay ($layer-.3, $test->[$wayIndexBorderColor], $test->[$wayIndexThickness]+2*$test->[$wayIndexBorderThickness], 0, nodes2Coordinates(@{$memWayNodes{$wayId}})) ;
707                        }
708
709
710                        if ($bridge eq "yes") {
711                                drawWayBridge ($layer-.04, "black", $test->[$wayIndexThickness]+4, 0, nodes2Coordinates(@{$memWayNodes{$wayId}})) ;
712                                drawWayBridge ($layer-.02, "white", $test->[$wayIndexThickness]+2, 0, nodes2Coordinates(@{$memWayNodes{$wayId}})) ;
713                        }
714                        if ($tunnel eq "yes") {
715                                drawWayBridge ($layer-.04, "black", $test->[$wayIndexThickness]+4, 11, nodes2Coordinates(@{$memWayNodes{$wayId}})) ;
716                                drawWayBridge ($layer-.02, "white", $test->[$wayIndexThickness]+2, 0, nodes2Coordinates(@{$memWayNodes{$wayId}})) ;
717                        }
718                        drawWay ($layer, $test->[$wayIndexColor], $test->[$wayIndexThickness], $test->[$wayIndexDash], nodes2Coordinates(@{$memWayNodes{$wayId}})) ;
719
720                        if (($onewayOpt eq "1") and ($oneway != 0) ) {
721                                addOnewayArrows (\@{$memWayNodes{$wayId}}, \%lon, \%lat, $oneway, $test->[$wayIndexThickness], $onewayColor, $layer) ;
722                        }
723
724                        if ($test->[$wayIndexLabel] ne "none") {
725                               
726                                my $name = "" ; my $ref1 ;
727                                ($name, $ref1) = createLabel (\@{$memWayTags{$wayId}}, $test->[$wayIndexLabel],0, 0) ;
728                                my @names = @$ref1 ;
729                                if (labelFitsWay (\@{$memWayNodes{$wayId}}, $name, $test->[$wayIndexLabelFont], $test->[$wayIndexLabelSize]) ) {
730
731                                        my $toLabel = 1 ;
732                                        my @way = @{$memWayNodes{$wayId}} ;
733                                        if ($lon{$memWayNodes{$wayId}[0]} > $lon{$memWayNodes{$wayId}[-1]}) {
734                                                @way = reverse (@way) ;
735                                                if ( ( ($test->[$wayIndexValue] eq "motorway") or ($test->[$wayIndexValue] eq "trunk") ) and ($declutterOpt eq "1") ) {
736                                                        $toLabel = 0 ;
737                                                }
738                                        }
739                                        if ($toLabel == 1) {
740                                                labelWay ($test->[$wayIndexLabelColor], $test->[$wayIndexLabelSize], $test->[$wayIndexLabelFont], $name, $test->[$wayIndexLabelOffset], nodes2Coordinates(@way)) ;
741                                        }
742                                }
743                                if ($dirOpt eq "1") {
744                                        if ($grid > 0) {
745                                                foreach my $node (@{$memWayNodes{$wayId}}) {
746                                                        foreach my $name (@names) {
747                                                                $directory{$name}{gridSquare($lon{$node}, $lat{$node}, $grid)} = 1 ;
748                                                        }
749                                                }
750                                        }
751                                        else {
752                                                foreach my $name (@names) {
753                                                        $directory{$name} = 1 ;
754                                                }
755                                        }
756                                }
757                        }
758                } # not filled
759                else {
760                        if ( ($wayId > -100000000) and (${$memWayNodes{$wayId}}[0] == ${$memWayNodes{$wayId}}[-1]) and (!defined $wayUsed{$wayId}) ) {
761                                if ( $test->[$wayIndexBaseLayer] == 0) { 
762                                        drawArea ($test->[$wayIndexColor], $test->[$wayIndexIcon], nodes2Coordinates( @{$memWayNodes{$wayId}} ) ) ; 
763                                        if ( ($test->[$wayIndexLabel] ne "none") and ( $test->[$wayIndexBaseLayer] == 0) ) {
764                                                foreach my $tag2 (@{$memWayTags{$wayId}}) {
765                                                        if ($tag2->[0] eq $test->[$wayIndexLabel]) {
766                                                                my ($x, $y) = (0, 0) ; my $count = 0 ;
767                                                                foreach my $node (@{$memWayNodes{$wayId}}) {
768                                                                        $x += $lon{$node} ; $y += $lat{$node} ; $count++ ;
769                                                                }
770                                                                $x = $x / $count ; $y = $y / $count ;
771                                                                # drawTextPos ($x, $y, 0, 0, $tag2->[1], $test->[$wayIndexLabelColor], $test->[$wayIndexLabelSize], $test->[$wayIndexLabelFont], $declutterOpt, $ppc) ;
772                                                                placeLabelAndIcon ($x, $y, 0, $tag2->[1], $test->[$wayIndexLabelColor], $test->[$wayIndexLabelSize], $test->[$wayIndexLabelFont], $ppc, "none", 0, 0, $allowIconMoveOpt) ;
773                                                        }
774                                                }
775                                        } # draw label
776                                }
777                        } #closed
778                } # filled
779        } # tag found
780} # ways
781
782
783print declutterStat() ;
784
785
786
787# draw other information
788
789print "draw legend etc. and write files...\n" ;
790
791if ($legendOpt == 1) {
792        createLegend() ;
793}
794
795if ($scaleOpt eq "1") {
796        printScale ($scaleDpi, $scaleColor) ;
797}
798
799if ($grid > 0) { drawGrid($grid, $gridColor) ; }
800
801if ($coordsOpt eq "1") {
802        drawCoords ($coordsExp, $coordsColor) ;
803}
804
805if ($rulerOpt == 1) {
806        drawRuler ($rulerColor) ;
807}
808
809drawFoot ("gary68's $programName $version - data CC-BY-SA www.openstreetmap.org", "black", 10, "sans-serif") ;
810
811
812writeSVG ($svgName) ;
813
814if ($pdfOpt eq "1") {
815        my ($pdfName) = $svgName ;
816        $pdfName =~ s/\.svg/\.pdf/ ;
817        print "creating pdf file $pdfName ...\n" ;
818        `inkscape -A $pdfName $svgName` ;
819}
820
821if ($pngOpt eq "1") {
822        my ($pngName) = $svgName ;
823        $pngName =~ s/\.svg/\.png/ ;
824        print "creating png file $pngName ...\n" ;
825        `inkscape -e $pngName $svgName` ;
826}
827
828if ($dirOpt eq "1") {
829        my $dirFile ;
830        my $dirName = $svgName ;
831        $dirName =~ s/\.svg/\_streets.txt/ ;
832        print "creating dir file $dirName ...\n" ;
833        open ($dirFile, ">", $dirName) or die ("can't open dir file\n") ;
834        if ($grid eq "0") {
835                foreach my $street (sort keys %directory) {
836                        print $dirFile "$street\n" ;
837                }
838        }
839        else {
840                foreach my $street (sort keys %directory) {
841                        print $dirFile "$street\t" ;
842                        foreach my $square (sort keys %{$directory{$street}}) {
843                                print $dirFile "$square " ;
844                        }
845                        print $dirFile "\n" ;
846                }
847        }
848        close ($dirFile) ;
849}
850
851if ($poiOpt eq "1") {
852        my $poiFile ;
853        my $poiName = $svgName ;
854        $poiName =~ s/\.svg/\_pois.txt/ ;
855        print "creating poi file $poiName ...\n" ;
856        open ($poiFile, ">", $poiName) or die ("can't open poi file\n") ;
857        if ($grid eq "0") {
858                foreach my $poi (sort keys %poiHash) {
859                        print $poiFile "$poi\n" ;
860                }
861        }
862        else {
863                foreach my $poi (sort keys %poiHash) {
864                        print $poiFile "$poi\t" ;
865                        foreach my $square (sort keys %{$poiHash{$poi}}) {
866                                print $poiFile "$square " ;
867                        }
868                        print $poiFile "\n" ;
869                }
870        }
871        close ($poiFile) ;
872}
873
874if ($tagStatOpt eq "1") {
875        my $tagFile ;
876        my $tagName = $svgName ;
877        $tagName =~ s/\.svg/\_tagstat.txt/ ;
878        print "creating tagstat file $tagName ...\n" ;
879        open ($tagFile, ">", $tagName) or die ("can't open tagstat file\n") ;
880
881        my %usedTagsNodes = () ; my %rulesNodes = () ;
882        my %usedTagsWays = () ; my %rulesWays = () ;
883        print $tagFile "\n--------\nTAG STAT for nodes and ways\n--------\n" ;
884        print $tagFile "\nOMITTED KEYS\n@noListTags\n\n" ;
885        foreach my $node (keys %memNodeTags) { 
886                foreach my $tag (@{$memNodeTags{$node}}) { $usedTagsNodes{$tag->[0]}{$tag->[1]}++ ;}
887        }
888        foreach my $way (keys %memWayTags) { 
889                foreach my $tag (@{$memWayTags{$way}}) { $usedTagsWays{$tag->[0]}{$tag->[1]}++ ;}
890        }
891        foreach my $delete (@noListTags) { 
892                delete $usedTagsNodes{$delete} ; 
893                delete $usedTagsWays{$delete} ; 
894        }
895
896
897        foreach my $rule (@ways) { 
898                my (@keys) = split /\|/, $rule->[$wayIndexTag] ;
899                my (@values) = split /\|/, $rule->[$wayIndexValue] ;
900                for (my $i=0; $i<=$#keys; $i++) {
901                        $rulesWays{$keys[$i]}{$values[$i]} = 1 ;
902                }
903        }
904        foreach my $rule (@nodes) { 
905                my @keys = split /\|/, $rule->[$nodeIndexTag] ;
906                my @values = split /\|/, $rule->[$nodeIndexValue] ;
907                for (my $i=0; $i<=$#keys; $i++) {
908                        $rulesNodes{$keys[$i]}{$values[$i]} = 1 ;
909                }
910        }
911
912        my @sortedNodes = () ;
913        foreach my $k (sort keys %usedTagsNodes) {
914                foreach my $v (sort keys %{$usedTagsNodes{$k}}) {
915                        push @sortedNodes, [$usedTagsNodes{$k}{$v}, $k, $v] ;
916                }
917        }
918        my @sortedWays = () ;
919        foreach my $k (sort keys %usedTagsWays) {
920                foreach my $v (sort keys %{$usedTagsWays{$k}}) {
921                        push @sortedWays, [$usedTagsWays{$k}{$v}, $k, $v] ;
922                }
923        }
924
925
926        print $tagFile "TOP 30 LIST NODES:\n" ;
927        @sortedNodes = sort { $a->[0] <=> $b->[0]} @sortedNodes ;
928        @sortedNodes = reverse @sortedNodes ;
929        my $i = 0 ; my $max = 29 ;
930        if (scalar @sortedNodes <30) { $max = $#sortedNodes ; }
931        for ($i = 0; $i<=$max; $i++) {
932                my $ruleText = "-" ;
933                if (defined $rulesNodes{$sortedNodes[$i]->[1]}{$sortedNodes[$i]->[2]}) { $ruleText = "RULE" ; }
934                printf $tagFile "%-25s %-35s %6i %-6s\n", $sortedNodes[$i]->[1], $sortedNodes[$i]->[2], $sortedNodes[$i]->[0], $ruleText ;
935        }
936        print $tagFile "\n" ;
937
938        print $tagFile "TOP 30 LIST WAYS:\n" ;
939        @sortedWays = sort { $a->[0] <=> $b->[0]} @sortedWays ;
940        @sortedWays = reverse @sortedWays ;
941        $i = 0 ; $max = 29 ;
942        if (scalar @sortedWays <30) { $max = $#sortedWays ; }
943        for ($i = 0; $i<=$max; $i++) {
944                my $ruleText = "-" ;
945                if (defined $rulesWays{$sortedWays[$i]->[1]}{$sortedWays[$i]->[2]}) { $ruleText = "RULE" ; }
946                printf $tagFile "%-25s %-35s %6i %-6s\n", $sortedWays[$i]->[1], $sortedWays[$i]->[2], $sortedWays[$i]->[0], $ruleText ;
947        }
948        print $tagFile "\n" ;
949
950        print $tagFile "LIST NODES:\n" ;
951        foreach my $k (sort keys %usedTagsNodes) {
952                foreach my $v (sort keys %{$usedTagsNodes{$k}}) {
953                        my $ruleText = "-" ;
954                        if (defined $rulesNodes{$k}{$v}) { $ruleText = "RULE" ; }
955                        printf $tagFile "%-25s %-35s %6i %-6s\n", $k, $v, $usedTagsNodes{$k}{$v}, $ruleText ;
956                }
957        }
958        print $tagFile "\n" ;
959        print $tagFile "LIST WAYS:\n" ;
960        foreach my $k (sort keys %usedTagsWays) {
961                foreach my $v (sort keys %{$usedTagsWays{$k}}) {
962                        my $ruleText = "-" ;
963                        if (defined $rulesWays{$k}{$v}) { $ruleText = "RULE" ; }
964                        printf $tagFile "%-25s %-35s %6i %-6s\n", $k, $v, $usedTagsWays{$k}{$v}, $ruleText ;
965                }
966        }
967        print $tagFile "\n" ;
968        close ($tagFile) ;
969}
970
971$time1 = time() ;
972print "\n$programName finished after ", stringTimeSpent ($time1-$time0), "\n\n" ;
973
974
975sub nodes2Coordinates {
976#
977# transform list of nodeIds to list of lons/lats
978#
979        my @nodes = @_ ;
980        my $i ;
981        my @result = () ;
982
983        #print "in @nodes\n" ;
984
985        for ($i=0; $i<=$#nodes; $i++) {
986                push @result, $lon{$nodes[$i]} ;
987                push @result, $lat{$nodes[$i]} ;
988        }
989        return @result ;
990}
991
992sub createLegend {
993        my $currentY = 20 ;
994        my $step = 30 ;
995        my $textX = 70 ;
996        my $textOffset = -5 ;
997        my $dotX = 40 ;
998        my $areaSize = 12 ;
999        my $wayStartX = 20 ;
1000        my $wayEndX = 60 ;
1001        my $areaStartX = 31 ;
1002        my $areaEndX = 55 ;
1003        my $count = 0 ;
1004        my $sizeLegend = 20 ;
1005       
1006        foreach my $node (@nodes) { 
1007                if ( ($node->[$nodeIndexLegend] == 1) and ($node->[$nodeIndexFromScale] <= $ruleScaleSet) and ($node->[$nodeIndexToScale] >= $ruleScaleSet) ) { 
1008                        $count++ ; 
1009                }
1010        }
1011        foreach my $way (@ways) { 
1012                if ( ($way->[$wayIndexLegend] == 1)  and ($way->[$wayIndexFromScale] <= $ruleScaleSet) and ($way->[$wayIndexToScale] >= $ruleScaleSet) ) { 
1013                        $count++ ; 
1014                } 
1015        }
1016
1017        # erase background
1018        drawAreaPix ("white", "", 0, 0,
1019                        180,0,
1020                        180, $count*$step + 15,
1021                        0, $count*$step + 15,
1022                        0, 0) ;
1023       
1024        foreach my $node (@nodes) { 
1025                if ( ($node->[$nodeIndexLegend] == 1) and ($node->[$nodeIndexFromScale] <= $ruleScaleSet) and ($node->[$nodeIndexToScale] >= $ruleScaleSet) ) { 
1026                        drawNodeDotPix ($dotX, $currentY, $node->[$nodeIndexColor], $node->[$nodeIndexThickness]) ;
1027                        drawTextPix ($textX, $currentY+$textOffset, $node->[$nodeIndexValue], "black", $sizeLegend, "Arial") ;
1028                        $currentY += $step ;
1029                } 
1030        }
1031
1032        foreach my $way (@ways) { 
1033                if ( ($way->[$wayIndexLegend] == 1)  and ($way->[$wayIndexFromScale] <= $ruleScaleSet) and ($way->[$wayIndexToScale] >= $ruleScaleSet) ) { 
1034                        if ($way->[$wayIndexFilled] == 0) {
1035                                if ( ($way->[$wayIndexBorderThickness] > 0) and ($way->[$wayIndexBorderColor ne "none"]) ) {
1036                                        drawWayPix ($way->[$wayIndexBorderColor], $way->[$wayIndexThickness]+2*$way->[$wayIndexBorderThickness], 0, $wayStartX, $currentY, $wayEndX, $currentY) ;
1037                                }
1038                                drawWayPix ($way->[$wayIndexColor], $way->[$wayIndexThickness], $way->[$wayIndexDash], $wayStartX, $currentY, $wayEndX, $currentY) ;
1039                        } 
1040                        else {
1041                                drawAreaPix ($way->[$wayIndexColor], $way->[$wayIndexIcon], $areaStartX, $currentY-$areaSize, 
1042                                        $areaEndX, $currentY-$areaSize,
1043                                        $areaEndX, $currentY+$areaSize,
1044                                        $areaStartX, $currentY+$areaSize,
1045                                        $areaStartX, $currentY-$areaSize) ;
1046                        }
1047                        drawTextPix ($textX, $currentY+$textOffset, $way->[$wayIndexValue], "black", $sizeLegend, "Arial") ;
1048                        $currentY += $step ;
1049                } 
1050        }
1051}
1052
1053sub processMultipolygons {
1054#
1055#
1056#
1057        print "initializing multipolygon data...\n" ;
1058        foreach my $relId (keys %memRelationMembers) {
1059                my $isMulti = 0 ;
1060                foreach my $tag (@{$memRelationTags{$relId}}) {
1061                        if ( ($tag->[0] eq "type") and ($tag->[1] eq "multipolygon") ) { $isMulti = 1 ; }
1062                }
1063
1064                if ($isMulti) {
1065                        if ($verbose eq "1") { print "\n---------------------------------------------------\n" ; }
1066                        if ($verbose eq "1") { print "\nRelation $relId is multipolygon!\n" ; }
1067                       
1068                        # get inner and outer ways
1069                        my (@innerWays) = () ; my (@outerWays) = () ;
1070                        foreach my $member ( @{$memRelationMembers{$relId}} ) {
1071                                if ( ($member->[0] eq "way") and ($member->[2] eq "outer") and (defined @{$memWayNodes{$member->[1]}} ) ) { push @outerWays, $member->[1] ; }
1072                                if ( ($member->[0] eq "way") and ($member->[2] eq "inner") and (defined @{$memWayNodes{$member->[1]}} )) { push @innerWays, $member->[1] ; }
1073                        }
1074                        if ($verbose eq "1") { print "OUTER WAYS: @outerWays\n" ; }
1075                        if ($verbose eq "1") { print "INNER WAYS: @innerWays\n" ; }
1076
1077                        my ($ringsWaysRef, $ringsNodesRef) ;
1078                        my @ringWaysInner = () ; my @ringNodesInner = () ; my @ringTagsInner = () ;
1079                        # build rings inner
1080                        if (scalar @innerWays > 0) {
1081                                ($ringsWaysRef, $ringsNodesRef) = buildRings (\@innerWays, 1) ;
1082                                @ringWaysInner = @$ringsWaysRef ; 
1083                                @ringNodesInner = @$ringsNodesRef ;
1084                                for (my $ring=0; $ring<=$#ringWaysInner; $ring++) {
1085                                        if ($verbose eq "1") { print "INNER RING $ring: @{$ringWaysInner[$ring]}\n" ; }
1086                                        my $firstWay = $ringWaysInner[$ring]->[0] ;
1087                                        if (scalar @{$ringWaysInner[$ring]} == 1) {$wayUsed{$firstWay} = 1 ; } # way will be marked as used/drawn by multipolygon
1088
1089                                        @{$ringTagsInner[$ring]} = @{$memWayTags{$firstWay}} ; # ring will be tagged like first contained way
1090                                        if ($verbose eq "1") {
1091                                                print "tags from first way...\n" ;
1092                                                foreach my $tag (@{$memWayTags{$firstWay}}) {
1093                                                        print "  $tag->[0] - $tag->[1]\n" ;
1094                                                }
1095                                        }
1096                                        if ( (scalar @{$memWayTags{$firstWay}}) == 0 ) {
1097                                                if ($verbose eq "1") { print "tags set to hole in mp.\n" ; }
1098                                                push @{$ringTagsInner[$ring]}, ["multihole", "yes"] ;
1099                                        }
1100
1101                                        # foreach my $tag (@{$ringTagsInner[$ring]}) { $usedTags{$tag->[0]}{$tag->[1]} = 1 ; }
1102                                }
1103                        }
1104
1105                        # build rings outer
1106                        my @ringWaysOuter = () ; my @ringNodesOuter = () ; my @ringTagsOuter = () ;
1107                        if (scalar @outerWays > 0) {
1108                                ($ringsWaysRef, $ringsNodesRef) = buildRings (\@outerWays, 1) ;
1109                                @ringWaysOuter = @$ringsWaysRef ; # not necessary for outer
1110                                @ringNodesOuter = @$ringsNodesRef ;
1111                                for (my $ring=0; $ring<=$#ringWaysOuter; $ring++) {
1112                                        if ($verbose eq "1") { print "OUTER RING $ring: @{$ringWaysOuter[$ring]}\n" ; }
1113                                        my $firstWay = $ringWaysOuter[$ring]->[0] ;
1114                                        if (scalar @{$ringWaysOuter[$ring]} == 1) {$wayUsed{$firstWay} = 1 ; }
1115                                        @{$ringTagsOuter[$ring]} = @{$memRelationTags{$relId}} ; # tags from relation
1116                                        if ($verbose eq "1") {
1117                                                print "tags from relation...\n" ;
1118                                                foreach my $tag (@{$memRelationTags{$relId}}) {
1119                                                        print "  $tag->[0] - $tag->[1]\n" ;
1120                                                }
1121                                        }
1122                                        if (scalar @{$memRelationTags{$relId}} == 1) {
1123                                                @{$ringTagsOuter[$ring]} = @{$memWayTags{$firstWay}} ; # ring will be tagged like first way
1124                                                #print "tags from first way...\n" ;
1125                                                #foreach my $tag (@{$memWayTags{$firstWay}}) {
1126                                                #       print "  $tag->[0] - $tag->[1]\n" ;
1127                                                #}
1128                                        }
1129
1130
1131                                        # foreach my $tag (@{$ringTagsOuter[$ring]}) { $usedTags{$tag->[0]}{$tag->[1]} = 1 ; }
1132                                }
1133                        } # outer
1134                       
1135                        my @ringNodesTotal = (@ringNodesInner, @ringNodesOuter) ;
1136                        my @ringWaysTotal = (@ringWaysInner, @ringWaysOuter) ;
1137                        my @ringTagsTotal = (@ringTagsInner, @ringTagsOuter) ;
1138
1139                        processRings (\@ringNodesTotal, \@ringWaysTotal, \@ringTagsTotal) ;
1140
1141                } # multi
1142
1143        } # relIds
1144}
1145
1146sub buildRings {
1147        my ($ref, $closeOpt) = @_ ;
1148        my (@allWays) = @$ref ;
1149        my @ringWays = () ;
1150        my @ringNodes = () ;
1151        my $ringCount = 0 ;
1152
1153        # print "build rings for @allWays\n" ;
1154        if ($verbose eq "1" ) { print "BR: called.\n" ; }
1155        while ( scalar @allWays > 0) {
1156                # build new test ring
1157                my (@currentWays) = () ; my (@currentNodes) = () ;
1158                push @currentWays, $allWays[0] ;
1159                if ($verbose eq "1" ) { print "BR: initial way for next ring id= $allWays[0]\n" ; }
1160                push @currentNodes, @{$memWayNodes{$allWays[0]}} ;
1161                my $startNode = $currentNodes[0] ;
1162                my $endNode = $currentNodes[-1] ;
1163                if ($verbose eq "1" ) { print "BR: initial start and end node $startNode $endNode\n" ; }
1164                my $closed = 0 ;
1165                shift @allWays ; # remove first element
1166                if ($startNode == $endNode) {   $closed = 1 ; }
1167
1168                my $success = 1 ;
1169                while ( ($closed == 0) and ( (scalar @allWays) > 0) and ($success == 1) ) {
1170                # while ( ($closed != 0) and ( (scalar @allWays) > 0) and ($success == 1) ) { # TODO CHECK
1171                        # try to find new way
1172                        if ($verbose eq "1" ) { print "TRY TO FIND NEW WAY\n" ; }
1173                        $success = 0 ;
1174                        if ($verbose eq "1" ) { print "BR: actual start and end node $startNode $endNode\n" ; }
1175                        my $i = 0 ;
1176                        while ( ($i < (scalar @allWays) ) and ($success == 0) ) {
1177                                if ($verbose eq "1" ) { print "BR: testing way $i = $allWays[$i]\n" ; }
1178                                if ($verbose eq "1" ) { print "BR:   rev in front?\n" ; }
1179                                if ( $memWayNodes{$allWays[$i]}[0] == $startNode ) { 
1180                                        $success = 1 ;
1181                                        # reverse in front
1182                                        @currentWays = ($allWays[$i], @currentWays) ;
1183                                        @currentNodes = (reverse (@{$memWayNodes{$allWays[$i]}}), @currentNodes) ;
1184                                        splice (@allWays, $i, 1) ;
1185                                }
1186                                if ($success ==0) {
1187                                        if ($verbose eq "1" ) { print "BR:   app at end?\n" ; }
1188                                        if ( $memWayNodes{$allWays[$i]}[0] == $endNode)  { 
1189                                                $success = 1 ;
1190                                                # append at end
1191                                                @currentWays = (@currentWays, $allWays[$i]) ;
1192                                                @currentNodes = (@currentNodes, @{$memWayNodes{$allWays[$i]}}) ;
1193                                                splice (@allWays, $i, 1) ;
1194                                        }
1195                                }
1196                                if ($success ==0) {
1197                                        if ($verbose eq "1" ) { print "BR:   app in front?\n" ; }
1198                                        if ( $memWayNodes{$allWays[$i]}[-1] == $startNode) { 
1199                                                $success = 1 ;
1200                                                # append in front
1201                                                @currentWays = ($allWays[$i], @currentWays) ;
1202                                                @currentNodes = (@{$memWayNodes{$allWays[$i]}}, @currentNodes) ;
1203                                                splice (@allWays, $i, 1) ;
1204                                        }
1205                                }
1206                                if ($success ==0) {
1207                                        if ($verbose eq "1" ) { print "BR:   rev at end?\n" ; }
1208                                        if ( $memWayNodes{$allWays[$i]}[-1] == $endNode) { 
1209                                                $success = 1 ;
1210                                                # append reverse at the end
1211                                                @currentWays = (@currentWays, $allWays[$i]) ;
1212                                                @currentNodes = (@currentNodes, (reverse (@{$memWayNodes{$allWays[$i]}}))) ;
1213                                                splice (@allWays, $i, 1) ;
1214                                        }
1215                                }
1216                                $i++ ;
1217                        } # look for new way that fits
1218
1219                        $startNode = $currentNodes[0] ;
1220                        $endNode = $currentNodes[-1] ;
1221                        if ($startNode == $endNode) { 
1222                                $closed = 1 ; 
1223                                if ($verbose eq "1" ) { print "BR: ring now closed\n" ;} 
1224                        }
1225
1226                } # new ring
1227               
1228                # examine ring and act
1229                if ( ($closed == 1) or ($closeOpt == 0) ) {
1230                        @{$ringWays[$ringCount]} = @currentWays ;
1231                        @{$ringNodes[$ringCount]} = @currentNodes ;
1232                        $ringCount++ ;
1233                }
1234
1235        } 
1236
1237        return (\@ringWays, \@ringNodes) ;
1238}
1239
1240sub processRings {
1241        my ($ref1, $ref2, $ref3) = @_ ;
1242        my @ringNodes = @$ref1 ;
1243        my @ringWays = @$ref2 ;
1244        my @ringTags = @$ref3 ;
1245        my @polygon = () ;
1246        my @polygonSize = () ;
1247        my @ringIsIn = () ;
1248        my @stack = () ; # all created stacks
1249        my %selectedStacks = () ; # stacks selected for processing
1250        my $actualLayer = 0 ; # for new tags
1251        # rings referenced by array index
1252
1253        # create polygons
1254        if ($verbose eq "1") { print "CREATING POLYGONS\n" ; }
1255        for (my $ring = 0 ; $ring <= $#ringWays; $ring++) {
1256                my @poly = () ;
1257                foreach my $node ( @{$ringNodes[$ring]} ) {
1258                        push @poly, [$lon{$node}, $lat{$node}] ;
1259                }
1260                my ($p) = Math::Polygon->new(@poly) ;
1261                $polygon[$ring] = $p ;
1262                $polygonSize[$ring] = $p->area ;
1263                if ($verbose eq "1") { 
1264                        print "  POLYGON $ring - created, size = $polygonSize[$ring] \n" ; 
1265                        foreach my $tag (@{$ringTags[$ring]}) {
1266                                print "    $tag->[0] - $tag->[1]\n" ;
1267                        }
1268                }
1269        }
1270
1271
1272        # create is_in list (unsorted) for each ring
1273        if ($verbose eq "1") { print "CALC isIn\n" ; }
1274        for (my $ring1=0 ; $ring1<=$#polygon; $ring1++) {
1275                my $res = 0 ;
1276                for (my $ring2=0 ; $ring2<=$#polygon; $ring2++) {
1277                        if ($ring1 < $ring2) {
1278                                $res = isIn ($polygon[$ring1], $polygon[$ring2]) ;
1279                                if ($res == 1) { 
1280                                        push @{$ringIsIn[$ring1]}, $ring2 ; 
1281                                        if ($verbose eq "1") { print "  $ring1 isIn $ring2\n" ; }
1282                                } 
1283                                if ($res == 2) { 
1284                                        push @{$ringIsIn[$ring2]}, $ring1 ; 
1285                                        if ($verbose eq "1") { print "  $ring2 isIn $ring1\n" ; }
1286                                } 
1287                        }
1288                }
1289        }
1290        if ($verbose eq "1") {
1291                print "IS IN LIST\n" ;
1292                for (my $ring1=0 ; $ring1<=$#ringNodes; $ring1++) {
1293                        if (defined @{$ringIsIn[$ring1]}) {
1294                                print "  ring $ring1 isIn - @{$ringIsIn[$ring1]}\n" ;
1295                        }
1296                }
1297                print "\n" ;
1298        }
1299
1300
1301        # sort is_in list, biggest first
1302        if ($verbose eq "1") { print "SORTING isIn\n" ; }
1303        for (my $ring=0 ; $ring<=$#ringIsIn; $ring++) {
1304                my @isIn = () ;
1305                foreach my $ring2 (@{$ringIsIn[$ring]}) {
1306                        push @isIn, [$ring2, $polygonSize[$ring2]] ;
1307                }
1308                @isIn = sort { $a->[1] <=> $b->[1] } (@isIn) ; # sorted array
1309
1310                my @isIn2 = () ; # only ring numbers
1311                foreach my $temp (@isIn) {
1312                        push @isIn2, $temp->[0] ;
1313                }
1314                @{$stack[$ring]} = reverse (@isIn2) ; 
1315                push @{$stack[$ring]}, $ring ; # sorted descending and ring self appended
1316                if ($verbose eq "1") { print "  stack ring $ring sorted: @{$stack[$ring]}\n" ; }
1317        }
1318
1319
1320
1321        # find tops and select stacks
1322        if ($verbose eq "1") { print "SELECTING STACKS\n" ; }
1323        my $actualStack = 0 ;
1324        for (my $stackNumber=0 ; $stackNumber<=$#stack; $stackNumber++) {
1325                # look for top element
1326                my $topElement = $stack[$stackNumber]->[(scalar @{$stack[$stackNumber]} - 1)] ;
1327                my $found = 0 ;
1328                for (my $stackNumber2=0 ; $stackNumber2<=$#stack; $stackNumber2++) {
1329                        if ($stackNumber != $stackNumber2) {
1330                                foreach my $ring (@{$stack[$stackNumber2]}) {
1331                                        if ($ring == $topElement) { 
1332                                                $found = 1 ;
1333                                                if ($verbose eq "1") { print "      element also found in stack $stackNumber2\n" ; }
1334                                        }
1335                                }
1336                        }
1337                }
1338
1339                if ($found == 0) {
1340                        @{$selectedStacks{$actualStack}} = @{$stack[$stackNumber]} ;
1341                        $actualStack++ ;
1342                        if ($verbose eq "1") { print "    stack $stackNumber has been selected.\n" ; }
1343                }
1344       
1345        }
1346       
1347        # process selected stacks
1348
1349        if ($verbose eq "1") { print "PROCESS SELECTED STACKS\n" ; }
1350        # while stacks left
1351        while (scalar (keys %selectedStacks) > 0) {
1352                my (@k) = keys %selectedStacks ;
1353                if ($verbose eq "1") { print "  stacks available: @k\n" ; }
1354                my @nodes = () ;
1355                my @nodesOld ;
1356                my @processedStacks = () ;
1357
1358                # select one bottom element
1359                my $key = $k[0] ; # key of first stack
1360                if ($verbose eq "1") { print "  stack nr $key selected\n" ; }
1361                my $ringToDraw = $selectedStacks{$key}[0] ;
1362                if ($verbose eq "1") { print "  ring to draw: $ringToDraw\n" ; }
1363
1364                push @nodesOld, @{$ringNodes[$ringToDraw]} ; # outer polygon
1365                push @nodes, [@{$ringNodes[$ringToDraw]}] ; # outer polygon as array
1366
1367                # and remove ring from stacks; store processed stacks
1368                foreach my $k2 (keys %selectedStacks) {
1369                        if ($selectedStacks{$k2}[0] == $ringToDraw) { 
1370                                shift (@{$selectedStacks{$k2}}) ; 
1371                                push @processedStacks, $k2 ;
1372                                if (scalar @{$selectedStacks{$k2}} == 0) { delete $selectedStacks{$k2} ; }
1373                                if ($verbose eq "1") { print "  removed $ringToDraw from stack $k2\n" ; }
1374                        } 
1375                }
1376
1377                # foreach stack in processed stacks
1378                foreach my $k (@processedStacks) {
1379                        # if now bottom of a stack is hole, then add this polygon to points
1380                        if (defined $selectedStacks{$k}) {
1381                                my $tempRing = $selectedStacks{$k}[0] ;
1382                                my $temp = $ringTags[$tempRing]->[0]->[0] ;
1383                                if ($verbose eq "1") { print "           testing for hole: stack $k, ring $tempRing, tag $temp\n" ; }
1384                                if ($ringTags[$tempRing]->[0]->[0] eq "multihole") {
1385                                        push @nodesOld, @{$ringNodes[$tempRing]} ;
1386                                        push @nodes, [@{$ringNodes[$tempRing]}] ;
1387                                        # print "      nodes so far: @nodes\n" ;
1388                                        # and remove this element from stack
1389                                        shift @{$selectedStacks{$k}} ;
1390                                        if (scalar @{$selectedStacks{$k}} == 0) { delete $selectedStacks{$k} ; }
1391                                        if ($verbose eq "1") { print "  ring $tempRing identified as hole\n" ; }
1392                                }
1393                        }
1394                }
1395
1396                # add way
1397                @{$memWayNodes{$newId}} = @nodesOld ;
1398                @{$memWayTags{$newId}} = @{$ringTags[$ringToDraw]} ;
1399                @{$memWayPaths{$newId}} = @nodes ;
1400                push @{$memWayTags{$newId}}, ["layer", $actualLayer] ;
1401                # should an existing layer tag be removed? TODO?
1402                $actualLayer++ ;
1403                if ($verbose eq "1") { 
1404                        print "  DRAWN: $ringToDraw, wayId $newId\n" ; 
1405                        foreach my $tag (@{$ringTags[$ringToDraw]}) {
1406                                print "    k/v $tag->[0] - $tag->[1]\n" ;
1407                        }
1408                }
1409                $newId -- ;
1410
1411        } # (while)
1412}
1413
1414sub isIn {
1415        # checks two polygons
1416        # return 0 = neither
1417        #        1 = p1 is in p2
1418        #        2 = p2 is in p1
1419        my ($p1, $p2) = @_ ;
1420
1421        my ($p1In2) = 1 ;
1422        my ($p2In1) = 1 ;
1423
1424        # p1 in p2 ?
1425        foreach my $pt1 ($p1->points) {
1426                if ($p2->contains ($pt1) ) {
1427                        # good
1428                }
1429                else {
1430                        $p1In2 = 0 ;
1431                }
1432        }
1433
1434        # p2 in p1 ?
1435        foreach my $pt2 ($p2->points) {
1436                if ($p1->contains ($pt2) ) {
1437                        # good
1438                }
1439                else {
1440                        $p2In1 = 0 ;
1441                }
1442        }
1443
1444        if ($p1In2 == 1) {
1445                return 1 ;
1446        }
1447        elsif ($p2In1 == 1) {
1448                return 2 ;
1449        }
1450        else {
1451                return 0 ;
1452        }
1453}
1454
1455
1456
1457sub processRoutes {
1458
1459        my %routeColors = () ;
1460        my %actualColorIndex = () ;
1461        my %colorNumber = () ;
1462        my %wayRouteLabels = () ;
1463        my %wayRouteIcons = () ;
1464
1465        # init before relation processing
1466        print "initializing route data...\n" ;
1467        foreach my $routeType (@routes) {
1468                print "  type: $routeType->[0]\n" ;
1469                $actualColorIndex{$routeType->[0]} = 0 ;
1470
1471                # get route colors from
1472                @{$routeColors{$routeType->[0]}} = split ( /;/, $routeType->[$routeIndexColor] ) ;
1473                $colorNumber{$routeType->[0]} = scalar @{$routeColors{$routeType->[0]}} ;
1474                print "  colors: @{$routeColors{$routeType->[0]}}\n" ;
1475        }
1476        print "end.\n" ;
1477
1478        foreach my $relId (keys %memRelationTags) {
1479                my $relationType = getValue ("type", \@{$memRelationTags{$relId}}) ;
1480                if ( $relationType eq "route" ) {
1481                        # look for rule
1482                        my $routeType = getValue ("route", \@{$memRelationTags{$relId}}) ;
1483
1484                        foreach my $test (@routes) {
1485                                if ( ($routeType eq $test->[$routeIndexRoute]) and ( $test->[$routeIndexFromScale] <= $ruleScaleSet) and ( $test->[$routeIndexToScale]>= $ruleScaleSet) ) {
1486
1487                                        # new route detected
1488                                        if ($verbose eq "1" ) { print "rule found for $relId, $routeType.\n" ;  }
1489       
1490                                        my $color = getValue ("color", \@{$memRelationTags{$relId}}) ;
1491                                        if ($color eq "") {
1492                                                $color = getValue ("colour", \@{$memRelationTags{$relId}}) ;
1493                                        }
1494                                        if ($verbose eq "1" ) { print "  color from tags: $color\n" ;   }
1495
1496                                        if ($color eq "") { 
1497                                                if ($verbose eq "1" ) { print "  actual color index: $actualColorIndex{$routeType}\n" ; }
1498                                                $color = $routeColors{$routeType}[$actualColorIndex{$routeType}] ; 
1499                                                $actualColorIndex{$routeType} = ($actualColorIndex{$routeType} + 1) % $colorNumber{$routeType} ;
1500                                        }
1501                                        if ($verbose eq "1" ) { print "  final color: $color\n" ; }
1502
1503
1504                                        # find icon
1505                                        my $iconName = getValue ("ref", \@{$memRelationTags{$relId}}) ;
1506                                        if ($iconName eq "") {
1507                                                getValue ("name", \@{$memRelationTags{$relId}})
1508                                        }
1509
1510                                        $iconName = $iconDir . $routeType . "-" . $iconName . ".svg" ;
1511                                        my $iconResult = open (my $file, "<", $iconName) ;
1512                                        # print "  trying $iconName\n" ;
1513                                        if ($iconResult) { 
1514                                                if ($verbose eq "1") { print "  icon $iconName found!\n" ; }
1515                                        } 
1516
1517                                        if (!$iconResult) {
1518                                                $iconName =~ s/.svg/.png/ ; 
1519                                                # print "  trying $iconName\n" ;
1520                                                $iconResult = open (my $file, "<", $iconName) ;
1521                                                if ($iconResult) { 
1522                                                        if ($verbose eq "1") { print "  icon $iconName found!\n" ; }
1523                                                } 
1524                                        }
1525
1526                                        my ($label, $ref) = createLabel (\@{$memRelationTags{$relId}}, $test->[$routeIndexLabel]) ;
1527                                        if ($verbose eq "1" ) { print "  label: $label\n" ; }
1528
1529                                        my $printIcon = "" ; if ($iconResult) { $printIcon=$iconName ; }
1530                                        printf "ROUTE %10s %10s %10s %30s %40s\n", $relId, $routeType, $color, $label, $printIcon ; 
1531
1532                                        # collect ways
1533
1534                                        my $mRef = getAllMembers ($relId, 0) ;
1535                                        my @tempMembers = @$mRef ;
1536
1537
1538
1539                                        my @relWays = () ;
1540                                        # foreach my $member (@{$memRelationMembers{$relId}}) {
1541                                        foreach my $member (@tempMembers) {
1542                                                if ( ( ($member->[2] eq "none") or ($member->[2] eq "route") ) and ($member->[0] eq "way") ) { push @relWays, $member->[1] ; }
1543                                                if ( ( ($member->[2] eq "forward") or ($member->[2] eq "backward") ) and ($member->[0] eq "way") ) { push @relWays, $member->[1] ; }
1544
1545
1546                                                # stops
1547                                                if ( (grep /stop/, $member->[2]) and ($member->[0] eq "node") ) {
1548                                                        # print "stop found in route $relId\n" ;
1549                                                        if ($test->[$routeIndexStopThickness] > 0) {
1550                                                                drawNodeDotRouteStops ($lon{$member->[1]}, $lat{$member->[1]}, $color, $test->[$routeIndexStopThickness]) ;
1551                                                        }
1552                                                }
1553
1554
1555
1556                                        }
1557                                        if ($verbose eq "1" ) { print "  ways: @relWays\n" ; }
1558                                        foreach my $w (@relWays) {
1559                                                drawWayRoute ($color, $test->[$routeIndexThickness], $test->[$routeIndexDash], $test->[$routeIndexOpacity], nodes2Coordinates (@{$memWayNodes{$w}} ) ) ;
1560                                                # $wayRouteLabels{$w} .= $label . " " ;
1561                                                $wayRouteLabels{$w}{$label} = 1 ;
1562                                                if ($iconResult) {                                             
1563                                                        $wayRouteIcons{$w}{$iconName} = 1 ;
1564                                                }
1565                                        }
1566                                } # rule found
1567                        } # test rules
1568                        # if ($verbose eq "1") { print "\n" ; }
1569                } # rel route
1570        }
1571
1572        # label route ways after all relations have been processed
1573        foreach my $w (keys %wayRouteLabels) {
1574                if (scalar @{$memWayNodes{$w}} > 1) {
1575                        my $label = "" ;
1576                        foreach my $l (keys %{$wayRouteLabels{$w}}) {
1577                                $label .= $l . " " ;
1578                        } 
1579
1580                        my @way = @{$memWayNodes{$w}} ;
1581                        if ($lon{$way[0]} > $lon{$way[-1]}) {
1582                                @way = reverse (@way) ;
1583                        }
1584
1585                        if (labelFitsWay (\@{$memWayNodes{$w}}, $label, $routeLabelFont, $routeLabelSize) ) {
1586                                labelWay ($routeLabelColor, $routeLabelSize, $routeLabelFont, $label, $routeLabelOffset, nodes2Coordinates (@way) ) ;
1587                        }
1588                }
1589        }
1590
1591        foreach my $w (keys %wayRouteIcons) {
1592                my $offset = 0 ;
1593                my $nodeNumber = scalar @{$memWayNodes{$w}} ;
1594                if ($nodeNumber > 1) {
1595                        my $node = $memWayNodes{$w}[int ($nodeNumber/2)] ;
1596                        my $num = scalar (keys %{$wayRouteIcons{$w}}) ;
1597                        $offset = int (-($num-1)*$routeIconDist/2) ; 
1598
1599                        foreach my $iconName (keys %{$wayRouteIcons{$w}}) {
1600                                # print "  $w $offset ICON $iconName drawn\n" ;
1601                                # drawIcon ($lon{$node}, $lat{$node}, $iconName, 0, 0, $declutterOpt, $offset) ;
1602                                placeLabelAndIcon ($lon{$node}, $lat{$node}, 0, "", "none", 0, "", $ppc, $iconName, 0, 0, $allowIconMoveOpt) ;
1603                                $offset += $routeIconDist ;
1604                        }
1605                }
1606        }
1607
1608}
1609
1610sub getAllMembers {
1611#
1612# get all members of a relation recursively
1613#
1614        my ($relId, $nestingLevel) = @_ ;
1615        my @allMembers = () ;
1616        my $maxNestingLevel = 20 ;
1617
1618        if ($nestingLevel > $maxNestingLevel) { 
1619                print "ERROR/WARNING nesting level of relations too deep. recursion stopped at depth $maxNestingLevel! relId=$relId\n" ;
1620        }
1621        else {
1622                foreach my $member (@{$memRelationMembers{$relId}}) {
1623                        if ( ($member->[0] eq "way") or ($member->[0] eq "node") ) {
1624                                push @allMembers, $member ;
1625                        }
1626                        if ( $member->[0] eq "relation" ) {
1627                                my $ref = getAllMembers ($member->[1], $nestingLevel+1) ;
1628                                push @allMembers, @$ref ;
1629                        }
1630                }       
1631        }
1632        return \@allMembers ;
1633}
1634
1635sub labelFitsWay {
1636        my ($refWayNodes, $text, $font, $size) = @_ ;
1637        my @wayNodes = @$refWayNodes ;
1638
1639        # calc waylen
1640        my $wayLength = 0 ; # in pixels
1641        for (my $i=0; $i<$#wayNodes; $i++) {
1642                my ($x1, $y1) = convert ($lon{$wayNodes[$i]}, $lat{$wayNodes[$i]}) ;
1643                my ($x2, $y2) = convert ($lon{$wayNodes[$i+1]}, $lat{$wayNodes[$i+1]}) ;
1644                $wayLength += sqrt ( ($x2-$x1)**2 + ($y2-$y1)**2 ) ;
1645        }
1646
1647
1648        # calc label len
1649        my $labelLength = length ($text) * $ppc / 10 * $size ; # in pixels
1650
1651        my $fit ;
1652        if ($labelLength < $wayLength) { $fit="fit" ; } else { $fit = "NOFIT" ; }
1653        # print "labelFitsWay: $fit, $text, labelLen = $labelLength, wayLen = $wayLength\n" ;
1654
1655        if ($labelLength < $wayLength) {
1656                return 1 ;
1657        }
1658        else {
1659                return 0 ;
1660        }
1661}
1662
1663sub getNodeRule {
1664        my ($ref1, $ref2, $scale) = @_ ;
1665        my @nodeTags = @$ref1 ;
1666        my @nodeRules = @$ref2 ;
1667        my $ruleFound ; undef $ruleFound ;
1668
1669        RUL2: foreach my $rule (@nodeRules) {
1670                if ( ( $rule->[$nodeIndexFromScale] <= $scale) and ( $rule->[$nodeIndexToScale]>= $scale) ) {
1671
1672                        # get k/v pairs
1673                        my @keys = split /\|/, $rule->[$nodeIndexTag] ;
1674                        my @values = split /\|/, $rule->[$nodeIndexValue] ;
1675                        my $allValid = 1 ; # assume all k/vs valid until proved otherwise
1676
1677                        # if (scalar @keys > 1) { print "multi rule\n" ;}
1678
1679                        RUL1: for (my $i=0; $i<=$#keys; $i++) {
1680                                my $found = 0 ;
1681                                foreach my $tag (@nodeTags) {
1682                                        if ( ($tag->[0] eq $keys[$i]) and ( ($tag->[1] eq $values[$i]) or ($values[$i] eq "*") ) ) {
1683                                                $found = 1 ;
1684                                        }
1685                                }
1686                                if ($found == 0) { 
1687                                        $allValid = 0 ; 
1688                                        last RUL1 ;
1689                                }
1690                        }
1691                        if ($allValid == 1) {
1692                                # if (scalar @keys > 1) { print "multi node FOUND\n" ;}
1693                                $ruleFound = $rule ;
1694                                last RUL2 ;
1695                        }
1696                } # scale
1697        } # all rules
1698
1699        return ($ruleFound) ;
1700}
1701
1702sub getWayRule {
1703        my ($ref1, $ref2, $scale) = @_ ;
1704        my @wayTags = @$ref1 ;
1705        my @wayRules = @$ref2 ;
1706        my $ruleFound ; undef $ruleFound ;
1707
1708        RUL4: foreach my $rule (@wayRules) {
1709                if ( ( $rule->[$wayIndexFromScale] <= $scale) and ( $rule->[$wayIndexToScale]>= $scale) ) {
1710
1711                        # get k/v pairs
1712                        my @keys = split /\|/, $rule->[$wayIndexTag] ;
1713                        my @values = split /\|/, $rule->[$wayIndexValue] ;
1714                        my $allValid = 1 ; # assume all k/vs valid until proved otherwise
1715
1716                        RUL3: for (my $i=0; $i<=$#keys; $i++) {
1717                                my $found = 0 ;
1718                                foreach my $tag (@wayTags) {
1719                                        if ( ($tag->[0] eq $keys[$i]) and ( ($tag->[1] eq $values[$i]) or ($values[$i] eq "*") ) ) {
1720                                                $found = 1 ;
1721                                        }
1722                                }
1723                                if ($found == 0) { 
1724                                        $allValid = 0 ; 
1725                                        last RUL3 ;
1726                                }
1727                        }
1728                        if ($allValid == 1) {
1729                                # if (scalar @keys > 1) { print "multi WAY FOUND\n" ;}
1730                                $ruleFound = $rule ;
1731                                last RUL4 ;
1732                        }
1733                } # scale
1734        } # all rules
1735
1736        return ($ruleFound) ;
1737}
1738
1739
1740# ------------------------------------------------------------------------------------------------
1741
1742sub processCoastLines {
1743#
1744#
1745#
1746        print "check and process coastlines...\n" ;
1747        # collect all coastline ways
1748        my @allWays = () ;
1749        foreach $wayId (keys %memWayNodes) {
1750                if (getValue ("natural", \@{$memWayTags{$wayId}}) eq "coastline" ) {
1751                        push @allWays, $wayId ;
1752                        if ($verbose eq "1") { print "COAST initial way $wayId start ${$memWayNodes{$wayId}}[0]  end ${$memWayNodes{$wayId}}[-1]\n" ; }
1753                }
1754        }
1755        if ($verbose eq "1") { print "COAST: " . scalar (@allWays) . " coastline ways found.\n" ; }
1756
1757        if (scalar @allWays > 0) {
1758                # build rings
1759                my ($refWays, $refNodes) = buildRings (\@allWays, 0) ;
1760                my @ringNodes = @$refNodes ; # contains all nodes of rings // array of arrays !
1761                if ($verbose eq "1") { print "COAST: " . scalar (@ringNodes) . " rings found.\n" ; }
1762
1763                # convert rings to coordinate system
1764                my @ringCoordsOpen = () ; my @ringCoordsClosed = () ;
1765                for (my $i=0; $i<=$#ringNodes; $i++) {
1766                        # print "COAST: initial ring $i\n" ;
1767                        my @actualCoords = () ;
1768                        foreach my $node (@{$ringNodes[$i]}) {
1769                                push @actualCoords, [convert ($lon{$node}, $lat{$node})] ;
1770                        }
1771                        if (${$ringNodes[$i]}[0] == ${$ringNodes[$i]}[-1]) {
1772                                push @ringCoordsClosed, [@actualCoords] ; # islands
1773                        }
1774                        else {
1775                                push @ringCoordsOpen, [@actualCoords] ;
1776                        }
1777                        # printRingCoords (\@actualCoords) ;
1778                        my $num = scalar @actualCoords ;
1779                        if ($verbose eq "1") { print "COAST: initial ring $i - $actualCoords[0]->[0],$actualCoords[0]->[1] -->> $actualCoords[-1]->[0],$actualCoords[-1]->[1]  nodes: $num\n" ; }
1780                }
1781
1782                if ($verbose eq "1") { print "COAST: add points on border...\n" ; }
1783                foreach my $ring (@ringCoordsOpen) {
1784                        # print "COAST:   ring $ring with border nodes\n" ;
1785                        # add first point on border
1786                        my $ref = nearestPoint ($ring->[0]) ;
1787                        my @a = @$ref ;
1788                        unshift @$ring, [@a] ;
1789                        # add last point on border
1790                        $ref = nearestPoint ($ring->[-1]) ;
1791                        @a = @$ref ;
1792                        push @$ring, [@a] ;
1793                        # printRingCoords ($ring) ;
1794                }
1795
1796                my @islandRings = @ringCoordsClosed ;
1797                if ($verbose eq "1") { print "COAST: " . scalar (@islandRings) . " islands found.\n" ; }
1798                @ringCoordsClosed = () ;
1799
1800                # process ringCoordsOpen
1801                # add other rings, corners...
1802                while (scalar @ringCoordsOpen > 0) { # as long as there are open rings
1803                        if ($verbose eq "1") { print "COAST: building ring...\n" ; }
1804                        my $ref = shift @ringCoordsOpen ; # get start ring
1805                        my @actualRing = @$ref ;
1806
1807                        my $closed = 0 ; # mark as not closed
1808                        my $actualX = $actualRing[-1]->[0] ;
1809                        my $actualY = $actualRing[-1]->[1] ;
1810
1811                        my $actualStartX = $actualRing[0]->[0] ; 
1812                        my $actualStartY = $actualRing[0]->[1] ; 
1813
1814                        if ($verbose eq "1") { print "COAST: actual and actualStart $actualX, $actualY   -   $actualStartX, $actualStartY\n" ; }
1815
1816                        my $corner ;
1817                        while (!$closed) { # as long as this ring is not closed
1818                                ($actualX, $actualY, $corner) = nextPointOnBorder ($actualX, $actualY) ;
1819                                # print "      actual $actualX, $actualY\n" ;
1820                                my $startFromOtherPolygon = -1 ;
1821                                # find matching ring if there is another ring
1822                                if (scalar @ringCoordsOpen > 0) {
1823                                        for (my $i=0; $i <= $#ringCoordsOpen; $i++) {
1824                                                my @test = @{$ringCoordsOpen[$i]} ;
1825                                                # print "    test ring $i: ", $test[0]->[0], " " , $test[0]->[1] , "\n" ;
1826                                                if ( ($actualX == $test[0]->[0]) and ($actualY == $test[0]->[1]) ) {
1827                                                        $startFromOtherPolygon = $i ;
1828                                                        if ($verbose eq "1") { print "COAST:   matching start other polygon found i= $i\n" ; }
1829                                                }
1830                                        }
1831                                }
1832                                # process matching polygon, if present
1833                                if ($startFromOtherPolygon != -1) { # start from other polygon {
1834                                        # append nodes
1835                                        # print "ARRAY TO PUSH: @{$ringCoordsOpen[$startFromOtherPolygon]}\n" ;
1836                                        push @actualRing, @{$ringCoordsOpen[$startFromOtherPolygon]} ;
1837                                        # set actual
1838                                        $actualX = $actualRing[-1]->[0] ;
1839                                        $actualY = $actualRing[-1]->[1] ;
1840                                        # drop p2 from opens
1841                                        splice @ringCoordsOpen, $startFromOtherPolygon, 1 ;
1842                                        if ($verbose eq "1") { print "COAST:   openring $startFromOtherPolygon added to actual ring\n" ; }
1843                                }
1844                                else {
1845                                        if ($corner) { # add corner to actual ring
1846                                                push @actualRing, [$actualX, $actualY] ;
1847                                                if ($verbose eq "1") { print "COAST:   corner $actualX, $actualY added to actual ring\n" ; }
1848                                        }
1849                                }
1850                                # check if closed
1851                                if ( ($actualX == $actualStartX) and ($actualY == $actualStartY) ) {
1852                                        $closed = 1 ;
1853                                        push @actualRing, [$actualX, $actualY] ;
1854                                        push @ringCoordsClosed, [@actualRing] ;
1855                                        if ($verbose eq "1") { print "COAST:    ring now closed and moved to closed rings.\n" ; }
1856                                }
1857                        } # !closed
1858                } # open rings
1859
1860                # get water color or default
1861                my $color = "lightblue" ;
1862                foreach my $way (@ways) {
1863                        if ( ($way->[$wayIndexTag] eq "natural") and ($way->[$wayIndexValue] eq "water") ) {
1864                                $color = $way->[$wayIndexColor] ;
1865                        }
1866                }
1867
1868                # build islandRings polygons
1869                if ($verbose eq "1") { print "OCEAN: building island polygons\n" ; }
1870                my @islandPolygons = () ;
1871                if (scalar @islandRings > 0) {
1872                        for (my $i=0; $i<=$#islandRings; $i++) {
1873                                my @poly = () ;
1874                                foreach my $node ( @{$islandRings[$i]} ) {
1875                                        push @poly, [$node->[0], $node->[1]] ;
1876                                }
1877                                my ($p) = Math::Polygon->new(@poly) ;
1878                                $islandPolygons[$i] = $p ;
1879                        }
1880                }
1881               
1882                # build ocean ring polygons
1883                if ($verbose eq "1") { print "OCEAN: building ocean polygons\n" ; }
1884                my @oceanPolygons = () ;
1885                if (scalar @ringCoordsClosed > 0) {
1886                        for (my $i=0; $i<=$#ringCoordsClosed; $i++) {
1887                                my @poly = () ;
1888                                foreach my $node ( @{$ringCoordsClosed[$i]} ) {
1889                                        push @poly, [$node->[0], $node->[1]] ;
1890                                }
1891                                my ($p) = Math::Polygon->new(@poly) ;
1892                                $oceanPolygons[$i] = $p ;
1893                        }
1894                }
1895                else {
1896                        if (scalar @islandRings > 0) {
1897                                if ($verbose eq "1") { print "OCEAN: build ocean rect\n" ; }
1898                                my @ocean = () ;
1899                                my ($x, $y) = getDimensions() ;
1900                                push @ocean, [0,0], [$x,0], [$x,$y], [0,$y], [0,0] ;
1901                                push @ringCoordsClosed, [@ocean] ;
1902                                my ($p) = Math::Polygon->new(@ocean) ;
1903                                push @oceanPolygons, $p ;
1904                        }
1905                }
1906
1907                # finally create pathes for SVG
1908                for (my $i=0; $i<=$#ringCoordsClosed; $i++) {
1909                # foreach my $ring (@ringCoordsClosed) {
1910                        my @ring = @{$ringCoordsClosed[$i]} ;
1911                        my @array = () ;
1912                        my @coords = () ;
1913                        foreach my $c (@ring) {
1914                                push @coords, $c->[0], $c->[1] ;
1915                        }
1916                        push @array, [@coords] ; 
1917                        if (scalar @islandRings > 0) {
1918                                for (my $j=0; $j<=$#islandRings; $j++) {
1919                                        # island in ring? 1:1 and coast on border?
1920                                        # if (isIn ($islandPolygons[$j], $oceanPolygons[$i]) == 1) {
1921                                        if ( (isIn ($islandPolygons[$j], $oceanPolygons[$i]) == 1) or 
1922                                                ( (scalar @islandRings == 1) and (scalar @ringCoordsClosed == 1) ) )    {
1923                                                if ($verbose eq "1") { print "OCEAN: island $j in ocean $i\n" ; }
1924                                                my @coords = () ;
1925                                                foreach my $c (@{$islandRings[$j]}) {
1926                                                        push @coords, $c->[0], $c->[1] ;               
1927                                                }
1928                                                push @array, [@coords] ;
1929                                        }
1930                                }
1931                        }
1932                        drawAreaOcean ($color, \@array) ;
1933                }
1934        }
1935}
1936
1937
1938sub nearestPoint {
1939#
1940# accepts x/y coordinates and returns nearest point on border of map to complete cut coast ways
1941#
1942        my $ref = shift ;
1943        my $x = $ref->[0] ;
1944        my $y = $ref->[1] ;
1945        my $xn ; my $yn ;
1946        my $min = 99999 ;
1947        # print "  NP: initial $x $y\n" ;
1948        my ($xmax, $ymax) = getDimensions() ;
1949        # print "  NP: dimensions $xmax $ymax\n" ;
1950        if ( abs ($xmax-$x) < $min) { # right
1951                $xn = $xmax ;
1952                $yn = $y ; 
1953                $min = abs ($xmax-$x) ;
1954        }
1955        if ( abs ($ymax-$y) < $min) { # bottom
1956                $xn = $x ;
1957                $yn = $ymax ; 
1958                $min = abs ($ymax-$y) ;
1959        }
1960        if ( abs ($x) < $min) { # left
1961                $xn = 0 ;
1962                $yn = $y ; 
1963                $min = abs ($x) ;
1964        }
1965        if ( abs ($y) < $min) { # top
1966                $xn = $x ;
1967                $yn = 0 ; 
1968        }
1969        # print "  NP: final $xn $yn\n" ;
1970        my @a = ($xn, $yn) ;
1971        return (\@a) ;
1972}
1973
1974
1975sub printRingCoords {
1976        my $ref = shift ;
1977        my @ringCoords = @$ref ;
1978
1979        print "        ring coords\n" ;
1980        foreach my $c (@ringCoords) {
1981                print "$c->[0], $c->[1] *** " ;
1982        }
1983        print "\n" ;
1984}
1985
1986
1987sub nextPointOnBorder {
1988#
1989# accepts x/y coordinates and returns next point on border - to complete coast rings with other polygons and corner points
1990# hints if returned point is a corner
1991#
1992        # right turns
1993        my ($x, $y) = @_ ;
1994        my ($xn, $yn) ;
1995        my $corner = 0 ;
1996        my ($xmax, $ymax) = getDimensions() ;
1997        if ($x == $xmax) { # right border
1998                if ($y < $ymax) {
1999                        $xn = $xmax ; $yn = $y + 1 ;
2000                }
2001                else {
2002                        $xn = $xmax - 1 ; $yn = $ymax ;
2003                }
2004        }
2005        else {
2006                if ($x == 0) { # left border
2007                        if ($y > 0) {
2008                                $xn = 0 ; $yn = $y - 1 ;
2009                        }
2010                        else {
2011                                $xn = 1 ; $yn = 0 ;
2012                        }
2013                }
2014                else {
2015                        if ($y == $ymax) { # bottom border
2016                                if ($x > 0) {
2017                                        $xn = $x - 1 ; $yn = $ymax ;
2018                                }
2019                                else {
2020                                        $xn = 0 ; $yn = $ymax - 1 ; 
2021                                }
2022                        }
2023                        else {
2024                                if ($y == 0) { # top border
2025                                        if ($x < $xmax) {
2026                                                $xn = $x + 1 ; $yn = 0 ;
2027                                        }
2028                                        else {
2029                                                $xn = $xmax ; $yn = 1 ; 
2030                                        }
2031                                }
2032                        }
2033                }
2034        }
2035        # print "NPOB: $x, $y --- finito $xn $yn\n" ;
2036
2037        if ( ($xn == 0) and ($yn == 0) ) { $corner = 1 ; }
2038        if ( ($xn == 0) and ($yn == $ymax) ) { $corner = 1 ; }
2039        if ( ($xn == $xmax) and ($yn == 0) ) { $corner = 1 ; }
2040        if ( ($xn == $xmax) and ($yn == $ymax) ) { $corner = 1 ; }
2041
2042        return ($xn, $yn, $corner) ;
2043}
2044
Note: See TracBrowser for help on using the repository browser.