Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change

general polygon clipper examples

by gadb (Novice)
on Jan 20, 2006 at 07:57 UTC ( #524424=perlquestion: print w/replies, xml ) 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 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. add_polygon 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 + add a hole.) $gpc->add_polygon(\@points, $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();
    "Keep pouring your ideas"
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(); $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... :-(

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://524424]
Approved by Corion
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others perusing the Monastery: (4)
As of 2018-08-18 17:53 GMT
Find Nodes?
    Voting Booth?
    Asked to put a square peg in a round hole, I would:

    Results (185 votes). Check out past polls.