The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.

NAME

Examples - Image::CCV example programs.

DESCRIPTION

This is a documentation only module showing the examples that are included in the Image::CCV distribution.

This file was auto-generated via the gen_examples_pod.pl program that is also included in the examples directory.

Example programs

The following is a list of the 3 example programs that are included in the Image::CCV distribution.

Example: facecrop.pl

    #!perl
    use strict;
    use warnings;
    use Getopt::Long;
    use Pod::Usage;
    use List::Util qw(max);
    use Imager;
    use Imager::Fill;
    use Image::CCV qw(detect_faces);
    
    use vars qw($VERSION);
    $VERSION = '0.11';
    
    =head1 NAME
    
    facecrop.pl - create crop from image using the largest face area
    
    =head1 SYNTAX
    
      facecrop.pl filename.png
    
      facecrop.pl filename.png -o thumb_filename.png
    
      facecrop.pl scene.png -o faces_%03d.png
    
    =head1 OPTIONS
    
    =over 4
    
    =item *
    
    C<--output-file> - output file name
    
    The output file name will be used as a template if more than one face
    is detected. Supply a sprintf() template (in other words: include a %s). 
    
    =item *
    
    C<--width> - maximum width of the output image
    
    =item *
    
    C<--height> - maximum height of the output image
    
    =item *
    
    C<--scale> - scale factor for the output area around the face
    
    Default is 1.5 which seems to usually capture the "whole face"
    around the detected area.
    
    =item *
    
    C<--largest> - only output the largest face found
    
    =item *
    
    C<--draw-box> - draw a box around the detection area
    
    =item *
    
    C<--verbose> - output more information during progress
    
    =back
    
    =cut
    
    pod2usage(1) unless @ARGV;
    GetOptions(
        'output-file|o:s'        => \my $out_file,
        'width|w:s'  => \my $max_width,
        'height|h:s' => \my $max_height,
        'scale|s:s'  => \my $scale,
        'largest'    => \my $only_largest,
        'draw-box'   => \my $draw_box,
        'verbose'    => \my $verbose,
    ) or pod2usage();
    
    $scale ||= 1.5; # default chosen by wild guess
    
    for my $scene (@ARGV) {
        my @coords = detect_faces( $scene );
        if(! @coords) {
            die "No face found\n";
        };
    
        if( $only_largest ) {
            # Now, find the largest face (area) in this image
            # We ignore the confidence value
            my $max = $coords[0];
            for (@coords) {
                if( $_->[2] * $_->[3] > $max->[2] * $max->[3] ) {
                    $max = $_
                }
            };
            @coords = ($max);
        };
        
        if( $verbose ) {
            print sprintf "%d Gesichter gefunden\n", 0+@coords;
        };
        
        my $index = 1;
        for my $face (@coords) {
            if( $out_file ) {
                my $out = Imager->new( file => $scene );            
                my ($x,$y,$width,$height,$confidence) = @$face;
                
                if( $draw_box ) {
                    my $color = Imager::Color->new( (1-$confidence/100) *255, $confidence/100 *255, 0 );
                    
                    # Draw a nice box
                    $out->box(
                        color => $color,
                        xmin => $x,
                        ymin => $y,
                        xmax => $x+$width,
                        ymax => $y+$height,
                        aa => 1,
                    );
                };
                
                # Scale the frame a bit up
                my $w = $face->[2] * $scale;
                my $h = $face->[3] * $scale;
                my $l = max( 0, $face->[0] - $face->[2]*(($scale -1) / 2));
                my $t = max( 0, $face->[1] - $face->[3]*(($scale -1) / 2) );
                
                $out = $out->crop( 
                           left => $l, top => $t,
                           width => $w, height => $h
                       );
                if( $max_width || $max_height ) {
                    $max_width  ||= $max_height;
                    $max_height ||= $max_width;
                    $out = $out->scale(
                        xpixels => $max_width,
                        ypixels => $max_height,
                        type => 'nonprop'
                    );
                };
                
                my $out_name = sprintf $out_file, $index++;
                $out->write( file => $out_name )
                    or die $out->errstr;
                print "$out_name\n";   
            } else {
                my ($x,$y,$width,$height,$confidence) = @$face;
                print "($x,$y): ${width}x$height @ $confidence\n";
            }
        }
    }

Download this example: http://cpansearch.perl.org/src/CORION/Image-CCV-0.11/examples/facecrop.pl

