このアーカイブは同期化されません。 mixi の日記が更新されても、このアーカイブには反映されません。
次に BMP を書き出す汎用ルーチンを作る。
write_bmp($data, $bit_count, $color_tables);
$data は、昨日の画像データと同じ。
$bit_count は書き出す BMP のピクセルあたりのビット数で、
1, 2, 4, 8, 16, 24, 32 を渡すことができるとする。
$bit_count が 16 以上の場合は、$color_tables は不要。
そして、$data のピクセルは昨日と同じ RGB 32 ビット値。
$bit_count が 8 以下の場合は、$color_tables が必須。
$color_tables は、RGB 32 ビット値の配列リファレンス。
この場合、$data の各ピクセルは、
カラーテーブルの番号を表す 32 ビット値。
sub write_bmp ($$;$) {
use integer;
my ($data, $bit_count, $colors) = @_;
my $width = @{$data->[0]};
my $height = @$data;
# 詰め物を含む行のバイト数。
my $line_size = int(($width * $bit_count + 31) / 32) * 4;
# カラーテーブルのバイト数。
my $ctable_size = $bit_count > 8 ? 0 : 2 ** $bit_count * 4;
binmode(select);
# BITMAPFILEHEADER 書き出し。
print pack("a2Vx4V", "BM", 54 + $ctable_size + $line_size * $height, 54 + $ctable_size);
# BITMAPINFOHEADER 書き出し。
print pack("VVVvvx24", 40, $width, $height, 1, $bit_count);
# RGBQUAD (カラーテーブル)
if ($ctable_size > 0) {
print pack("V", $_) foreach @$colors;
}
# データ書き込み開始。
foreach my $line (reverse @$data) {
if ($bit_count == 32) {
# 32 ビットなので自然にエンコードできる。
print pack("V*", @$line);
} elsif ($bit_count == 24) {
# 32 ビットで pack し、最後のバイトを捨てる。
my @bytes = map { substr(pack("V", $_), 0, int($bit_count / 8)) } @$line;
print pack("a*\@$line_size", join('', @bytes));
} elsif ($bit_count == 16) {
# RGB それぞれ下位の 3 ビットを切り捨て、
# 16 ビット値に pack する。
my @bytes = ();
foreach (@$line) {
my ($red, $green, $blue) =
unpack('xCCC', pack('N', $_));
push @bytes, pack("v", $red >> 3 << 10
| $green >> 3 << 5 | $blue >> 3);
}
print pack("a*\@$line_size", join('', @bytes));
} else {
# 必要なビット長ずつ文字列で切り出す。
my @bits = map {
substr(unpack("B8", pack("C", $_)), -$bit_count)
} @$line;
print pack("B*\@$line_size", join('', @bits));
}
}
}
昨日と今日の関数は、今度も使うので、
参照可能なモジュールとして別ファイルにしておこう。
package bmp_io;
require 5.6.0;
use strict;
use warnings;
use integer;
BEGIN {
use Exporter;
our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
$VERSION = '1.00';
@ISA = qw<Exporter>;
@EXPORT = qw<read_bmp write_bmp>;
@EXPORT_OK = ();
%EXPORT_TAGS = ();
}
# read_bmp 実装
# write_bmp 実装
1;
こうしておけば、楽にテストスクリプトが作れるようになる。
例えば、24 もしくは 32 ビットの bmp を読み込んで、
16 ビットで書き出すスクリプトを作ってみると、
use strict;
use warnings;
use bmp_io;
sub adjust ($) {
use integer;
my $value = shift;
$value = 0 if $value < 0;
$value = 255 if $value > 255;
int($value);
}
my $data = read_bmp;
write_bmp($data, 16);
たったこれだけとなった。