package MyUnion;

use strict;
use warnings;
use FindBin;

our $VERSION   = 0.001;
our @EXPORT_OK = qw/ wrap_ppunpo /;
 
use Inline C => Config => LIBS => 
    "-L$FindBin::Bin/lib -lgfortran -lpolypack";
 
use Inline C => <<'EOC';

extern void ppunpo_( 
    float* xclip, float* yclip, int* nclip,
    float* xpoly, float* ypoly, int* npoly,
    float* rwork, void*  iwork, int* nwork,
    void*  cback, int*   error 
);

AV* ary;    // AoA; collect output here, array (i.e. one call
            // to call-back function, below) per sub-path

static void urpp( float* xcra, float* ycra, int* ncra ) {
    int i;
    AV* pgone = newAV();
    for ( i = 0; i < *ncra; i ++ ) {
        AV* point = newAV();
        av_push( point, newSVnv( xcra[ i ]));
        av_push( point, newSVnv( ycra[ i ]));
        av_push( pgone, newRV_noinc( point ));
    }
    av_push( ary, newRV_noinc( pgone ));
}

SV* wrap_ppunpo( SV* ccp, SV* csp ) {
    AV* ccp_ary = SvRV( ccp );
    AV* csp_ary = SvRV( csp );
    int nccp    = av_top_index( ccp_ary ) + 1;
    int ncsp    = av_top_index( csp_ary ) + 1;
    int nwrk    = 20 * ( nccp + ncsp );

    float* xccp = malloc( nccp * sizeof( float ));
    float* yccp = malloc( nccp * sizeof( float ));
    float* xcsp = malloc( ncsp * sizeof( float ));
    float* ycsp = malloc( ncsp * sizeof( float ));
    float* work = malloc( nwrk * sizeof( float ));
    
    int i;
    AV* point;
    for ( i = 0; i < nccp; i ++ ) {
        point = SvRV( *av_fetch( ccp_ary, i, 0 ));
        xccp[ i ] = SvNV( *av_fetch( point, 0, 0 ));
        yccp[ i ] = SvNV( *av_fetch( point, 1, 0 ));
    }
    for ( i = 0; i < ncsp; i ++ ) {
        point = SvRV( *av_fetch( csp_ary, i, 0 ));
        xcsp[ i ] = SvNV( *av_fetch( point, 0, 0 ));
        ycsp[ i ] = SvNV( *av_fetch( point, 1, 0 ));
    }
    
    ary = newAV();
    
    int ierr;
    ppunpo_( 
        &xccp[0], &yccp[0], &nccp, 
        &xcsp[0], &ycsp[0], &ncsp, 
        &work[0], &work[0], &nwrk,
        &urpp, &ierr 
    );

    SV* ret;
    if ( ierr ) {
        av_undef( ary );
        ret = newSV( 0 );
    }
    else {
        ret = newRV_noinc( ary );
    }
    free( xccp );
    free( yccp );
    free( xcsp );
    free( ycsp );
    free( work );   // Note, this also frees memory 
                    // used by data passed to call-back

    return( ret );
}
 
EOC

1;


##</code><code>##

use strict;
use warnings;
use feature 'say';
use FindBin;
use Data::Dump 'dd';
use autodie;
use Benchmark 'cmpthese';
 
use lib "$FindBin::Bin/lib";
use MyUnion 'wrap_ppunpo';

use Math::Geometry::Planar;

{                       ###### Demo data output block
    my @sets = (
        [[0,0],[0,2],[2,2],[2,0],[0,0]],
        [[0,0],[3,0],[3,1],[0,1],[0,0]],
        [[3,0],[3,2],[4,2],[4,0],[3,0]],
        [[0,2],[0,3],[1,3],[1,2],[0,2]],
    );
    say "\n**** Demo output for GPC:\n";

    my $clip_gpc_obj = Math::Geometry::Planar-> new;
    my $poly_gpc_obj = Math::Geometry::Planar-> new;

    $clip_gpc_obj-> points( $sets[ 0 ]);
    for ( 1.. 3 ) {
        $poly_gpc_obj-> points( $sets[ $_ ]);
        dd [ 
            map @{ $_-> polygons }, Gpc2Polygons( 
                GpcClip( 
                    'UNION', 
                    $poly_gpc_obj-> convert2gpc,
                    $clip_gpc_obj-> convert2gpc,
                )
            )
        ]
    }
    say "\n\n*** Demo output for POLYPACK:\n";
    dd wrap_ppunpo( @sets[ 0, $_ ]) for 1 .. 3;
}

####################### Benchmark 

my $clip_points = _get_data( 'c' );    # clipmask polygon points
my $poly_points = _get_data( 's' );    # sample polygon points

my $clip_gpc_obj = Math::Geometry::Planar-> new;
my $poly_gpc_obj = Math::Geometry::Planar-> new;
$clip_gpc_obj-> points( $clip_points );
$poly_gpc_obj-> points( $poly_points );
my $clip_gpc_struct = $clip_gpc_obj-> convert2gpc;
my $poly_gpc_struct = $poly_gpc_obj-> convert2gpc;

say "\n\n*** Benchmark (union of polygons with "
    . @$clip_points . ' and ' . @$poly_points . " points):\n";

cmpthese( -5, {
    GPC_lib => sub {
        my $union_gpc_struct = GpcClip( 
            'UNION', 
            $poly_gpc_struct,
            $clip_gpc_struct,
        );
        my ( $contour ) = Gpc2Polygons( $union_gpc_struct );
        return $contour-> polygons;
    },
    POLYPACK => sub {
        return wrap_ppunpo( $clip_points, $poly_points );
    },
});

sub _get_data {             # only simple wlr files expected!
    my $name = shift;

    open my $fh, '<', "sample/$name.wlr";
    <$fh>; <$fh>; <$fh>; 

    my @a;
    push @a, [ map { 0 + $_ } split ',', <$fh> ]
        until eof $fh;
    return \@a
}

__END__


##</code><code>##

**** Demo output for GPC:

[[[2, 2], [0, 2], [0, 1], [0, 0], [3, 0], [3, 1], [2, 1]]]
[
  [[4, 2], [3, 2], [3, 0], [4, 0]],
  [[2, 2], [0, 2], [0, 0], [2, 0]],
]
[[[1, 3], [0, 3], [0, 2], [0, 0], [2, 0], [2, 2], [1, 2]]]


*** Demo output for POLYPACK:

[
  [[2, 2], [2, 1], [3, 1], [3, 0], [2, 0], [0, 0], [0, 2], [2, 2]],
]
[
  [[2, 2], [2, 0], [0, 0], [0, 2], [2, 2]],
  [[4, 2], [4, 0], [3, 0], [3, 2], [4, 2]],
]
[
  [[1, 3], [1, 2], [2, 2], [2, 0], [0, 0], [0, 2], [0, 3], [1, 3]],
]


*** Benchmark (union of polygons with 31084 and 38755 points):

            s/iter  GPC_lib POLYPACK
GPC_lib       1.26       --     -98%
POLYPACK 2.74e-002    4491%       --