270 lines
10 KiB
Perl
270 lines
10 KiB
Perl
#
|
|
# PERL mapweaver module by gary68
|
|
#
|
|
# Copyright(C)2011, Gerhard Schwanz
|
|
#
|
|
# 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
|
|
# Free Software Foundation; either version 3 of the License, or(at your option)any later version.
|
|
#
|
|
# This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
|
# FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
|
|
#
|
|
# You should have received a copy of the GNU General Public License along with this program; if not, see <http://www.gnu.org/licenses/>
|
|
#
|
|
|
|
|
|
package mwCoastLines;
|
|
use strict; use warnings;
|
|
use Math::Polygon; use List::Util qw[min max];
|
|
|
|
use mwMap;
|
|
use mwFile;
|
|
use mwConfig;
|
|
use mwMisc;
|
|
|
|
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
|
|
|
|
require Exporter;
|
|
|
|
@ISA = qw(Exporter AutoLoader);
|
|
|
|
@EXPORT = qw(processCoastLines
|
|
|
|
);
|
|
|
|
|
|
sub nearestPoint{#
|
|
# accepts x/y coordinates and returns nearest point on border of map to complete cut coast ways
|
|
#
|
|
my $ref = shift;
|
|
my $x = $ref->[0];
|
|
my $y = $ref->[1];
|
|
my $xn; my $yn;
|
|
my $min = 99999;
|
|
# print " NP: initial $x $y\n";
|
|
my($xmax, $ymax)= getDimensions();
|
|
# print " NP: dimensions $xmax $ymax\n";
|
|
if(abs($xmax-$x)<$min){# right
|
|
$xn = $xmax;
|
|
$yn = $y;
|
|
$min = abs($xmax-$x);
|
|
} if(abs($ymax-$y)<$min){# bottom
|
|
$xn = $x;
|
|
$yn = $ymax;
|
|
$min = abs($ymax-$y);
|
|
} if(abs($x)<$min){# left
|
|
$xn = 0;
|
|
$yn = $y;
|
|
$min = abs($x);
|
|
} if(abs($y)< $min){# top
|
|
$xn = $x;
|
|
$yn = 0;
|
|
} # print " NP: final $xn $yn\n";
|
|
my @a =($xn, $yn);
|
|
return \@a;
|
|
}sub nextPointOnBorder{#
|
|
# accepts x/y coordinates and returns next point on border - to complete coast rings with other polygons and corner points
|
|
# hints if returned point is a corner
|
|
#
|
|
# right turns
|
|
my($x, $y)= @_;
|
|
my($xn, $yn);
|
|
my $corner = 0;
|
|
my($xmax, $ymax)= getDimensions();
|
|
if($x == $xmax){# right border
|
|
if($y < $ymax){ $xn = $xmax; $yn = $y + 1;
|
|
} else{ $xn = $xmax - 1; $yn = $ymax;
|
|
}} else{ if($x == 0){# left border
|
|
if($y > 0){ $xn = 0; $yn = $y - 1;
|
|
} else{ $xn = 1; $yn = 0;
|
|
} } else{ if($y == $ymax){# bottom border
|
|
if($x > 0){ $xn = $x - 1; $yn = $ymax;
|
|
} else{ $xn = 0; $yn = $ymax - 1;
|
|
} } else{ if($y == 0){# top border
|
|
if($x < $xmax){ $xn = $x + 1; $yn = 0;
|
|
} else{ $xn = $xmax; $yn = 1;
|
|
} } } }} # print "NPOB: $x, $y --- finito $xn $yn\n";
|
|
|
|
if(($xn == 0)and($yn == 0)){$corner = 1;} if(($xn == 0)and($yn == $ymax)){$corner = 1;} if(($xn == $xmax)and($yn == 0)){$corner = 1;} if(($xn == $xmax)and($yn == $ymax)){$corner = 1;}
|
|
return($xn, $yn, $corner);
|
|
}
|
|
# ---------------------------------------------------------------------------------
|
|
|
|
sub processCoastLines{ print "check and process coastlines...\n";
|
|
|
|
my $ref = shift; # ref to all coast ways
|
|
my @allWays = @$ref;
|
|
|
|
if(cv('debug')){
|
|
print "COAST: " . scalar(@allWays). " coast ways initially found.\n";
|
|
print "COAST: ways: @allWays\n\n";
|
|
}
|
|
|
|
my($lonRef, $latRef)= getNodePointers();
|
|
my($nodesRef, $tagRef)= getWayPointers();
|
|
|
|
# check coast ways. eliminate invisible ways. eliminate points outside map.
|
|
my @newWays =();
|
|
foreach my $w(@allWays){ my @nodes = @{$$nodesRef{$w}};
|
|
|
|
my $allIn = 1;
|
|
my $allOut = 1;
|
|
foreach my $n(@nodes){ if(pointInMap($n)){ $allOut = 0;
|
|
} else{ $allIn = 0;
|
|
} }
|
|
if($allIn){ # use way as it is
|
|
push @newWays, $w;
|
|
print "COAST: way $w will be used unmodified.\n" if cv('debug');
|
|
} elsif($allOut){ # do nothing
|
|
print "COAST: way $w will NOT be used. outside map.\n" if cv('debug');} } else{ # eliminate all outside nodes at start and end of way, then use new way
|
|
|
|
# eliminate outsides at start
|
|
shift @nodes while((scalar(@nodes)>= 1)and not pointInMap($nodes[0]));
|
|
# eliminate outsides at end
|
|
while((scalar @nodes >= 1)and not pointInMap($nodes[-1])){ pop @nodes;
|
|
}
|
|
if(scalar @nodes >= 2){ @{$$nodesRef{$w}}= @nodes;
|
|
push @newWays, $w;
|
|
if(cv('debug')eq "1"){print "COAST: modified way $w will be used.\n";} } else{ if(cv('debug')eq "1"){print "COAST: way $w too short now.\n";} } }
|
|
}
|
|
@allWays = @newWays;
|
|
if(cv('debug')eq "1"){
|
|
print "\nCOAST: " . scalar(@allWays). " coast ways will be used.\n";
|
|
print "COAST: ways: @allWays\n\n";
|
|
}
|
|
if(scalar @allWays > 0){ # build rings
|
|
my($refWays, $refNodes)= buildRings(\@allWays, 0);
|
|
my @ringNodes = @$refNodes; # contains all nodes of rings // array of arrays !
|
|
print "COAST: " . scalar(@ringNodes). " rings found.\n" if cv('debug');
|
|
|
|
# convert rings to coordinate system
|
|
my @ringCoordsOpen =(); my @ringCoordsClosed =();
|
|
for(my $i=0; $i<=$#ringNodes; $i++){ # print "COAST: initial ring $i\n";
|
|
my @actualCoords =();
|
|
foreach my $node(@{$ringNodes[$i]}){ push @actualCoords, [convert($$lonRef{$node}, $$latRef{$node})];
|
|
} if(${$ringNodes[$i]}[0] == ${$ringNodes[$i]}[-1]){ push @ringCoordsClosed, [@actualCoords]; # islands
|
|
} else{ push @ringCoordsOpen, [@actualCoords];
|
|
} # printRingCoords(\@actualCoords);
|
|
my $num = scalar @actualCoords;
|
|
print "COAST: initial ring $i - $actualCoords[0]->[0],$actualCoords[0]->[1] -->> $actualCoords[-1]->[0],$actualCoords[-1]->[1] nodes: $num\n" if cv('debug');
|
|
}
|
|
if(cv('debug')eq "1"){print "COAST: add points on border...\n";} foreach my $ring(@ringCoordsOpen){ # print "COAST: ring $ring with border nodes\n";
|
|
# add first point on border
|
|
my $ref = nearestPoint($ring->[0]);
|
|
my @a = @$ref;
|
|
unshift @$ring, [@a];
|
|
# add last point on border
|
|
$ref = nearestPoint($ring->[-1]);
|
|
@a = @$ref;
|
|
push @$ring, [@a];
|
|
# printRingCoords($ring);
|
|
}
|
|
my @islandRings = @ringCoordsClosed;
|
|
print "COAST: " . scalar(@islandRings). " islands found.\n" if cv('debug');
|
|
@ringCoordsClosed =();
|
|
|
|
# process ringCoordsOpen
|
|
# add other rings, corners...
|
|
while(scalar @ringCoordsOpen > 0){# as long as there are open rings
|
|
print "COAST: building ring...\n" if(cv('debug');
|
|
my $ref = shift @ringCoordsOpen; # get start ring
|
|
my @actualRing = @$ref;
|
|
|
|
my $closed = 0; # mark as not closed
|
|
my $actualX = $actualRing[-1]->[0];
|
|
my $actualY = $actualRing[-1]->[1];
|
|
|
|
my $actualStartX = $actualRing[0]->[0];
|
|
my $actualStartY = $actualRing[0]->[1];
|
|
|
|
print "COAST: actual and actualStart $actualX, $actualY - $actualStartX, $actualStartY\n" if cv('debug');
|
|
|
|
my $corner;
|
|
while(!$closed){# as long as this ring is not closed
|
|
($actualX, $actualY, $corner)= nextPointOnBorder($actualX, $actualY);
|
|
# print " actual $actualX, $actualY\n";
|
|
my $startFromOtherPolygon = -1;
|
|
# find matching ring if there is another ring
|
|
if(scalar(@ringCoordsOpen)> 0){ for(my $i=0; $i <= $#ringCoordsOpen; $i++){ my @test = @{$ringCoordsOpen[$i]};
|
|
# print " test ring $i: ", $test[0]->[0], " " , $test[0]->[1] , "\n";
|
|
if(($actualX == $test[0]->[0])and($actualY == $test[0]->[1])){ $startFromOtherPolygon = $i;
|
|
print "COAST: matching start other polygon found i= $i\n" if cv('debug');
|
|
} } } # process matching polygon, if present
|
|
if($startFromOtherPolygon != -1){# start from other polygon{ # append nodes
|
|
# print "ARRAY TO PUSH: @{$ringCoordsOpen[$startFromOtherPolygon]}\n";
|
|
push @actualRing, @{$ringCoordsOpen[$startFromOtherPolygon]};
|
|
# set actual
|
|
$actualX = $actualRing[-1]->[0];
|
|
$actualY = $actualRing[-1]->[1];
|
|
# drop p2 from opens
|
|
splice @ringCoordsOpen, $startFromOtherPolygon, 1;
|
|
print "COAST: openring $startFromOtherPolygon added to actual ring\n" if cv('debug');
|
|
} else{ if($corner){# add corner to actual ring
|
|
push @actualRing, [$actualX, $actualY];
|
|
print "COAST: corner $actualX, $actualY added to actual ring\n" if cv('debug');
|
|
} } # check if closed
|
|
if(($actualX == $actualStartX)and($actualY == $actualStartY)){ $closed = 1;
|
|
push @actualRing, [$actualX, $actualY];
|
|
push @ringCoordsClosed, [@actualRing];
|
|
print "COAST: ring now closed and moved to closed rings.\n" if cv('debug');
|
|
} }# !closed
|
|
}# open rings
|
|
|
|
my $color = cv('oceancolor');
|
|
|
|
# build islandRings polygons
|
|
print "OCEAN: building island polygons\n" if cv('debug');
|
|
my @islandPolygons =();
|
|
if(scalar @islandRings > 0){ for(my $i=0; $i<=$#islandRings; $i++){ my @poly =();
|
|
foreach my $node(@{$islandRings[$i]}){ push @poly, [$node->[0], $node->[1]];
|
|
} my($p)= Math::Polygon->new(@poly);
|
|
$islandPolygons[$i] = $p;
|
|
} }
|
|
# build ocean ring polygons
|
|
if(cv('debug')eq "1"){print "OCEAN: building ocean polygons\n";} my @oceanPolygons =();
|
|
if(scalar(@ringCoordsClosed)> 0){ for(my $i=0; $i<=$#ringCoordsClosed; $i++){ my @poly =();
|
|
foreach my $node(@{$ringCoordsClosed[$i]}){ push @poly, [$node->[0], $node->[1]];
|
|
} my($p)= Math::Polygon->new(@poly);
|
|
$oceanPolygons[$i] = $p;
|
|
} } else{ if(scalar(@islandRings)> 0){ if(cv('debug')eq "1"){print "OCEAN: build ocean rect\n";} my @ocean =();
|
|
my($x, $y)= getDimensions();
|
|
push @ocean, [0,0], [$x,0], [$x,$y], [0,$y], [0,0];
|
|
push @ringCoordsClosed, [@ocean];
|
|
my($p)= Math::Polygon->new(@ocean);
|
|
push @oceanPolygons, $p;
|
|
} }
|
|
# finally create pathes for SVG
|
|
for(my $i=0; $i<=$#ringCoordsClosed; $i++){ # foreach my $ring(@ringCoordsClosed){ my @ring = @{$ringCoordsClosed[$i]};
|
|
my @array =();
|
|
my @coords =();
|
|
foreach my $c(@ring){ push @coords, $c->[0], $c->[1];
|
|
} push @array, [@coords];
|
|
if(scalar @islandRings > 0){ for(my $j=0; $j<=$#islandRings; $j++){ # island in ring? 1:1 and coast on border?
|
|
# if(isIn($islandPolygons[$j], $oceanPolygons[$i])== 1){ if((isIn($islandPolygons[$j], $oceanPolygons[$i])== 1)or
|
|
((scalar @islandRings == 1)and(scalar @ringCoordsClosed == 1))){ if(cv('debug')eq "1"){print "OCEAN: island $j in ocean $i\n";} my @coords =();
|
|
foreach my $c(@{$islandRings[$j]}){ push @coords, $c->[0], $c->[1];
|
|
} push @array, [@coords];
|
|
} } }
|
|
|
|
# drawAreaOcean($color, \@array);
|
|
my $svgText = "fill=\"$color\" ";
|
|
drawArea($svgText, "none", \@array, 0, "base");
|
|
|
|
}}}
|
|
sub pointInMap{ my($n)= shift;
|
|
my($sizeX, $sizeY)= getDimensions();
|
|
my($lonRef, $latRef)= getNodePointers();
|
|
|
|
my($x, $y)= convert($$lonRef{$n}, $$latRef{$n});
|
|
|
|
my $ok = 0;
|
|
if(($x >= 0)and
|
|
($x <= $sizeX)and
|
|
($y >= 0)and
|
|
($y <= $sizeY)){ $ok = 1;
|
|
} return $ok;
|
|
}
|
|
1;
|
|
|
|
|