では、カラーテーブルを使った BMP を作ってみよう。

use strict;
use warnings;
use integer;

# 基本情報
my $width  = 100;
my $height = 75;
my $bit_count = 4;
# カラーテーブル。0:黒, 1:赤, 2:緑, 3:青
my @colors = (
  0x00000000, 0x00ff0000,
  0x0000ff00, 0x000000ff,
  (0) x 12
);

# データの準備
my @data = ();
push(@data, [(2) x $width]) foreach (1..25);
push(@data, [(1) x $width]) foreach (1..25);
push(@data, [(3) x $width]) foreach (1..25);

# 出力開始

binmode(select);

my $line_size = int(($width * $bit_count + 31) / 32) * 4;
my $ctbl_size = $bit_count > 8 ? 0 : 2 ** $bit_count * 4;

# BITMAPFILEHEADER
print pack("a2Vx4V", "BM",
 54 + $ctbl_size + $line_size * $height,
 54 + $ctbl_size);

# BITMAPINFOHEADER
print pack("VVVvvx24", 40, $width, $height, 1, $bit_count);

# RGBQUAD (カラーテーブル)
if ($ctbl_size > 0) {
  print pack("V", $_) foreach @colors;
}

foreach my $line (reverse @data) {
  if ($bit_count >= 8) {
    my @bytes = map {
     substr(pack("V", $_), 0, int($bit_count / 8))
    } @$line;
    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));
  }
}

exit;

今日は、データ作成部と、BMP 書き込み部を分離してみた。

@colors はカラーテーブル。
数値スカラ値の配列となっている。
各値は、00000000rrrrrrrrggggggggbbbbbbbb のRGB 値だ。

@data は、行データのリファレンスの配列。
行データは、ピクセルの配列だ。ピクセルは、数値スカラ値。
8 ビット以下の場合、カラーテーブルの番号であり、
そうでない場合は、指定ビット長の RGB 値となる。