実践 #2

このアーカイブは同期化されません。 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);

たったこれだけとなった。