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

Last change on this file since 23856 was 23799, checked in by gary68, 9 years ago

1.11 of mapgen

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