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

Last change on this file since 26424 was 25772, checked in by gary68, 9 years ago

new mapgen version

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