Imagerで GIFを作る

"アニメーションGIFシャッフルするやつ"を Perlで書いてみた - Life is very short

で Imagerで GIFを簡単に扱えることがわかったんで、
一から作るということをやってみた。

コード

2011年のトップ 20 AV女優の画像を GIF化します。
名前とランクも画像に埋め込みます。

#!perl
use strict;
use warnings;

use Imager;
use URI;
use Web::Scraper;
use Furl;
use Encode;
use utf8;

my $ranking_2011 = scraper {
    process 'table.mg-b20 > tr > td > a', 'actresses[]' => scraper {
        process "img", 'url' => '@src', 'name' => '@alt';
    };
};

my $url = 'http://www.dmm.co.jp/mono/dvd/-/ranking/=/term=year_2011/mode=actress/';
my $res = $ranking_2011->scrape( URI->new($url) );
die "Can't download $url" unless $res;

my $font = Imager::Font->new(
    file => '/usr/share/fonts/truetype/vlgothic/VL-Gothic-Regular.ttf',
  );

my $ua = Furl->new;
my @imgs;
my $index = 1;
for my $actress (@{$res->{actresses}}) {
    (my $img_url = $actress->{url}) =~ s{medium/}{};
    my $res = $ua->get($img_url);
    die "Can't download $img_url" unless $res;

    my $i = Imager->new(data => $res->content) or die Imager->errstr;
    $i->string(
        x      => 0,
        y      => 15,
        string => (decode_utf8(sprintf "%2d", $index) . "位"),
        font   => $font,
        size   => 14,
        aa     => 1,
        color  => '#228b22',
    ) or die $i->errstr;

    (my $name = $actress->{name}) =~ s{[(（].*\z}{}xms;
    $i->string(
        x      => 10,
        y      => $i->getheight - 5,
        string => $name,
        font   => $font,
        size   => 16,
        aa     => 1,
        color  => '#8b0000',
    ) or die $i->errstr;
    push @imgs, $i;

    $index++;
}

my $img = Imager->new;
$img->write_multi({
    file      => '2011_actresses.gif',
    gif_delay => 100,
    gif_loop  => 0,
}, @imgs) or die $img->errstr;

実行結果

おわりに

Imagerを使えば GIFを作るのも簡単でした。
文字を埋め込むということも簡単です。センスさえあれば
いろいろ楽しいことができそうです。