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

Last change on this file since 21060 was 21038, checked in by gary68, 9 years ago

mapgen 1.03

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