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

Last change on this file was 29705, checked in by lucasvr, 6 years ago

New command, -ignorelabels, to indicate that labels are not to be rendered at all.

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