Experimental Image::BoxFind module:    Image/t/16-spot_bounds_truncate.t


     # Test file created outside of h2xs framework.
# Run this like so: `perl Image-BoxFind.t'
#   doom@kzsu.stanford.edu     2007/10/22 04:50:12

use warnings;
use strict;
$|=1;
my $DEBUG = 0;
use Data::Dumper;

use Test::More;
BEGIN { plan tests => 10 };
use Test::Number::Delta;

use Data::Dumper;
use File::Basename qw( basename );

use FindBin qw( $Bin );
use lib "$Bin/../..";
my $lib = "$Bin/../..";

BEGIN { #1
  use_ok( 'Image::BoxFind' );
}

#2
ok(1, "Traditional: If we made it this far, we're ok.");

{#3,4,5,6
  my $test_name = "spot_bounds_truncate";
  my $image_file = "$Bin/dat/images/firefox_save_as.png";
  my $basename = basename( $image_file );
  $basename =~ s{\.png$}{}x;
  my $bf = Image::BoxFind->new( {
                                 image_file => $image_file,
                                 DEBUG      => $DEBUG,
#                                 spotsize_x         => 4,
#                                 spotsize_y         => 8,
                                 refocus_factor     => 4,
                                 forward_horizon    =>  3,
                                 transverse_horizon =>  7,
                                 direction          => 'y_plus',

                                } );

  my $cases = [
            [ [ 0, 0],
              [ 0, 0 , 6, 2 ],
            ],

            [ [ 50, 50],
              [ 50, 50, 56, 52 ],
            ],

            [ [ 50, 166],
              [ 50, 166, 56, 168 ],
            ],

            [ [ 490, 50],
              [ 490, 50, 492, 52 ],
            ],

           ];


  $bf->debug("bf:". Dumper( $bf ) . "\n" );

  foreach my $case ( @{ $cases } ) {

    my ($x, $y) = @{ $case->[0] };
    my ($x1, $y1, $x2, $y2) = $bf->spot_bounds_truncated( $x , $y );
    my $result = [ $x1, $y1, $x2, $y2 ];
    my $expected = $case->[1];

    my $area = area( $result );

    is_deeply($result, $expected, "Testing $test_name: ($x, $y) on $basename direction y") or
    do {
      print $bf->adjustable_parameter_report();
      print "result: (" . join( ", ", @{ $result }  ) . ") \n";
      print "expect: (" . join( ", ", @{ $expected }  ) . ") \n";
      print "area: ", $area, "\n";
    };
  }
}

{ #7,8,9,10
  my $test_name = "spot_bounds_truncate";
  my $image_file = "$Bin/dat/images/firefox_save_as.png";
  my $basename = basename( $image_file );
  $basename =~ s{\.png$}{}x;
  my $bf = Image::BoxFind->new( {
                                 image_file => $image_file,
                                 DEBUG      => $DEBUG,
#                                 spotsize_x         => 4,
#                                 spotsize_y         => 8,
                                 refocus_factor     => 4,
                                 forward_horizon    =>  3,
                                 transverse_horizon =>  7,
                                 direction          => 'x_plus',

                                } );

  my $cases = [
            [ [ 0, 0],
              [ 0, 0 , 2, 6 ],
            ],

            [ [ 50, 50],
              [ 50, 50, 52, 56 ],
            ],

            [ [ 50, 166],
              [ 50, 166, 52, 168 ],
            ],

            [ [ 490, 50],
              [ 490, 50, 492, 56 ],
            ],

           ];


  $bf->debug("bf:". Dumper( $bf ) . "\n" );

  foreach my $case ( @{ $cases } ) {

    my ($x, $y) = @{ $case->[0] };
    my ($x1, $y1, $x2, $y2) = $bf->spot_bounds_truncated( $x , $y );
    my $result = [ $x1, $y1, $x2, $y2 ];
    my $expected = $case->[1];

    my $area = area( $result );

    is_deeply($result, $expected, "Testing $test_name: ($x, $y) on $basename direction x") or
    do {
      print $bf->adjustable_parameter_report();
      print "result: (" . join( ", ", @{ $result }  ) . ") \n";
      print "expect: (" . join( ", ", @{ $expected }  ) . ") \n";
      print "area: ", $area, "\n";
    };
  }
}




sub area {
  my $rect = shift;
  my $area = abs($rect->[0] - $rect->[2]) *  abs($rect->[1] - $rect->[3]);
  return $area;
}

     

Joseph Brenner, Tue Nov 27 17:40:02 2007