/usr/share/perl5/Data/ParseBinary/Graphics/BMP.pm is in libdata-parsebinary-perl 0.31~dfsg-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 | package Data::ParseBinary::Graphics::BMP;
use strict;
use warnings;
use Data::ParseBinary;
# Windows/OS2 Bitmap (BMP)
#===============================================================================
# pixels: uncompressed
#===============================================================================
sub UncompressedRows {
my ($subcon, $align_to_byte) = @_;
# argh! lines must be aligned to a 4-byte boundary, and bit-pixel
# lines must be aligned to full bytes...
my $line_pixels;
if ($align_to_byte) {
$line_pixels = Bitwise(Array(sub { $_->ctx(2)->{width} }, $subcon));
} else {
$line_pixels = Array(sub { $_->ctx(2)->{width} }, $subcon);
}
return Array(sub { $_->ctx->{height} }, Aligned($line_pixels, 4));
}
my $uncompressed_pixels = Switch("uncompressed", sub { $_->ctx->{bpp} },
{
1 => UncompressedRows(Bit("index"), 1),
4 => UncompressedRows(Nibble("index"), 1),
8 => UncompressedRows(Byte("index")),
24 => UncompressedRows(Sequence("rgb", Byte("red"), Byte("green"), Byte("blue"))),
}
);
#===============================================================================
# file structure
#===============================================================================
our $bmp_parser = Struct("bitmap_file",
# header
Const(String("signature", 2), "BM"),
ULInt32("file_size"),
Padding(4),
ULInt32("data_offset"),
ULInt32("header_size"),
Enum(Alias("version", "header_size"),
v2 => 12,
v3 => 40,
v4 => 108,
),
ULInt32("width"),
ULInt32("height"),
Value("number_of_pixels", sub { $_->ctx->{width} * $_->ctx->{height} }),
ULInt16("planes"),
ULInt16("bpp"), # bits per pixel
Enum(ULInt32("compression"),
Uncompressed => 0,
RLE8 => 1,
RLE4 => 2,
Bitfields => 3,
JPEG => 4,
PNG => 5,
),
ULInt32("image_data_size"), # in bytes
ULInt32("horizontal_dpi"),
ULInt32("vertical_dpi"),
ULInt32("colors_used"),
ULInt32("important_colors"),
# palette (24 bit has no palette)
If( sub { $_->ctx->{bpp} <= 8 },
Array( sub { 2 ** $_->ctx->{bpp} },
Struct("palette",
Byte("blue"),
Byte("green"),
Byte("red"),
Padding(1),
)
)
),
# pixels
Pointer( sub { $_->ctx->{data_offset} },
Switch("pixels", sub { $_->ctx->{compression} },
{
"Uncompressed" => $uncompressed_pixels,
}
),
),
);
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw($bmp_parser);
1;
__END__
=head1 NAME
Data::ParseBinary::Graphics::BMP
=head1 SYNOPSIS
use Data::ParseBinary::Graphics::BMP qw{$bmp_parser};
my $data = $bmp_parser->parse(CreateStreamReader(File => $fh));
Can parse / build any BMP file, (1, 4, 8 or 24 bit) as long as RLE is not used.
This is a part of the Data::ParseBinary package, and is just one ready-made parser.
please go to the main page for additional usage info.
=cut
|