No such thing as a small change PerlMonks

### general polygon clipper examples

 on Jan 20, 2006 at 07:57 UTC Need Help??
gadb has asked for the wisdom of the Perl Monks concerning the following question:

Does anyone know of more complete examples for the Math::Geometry::Planar::GPC::Polygon module? The man page really just points at the GPC docs. Thanks, Graham.

Replies are listed 'Best First'.
Re: general polygon clipper examples
by tall_man (Parson) on Jan 20, 2006 at 21:38 UTC
You can find a working example in the test.pl which comes with the CPAN module. It shows the construction of a polygon with holes and how to do INTERSECT, UNION, and DIFFERENCE.
Re: general polygon clipper examples
by jesuashok (Curate) on Jan 20, 2006 at 08:47 UTC
Hi Find it If Useful :-
```Bound Functions
These are the functions provide by the Inline-C code. See function
+s.c in
the source package for intimate details.

from_file
Loads a from a file into your gpc object. See the GPC library
documentation for details.

\$gpc->from_file(\$filename, \$want_hole);

to_file
Writes to a file.

\$gpc->to_file(\$filename, \$want_hole);

clip_to
Clips the \$gpc object to the \$othergpc object.

\$action may be any of the following:

INTERSECT
DIFFERENCE
UNION

\$gpc->clip_to(\$othergpc, \$action);

Be wary. This interface may need to change.

Adds a polygon to the gpc object. @points is a list of array refer
+ences
which describe the point of the polygon. \$hole is 1 or 0 (0 to not
hole.)

get_polygons
Gets the polygons from the gpc object. I'm not sure how to tell yo
+u if
they are holes or not. @pgons will be a list of refs to lists of r
+efs.

@pgons = \$gpc->get_polygons();

Helper Functions
Pure-perl implementation from here down.

as_string
\$gpc->as_string();
Re: general polygon clipper examples
by explorer (Chaplain) on Jan 21, 2006 at 12:55 UTC
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();
+][0]}, 0);

# Idem para el polígono a restart
my \$gpc_sup = Math::Geometry::Planar::GPC::Pol
+ygon->new();
[
[ \$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
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

# Añadir luego los agujeros que tenga
my \$num_pol = @{\$Contornos{\$base}[\$i]};
foreach my \$agujero ( 1 .. \$num_pol-1 )
{
+ro]}, 1);
}

# Idem para el polígono a restart
my \$gpc_sup = Math::Geometry::Planar::GPC::Polygon->new();

# 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 '';

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--;
}
+ \$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... :-(

Create A New User
Node Status?
node history
Node Type: perlquestion [id://524424]
Approved by Corion
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others exploiting the Monastery: (3)
As of 2018-05-24 05:03 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
World peace can best be achieved by:

Results (174 votes). Check out past polls.

Notices?