animager.pl

#!/usr/bin/env perl
use strict;
use warnings;
use utf8;
use feature qw/say/;

use Imager;
use Imager::AnimeFace;
use Getopt::Long;

# default params
my $source_name = undef;
my $crop = 0;
my $frame = 0;
my $mosaic = 0;

# colors configuration
my $colors = {
    chin    => Imager::Color->new(255, 0, 0),
    face    => Imager::Color->new(255, 255, 128),
    mouth   => Imager::Color->new(255, 128, 255),
    eyes    => {
        left    => Imager::Color->new(128, 255, 0),
        right   => Imager::Color->new(255, 128, 0),
    },
};

# input parameter
GetOptions(
    'source=s' => \$source_name,
    'crop' => \$crop,
    'frame' => \$frame,
    'mosaic' => \$mosaic
);

my @source_names = ();
my $source;
my $process_func = undef;
unless (defined $source_name and ($crop or $frame or $mosaic)) {
    say 'Usage: --souce=<sourcefile> [--crop|--frame]';
    exit;
} else {
    # loading image
    $source = Imager->new();
    $source->read(file => $source_name);
    @source_names = split /\./, $source_name;

    # mode
    if ($crop) {
        $process_func = \&crop_and_save;
        $frame = $mosaic = 0;
    } elsif ($frame) {
        $process_func = \&framing;
        $mosaic = 0;
    } elsif ($mosaic) {
        $process_func = \&mosaic;
    } else {
        say 'Usage: --souce=<sourcefile> [--crop|--frame]';
        exit;
    }
}

# scan
my $faces = detect_animeface($source);

for my $num (0..scalar(@$faces)) {

    my $face = $faces->[$num];

    next if (ref $face ne 'HASH');

    for my $parts_name (keys $face) {

        my $parts = $face->{$parts_name};
        my $savefilename = $source_names[0].'-'.$num.'-'.$parts_name;
        
        next if (ref $parts ne 'HASH');
        if (exists $parts->{height}) {
            $process_func->(
                filename => $savefilename.'.'.$source_names[1],
                source   => $source,
                crops    => $parts,
                color    => $colors->{$parts_name}
            );
        } else {
            for my $subparts_name (keys $parts) {
                if (exists $parts->{$subparts_name}->{height}) {
                    $process_func->(
                        filename => $savefilename.'-'.$subparts_name.'.'.$source_names[1],
                        source   => $source,
                        crops    => $parts->{$subparts_name},
                        color    => $colors->{$parts_name}->{$subparts_name},
                    );
                }
            }
        }
    }

}

if ($frame) {
    $source->write(file => $source_names[0].'-framing'.'.'.$source_names[1]);
} elsif ($mosaic) {
    $source->write(file => $source_names[0].'-mosaic'.'.'.$source_names[1]);
}

sub crop_and_save {
    my (%args) = @_;

    my $filename = $args{filename};
    my $source = $args{source};
    my $crops = $args{crops};

    # crop
    my $parts_image = $source->crop(
        left    => $crops->{x},
        top     => $crops->{y},
        width   => $crops->{width},
        height  => $crops->{height},
    );

    # save
    $parts_image->write(file => $filename);
}

sub framing {
    my (%args) = @_;

    my $filename = $args{filename};
    my $source = $args{source};
    my $crops = $args{crops};
    my $color = $args{color} || Imager::Color->new(0, 0, 0);

    $source = $source->box(
      color  => $color,
      xmin   => $crops->{x},
      ymin   => $crops->{y},
      xmax   => $crops->{x} + $crops->{width},
      ymax   => $crops->{y} + $crops->{height},
      filled => 0
    );
}

sub mosaic {
    my (%args) = @_;

    my $filename = $args{filename};
    my $source = $args{source};
    my $crops = $args{crops};
    
    # crop
    my $parts_image = $source->crop(
        left    => $crops->{x},
        top     => $crops->{y},
        width   => $crops->{width},
        height  => $crops->{height},
    );
    # mosaic
    $parts_image->filter(type => 'mosaic', size => 10);
    # paste
    $source->paste(
        left    => $crops->{x},
        top     => $crops->{y},
        img     => $parts_image
    );
}