Perlで画像処理をしたいと思った。

目標

• キャラクターなんとか機の画像合成部分の動作をPerlで実装する(パーツの選択とかはスクリプト内で手打ちする)
• Win7のStrawberry Perlx64版で動作する
• Cent OS 6Webサーバ上でCGIとして動作する(本エントリ内では実現しない)

「キャラクターなんとか機」とは、素材として収録されている透過PNG画像を組み合わせ、さらに色の変更を行い、人物のいわゆる「立ち絵」を生成するプログラムである。

Perlでの画像処理ライブラリの有名どころはGD・ImageMagick・Imagerの３つのようだ。
StrawberryPerlにはGDとImagerがはじめから入っていたので、とりあえずImagerを使ってみることにした。
(StrawberryPerlにImageMagickインストールするのがうまくいかなかった。)

CentOS6にImagerをインストール

参考サイト
#yum list installed
してみると、
giflib.i686                                             4.1.6-3.1.el6
libjpeg.i686                                            6b-46.el6
libpng.i686                                             2:1.2.49-1.el6_2
なんだはいってるじゃん
ってことで
#cpan -i Imager
ずらずらーっと流れて結構時間かかって、
#perl -MImager -e 'print join ", ", sort keys %Imager::formats'
bmp, ifs, pnm, raw, tga
あれっ
あ、よく見てなかった。develがいるのか。
#yum install libjpeg-devel
#yum install libpng-devel
#yum install giflib-devel
で、
#cpan
cpan> force install Imager
#perl -MImager -e 'print join ", ", sort keys %Imager::formats'
bmp, gif, ifs, jpeg, png, pnm, raw, tga
よし、OK

追記。stringを使いたい場合


#yum install freetype-devel
#cpan
cpan> force install Imager

スクリプトを作成

スクリプト自体の参考

キャラクターなんとか機の動作の参考１

キャラクターなんとか機の動作の参考２

色の変更については、日本語の情報が見つけられなかったのでCPANで確認した。

げげ、行列の乗算なんて長らくやってない。どうやるんだったかな…

use Imager;
my @layers = (
'accessory_back',
'hair_back',
'hair_back_accessory',
'body_back',
'accessory_underwear',
'body_front',
'body_front_color',
'accessory_middle_back',
'head',
'accessory_middle_front',
'face_back',
'hair_front',
'hair_front_accessory',
'face_front',
'eye',
'accessory_front'
);
my %colorgloup = (
'head'				=> 'body',
'face_back'			=> '',
'face_front'			=> '',
'eye'				=> 'eye',
'hair_back'			=> 'hair',
'hair_front'			=> 'hair',
'hair_back_accessory'		=> '',
'hair_front_accessory'		=> '',
'body_back'			=> 'body',
'body_front'			=> '',
'body_front_color'		=> 'cloth',
'accessory_underwear'		=> '',
'accessory_middle_back'		=> '',
'accessory_middle_front'	=> '',
'accessory_back'		=> '',
'accessory_front'		=> ''
);
my %charaparts = (
'head'				=> '普通な顔1.png',
'face_back'			=> '素.png',
'face_front'			=> '素.png',
'eye'				=> '普通な目1.png',
'hair_back'			=> 'セミロング.png',
'hair_front'			=> 'ナチュラル.png',
'hair_back_accessory'		=> 'ツインテール(長).png',
'hair_front_accessory'		=> '',
'body_back'			=> 'セーラー服1.png',
'body_front'			=> 'セーラー服1.png',
'body_front_color'		=> 'セーラー服1.png',
'accessory_underwear'		=> '',
'accessory_middle_back'		=> '',
'accessory_middle_front'	=> '',
'accessory_back'		=> '',
'accessory_front'		=> ''
);
my %colormatrixorigin = (
'blue'	=> [	[ 1	, 0	, 0	, 0	],
		[ 1	, 0	, 0	, 0	],
		[ 0	, 0	, 1	, 0	],
		[ 0	, 0	, 0	, 1	], ],
'pur'	=> [	[ 0	, 0	, 1	, 0	],
		[ 1	, 0	, 0	, 0	],
		[ 0	, 0	, 1	, 0	],
		[ 0	, 0	, 0	, 1	], ],
'red'	=> [	[ 0	, 0	, 1	, 0	],
		[ 1	, 0	, 0	, 0	],
		[ 1	, 0	, 0	, 0	],
		[ 0	, 0	, 0	, 1	], ],
'yel'	=> [	[ 0	, 0	, 1	, 0	],
		[ 0	, 0	, 1	, 0	],
		[ 1	, 0	, 0	, 0	],
		[ 0	, 0	, 0	, 1	], ],
'grn'	=> [	[ 1	, 0	, 0	, 0	],
		[ 0	, 0	, 1	, 0	],
		[ 1	, 0	, 0	, 0	],
		[ 0	, 0	, 0	, 1	], ],
'wtr'	=> [	[ 1	, 0	, 0	, 0	],
		[ 0	, 0	, 1	, 0	],
		[ 0	, 0	, 1	, 0	],
		[ 0	, 0	, 0	, 1	], ],
'blk'	=> [	[ 1	, 0	, 0	, 0	],
		[ 1	, 0	, 0	, 0	],
		[ 1	, 0	, 0	, 0	],
		[ 0	, 0	, 0	, 1	], ],
'wht'	=> [	[ 0	, 0	, 1	, 0	],
		[ 0	, 0	, 1	, 0	],
		[ 0	, 0	, 1	, 0	],
		[ 0	, 0	, 0	, 1	], ],
'dummy'	=> [	[ 1	, 0	, 0	, 0	],
		[ 0	, 1	, 0	, 0	],
		[ 0	, 0	, 1	, 0	],
		[ 0	, 0	, 0	, 1	], ]
);
my %colormatrix = (
'eye'	=> $colormatrixorigin{'blk'},
'hair'	=> $colormatrixorigin{'red'},
'cloth'	=> $colormatrixorigin{'blue'},
'body'	=> $colormatrixorigin{'dummy'},
);
my $imager = Imager->new(xsize => 300,ysize => 400, channels => 4);
my $imagertmp = Imager->new(xsize => 300,ysize => 400, channels => 4);
my $counter = 0;
foreach(@layers){
	$counter++;
	unless($charaparts{$_}){next;}
	$imagertmp->read( file => "data/default/$_/$charaparts{$_}" ) or die $imagertmp->errstr;
	if($colormatrix{$colorgloup{$_}}){
		$imagertmp = $imagertmp->convert(matrix => $colormatrix{$colorgloup{$_}});
	}
	$imager->rubthrough( src => $imagertmp, tx => 0, ty =>0);
}
$imager->write( file => 'imagertest.png')or die $imager->errstr;

今のところは動作確認なので、もっとシンプルに書けるんじゃないか、なんてことは気にしない。

結果

なんかでた。

今後の課題

• 現状ではサーバ上で動作しない。パーツのファイル名が日本語であることが原因か。
• パーツや色をランダムに選択して大量生成する機能がほしい