Example: facetest.pl

    #!perl
    use strict;
    use warnings;
    use Getopt::Long;
    use Pod::Usage;
    use Imager;
    use Imager::Fill;
    use Image::CCV qw(detect_faces);
    
    use vars qw($VERSION);
    $VERSION = '0.11';
    
    =head1 NAME
    
    facetest.pl - simple face detection
    
    =head1 SYNTAX
    
      facetest.pl filename.png
    
    =cut
    
    GetOptions(
        'd|draw:s' => \my $draw_file,
    ) or pod2usage();
    
    for my $scene (@ARGV) {
        my @coords = detect_faces( $scene );
    
        if( $draw_file ) {
            my $out = Imager->new( file => $scene );
    
            for (@coords) {
                my ($x,$y,$width,$height,$confidence) = @$_;
                my $color = Imager::Color->new( (1-$confidence/100) *255, $confidence/100 *255, 0 );
                
                # Draw a nice box
                $out->box(
                    color => $color,
                    xmin => $x,
                    ymin => $y,
                    xmax => $x+$width,
                    ymax => $y+$height,
                    aa => 1,
                );
            };
    
            $out->write( file => $draw_file )
                or die $out->errstr;
        } else {
            for (@coords) {
                my ($x,$y,$width,$height,$confidence) = @$_;
                print "($x,$y): ${width}x$height @ $confidence\n";
            };
        }
    }

Download this example: http://cpansearch.perl.org/src/CORION/Image-CCV-0.11/examples/facetest.pl

Example: sifttest.pl

paste the two input images side by side $out->rubthrough( #!perl use strict; use warnings; use Getopt::Long; use Pod::Usage; use Imager; use Imager::Fill; use List::Util qw(max); use Image::CCV qw(sift);

    use vars qw($VERSION);
    $VERSION = '0.11';
    
    =pod
    
    Command-line options are:
    
    =over 2
    
    =item *
    
    C<--scene> - image of a scene to use
    
    =item *
    
    C<--object> - image of an object to use
    
    =item *
    
    C<--object> - filename of output file, defaults to out.png
    
    =cut
    
    pod2usage(1) unless @ARGV;
    GetOptions(
        'scene|s:s'   => \my $scene,
        'object|t:s'  => \my $object, # t=thing
        'output|o:s'  => \my $output,
    ) or pod2usage();
    
    die "scene image-file: $scene not found!" unless -f $scene;
    die "object image-file: $object not found!" unless -f $object;
    
    $output ||= 'out.png';
    print "output file: $output \n";
    
    my @coords = sift( $object, $scene, );
    print "@$_\n" for @coords;
    
    my $scene_image = Imager->new( file => $scene );
    my $object_image = Imager->new( file => $object );
    
    my $xsize = $scene_image->getwidth + $object_image->getwidth;
    my $ysize = max( $scene_image->getheight, $object_image->getheight);
    
    my $out = Imager->new(
        xsize => $xsize,
        ysize => $ysize,
    );
    
    # paste the two input images side by side
    $out->rubthrough(
        src => $scene_image,
        tx => 0, ty => 0,
        src_minx => 0,
        src_maxx => $scene_image->getwidth-1,
        src_miny => 0,
        src_maxy => $scene_image->getheight-1,
    );
    
    my $obj_ofs_x = $scene_image->getwidth;
    my $obj_ofs_y = 0;
    
    $out->rubthrough(
        src => $object_image,
        tx => $obj_ofs_x, ty => $obj_ofs_y,
        src_minx => 0,
        src_maxx => $object_image->getwidth-1,
        src_miny => 0,
        src_maxy => $object_image->getheight-1,
    );
    
    my @points = @coords;
    
    my $green = Imager::Color->new( 0, 255, 0 );
    for (@points) {
        $out->line(
            color => $green,
            x1 => $_->[0]+$obj_ofs_x,
            y1 => $_->[1]+$obj_ofs_y,
            x2 => $_->[2],
            y2 => $_->[3],
        );
    };
    
    $out->write( file => $output )
        or die $out->errstr;

Download this example: http://cpansearch.perl.org/src/CORION/Image-CCV-0.11/examples/sifttest.pl

AUTHOR

Max Maischein corion@cpan.org

Contributed examples contain the original author's name.

COPYRIGHT

Copyright 2012 by Max Maischein corion@cpan.org.

All Rights Reserved. This module is free software. It may be used, redistributed and/or modified under the same terms as Perl itself.