Experimental Image::BoxFind module: Image/t/lib/Image/BoxFind/Testing/Eyeballs.pm
package Image::BoxFind::Testing::Eyeballs;
# doom@kzsu.stanford.edu
# 26 Oct 2007
=head1 NAME
Image::BoxFind::Testing::Eyeballs - lib of rects found in images via 'eyeball'
=head1 SYNOPSIS
use Image::BoxFind::Testing::Eyeballs ':all';
my $expected_rect_list = define_expected_via_eyeball( $image_file_name );
=head1 DESCRIPTION
To do tests of automated systems of picking rectangular
features out of an image, you need to know what the expected
results are. This module is a library of expected results
for associated images found in B<t/dat/images> inside this
distribution.
These expected results were determined "by eyeball", by viewing
the image in gimp.
=head2 the proceedure for adding coverage for new images
The "PROC" is like so:
=over
=item *
Make a rough "rectangle list" by hand, by viewing the image in gimp:
Specifically, this was done by hovering the rectangle select
mouse cursor around the corners of apparent rectangles so that
the (x,y) values could be read off from the status bar.
=item *
add a sub that defines the rectangle list data
structure and returns it.
=item *
put the name of that sub in define_expected_via_eyeball,
keyed by the basename of the image file.
=back
Note, this code can use my usual "sub define_* {}" material,
cut and pasted into place.
It avoids a large, unweidly data structure in one place
by instead using coderefs internally.
=head2 EXPORT
This module exports a single function (at present):
=over
=cut
use 5.006;
use strict;
use warnings;
my $DEBUG = 1;
use Carp;
use Data::Dumper;
use File::Basename qw( fileparse );
require Exporter;
our @ISA = qw(Exporter);
our %EXPORT_TAGS = ( 'all' => [
qw(
define_expected_via_eyeball
define_expect_empirical_simple_test_3
define_expect_simple_test_3
define_expect_empirical_simple_test_2
define_expect_simple_test_2
define_expect_empirical_firefox_save_as
define_expect_firefox_save_as
define_expect_rhythmbox_prefs
define_expect_gimp_open_dialog
) ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw( );
our $VERSION = '0.01';
=item define_expected_via_eyeball
Given an image name of an image in B<t/dat/images>, returns an associated
coderef which when executed, will return the list of rectangles expected to be
found in that image.
Multiple forms of the image name are accepted by this routine:
it uses the basename of the image, ignoring the path and file extension
See L<Image::BoxFind>.
=cut
sub define_expected_via_eyeball {
my $image_file_name = shift;
my @suffixlist =
('\.png', '\.PNG', '\.gif', '\.GIF', '\.jpeg', '\.JPEG', '\.jpg', '\.JPG');
my $name = ( fileparse($image_file_name,@suffixlist) )[0];
my %balls = (
simple_test_3 =>
\&define_expect_simple_test_3,
simple_test_2 =>
\&define_expect_simple_test_2,
firefox_save_as =>
\&define_expect_firefox_save_as,
rhythmbox_prefs =>
\&define_expect_rhythmbox_prefs,
gimp_open_dialog =>
\&define_expect_gimp_open_dialog,
);
my $selector = $balls{ $name };
my $selection = $selector->();
return $selection;
}
# Another wrapper sub might be defined to return
# the empricials...
# define_expect_empirical_firefox_save_as
=back
=head2 internally used subs (not for export)
Note, originally seeded with material cut and pasted from
/home/doom/End/Cave/GuiTest/lib/perl/Image/t/04-Image-BoxFind.t
=over
=item TODO
=cut
sub define_expect_empirical_simple_test_3 {
my $expect =
[ [
[ 45, 38 ],
[ 104, 39 ],
[ 104, 88 ],
[ 45, 88 ]
],
[
[ 52, 173 ],
[ 121, 174 ],
[ 121, 209 ],
[ 52, 209 ]
],
[
[ 120, 39 ],
[ 207, 40 ],
[ 207, 150 ],
[ 120, 150 ]
],
[
[ 138, 174 ],
[ 206, 175 ],
[ 206, 210 ],
[ 138, 210 ]
]
];
return $expect;
}
# eyeball values via gimp
sub define_expect_simple_test_3 {
my $expected =
[ [
[ 44, 38 ],
[ 106, 38 ],
[ 106, 89 ],
[ 44, 90 ]
],
[
[ 51, 173 ],
[ 122, 173 ],
[ 122, 211 ],
[ 51, 210 ]
],
[
[ 119, 39 ],
[ 209, 39 ],
[ 209, 152 ],
[ 119, 151 ]
],
[
[ 137, 174 ],
[ 208, 175 ],
[ 208, 212 ],
[ 137, 211 ]
]
];
return $expected;
}
sub define_expect_empirical_simple_test_2 {
my $expect =
[
[ [20, 6], [81, 9], [81, 56], [20, 56]
],
[ [27, 141], [95, 145], [95, 177], [27, 177]
],
[ [95, 7], [182, 11], [182, 118], [95, 118]
],
[ [113, 142], [181, 146], [181, 178], [113, 178]
]
];
return $expect;
}
# eyeball values via gimp -- corrected Tue Oct 16 23:56:31 2007
sub define_expect_simple_test_2 {
my $expected =
[
[ [ 19, 5],
[ 81, 6],
[ 81, 57],
[ 19, 57]
],
[ [ 26, 141],
[ 97, 142],
[ 96, 178],
[ 27, 178]
],
[ [ 94, 7],
[ 184, 7],
[ 184, 119],
[ 94, 120]
],
[ [ 113, 142],
[ 184, 142],
[ 183, 179],
[ 113, 179]
],
];
return $expected;
}
### TODO review these numbers, don't remember their provenance
sub define_expect_empirical_firefox_save_as {
my $expect =
[ [
[ 115, 13 ],
[ 479, 13 ],
[ 479, 32 ],
[ 114, 32 ],
],
[
[ 113, 47 ],
[ 479, 48 ],
[ 480, 72 ],
[ 113, 72 ],
],
[
[ 306, 130 ],
[ 388, 129 ],
[ 388, 155 ],
[ 306, 155 ],
],
[
[ 396, 129 ],
[ 479, 129 ],
[ 479, 155 ],
[ 396, 155 ],
],
# [ # disk symbol on save button: ignore for now
# [ 415, 136 ],
# [ 428, 136 ],
# [ 428, 149 ],
# [ 415, 149 ],
# ],
];
return $expect;
}
# eyeball values via gimp (I think)
sub define_expect_firefox_save_as {
my $rect =
[
[
[ 115, 13 ],
[ 479, 13 ],
[ 479, 32 ],
[ 114, 32 ],
],
[
[ 113, 47 ],
[ 479, 48 ],
[ 480, 72 ],
[ 113, 72 ],
],
[
[ 306, 130 ],
[ 388, 129 ],
[ 388, 155 ],
[ 306, 155 ],
],
[
[ 396, 129 ],
[ 479, 129 ],
[ 479, 155 ],
[ 396, 155 ],
],
# [ # disk symbol on save button: ignore for now
# [ 415, 136 ],
# [ 428, 136 ],
# [ 428, 149 ],
# [ 415, 149 ],
# ],
];
return $rect;
}
sub define_expect_rhythmbox_prefs {
my $rect =
[
[ # button: 'help'
[ 12, 286 ],
[ 95, 286 ],
[ 96, 311 ],
[ 12, 311 ],
],
[ # tab: 'library'
[ 71, 19 ],
[ 124, 19 ],
[ 124, 37 ],
[ 71, 37 ],
],
[ # tab: 'podcasts'
[ 124, 19 ],
[ 124, 37 ],
[ 194, 19 ],
[ 194, 37 ],
],
[ # tab: 'sharing'
[ 194, 19 ],
[ 254, 19 ],
[ 254, 36 ],
[ 194, 37 ],
],
[ # tab: 'audioscrubber'
[ 255, 19 ],
[ 359, 19 ],
[ 360, 37 ],
[ 255, 38 ],
],
# add checkboxes? TODO
[ # button: 'close'
[ 356, 286 ],
[ 437, 286 ],
[ 438, 312 ],
[ 355, 312 ],
],
];
return $rect;
}
sub define_expect_gimp_open_dialog {
my $rect =
[
[ # Help
[ 12, 361 ],
[ 95, 361 ],
[ 95, 391 ],
[ 12, 391 ],
],
[ # upper-left location display box
[ 13, 14 ],
[ 210, 14 ],
[ 210, 270 ],
[ 13, 270 ],
],
[ # Add
[ 13, 279 ],
[ 107, 278 ],
[ 107, 307 ],
[ 12, 306 ],
],
[ # Remove
[ 115, 279 ],
[ 210, 279 ],
[ 210, 306],
[ 115, 306 ],
],
[ # Home
[ 218, 13 ],
[ 276, 13 ],
[ 277, 36 ],
[ 217, 36 ],
],
[ # Name label
[ 219, 45 ],
[ 392, 45 ],
[ 392, 70 ],
[ 219, 70 ],
],
[ # Name/Modified display
[ 220, 70 ],
[ 445, 70 ],
[ 445, 269 ],
[ 220, 269],
],
[ # Dark stripped band "Boxfind.pm"
[ 220, 110 ],
[ 445, 110 ],
[ 445, 127 ],
[ 220, 127 ],
],
# Note: ignoring *pale* striped bands fornow
[ # All Files
[ 277, 278 ],
[ 617, 278 ],
[ 617, 307 ],
[ 277, 307 ],
],
[ # End
[ 281, 13 ],
[ 310, 13 ],
[ 310, 36 ],
[ 281, 36 ],
],
[ # Cave
[ 316, 13 ],
[ 351, 13 ],
[ 351, 36 ],
[ 316, 36 ],
],
[ # GuiTest
[ 356, 13 ],
[ 406, 13 ],
[ 406, 36 ],
[ 356, 36 ],
],
[ # Modified label
[ 392, 45 ],
[ 445, 45 ],
[ 445, 70 ],
[ 392, 70 ],
],
[ # lib
[ 412, 13 ],
[ 432, 13 ],
[ 432, 36 ],
[ 412, 36 ],
],
[ # perl
[ 437, 13 ],
[ 467, 13 ],
[ 467, 36 ],
[ 437, 36 ],
],
[ # Cancel
[ 442, 362 ],
[ 526, 362 ],
[ 526, 391 ],
[ 442, 391 ],
],
[ # Preview label
[ 461, 45 ],
[ 614, 45 ],
[ 614, 69 ],
[ 461, 69 ],
],
[ # Preview display
[ 461, 69 ],
[ 615, 69 ],
[ 615, 271 ],
[ 461, 271 ],
],
[ # Image
[ 472, 13 ],
[ 514, 13 ],
[ 514, 36 ],
[ 472, 36 ],
],
[ # t
[ 512, 13 ],
[ 533, 13 ],
[ 533, 36 ],
[ 512, 36 ],
],
[ # Open
[ 533, 362 ],
[ 617, 362 ],
[ 617, 391 ],
[ 533, 391 ],
],
[ # dat
[ 539, 13 ],
[ 565, 13 ],
[ 565, 36 ],
[ 539, 36 ],
],
];
return $rect;
}
### TODO
### Add more subs here, if needed.
sub define_XXX_template {
my $rect =
[ [
[ 115, 13 ],
[ 479, 13 ],
[ 479, 32 ],
[ 114, 32 ],
],
[
[ 415, 136 ],
[ 428, 136 ],
[ 428, 149 ],
[ 415, 149 ],
],
];
return $rect;
}
1;
=back
=head1 SEE ALSO
o related modules: L<Image::BoxFind>
TODO
o web site set up for your module (if you have it)
=head1 AUTHOR
Joseph Brenner, E<lt>doom@kzsu.stanford.eduE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2007 by Joseph Brenner
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.2 or,
at your option, any later version of Perl 5 you may have available.
=head1 BUGS
None reported... yet.
=cut
Joseph Brenner,
Tue Nov 27 17:40:02 2007