Image::Magickで文字を画像化する

このところ動画クリップを作ることが多いので、動画にタイトルを付けるのをバッチ処理化できないかなと思って、まずは、ImageMagickを使って文字を画像化するスクリプトを作ってみました。
Windows版のImageMagickをインストールするとActivePerl用のモジュールもインストールしてくれるのでそれを使っています。

これをFFmpegと組み合わせれば、大量の動画クリップにタイトルを付ける作業をバッチ処理でできそうです。次は生成した画像をつなげて動画にするところを作ってみようと思います。
コードはこちら。無保証、自己責任でよろしくです。

#!/usr/bin/perl

use strict;
use warnings;

use Image::Magick;

text2image( { 
	text      => "Image::Magickで\n文字を画像にする\nテスト",
	file      => 'a.png',
	size      => '640x480',
	bg        => 'black',
	fg        => 'white',
	font      => 'C:/Windows/Fonts/meiryo.ttc',
	pointsize => '56',
} );

sub text2image {
	my $arg = shift;

	# オブジェクト生成
	my $image = Image::Magick->new( size => $arg->{size} );

	# キャンバス生成
	$image->ReadImage( 'xc:' . $arg->{bg} );

	# キャンバスサイズ取得
	my ( $width, $height ) = $arg->{size} =~ /(\d+)x(\d+)/g;

	# 文字描画位置取得
	my ( $char_width, $char_height, $ascender, $descender,
		 $text_width, $text_height, $max_advance, 
		 $bounds_x1, $bounds_y1, $bounds_x2, $bounds_y2,
		 $origin_x, $origin_y )
	= $image->QueryFontMetrics(
		encoding  => 'UTF-8',
		text      => $arg->{text},
		font      => $arg->{font},
		fill      => $arg->{fg},
		pointsize => $arg->{pointsize},
		align     => 'Center',
	);

	# 文字描画位置計算(画面中央)
	my $lines = ( $arg->{text} =~ s/\n/\n/g );
	my $x = $width / 2;
	my $y = $height / 2 - $char_height * $lines / 2;

	# 文字描画
	$image->Annotate(
		encoding  => 'UTF-8',
		text      => $arg->{text},
		font      => $arg->{font},
		fill      => $arg->{fg},
		pointsize => $arg->{pointsize},
		align     => 'Center',
		x         => $x,
		y         => $y,
	);

	# ファイル出力
	$image->Write($arg->{file});
}