帰ってきたネコブログ

久々なので、リファクタリングしておさらいしてみる。

あんまし、お行儀の良い書き方じゃないけど、
こんな感じで、塗りつぶし領域の結果を取得すると、
ちょっと無理矢理だけど、手を抜くことが出来る。

use v5.14;
use strict;
use warnings;
use Imager;

if ( (not @ARGV) or (not -e $ARGV[0]) ) {
    say "Usage:
    perl $0 file_path";
    exit( 0 );
}

my $img = Imager->new( file => $ARGV[0] )
    or die Imager->errstr();
my $img_dst = $img->convert( preset => 'rgb' ); # gray -> rgb

my $h = $img->getheight();
my ( $ix, $iy ) = ( 0, 0 );
my $area_no = 1;
while ( $iy < $h ) {
    my $tmp = $img->getsamples( y => $iy, channels => [0] );
    my @pixels = unpack( 'C*', $tmp );

    my $found = 0;
    while ( $ix < scalar(@pixels) ) {
        if ( $pixels[$ix] == 255 ) {
            my $c = Imager::Color->new( $area_no, $area_no, $area_no );
            $img->flood_fill( x => $ix, y => $iy, color => $c );

            my $area = calc_filled_area( $img, $area_no, $ix, $iy );
            print_area_info( $area_no, $area );
            $img_dst->box( color => 'red', %{$area} );

            $area_no++;
            $found = 1;
            last;
        }

        $ix++;
    }

    if ( not $found ) {
        $ix = 0;
        $iy++;
    }

    if ( 255 < $area_no ) {
        die 'area_no = ', $area_no, ' too many areas! sorry.';
    }
}

sub calc_filled_area {
    my ( $img, $area_no, $filled_x, $filled_y ) = @_;

    my ( $xmin, $xmax ) = ( $filled_x, $filled_x );
    my ( $ymin, $ymax ) = ( $filled_y, $filled_y );

    my $h = $img->getheight();
    my $iy = $ymin;
    while ( $iy < $h ) {
        my $tmp = $img->getsamples( y => $iy, channels => [0] );
        my @pixels = unpack( 'C*', $tmp );

        my $found = grep { $_ == $area_no } @pixels;
        if ( $found ) {
            my $st = 0;
            $st++ while $pixels[$st] != $area_no;

            my $en = scalar(@pixels) - 1;
            $en-- while $pixels[$en] != $area_no;

            $xmin = $st if $st < $xmin;
            $xmax = $en if $xmax < $en;
        }

        if ( not $found ) {
            last;
        }
        else {
            $ymax = $iy;
            $iy++;
        }
    }

    return +{
        xmin => $xmin,
        ymin => $ymin,
        xmax => $xmax,
        ymax => $ymax
    };
}

sub print_area_info {
    my ( $area_no, $area ) = @_;
    printf( "area_no = %3d, (x, y) = (%4d, %4d), w = %4d, h = %4d",
        $area_no,
        $area->{xmin},
        $area->{ymin},
        $area->{xmax} - $area->{xmin} + 1,
        $area->{ymax} - $area->{ymin} + 1 );
    print "\n";
}

$img_dst->write( file => $0 . '.png' );

結果は、こんな感じ。

入力画像がモノクロだったので、
赤線で枠を描画する前に、RGBに変換してる。

やりたいことは、
1つ1つ切り抜いて、垂直になるように回転して、
高さでソートしつつ、それをGIFアニメとしてファイル出力したい。

次は、回転後の画像を1つの画像に集めることかな。

おしまい。

カテゴリー: Perl, コンピューター by ネコ on 2014年08月23日 | タグ: Imager > メモ