This library have a serious problem... don't return what polygons are holes after a difference operation.
I tried make a few of XS programming last summer, but don't succes.
So, the solution are to read the stringfy out of the operation.
This example is for to normalize polygons (remove artifacts and split polygon with only a vertice common into more polygons): the trick is subtract a polygon with the dimensions of all space or work (width x height) and read the result.
sub Normaliza
{
say "Normalizar polígonos" if DEBUG;
# Recorremos todos los polígonos y le restamos un polígono cer
+o
# El resultado se almacenará como nuevos polígonos
my %NewContornos;
my $Ancho = 400;
my $Alto = 200;
my $c;
my $d;
foreach my $base ( sort { $a <=> $b } keys %Contornos )
{
# Para todos los contornos de ese valor
foreach my $i ( 0..$#{$Contornos{$base}} )
{
$c++;
# Creamos objeto polígono base
my $gpc_base = Math::Geometry::Planar::GPC::Po
+lygon->new();
$gpc_base->add_polygon(\@{$Contornos{$base}[$i
+][0]}, 0);
# Idem para el polígono a restart
my $gpc_sup = Math::Geometry::Planar::GPC::Pol
+ygon->new();
$gpc_sup->add_polygon(
[
[ $Ancho+0, $Alto+0 ], [ $Ancho+1, $Al
+to+0 ],
[ $Ancho+1, $Alto+1 ], [ $Ancho+0, $Al
+to+1 ],
], 0);
# Calcular diferencias
my $gpc_res = $gpc_base->clip_to($gpc_sup, 'DI
+FFERENCE');
# Almacenar resultado, todos los polígonos enc
+ontrados
my @p = $gpc_res->get_polygons;
foreach my $poly ( 0..$#p )
{
push @{ $NewContornos{$base} }, [ [ @{
+ clone(\@{$p[$poly]}) } ] ];
$d++;
}
}
}
say "\t$c -> $d" if DEBUG;
%Contornos = %{ clone(\%NewContornos) };
}
Okey... is only a difference operation...
Other hard example... A difference between two polygons. The result will have holes (or no). The result of difference operation is a list of polygons, AND we hope that GPC library return the holes BEFORE the points of polygon father, so is not necessary to read the stringfy return of operation:
sub Diferencias
{
# Cálculo de las diferencias entre dos polígonos
my ($base,$i,$sup,$j) = @_;
# Creamos objeto polígono base
my $gpc_base = Math::Geometry::Planar::GPC::Polygon->new();
# Añadir primero el contorno principal
$gpc_base->add_polygon(\@{$Contornos{$base}[$i][0]}, 0);
# Añadir luego los agujeros que tenga
my $num_pol = @{$Contornos{$base}[$i]};
foreach my $agujero ( 1 .. $num_pol-1 )
{
$gpc_base->add_polygon(\@{$Contornos{$base}[$i][$aguje
+ro]}, 1);
}
# Idem para el polígono a restart
my $gpc_sup = Math::Geometry::Planar::GPC::Polygon->new();
$gpc_sup->add_polygon(\@{$Contornos{$sup}[$j][0]}, 0);
# Calcular diferencias
my $gpc_res = $gpc_base->clip_to($gpc_sup, 'DIFFERENCE');
undef $gpc_base;
undef $gpc_sup;
my $res = $gpc_res->as_string();
# Si no hay di
+ferencias, salir inmediatamente
# If the result of operation is null, the two polygons aren't
+coincidences.
return if $res eq '';
# Almacenar resultado
my @p = $gpc_res->get_polygons;
@{$Contornos{$base}[$i]} = (); # A new definition of
+this contour
foreach my $poly ( 0..$#p )
{
# HERE ARE THE TRICK:
# WE READ THE @p LIST OF POLYGONS RESULT OF DIFFERENCE
+ OPERATION ->and<-
# HOPE THIS N-1 ->FIRST<- POLYGONS ARE THE HOLES OF TH
+E BIGGER POLYGON, THAT
# THESE POINTS ARE IN THE ->LAST<- POLYGON OF @p LIST.
# SO, WE READ THE LIST IN ->REVERSE<- ($#p-$poly) TO R
+EAD FIRST THE BIG POLYGON (the convex hull)
# AND NEXT, THE HOLES.
# We need to use the clone method of Clone module to m
+ake a copy of all struct return by gpc, because
# are freed afterwards.
# Here, I'm storing the points in a 4D struct:
# $base is the value (altitude) of the contour base w
+e are subtracting $sup contour
# $i is the number of contour into $base value contou
+rs
# $j is the number of contour into $sup value contour
+s
# %Contornos is a hash of arrays to arrays to arrays.
# Every key of %Contornos is a altitude value (or the
+physic value you set to the contours)
# Every altitude value is an array of contours of the
+same physic value ($base).
# Every $i-contour of $base value is an array of polyg
+ons ($poly).
# -> THE FIRST POLYGON IS THE 'BIG' POLYGON AND NEXT
+ ARE THE HOLES OF THIS POLYGON <-
# And every polygon is an array of points (the parent
+@{}):
@{ $Contornos{$base}[$i][$poly] } = @{ clone(\@{$p[$#p
+ - $poly]}) };
# # (These lines work the same the one above)
# my $k = $#p - $poly;
# foreach my $j ( @{$p[$k]} )
# {
# $Contornos{$base}[$i][$poly][$j][0] = $p[$k][$
+j][0];
# $Contornos{$base}[$i][$poly][$j][1] = $p[$k][$
+j][1];
# }
}
# important: free memory
undef $gpc_res;
}
Other solution is to use the modulo Math::Geometry::Planar. To Make a loop for all polygons and check when a polygon is inside other. Then add this polygon like hole of the big polygon. SO... is not necessary to make difference operations :)
sub Agujerear($)
{
say "\t\tAgujerear" if DEBUG;
my $valor = shift;
# Recorrer todos los polígonos y contruir el hash %Contornos
#-------------------------------------------------------------
+---------------
# Para cada polígono BORDE de la capa $valor
# Creamos contorno a partir de ese polígono
# Para cada polígono AGUJERO de la capa $valor
# Si el agujero está dentro, asociarlo
# Para todos los puntos del aguj
+ero
# Si un sólo vértice est
+á dentro del polígono, es un agujero suyo
# Lo asociamos guardándo
+lo en su contorno
#-------------------------------------------------------------
+---------------
foreach my $poligono ( @{ $Poligonos{$valor}[BORDE] } )
{
my $contorno = Math::Geometry::Planar->new;
$contorno->polygons( [ $poligono->points ] );
foreach my $agujero ( @{ $Poligonos{$valor}[AGUJERO] }
+ )
{
my $vertices = @{ $agujero->points };
foreach my $vertice ( @{ $agujero->points } )
{
next unless $poligono->isinside($verti
+ce);
$vertices--;
}
$contorno->add_polygons( $agujero->points ) if
+ $vertices < 2;
}
push @{ $Contornos{$valor} }, $contorno;
}
say if DEBUG;
}
(this 10 lines example was really hard to get to finish... 15 days!)
GPC library have other module at CPAN: Math::Geometry::Planar::GPC (the next version of Math::Geometry::GPC), but is more low level that Math::Geometry::Planar::GPC::Polygon... but here you can to access to hole' points directly.
But... GPC need a better perl support... :-( |