use strict;
use warnings;
use feature 'say';

use PDL;
use PDL::NiceSlice;
use PDL::IO::Image;
use PDL::Image2D;
use PDL::ImageND;

use Encode    'decode';
use Benchmark 'cmpthese';
use Data::Dump;

my $fn  = 'test.png';
my $img = PDL::IO::Image-> new_from_file( $fn );
my $pdl = $img-> pixels_to_pdl-> short;
my $sgm = cc8compt( $pdl == 0 )-> short;

# "Short" in line above is required for PDL that ships 
# with Strawberry 5.26. Otherwise $sgm gets long. Wasn't 
# so in 5.24. Not nice.

# $sgm ('segmented image') will be a test subject.

cmpthese( 5, {
    pdl_naive => \&get_bboxes_pdl_naive,
    regex     => \&get_bboxes_regex,
    pdl       => \&get_bboxes_pdl,
});

sub get_bboxes_pdl_naive {
    return [ map { 
        my $obj = whichND( $sgm == $_ );
        [
            [ $obj-> slice( 0 )-> minmax ],
            [ $obj-> slice( 1 )-> minmax ],
        ]
    } 1 .. $sgm-> max ]
}

sub get_bboxes_regex {
    my ( $w, $h ) = $sgm-> dims;
    my $str       = ${ $sgm-> get_dataref };

    my @b = map {
        [ [ $w, 0 ], [ $h, 0 ] ]
    } 0 .. $sgm-> max;

    $w *= 2;

    for my $y ( 0 .. $h - 1 ) {
        my $s = decode 'UTF16LE', substr( $str, $y * $w, $w );

        while( $s =~ m/[^\0]+/g ) {
            my $c = ord( $& ); 
            $b[ $c ][0][0] = $-[0]     if $-[0]     < $b[ $c ][0][0];
            $b[ $c ][0][1] = $+[0] - 1 if $+[0] - 1 > $b[ $c ][0][1];
            $b[ $c ][1][0] = $y        if $y        < $b[ $c ][1][0];
            $b[ $c ][1][1] = $y        if $y        > $b[ $c ][1][1];
        }
    }
    shift @b;
    return \@b
}

sub get_bboxes_pdl {
    my $idx       = $sgm-> flat-> qsorti;
    my ( $runs )  = $sgm-> flat-> index( $idx )-> rle;
    $runs         = $runs-> where( $runs != 0 )-> cumusumover;
    my ( $x, $y ) = $sgm-> one2nd( $idx );

    return [ map {
        my $start = $runs( $_ - 1 );
        my $stop  = $runs( $_ ) - 1;
        [[ $x( $start:$stop )-> minmax ],
         [ $y( $start:$stop )-> minmax ]]
    } 1 .. $runs-> nelem - 1 ]
}