source: subversion/applications/utils/gary68/boundaries.pl @ 15866

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

2.0 beta -> alpha

  • Property svn:keywords set to Date Author Revision
File size: 36.7 KB
Line 
1#
2#  $Revision: 15866 $ by $Author: gary68 $, $Date: 2009-06-12 15:02:20 +0000 (Fri, 12 Jun 2009) $
3#
4# boundaries.pl by gary68
5#
6#
7#
8# Copyright (C) 2009, Gerhard Schwanz
9#
10# 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
11# Free Software Foundation; either version 3 of the License, or (at your option) any later version.
12#
13# This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
15#
16# You should have received a copy of the GNU General Public License along with this program; if not, see <http://www.gnu.org/licenses/>
17#
18#
19#
20# IN:  file.osm
21#
22# OUT: file.htm (list)
23# OUT: file.csv (list)
24# OUT: file.hirarchy.htm (list)
25# OUT: file.hirarchy.csv (list)
26# OUT: fileXXXXX.poly (borders original)
27# OUT: fileSimplifiedXXXXX.poly (borders simplified)
28# OUT: fileXXXXX.png (map of border)
29#
30# relation member roles used: outer and none
31#
32# parameters and options see below
33#
34# Version 2
35# - find hirarchies and report
36# - use simplified polygons for hirarchy if specified
37# - time calc
38# - error handling for relations caontaining themselves as member
39# - check for max nesting level when parsing relation members being relations (prevent loops eating memory and terminate program)
40# - resize option (-resize, -factor (float > 1.0)
41# - pics with resized polygons
42# - distinguish between invalid and selected
43# - qualify invalid relation list with causes of errors
44#
45#
46#
47
48use strict ;
49use warnings ;
50
51use File::stat ;
52use Time::localtime ; 
53use Getopt::Long ;
54use Math::Polygon ;
55
56use OSM::osm 4.4 ;
57use OSM::osmgraph ;
58
59my $program = "boundaries.pl" ;
60my $usage = $program . " see code GetOptions" ;
61my $version = "2.0" ;
62my $maxNestingLevel = 10 ; # for relations
63
64my $nodeId ;            # variables for reading nodes
65my $nodeUser ;
66my $nodeLat ;
67my $nodeLon ;
68my @nodeTags ;
69my $aRef1 ;
70my $aRef2 ;
71
72my $wayId ;             # variables for reading ways
73my $wayUser ;
74my @wayNodes ;
75my @wayTags ;
76
77my $relationId ;        # variables for reading relations
78my $relationUser ;
79my @relationMembers ;
80my @relationTags ;
81
82my %lon = () ; my %lat = () ;   # all node positions
83
84my @neededNodes = () ;  # will be used to load only needed data
85my @neededWays = () ;   # will be used to load only needed data
86
87my %wayNodesHash = () ; # nodes forming a way
88my %relationWays = () ; # ways contained (first directly, later also indirect by relation reference) in relation
89my %relationRelations = () ;    # relations contained in relation (referenced)
90my %validRelation = () ;        # checked and valid
91my %selectedRelation = () ;     # can be used for evaluation, selected
92my %completeWay = () ;          # this is the boundary as built by checkSegments, all nodes in correct order
93my %relationName = () ;         # relation data
94my %relationType = () ;         # relation data
95my %relationBoundary = () ;     # relation data
96my %relationLength = () ;       # relation data, original
97my %relationAdminLevel = () ;   # relation data
98my %relationPolygon = () ;              # relation original polygon
99my %relationPolygonSimplified = () ;    # relation simplified polygon
100my %relationPolygonResized = () ;       # relation resized polygon
101my %relationIsIn = () ;         # lists boundaries this relation is inside
102my %relationSize = () ;         # area as returned by math::polygon->area (no projection applied, so no real value! used only to sort is_ins)
103my %relationSegments = () ;     #
104my %relationOpen = () ; #
105my %relationWaysValid = () ;    #
106
107my $relationCount = 0 ;         # total
108my $wayCount = 0 ; 
109my $invalidWayCount = 0 ; 
110my %invalidWays ;               # node count < 2, osmcut, osmosis, error...
111my $adminInvalidCount = 0 ;     # how many relations are not used due to admin restriction
112
113# command line things
114my $optResult ;
115my $verbose = "" ;
116my $adminLevelOpt = "" ;
117my $polyOpt = "" ;
118my $hirarchyOpt = 0 ;
119my $simplifyOpt = "" ;
120my $debugOpt = "" ;
121my $picOpt = "" ;
122my $picSize = 1024 ; # default pic size longitude in pixels
123my $resizeOpt = "" ;
124my $resizeFactor = 1.05 ; # 5% bigger default
125my $osmName = "" ; 
126my $htmlName = "" ; my $htmlFile ;
127my $csvName = "" ; my $csvFile ;
128my $polyBaseName = "" ;
129my $polyName = "" ; my $polyFile ;
130
131# defaults for simplify
132my $simplifySlope = 0.001 ; # IN DEGREES, ~100m
133my $simplifySame = 0.002 ; # IN DEGREES, ~200m
134my $simplifyNpk = 2 ;    # max nodes per kilometer for simplified polygon
135
136
137$optResult = GetOptions (       "in=s"          => \$osmName,           # the in file, mandatory
138                                "html=s"        => \$htmlName,          # output file html, mandatory ([dir/]*.htm)
139                                "csv=s"         => \$csvName,           # output file csv, mandatory ([dir/]*.csv)
140                                "poly"          => \$polyOpt,           # option to create poly files, then give polyBaseName
141                                "polybase:s"    => \$polyBaseName,      # base filename for poly files. relId is appended. also used for pic names. [dir/]name
142                                "simplify"      => \$simplifyOpt,       # should simplified polygons be used?
143                                "slope:f"       => \$simplifySlope,     # simplify (Math::Polygon). distance in DEGREES. With three points X(n),X(n+1),X(n+2), the point X(n+1) will be removed if the length of the path over all three points is less than slope longer than the direct path between X(n) and X(n+2)
144                                "same:f"        => \$simplifySame,      # distance (IN DEGREES) for nodes to be considered the same
145                                "npk:f"         => \$simplifyNpk,       # max nodes per km when simplifying
146                                "debug"         => \$debugOpt,         
147                                "pics"          => \$picOpt,            # specifies if pictures of polygons are drawn. polybasename must be given.
148                                "hirarchy"      => \$hirarchyOpt,       # specifies if hirarchies of boundaries are calculated. don't together use with adminlevel. can/should be used with -simplify, then simplified polygons are used for building the hirarchy - much faster
149                                "resize"        => \$resizeOpt, # specifies if new resized polygon will be produced (-polygon must be specified, maybe use -factor, if -simplify is given, simplified polygon will be resized)
150                                "factor:f"      => \$resizeFactor,      # specifies how much bigger the resized polygon will be
151                                "picsize:i"     => \$picSize,           # specifies pic size longitude in pixels
152                                "adminlevel:s"  => \$adminLevelOpt,     # specifies which boundaries to look at
153                                "verbose"       => \$verbose) ;         # turns twitter on
154
155
156
157my $time0 = time() ;
158my $time1 ;
159
160print "\n$program $version \nfor file $osmName\n\n" ;
161
162#if ($optResult == 0) {
163#       die ("usage...\n") ;
164#}
165
166#
167# PARSING RELATIONS
168# after this step rudimentary data of relations is present.
169# however relation members are not yet evaluated
170#
171print "parsing relations...\n" ;
172openOsmFile ($osmName) ;
173print "- skipping nodes...\n" ;
174skipNodes() ;
175print "- skipping ways...\n" ;
176skipWays() ;
177print "- checking...\n" ;
178
179($relationId, $relationUser, $aRef1, $aRef2) = getRelation () ;
180if ($relationId != -1) {
181        @relationMembers = @$aRef1 ;
182        @relationTags = @$aRef2 ;
183}
184
185while ($relationId != -1) {
186
187        my $name = "" ; 
188        my $type = "" ; 
189        my $boundary = "" ; 
190        my $landArea = "" ; 
191        my $adminLevel = "" ;
192
193        my $i ;
194        # process tags
195        if (scalar (@relationTags) > 0) {
196                for ($i=0; $i<scalar (@relationTags); $i++) {
197                        if ( ${$relationTags[$i]}[0] eq "name") { $name =  ${$relationTags[$i]}[1] ; }
198                        if ( ${$relationTags[$i]}[0] eq "type") { $type =  ${$relationTags[$i]}[1] ; }
199                        if ( ${$relationTags[$i]}[0] eq "boundary") { $boundary =  ${$relationTags[$i]}[1] ; }
200                        if ( ${$relationTags[$i]}[0] eq "admin_level") { $adminLevel =  ${$relationTags[$i]}[1] ; }
201                        if ( ${$relationTags[$i]}[0] eq "land_area") { $landArea =  ${$relationTags[$i]}[1] ; }
202                }
203        }
204        # process interesting tags. evaluate relation at all?   
205        my $eval = 0 ;
206        if (  ( ($boundary ne "") or ($landArea ne "") or ($adminLevel ne "") ) and 
207                ( ($type eq "multipolygon") or ($type eq "boundary")  )  ) { 
208                $eval = 1 ; 
209        }
210        # process members if relation is needed and has members
211        if ( ($eval == 1) and (scalar (@relationMembers) > 0) ) {
212                $relationName{$relationId} = $name ;
213                $relationType{$relationId} = $type ;
214                $relationBoundary{$relationId} = $boundary ;
215                $relationAdminLevel{$relationId} = $adminLevel ;
216                @{$relationWays{$relationId}} = () ;
217                @{$relationRelations{$relationId}} = () ;
218                @{$relationIsIn{$relationId}} = () ;
219                $validRelation{$relationId} = 1 ;
220                $selectedRelation{$relationId} = 1 ;
221                $relationSegments{$relationId} = 0 ;
222                $relationOpen{$relationId} = 0 ;
223                $relationWaysValid{$relationId} = 1 ;
224                if ($verbose) { print "\nfound relation id=$relationId\nname=$name\ntype=$type\nboundary=$boundary\nadminLevel=$adminLevel\nlandArea=$landArea\n" ; }
225                for ($i=0; $i<scalar (@relationMembers); $i++) {
226                        # way?
227                        if ( (${$relationMembers[$i]}[0] eq "way") and ((${$relationMembers[$i]}[2] eq "none") or (${$relationMembers[$i]}[2] eq "outer")) ){ 
228                                push @neededWays, ${$relationMembers[$i]}[1] ; 
229                                push @{$relationWays{$relationId}}, ${$relationMembers[$i]}[1] ; 
230                        }
231                        # relation?
232                        if ( (${$relationMembers[$i]}[0] eq "relation") and ((${$relationMembers[$i]}[2] eq "none") or (${$relationMembers[$i]}[2] eq "outer")) ){ 
233                                if (${$relationMembers[$i]}[1] == $relationId) {
234                                        print "ERROR: relation $relationId contains itself as a member. entry discarded.\n" ;
235                                }
236                                else {
237                                        push @{$relationRelations{$relationId}}, ${$relationMembers[$i]}[1]  ;
238                                }
239                        }
240                }
241        }
242
243        #next relation
244        ($relationId, $relationUser, $aRef1, $aRef2) = getRelation () ;
245        if ($relationId != -1) {
246                @relationMembers = @$aRef1 ;
247                @relationTags = @$aRef2 ;
248        }
249}
250
251closeOsmFile () ;
252
253#
254# GET MORE WAYS out of referenced relations (recursive)
255#
256my $rel ;
257foreach $rel (keys %relationWays) {
258        if (scalar (@{$relationRelations{$rel}}) > 1) {
259                if ($verbose) { print "get relations for relation $rel\n" ; }
260                my (@newWays) = getWays ($rel, 0, @{$relationRelations{$rel}}) ;
261                push @{$relationWays{$rel}}, @newWays ;
262        }
263}
264# now %relationWays contain all needed (recursive) ways of a boundary
265
266#
267# PARSE WAYS FOR NODES
268#
269print "\nparsing ways...\n" ;
270openOsmFile ($osmName) ;
271print "- skipping nodes...\n" ;
272skipNodes() ;
273print "- reading ways...\n" ;
274
275@neededWays = sort { $a <=> $b } @neededWays ;
276
277($wayId, $wayUser, $aRef1, $aRef2) = getWay () ;
278if ($wayId != -1) {
279        @wayNodes = @$aRef1 ;
280        @wayTags = @$aRef2 ;
281}
282while ($wayId != -1) { 
283        my $needed = 0 ;
284        $needed = binSearch ($wayId, \@neededWays ) ;
285        if (scalar (@wayNodes) >= 2) {
286                if ($needed >= 0) {
287                        $wayCount++ ;
288                        @{$wayNodesHash{$wayId}} = @wayNodes ;
289                        push @neededNodes, @wayNodes ;
290                        $invalidWays{$wayId} = 0 ;
291                }
292        }
293        else {
294                # an invalid way itself is no problem first. it will lead to a gap in a boundary if used however...
295                #if ($verbose) { print "ERROR: invalid way (one node only): ", $wayId, "\n" ; }
296                $invalidWayCount++ ;
297                $invalidWays{$wayId} = 1 ;
298        }
299
300        # next way
301        ($wayId, $wayUser, $aRef1, $aRef2) = getWay () ;
302        if ($wayId != -1) {
303                @wayNodes = @$aRef1 ;
304                @wayTags = @$aRef2 ;
305        }
306}
307
308closeOsmFile () ;
309
310if ($verbose) { print "\nthere are $invalidWayCount invalid ways\n\n" ; }
311
312#
313# PARSE NODES FOR POSITIONS
314#
315print "\nparsing nodes...\n" ;
316openOsmFile ($osmName) ;
317
318@neededNodes = sort { $a <=> $b } @neededNodes ;
319
320($nodeId, $nodeLon, $nodeLat, $nodeUser, $aRef1) = getNode () ;
321if ($nodeId != -1) {
322        @nodeTags = @$aRef1 ;
323}
324
325while ($nodeId != -1) {
326        my $needed = 0 ;
327
328        $needed = binSearch ($nodeId, \@neededNodes ) ;
329        if ($needed >= 0) { 
330                $lon{$nodeId} = $nodeLon ; 
331                $lat{$nodeId} = $nodeLat ;
332        }
333
334        # next
335        ($nodeId, $nodeLon, $nodeLat, $nodeUser, $aRef1) = getNode () ;
336        if ($nodeId != -1) {
337                @nodeTags = @$aRef1 ;
338        }
339}
340print "done.\n" ;
341
342#
343# STATS
344#
345print "\n", scalar (keys %relationName), " relations read into memory.\n" ;
346print scalar (keys %wayNodesHash), " ways read into memory.\n" ;
347print scalar (keys %lon), " nodes read into memory.\n\n" ;
348
349#
350# CHECK FOR VALID BOUNDARIES
351#
352print "check for valid boundaries...\n" ;
353my $valid = 0 ; my $invalid = 0 ; 
354foreach $rel (keys %relationWays) {
355
356        my $way ;
357        my $waysValid = 1 ;
358
359        # if the relation ain't got a single way...
360        if (scalar (@{$relationWays{$rel}}) == 0)  { 
361                $waysValid = 0 ;
362                $relationWaysValid{$rel} = 0 ;
363                if ($verbose eq "1") { print "INVALID relation $rel due to no ways\n" ; }
364        }
365
366        # if the boundary contains an invalid way. chances for success are low :-)
367        foreach $way (@{$relationWays{$rel}}) {
368                if ($invalidWays{$way} == 1) { 
369                        $waysValid = 0 ; 
370                        $relationWaysValid{$rel} = 0 ;
371                        if ($verbose eq "1") { print "INVALID RELATION id=$rel, name=$relationName{$rel} due to invalid way $way\n" ; }
372                }
373        }
374
375        # check for multiple usage of ways. checkSegments doesn't like that.
376        my (@temp) = sort (@{$relationWays{$rel}}) ; my $i ;
377        for ($i=0; $i<$#temp; $i++) {
378                if ($temp[$i] == $temp[$i+1]) {
379                        print "ERROR RELATION id=$rel name=$relationName{$rel} contains way $temp[$i] twice\n" ;
380                        $waysValid = 0 ;
381                        $relationWaysValid{$rel} = 0 ;
382                } 
383        }
384
385        # if we do have ways...
386        if (scalar @{$relationWays{$rel}} > 0) {
387                my $segments = 0 ; my $open = 0 ; my @way = () ; 
388                if ($waysValid == 1) {
389                        if ($verbose) { print "call checksegments rel = $rel --- ways = @{$relationWays{$rel}}\n" ; } 
390                        # now let's see if we can build a single closed way out of all these ways...
391                        ($segments, $open, @way) = checkSegments3 ( @{$relationWays{$rel}} ) ; 
392                }
393                if ( ($segments == 1) and ($open == 0) and ($waysValid == 1) ) {
394                        $valid ++ ;
395                        $validRelation {$rel} = 1 ;
396                        @{$completeWay{$rel}} = @way ;
397                        $relationSegments{$rel} = $segments ;
398                        $relationOpen{$rel} = $open ;
399                        if ($verbose) { print "complete and closed way found for relation $rel, name=$relationName{$rel}\n" ; }
400                }
401                else {
402                        $invalid ++ ;
403                        $validRelation {$rel} = 0 ;
404                        $relationSegments{$rel} = $segments ;
405                        $relationOpen{$rel} = $open ;
406                        if ($verbose eq "1") { print "INVALID RELATION id=$rel, name=$relationName{$rel}, segments=$segments, open=$open, waysValid=$waysValid\n" ; }
407                }
408        }
409        else {
410                $invalid ++ ;
411                $validRelation {$rel} = 0 ;
412                print "INVALID RELATION id=$rel, no ways given.\n" ;
413                $relationWaysValid{$rel} = 0 ;
414        }
415
416        # check for admin level given as option
417        if (($adminLevelOpt ne "") and ($adminLevelOpt ne $relationAdminLevel{$rel})) {
418                $selectedRelation {$rel} = 0 ;
419                $adminInvalidCount++ ;
420        }
421}
422print "done.\n" ;
423print "\nTOTAL $valid valid relations, $invalid invalid relations.\n" ;
424print "$adminInvalidCount relations selected by admin level.\n" ;
425print "REMAINING for evaluation: ", $valid - $adminInvalidCount, " relations\n\n" ;
426
427#
428# CHECK IF NEEDED NODES COULD BE FOUND
429#
430print "checking if all needed nodes could be found in osm file...\n" ;
431my $nodesMissing = 0 ; my $node ;
432foreach $node (@neededNodes) {
433        if ( (! (defined ($lon{$node}))) or (!(defined ($lat{$node}))) ) {
434                print "ERROR: lon/lat for node $node missing. node not found or not valid in osm file.\n" ;
435                $nodesMissing = 1 ; my $way ;
436                foreach $way (keys %wayNodesHash) {
437                        my $n2 ;
438                        foreach $n2 (@{$wayNodesHash{$way}}) {
439                                if ($node == $n2) {
440                                        print "       node used in way $way\n" ;
441                                }
442                        }
443                }
444        }
445}
446
447#
448# CHECK IF NEEDED WAYS COULD BE FOUND
449#
450print "checking if all needed ways could be found in osm file...\n" ;
451my $waysMissing = 0 ; my $way ;
452foreach $way (@neededWays) {
453        if ( ! (defined ( @{$wayNodesHash{$way}} ) ) ) {
454                if ($invalidWays{$way}) {
455                        print "WARNING way $way invalid in osm file.\n" ;
456                }
457                else {
458                        print "ERROR: nodes for way $way missing. way not found in osm file.\n" ;
459                        $waysMissing = 1 ;
460                        foreach $rel (keys %relationName) {
461                                my $w2 ;
462                                foreach $w2 (@{$relationWays{$rel}}) {
463                                        if ($way == $w2) {
464                                                print "       way used in relation $rel (directly or indirectly).\n" ;
465                                        }
466                                }
467                        }
468                }
469        }
470}
471
472if ($nodesMissing == 1 ) { 
473        print "ERROR: at least one needed node missing in osm file.\n" ; 
474}
475else {
476        print "all needed nodes found.\n" ;
477}
478if ($waysMissing == 1 ) { 
479        print "ERROR: at least one needed way missing in osm file.\n" ; 
480}
481else {
482        print "all needed ways found.\n" ;
483}
484if ( ($nodesMissing == 1) or ($waysMissing == 1) )  {
485        die ("ERROR: at least one needed node or way missing.\n")
486}
487print "done (node and way check).\n" ;
488
489#
490# CALC LENGTH OF VALID RELATIONS,
491# CALC SIMPLIFIED AND RESIZED WAY IF NEEDED
492#
493print "calc length, build polygons, (simplify, resize)...\n" ; 
494foreach $rel (keys %relationWays) {
495        if ( ($validRelation{$rel}) and ($selectedRelation{$rel}) ) {
496                my (@wayNodes) = @{$completeWay{$rel}} ;
497                my $length = 0 ;
498                my $i ;
499                for ($i = 0; $i<$#wayNodes; $i++) {
500                        $length += distance ($lon{$wayNodes[$i]}, $lat{$wayNodes[$i]}, $lon{$wayNodes[$i+1]}, $lat{$wayNodes[$i+1]}) ;
501                }
502                $relationLength{$rel} = int ($length * 100) / 100 ;
503
504                if ($polyOpt eq "1" ) {
505                        my @poly = () ; my $node ;
506                        foreach $node (@wayNodes) {
507                                push (@poly, [$lon{$node}, $lat{$node}]) ;
508                        }
509                        $relationPolygon{$rel} = Math::Polygon->new(@poly) ;
510                        $relationSize{$rel} = $relationPolygon{$rel}->area ;
511
512                        if ($simplifyOpt eq "1") { 
513                                my ($maxNodes) = int ($relationLength{$rel} * $simplifyNpk ) ; 
514                                $relationPolygonSimplified{$rel} = $relationPolygon{$rel}->simplify (max_points => $maxNodes, same => $simplifySame, slope => $simplifySlope ) ;
515                                if ($verbose) { print "simplify $rel: nodes=", scalar(@wayNodes), " maxNodes=$maxNodes length=$relationLength{$rel}" ; } 
516                                if ($verbose) { print " new node count=", $relationPolygonSimplified{$rel}->nrPoints, "" ; } 
517                                my ($percent) = int ($relationPolygonSimplified{$rel}->nrPoints / scalar(@wayNodes) * 100 ) ;
518                                if ($verbose) { print " new size of polygon=", $percent, "%\n" ; } 
519                        }
520                        if ($resizeOpt eq "1") { 
521                                if ($simplifyOpt eq "1") { 
522                                        my ($x, $y) = center( $relationPolygonSimplified{$rel} ) ;
523                                        $relationPolygonResized{$rel} = $relationPolygonSimplified{$rel}->resize (center => [$x, $y], scale => $resizeFactor) ;
524                                }
525                                else {
526                                        my ($x, $y) = center( $relationPolygon{$rel} ) ;
527                                        $relationPolygonResized{$rel} = $relationPolygon{$rel}->resize (center => [$x, $y], scale => $resizeFactor) ;
528                                }
529                        }
530                }
531        }
532        else {
533                $relationLength{$rel} = 0 ;
534        }
535}
536print "done.\n" ; 
537
538#
539# WRITE POLY FILES IF SPECIFIED
540#
541if ( ($polyBaseName ne "") and ($polyOpt eq "1") ) {
542        print "write poly files...\n" ; 
543        foreach $rel (keys %relationWays) {
544                if ( ($validRelation{$rel}) and ($selectedRelation{$rel}) ) {
545                        my @way ; my $polyFileName = "" ; my @points = () ; my $text = "" ;
546                        if ($verbose) { print "write poly file for relation $rel $relationName{$rel} (", scalar (@points) , " nodes) ...\n" ; }
547
548
549                        if ($simplifyOpt eq "1") { 
550                                $polyFileName = $polyBaseName . ".simplified." . $rel . ".poly" ;
551                                @points = $relationPolygonSimplified{$rel}->points ;
552                                $text = " (SIMPLIFIED)" ;
553                                open ($polyFile, ">", $polyFileName) or die ("can't open poly output file") ;
554                                print $polyFile $relationName{$rel}, $text, "\n" ; # name
555                                print $polyFile "1\n" ;
556                                foreach my $pt ( @points ) {
557                                        printf $polyFile "   %E   %E\n", $pt->[0], $pt->[1] ;
558                                }
559                                print $polyFile "END\n" ;
560                                print $polyFile "END\n" ;
561                                close ($polyFile) ;
562                        }
563
564                        if ($resizeOpt eq "1") { 
565                                $polyFileName = $polyBaseName . ".resized." . $rel . ".poly" ;
566                                @points = $relationPolygonResized{$rel}->points ;
567                                $text = " (RESIZED)" ;
568                                open ($polyFile, ">", $polyFileName) or die ("can't open poly output file") ;
569                                print $polyFile $relationName{$rel}, $text, "\n" ; # name
570                                print $polyFile "1\n" ;
571                                foreach my $pt ( @points ) {
572                                        printf $polyFile "   %E   %E\n", $pt->[0], $pt->[1] ;
573                                }
574                                print $polyFile "END\n" ;
575                                print $polyFile "END\n" ;
576                                close ($polyFile) ;
577                        }
578
579                        $polyFileName = $polyBaseName . "." . $rel . ".poly" ;
580                        @points = $relationPolygon{$rel}->points ;
581
582                        open ($polyFile, ">", $polyFileName) or die ("can't open poly output file") ;
583                        print $polyFile $relationName{$rel}, "\n" ; # name
584                        print $polyFile "1\n" ;
585                        foreach my $pt ( @points ) {
586                                printf $polyFile "   %E   %E\n", $pt->[0], $pt->[1] ;
587                        }
588                        print $polyFile "END\n" ;
589                        print $polyFile "END\n" ;
590                        close ($polyFile) ;
591                }
592        }
593        print "done.\n" ; 
594}
595
596#
597# WRITE PICS IF SPECIFIED
598#
599if ( ($polyBaseName ne "") and ($picOpt eq "1") ) {
600        print "write picture files...\n" ; 
601        foreach $rel (keys %relationWays) {
602                if ( ($validRelation{$rel}) and ($selectedRelation{$rel}) ) {
603                        drawPic ($rel) ;
604                }
605        }
606        print "done.\n" ; 
607}
608#
609# BUILD AND PRINT HIRARCHIES
610#
611if ($hirarchyOpt eq "1") {
612        print "building hirarchies...\n" ;
613        my $rel ; my $rel1 ; my $rel2 ; 
614        foreach $rel1 (keys %relationName) {
615                foreach $rel2 (keys %relationName) {
616                        if ( ($rel1 < $rel2) and ($validRelation{$rel1}) and ($validRelation{$rel2}) and ($selectedRelation{$rel1}) and ($selectedRelation{$rel2}) ) {
617                                my $res ;
618                                if ($simplifyOpt eq "1") {
619                                        $res = isIn ($relationPolygonSimplified{$rel1}, $relationPolygonSimplified{$rel2}) ;
620                                }
621                                else {
622                                        if ($debugOpt eq "1") { print "call isIn $rel1 $rel2\n" ; }
623                                        $res = isIn ($relationPolygon{$rel1}, $relationPolygon{$rel2}) ;
624                                }
625                                if ($res == 2) { push @{$relationIsIn{$rel2}}, $rel1 ; }
626                                if ($res == 1) { push @{$relationIsIn{$rel1}}, $rel2 ; }
627                        }
628                }
629        }
630
631        my ($csvNameHirarchy) = $csvName ;
632        my ($htmlNameHirarchy) = $htmlName ;
633        $csvNameHirarchy =~  s/.csv/.hirarchy.csv/ ;
634        $htmlNameHirarchy =~ s/.htm/.hirarchy.htm/ ;
635
636        open ($htmlFile, ">", $htmlNameHirarchy) or die ("can't open html output file") ;
637        open ($csvFile, ">", $csvNameHirarchy) or die ("can't open csv output file") ;
638
639        printHTMLHeader ($htmlFile, "boundaries by gary68 - hirarchy") ;
640        print $csvFile "Line;RelationId;Name;Type;Boundary;AdminLevel;is_in\n" ;
641        print $htmlFile "<h1>boundary.pl by gary68 - hirarchy</h1>" ;
642        print $htmlFile "<p>Version ", $version, "</p>\n" ;
643        print $htmlFile "<H2>Statistics</H2>\n" ;
644        print $htmlFile "<p>", stringFileInfo ($osmName), "</p>\n" ;
645        print $htmlFile "<h2>Data</h2>" ;
646        printHTMLTableHead ($htmlFile) ;
647        printHTMLTableHeadings ($htmlFile, ("Line", "RelationId", "Name", "Type", "Boundary", "AdminLevel", "is_in")) ;
648
649        my $line = 0 ;
650        # TODO optimize loop!
651        foreach $rel (keys %relationName) {
652                if ( ($validRelation{$rel}) and ($selectedRelation{$rel}) ) {
653                #if (($validRelation{$rel}) and (scalar (@{$relationIsIn{$rel}}) > 0 ) ) {
654                       
655                        my @is_in = () ;
656                        foreach my $r2 ( @{$relationIsIn{$rel}} ) {
657                                push @is_in, [ $r2, $relationSize{$r2} ] ;
658                        }
659                        @is_in = sort { $a->[1] <=> $b->[1] } (@is_in) ;
660                       
661                        $line++ ;
662                        print $csvFile $line, ";" ;
663                        print $csvFile $rel, ";" ;
664                        print $csvFile $relationName{$rel}, ";" ;
665                        print $csvFile $relationType{$rel}, ";" ;
666                        print $csvFile $relationBoundary{$rel}, ";" ;
667                        print $csvFile $relationAdminLevel{$rel}, ";" ;
668
669                        foreach my $r2 (@is_in) {
670                                print $csvFile $r2->[0], ";" ;
671                        }
672                        print $csvFile "\n" ;
673
674                        printHTMLRowStart ($htmlFile) ;
675                        printHTMLCellRight ($htmlFile, $line) ;
676                        printHTMLCellRight ($htmlFile, historyLink ("relation", $rel) . "(osm) " . analyzerLink($rel) . "(analyzer)" ) ;
677                        printHTMLCellLeft ($htmlFile, $relationName{$rel}) ;
678                        printHTMLCellLeft ($htmlFile, $relationType{$rel}) ;
679                        printHTMLCellLeft ($htmlFile, $relationBoundary{$rel}) ;
680                        printHTMLCellLeft ($htmlFile, $relationAdminLevel{$rel}) ;
681
682                        print $htmlFile "<td align=\"left\">\n" ;
683                        foreach my $r2 (@is_in) {
684                                print $htmlFile historyLink ("relation", $r2->[0]), "(osm) ", analyzerLink ($r2->[0]), "(analyzer) " ;
685                                print $htmlFile $relationName{$r2->[0]}, "<br>\n" ;
686                        }
687                        print $htmlFile "</td>\n" ;
688
689                        printHTMLRowEnd ($htmlFile) ;
690
691                }
692        }
693
694        printHTMLTableFoot ($htmlFile) ;
695        printHTMLFoot ($htmlFile) ;
696
697        close ($htmlFile) ;
698        close ($csvFile) ;
699        print "done.\n" ;
700} # hirarchy
701
702
703
704
705#
706# WRITE OVERVIEW FILES, HTML and CSV
707#
708open ($htmlFile, ">", $htmlName) or die ("can't open html output file") ;
709open ($csvFile, ">", $csvName) or die ("can't open csv output file") ;
710
711printHTMLHeader ($htmlFile, "boundaries by gary68") ;
712print $csvFile "Line;RelationId;Name;Type;Boundary;AdminLevel;Length;Nodes;NodesPerKm\n" ;
713print $htmlFile "<h1>boundary.pl by gary68</h1>" ;
714print $htmlFile "<p>Version ", $version, "</p>\n" ;
715print $htmlFile "<H2>Statistics</H2>\n" ;
716print $htmlFile "<p>", stringFileInfo ($osmName), "</p>\n" ;
717print $htmlFile "<h2>Data</h2>" ;
718printHTMLTableHead ($htmlFile) ;
719printHTMLTableHeadings ($htmlFile, ("Line", "RelationId", "Name", "Type", "Boundary", "AdminLevel", "Length", "Nodes", "NodesPerKm")) ;
720
721my $line = 0 ;
722foreach $rel (keys %relationWays) {
723        if ( ($validRelation{$rel}) and ($selectedRelation{$rel}) ) {
724                $line++ ;
725                my $nodesPerKm = int ( scalar ( @{$completeWay{$rel}} / $relationLength{$rel} * 100 ) ) / 100 ;
726                print $csvFile $line, ";" ;
727                print $csvFile $rel, ";" ;
728                print $csvFile "\"", $relationName{$rel}, "\";" ;
729                print $csvFile $relationType{$rel}, ";" ;
730                print $csvFile $relationBoundary{$rel}, ";" ;
731                print $csvFile $relationAdminLevel{$rel}, ";" ;
732                print $csvFile $relationLength{$rel}, ";" ;
733                print $csvFile scalar ( @{$completeWay{$rel}} ), ";" ;
734                print $csvFile $nodesPerKm, "\n" ;
735
736                printHTMLRowStart ($htmlFile) ;
737                printHTMLCellRight ($htmlFile, $line) ;
738                printHTMLCellRight ($htmlFile, historyLink("relation", $rel) . "(osm) " .analyzerLink($rel) . "(analyzer)" ) ;
739                printHTMLCellLeft ($htmlFile, $relationName{$rel}) ;
740                printHTMLCellLeft ($htmlFile, $relationType{$rel}) ;
741                printHTMLCellLeft ($htmlFile, $relationBoundary{$rel}) ;
742                printHTMLCellRight ($htmlFile, $relationAdminLevel{$rel}) ;
743                printHTMLCellRight ($htmlFile, $relationLength{$rel}) ;
744                printHTMLCellRight ($htmlFile, scalar ( @{$completeWay{$rel}} ) ) ;
745                printHTMLCellRight ($htmlFile, $nodesPerKm) ;
746                printHTMLRowEnd ($htmlFile) ;
747
748        }
749}
750printHTMLTableFoot ($htmlFile) ;
751
752print $htmlFile "<h2>Invalid Relations</h2>\n" ;
753print $htmlFile "<p>List reflects the moment the *.osm file was created and a relation may be invalid because one or more ways were clipped in the process of creating the *.osm file.</p>\n" ;
754printHTMLTableHead ($htmlFile) ;
755printHTMLTableHeadings ($htmlFile, ("RelationId", "#segments", "#open segments", "ways valid")) ;
756foreach $rel (keys %relationWays) {
757        if (! $validRelation{$rel}) {
758                printHTMLRowStart ($htmlFile) ;
759                printHTMLCellRight ($htmlFile, historyLink("relation", $rel) . "(osm) " .analyzerLink($rel) . "(analyzer)" ) ;
760                printHTMLCellRight ($htmlFile, $relationSegments{$rel} ) ;
761                printHTMLCellRight ($htmlFile, $relationOpen{$rel} ) ;
762                printHTMLCellRight ($htmlFile, $relationWaysValid{$rel} ) ;
763                printHTMLRowEnd ($htmlFile) ;
764        }
765}
766printHTMLTableFoot ($htmlFile) ;
767
768printHTMLFoot ($htmlFile) ;
769close ($htmlFile) ;
770close ($csvFile) ;
771
772#print "\n$program finished.\n\n";
773print "\n", $program, " ", $osmName, " FINISHED after ", stringTimeSpent (time - $time0), "\n\n" ;
774
775
776
777
778
779
780
781sub checkSegments3 {
782        # sub builds segments for given set of ways.
783        # returns number of segments, number of open segments and complete way if one closed segment was found.
784        my (@ways) = @_ ;
785        my $way ; my $node ;
786        my @openEnds = () ;
787        my $segments = 0 ; my $openSegments = 0 ;
788        my $found = 1 ;
789        my $way1 ; my $way2 ;
790        my $endNodeWay2 ;       my $startNodeWay2 ;
791        my %starts = () ; my %ends = () ;
792        my %wayStart = () ; my %wayEnd = () ;
793        my %wayNodes = () ;
794        my @completeWay = () ;
795
796        #init
797        foreach $way (@ways) {
798                push @{$starts{$wayNodesHash{$way}[0]}}, $way ;
799                push @{$ends{$wayNodesHash{$way}[-1]}}, $way ;
800                $wayStart{$way} = $wayNodesHash{$way}[0] ;
801                $wayEnd{$way} = $wayNodesHash{$way}[-1] ;
802                @{$wayNodes{$way}} = @{$wayNodesHash{$way}} ; # complete...
803                #print "    cs way = $way --- nodes = @{$wayNodesHash{$way}}\n" ;
804        }
805
806        while ($found == 1) {
807                $found = 0 ;
808
809                # check start/start
810                loop1:
811                foreach $node (keys %starts) {
812
813                        # if node with more than 1 connecting way...
814                        if (scalar (@{$starts{$node}}) > 1) {
815                                $way1 = ${$starts{$node}}[0] ; $way2 = ${$starts{$node}}[1] ;
816                                #print "merge start/start $way1 and $way2 at node $node\n" ;
817
818                                # complete
819                                @{$wayNodes{$way1}} = ( reverse ( @{$wayNodes{$way2}}[1..$#{$wayNodes{$way2}}] ), @{$wayNodes{$way1}} ) ;
820
821                                $endNodeWay2 = $wayEnd{$way2} ;
822                                #print "end node way2 = $endNodeWay2\n" ;
823
824                                # way1 gets new start: end way2
825                                push @{$starts{ $endNodeWay2 }}, $way1 ;
826                                $wayStart{$way1} = $endNodeWay2 ;
827
828                                # remove end way2
829                                if (scalar (@{$ends{$endNodeWay2}}) == 1) {
830                                        delete $ends{$endNodeWay2} ;
831                                        #print "$endNodeWay2 removed from end hash\n" ;
832                                }
833                                else {
834                                        @{$ends{$endNodeWay2}} = removeElement ($way2, @{$ends{$endNodeWay2}}) ;
835                                        #print "way $way2 removed from node $endNodeWay2 from end hash\n" ;
836                                }
837                               
838                                # remove way2
839                                delete $wayEnd{$way2} ;
840                                delete $wayStart{$way2} ;
841                                delete $wayNodes{$way2} ;
842
843                                # remove connecting starts
844                                if (scalar @{$starts{$node}} == 2) {
845                                        delete $starts{$node} ;
846                                        #print "$node removed from start hash\n" ;
847                                }
848                                else {
849                                        @{$starts{$node}} = @{$starts{$node}}[2..$#{$starts{$node}}] ;
850                                        #print "first two elements removed from start hash node = $node\n" ;
851                                }
852                                #print "\n" ;
853                                $found = 1 ; 
854                                last loop1 ;
855                        }
856                }
857
858                # check end/end
859                if (!$found) {
860                        loop2:
861                        foreach $node (keys %ends) {
862
863                                # if node with more than 1 connecting way...
864                                if (scalar @{$ends{$node}} > 1) {
865                                        $way1 = ${$ends{$node}}[0] ; $way2 = ${$ends{$node}}[1] ;
866                                        #print "merge end/end $way1 and $way2 at node $node\n" ;
867       
868                                        # complete
869                                        @{$wayNodes{$way1}} = ( @{$wayNodes{$way1}}, reverse ( @{$wayNodes{$way2}}[0..$#{$wayNodes{$way2}}-1] ) )  ;
870
871                                        $startNodeWay2 = $wayStart{$way2} ;
872                                        #print "start node way2 = $startNodeWay2\n" ;
873       
874                                        # way1 gets new end: start way2
875                                        push @{$ends{ $startNodeWay2 }}, $way1 ;
876                                        $wayEnd{$way1} = $startNodeWay2 ;
877       
878                                        # remove start way2
879                                        if (scalar (@{$starts{$startNodeWay2}}) == 1) {
880                                                delete $starts{$startNodeWay2} ;
881                                                #print "$startNodeWay2 removed from start hash\n" ;
882                                        }
883                                        else {
884                                                @{$starts{$startNodeWay2}} = removeElement ($way2, @{$starts{$startNodeWay2}}) ;
885                                                #print "way $way2 removed from node $startNodeWay2 from start hash\n" ;
886                                        }
887                               
888                                        # remove way2
889                                        delete $wayEnd{$way2} ;
890                                        delete $wayStart{$way2} ;
891                                        delete $wayNodes{$way2} ;
892
893                                        # remove connecting ends
894                                        if (scalar @{$ends{$node}} == 2) {
895                                                delete $ends{$node} ;
896                                                #print "$node removed from end hash\n" ;
897                                        }
898                                        else {
899                                                @{$ends{$node}} = @{$ends{$node}}[2..$#{$ends{$node}}] ;
900                                                #print "first two elements removed from end hash node = $node\n" ;
901                                        }
902                                        #print "\n" ;
903                                        $found = 1 ; 
904                                        last loop2 ;
905                                }
906                        }
907                }
908
909
910                # check start/end
911                if (!$found) {
912                        my $wayFound = 0 ;
913                        loop3:
914                        foreach $node (keys %starts) {
915                                if (exists ($ends{$node})) {
916                                        #look for different! ways
917                                        my (@startingWays) = @{$starts{$node}} ;
918                                        my (@endingWays) = @{$ends{$node}} ;
919                                        my $w1 ; my $w2 ;
920                                        loop4:
921                                        foreach $w1 (@startingWays) {
922                                                foreach $w2 (@endingWays) {
923                                                        if ($w1 != $w2) {
924                                                                $wayFound = 1 ;
925                                                                $way1 = $w1 ; 
926                                                                $way2 = $w2 ; # merge w1 and w2
927                                                                #print "start/end: merge ways $way1 and $way2 connected at node $node\n" ;
928                                                                last loop4 ;
929                                                        }
930                                                }
931                                        } # look for ways
932                                        if ($wayFound) {
933                                                #print "way $way1 start $wayStart{$way1} end $wayEnd{$way1}\n" ;
934                                                #print "way $way2 start $wayStart{$way2} end $wayEnd{$way2}\n" ;
935
936                                                # way1 gets new start: start way2
937                                                $wayStart{$way1} = $wayStart{$way2} ;
938                                                my ($way2StartNode) = $wayStart{$way2} ;
939
940                                                # complete
941                                                @{$wayNodes{$way1}} = ( @{$wayNodes{$way2}}[0..$#{$wayNodes{$way2}}-1], @{$wayNodes{$way1}} ) ;
942
943                                                push @{$starts{$way2StartNode}}, $way1 ;
944                                                #print "way $way1 added to starts for node $way2StartNode\n" ;
945
946                                                # remove start way1
947                                                if (scalar (@{$starts{$node}}) == 1) {
948                                                        delete $starts{$node} ;
949                                                        #print "$way1 removed from start hash for node $node\n" ;
950                                                }
951                                                else {
952                                                        @{$starts{$node}} = removeElement ($way1, @{$starts{$node}}) ;
953                                                        #print "$way1 removed from start hash for node $node\n" ;
954                                                }
955
956                                                #remove end way2
957                                                if (scalar (@{$ends{$node}}) == 1) {
958                                                        delete $ends{$node} ;
959                                                        #print "$way2 removed from end hash for node $node\n" ;
960                                                }
961                                                else {
962                                                        @{$ends{$node}} = removeElement ($way2, @{$ends{$node}}) ;
963                                                        #print "$way2 removed from end hash for node $node\n" ;
964                                                }
965                                                #remove start way2
966                                                if (scalar (@{$starts{$way2StartNode}}) == 1) {
967                                                        delete $starts{$way2StartNode} ;
968                                                        #print "$way2 removed from start hash for node $way2StartNode\n" ;
969                                                }
970                                                else {
971                                                        @{$starts{$way2StartNode}} = removeElement ($way2, @{$starts{$way2StartNode}}) ;
972                                                        #print "$way2 removed from start hash for node $way2StartNode\n" ;
973                                                }
974
975                                                # remove way2
976                                                delete $wayEnd{$way2} ;
977                                                delete $wayStart{$way2} ;
978                                                delete $wayNodes{$way2} ;
979                                                #print "way $way2 removed from waystart and wayend hashes\n" ;
980
981                                                #print "\n" ;
982                                                $found = 1 ; 
983                                                last loop3 ;
984                                        }
985                                }
986                        }
987                }
988        }
989
990        # evaluation
991
992
993        #print "\nSUB RESULT\n" ;
994        foreach $way (keys %wayStart) {
995                #print "way $way start $wayStart{$way} end $wayEnd{$way}\n" ;
996                if ($wayStart{$way} != $wayEnd{$way}) {
997                        $openSegments++ ;
998                        #print "   open!\n" ;
999                        push @openEnds, $wayStart{$way}, $wayEnd{$way} ;
1000                }
1001        }
1002        #print "SUB RESULT END\n" ;
1003
1004        # return complete way
1005        if ( (scalar(keys %wayStart) == 1) and ($openSegments == 0) ) {
1006                foreach $way1 (keys %wayStart) {
1007                        @completeWay = @{$wayNodes{$way1}} ;
1008                }
1009        }
1010        else {
1011                @completeWay = () ;
1012        }
1013
1014        return (scalar (keys %wayStart), $openSegments, @completeWay) ;
1015}
1016
1017sub removeElement {
1018        # sub removes a single value (once) from an array
1019        my ($element, @array) = @_ ;
1020        my @arrayNew = () ;
1021        my $pos = -1 ; my $i ;
1022        for ($i=0; $i<=$#array; $i++) { if ($array[$i] == $element) { $pos = $i ; } }
1023        if ($pos != -1) {
1024                if ($pos == 0) {
1025                        @arrayNew = @array[1..$#array] ;
1026                }
1027                if ($pos == $#array) {
1028                        @arrayNew = @array[0..$#array-1] ;
1029                }
1030                if ( ($pos > 0) and ($pos < $#array) ) {
1031                        @arrayNew = @array[0..$pos-1, $pos+1..$#array] ;
1032                }
1033        }
1034        return @arrayNew ;
1035}
1036
1037
1038sub drawPic {
1039        # draws simple picture of relation/boundary. original and possibly simplified/resized boundary.
1040        my ($rel) = shift ;
1041        my $buffer = 0.1 ;
1042        my $lonMin = 999 ;
1043        my $latMin = 999 ;
1044        my $lonMax = -999 ; 
1045        my $latMax = -999 ; 
1046        my $node ;
1047        foreach $node (@{$completeWay{$rel}}) {
1048                if ($lon{$node} > $lonMax) { $lonMax = $lon{$node} ; }
1049                if ($lat{$node} > $latMax) { $latMax = $lat{$node} ; }
1050                if ($lon{$node} < $lonMin) { $lonMin = $lon{$node} ; }
1051                if ($lat{$node} < $latMin) { $latMin = $lat{$node} ; }
1052        }
1053        $lonMin = $lonMin - ($buffer * ($lonMax - $lonMin)) ;
1054        $latMin = $latMin - ($buffer * ($latMax - $latMin)) ;
1055        $lonMax = $lonMax + ($buffer * ($lonMax - $lonMin)) ;
1056        $latMax = $latMax + ($buffer * ($latMax - $latMin)) ;
1057
1058        initGraph ($picSize, $lonMin, $latMin, $lonMax, $latMax) ;
1059       
1060        my @coordinates = () ; my $pt ;
1061        foreach $pt ($relationPolygon{$rel}->points) {
1062                push @coordinates, $pt->[0], $pt->[1] ;
1063        }
1064        drawWay ("green", 3, @coordinates) ;
1065
1066        if ($simplifyOpt eq "1") {     
1067                @coordinates = () ;
1068                foreach $pt ($relationPolygonSimplified{$rel}->points) {
1069                        push @coordinates, $pt->[0], $pt->[1] ;
1070                }
1071                drawWay ("blue", 1, @coordinates) ;
1072        }
1073
1074        if ($resizeOpt eq "1") {       
1075                @coordinates = () ;
1076                foreach $pt ($relationPolygonResized{$rel}->points) {
1077                        push @coordinates, $pt->[0], $pt->[1] ;
1078                }
1079                drawWay ("red", 1, @coordinates) ;
1080        }
1081
1082        drawNodeCircle (center ($relationPolygon{$rel}), "black", 4) ;
1083
1084        drawHead ($program . " ". $version . " by Gary68" . " RelId = " . $rel . " name = " . $relationName{$rel}, "black", 3) ;
1085        drawFoot ("data by openstreetmap.org" . " " . $osmName . " " .ctime(stat($osmName)->mtime), "gray", 3) ;
1086        drawLegend (3, "Center", "black", "Resized", "red", "Simplified", "blue", "Original", "green") ;
1087        drawRuler ("black") ;
1088        writeGraph ($polyBaseName . "." . $rel . ".png") ;
1089}
1090
1091sub getWays {
1092        # sub gets all ways of given relation and all ways of referenced relations, recursive
1093        my ($startingRelation, $level, @relations) = @_ ;
1094        my @result = () ;
1095
1096        if ($verbose) { print "getways called for starting relation $startingRelation with members: @relations\n" ; }
1097        if ($level > $maxNestingLevel) { 
1098                die ("ERROR: relations nested deeper than $maxNestingLevel levels, maybe a loop? starting relation is $startingRelation.\n") ;
1099        }
1100
1101        my $rel ;       
1102        foreach $rel (@relations) {
1103                if (defined ($relationName{$rel})) {
1104                        push @result, @{$relationWays{$rel}} ;
1105                        if (scalar (@{$relationRelations{$rel}}) > 0) {
1106                                my $rel2 ;
1107                                foreach $rel2 (@{$relationRelations{$rel}}) { # could be done without loop, pass whole array...
1108                                        push @result, getWays ($startingRelation, $level+1, $rel2) ;
1109                                }
1110                        }
1111                }
1112                else {
1113                        print "ERROR. Nested relation id=$rel not found or not tagged correctly.\n" ;
1114                }
1115        }
1116        if ($verbose) { print "  getways result: @result\n" ; }
1117        return @result ;
1118}
1119
1120sub isIn {
1121        # check if polygon 1 is in polygon 2 or vice versa
1122        # return 0 = neither
1123        #        1 = p1 is in p2
1124        #        2 = p2 is in p1
1125        my ($p1, $p2) = @_ ;
1126       
1127        if ($debugOpt eq "1") { print "is in called: $p1 $p2\n" ; }
1128
1129        my $p1In2 = 1 ;
1130        first:
1131        foreach my $pt ($p1->points) {
1132                if ($p2->contains ($pt) ) {
1133                        # ok
1134                }
1135                else {
1136                        $p1In2 = 0 ;
1137                        last first ;
1138                }
1139        }
1140
1141        my $p2In1 = 1 ;
1142        second:
1143        foreach my $pt ($p2->points) {
1144                if ($p1->contains ($pt) ) {
1145                        # ok
1146                }
1147                else {
1148                        $p2In1 = 0 ;
1149                        last second ;
1150                }
1151        }
1152
1153        if ($p1In2 == 1) {
1154                return 1 ;
1155        }
1156        elsif ($p2In1 == 1) {
1157                return 2 ;
1158        }
1159        else {
1160                return 0 ;
1161        }
1162
1163}
1164
1165sub center {
1166        my ($polygon) = shift ;
1167        my $lonSum = 0 ;
1168        my $latSum = 0 ;
1169        my $number = 0 ;
1170
1171        foreach my $pt ($polygon->points) {
1172                $lonSum += $pt->[0] ;
1173                $latSum += $pt->[1] ;
1174                $number ++ ;
1175        }
1176        return ($lonSum/$number, $latSum/$number) ;
1177}
Note: See TracBrowser for help on using the repository browser.