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

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

version 1.01 of mapgen - [-clipbox]

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