include "draw.s7i";
include "bin64.s7i";
include "jpeg.s7i";
include "png.s7i";
include "pixelimage.s7i";
const string: BMP_MAGIC is "BM";
const integer: BMP_FILE_HEADER_SIZE is 14;
const integer: BMP_COREHEADER is 12;
const integer: BMP_INFOHEADER_OS22X_SHORT is 16;
const integer: BMP_INFOHEADER is 40;
const integer: BMP_INFOHEADER_V2 is 52;
const integer: BMP_INFOHEADER_V3 is 56;
const integer: BMP_INFOHEADER_OS22X is 64;
const integer: BMP_INFOHEADER_V4 is 108;
const integer: BMP_INFOHEADER_V5 is 124;
const integer: BMP_BI_RGB is 0;
const integer: BMP_BI_RLE8 is 1;
const integer: BMP_BI_RLE4 is 2;
const integer: BMP_BI_BITFIELDS is 3;
const integer: BMP_BI_JPEG is 4;
const integer: BMP_BI_PNG is 5;
const integer: BMP_BI_ALPHABITFIELDS is 6;
const integer: BMP_BI_CMYK is 11;
const integer: BMP_BI_CMYKRLE8 is 12;
const integer: BMP_BI_CMYKRLE4 is 13;
const type: bmpColorBitfield is new struct
var integer: mask is 0;
var integer: rShift is 0;
var integer: scale is 0;
end struct;
const type: bmpHeader is new struct
var integer: bmpFileSize is 0;
var integer: offset is 0;
var integer: calculatedOffset is 0;
var integer: dibHeaderSize is 0;
var integer: width is 0;
var integer: height is 0;
var integer: planes is 0;
var integer: bitsPerPixel is 0;
var integer: compressionMethod is BMP_BI_RGB;
var integer: rawDataSize is 0;
var integer: horizontalResolution is 0;
var integer: verticalResolution is 0;
var integer: paletteColors is 0;
var integer: importantColors is 0;
var bmpColorBitfield: redBitfield is bmpColorBitfield.value;
var bmpColorBitfield: greenBitfield is bmpColorBitfield.value;
var bmpColorBitfield: blueBitfield is bmpColorBitfield.value;
var bmpColorBitfield: alphaBitfield is bmpColorBitfield.value;
var integer: colorSpace is 0;
var array integer: colorSpaceEndpoints is 0 times 0;
var integer: redGamma is 0;
var integer: greenGamma is 0;
var integer: blueGamma is 0;
var colorLookupTable: palette is colorLookupTable.value;
end struct;
const func bmpColorBitfield: bmpColorBitfield (in integer: mask) is func
result
var bmpColorBitfield: bitfield is bmpColorBitfield.value;
begin
bitfield.mask := mask;
bitfield.rShift := lowestSetBit(bitfield.mask);
bitfield.scale := pred(2 ** (bitLength(bitfield.mask) - bitfield.rShift));
bitfield.rShift := max(0, bitfield.rShift);
end func;
const func string: str (in bmpColorBitfield: bitfield) is
return "(" <& bitfield.mask radix 2 lpad0 32 <&
", " <& bitfield.rShift lpad 2 <&
", " <& bitfield.scale <& ")";
const func integer: toColor (in bmpColorBitfield: bitfield, in integer: pixelColor) is
return 65535 * (integer(bin64(pixelColor) & bin64(bitfield.mask)) >> bitfield.rShift) div bitfield.scale;
const proc: readBitMasks (inout file: bmpFile, inout bmpHeader: header) is func
local
var integer: numOfBitMaskBytes is 0;
var string: stri is "";
begin
if header.compressionMethod = BMP_BI_BITFIELDS or
header.compressionMethod = BMP_BI_ALPHABITFIELDS then
numOfBitMaskBytes := header.compressionMethod = BMP_BI_BITFIELDS ? 12 : 16;
stri := gets(bmpFile, numOfBitMaskBytes);
if length(stri) = numOfBitMaskBytes then
header.calculatedOffset +:= numOfBitMaskBytes;
header.redBitfield := bmpColorBitfield(bytes2Int(stri[1 fixLen 4], UNSIGNED, LE));
header.greenBitfield := bmpColorBitfield(bytes2Int(stri[5 fixLen 4], UNSIGNED, LE));
header.blueBitfield := bmpColorBitfield(bytes2Int(stri[9 fixLen 4], UNSIGNED, LE));
if header.compressionMethod = BMP_BI_ALPHABITFIELDS then
header.alphaBitfield := bmpColorBitfield(bytes2Int(stri[13 fixLen 4], UNSIGNED, LE));
end if;
else
raise RANGE_ERROR;
end if;
end if;
end func;
const proc: showHeader (in bmpHeader: header) is func
begin
writeln("bmpFileSize: " <& header.bmpFileSize);
writeln("offset: " <& header.offset);
writeln("dibHeaderSize: " <& header.dibHeaderSize);
writeln("width: " <& header.width);
writeln("height: " <& header.height);
writeln("planes: " <& header.planes);
writeln("bitsPerPixel: " <& header.bitsPerPixel);
writeln("compressionMethod: " <& header.compressionMethod);
writeln("rawDataSize: " <& header.rawDataSize);
writeln("horizontalResolution: " <& header.horizontalResolution);
writeln("verticalResolution: " <& header.verticalResolution);
writeln("paletteColors: " <& header.paletteColors);
writeln("importantColors: " <& header.importantColors);
writeln("redBitfield: " <& str(header.redBitfield));
writeln("greenBitfield: " <& str(header.greenBitfield));
writeln("blueBitfield: " <& str(header.blueBitfield));
writeln("colorSpace: " <& bytes(header.colorSpace, UNSIGNED, BE));
writeln("redGamma: " <& header.redGamma);
writeln("greenGamma: " <& header.greenGamma);
writeln("blueGamma: " <& header.blueGamma);
end func;
const proc: readDibHeader (inout file: bmpFile, inout bmpHeader: header) is func
local
var string: stri is "";
begin
stri := gets(bmpFile, header.dibHeaderSize - 4);
if header.dibHeaderSize in {BMP_COREHEADER, BMP_INFOHEADER_OS22X_SHORT,
BMP_INFOHEADER, BMP_INFOHEADER_V2,
BMP_INFOHEADER_V3, BMP_INFOHEADER_OS22X,
BMP_INFOHEADER_V4, BMP_INFOHEADER_V5} and
length(stri) = header.dibHeaderSize - 4 then
header.calculatedOffset +:= header.dibHeaderSize;
if header.dibHeaderSize = BMP_COREHEADER then
header.width := bytes2Int(stri[1 fixLen 2], UNSIGNED, LE);
header.height := bytes2Int(stri[3 fixLen 2], UNSIGNED, LE);
header.planes := bytes2Int(stri[5 fixLen 2], UNSIGNED, LE);
header.bitsPerPixel := bytes2Int(stri[7 fixLen 2], UNSIGNED, LE);
elsif header.dibHeaderSize = BMP_INFOHEADER_OS22X_SHORT then
header.width := bytes2Int(stri[ 1 fixLen 4], UNSIGNED, LE);
header.height := bytes2Int(stri[ 5 fixLen 4], UNSIGNED, LE);
header.planes := bytes2Int(stri[ 9 fixLen 2], UNSIGNED, LE);
header.bitsPerPixel := bytes2Int(stri[11 fixLen 2], UNSIGNED, LE);
else
header.width := bytes2Int(stri[ 1 fixLen 4], UNSIGNED, LE);
header.height := bytes2Int(stri[ 5 fixLen 4], UNSIGNED, LE);
header.planes := bytes2Int(stri[ 9 fixLen 2], UNSIGNED, LE);
header.bitsPerPixel := bytes2Int(stri[11 fixLen 2], UNSIGNED, LE);
header.compressionMethod := bytes2Int(stri[13 fixLen 4], UNSIGNED, LE);
header.rawDataSize := bytes2Int(stri[17 fixLen 4], UNSIGNED, LE);
header.horizontalResolution := bytes2Int(stri[21 fixLen 4], UNSIGNED, LE);
header.verticalResolution := bytes2Int(stri[25 fixLen 4], UNSIGNED, LE);
header.paletteColors := bytes2Int(stri[29 fixLen 4], UNSIGNED, LE);
header.importantColors := bytes2Int(stri[33 fixLen 4], UNSIGNED, LE);
if header.dibHeaderSize = BMP_INFOHEADER then
readBitMasks(bmpFile, header);
elsif header.dibHeaderSize = BMP_INFOHEADER_V2 or
header.dibHeaderSize = BMP_INFOHEADER_V3 or
header.dibHeaderSize >= BMP_INFOHEADER_V4 then
if header.compressionMethod = BMP_BI_BITFIELDS or
header.compressionMethod = BMP_BI_ALPHABITFIELDS then
header.redBitfield := bmpColorBitfield(bytes2Int(stri[37 fixLen 4], UNSIGNED, LE));
header.greenBitfield := bmpColorBitfield(bytes2Int(stri[41 fixLen 4], UNSIGNED, LE));
header.blueBitfield := bmpColorBitfield(bytes2Int(stri[45 fixLen 4], UNSIGNED, LE));
if header.compressionMethod = BMP_BI_ALPHABITFIELDS then
header.alphaBitfield := bmpColorBitfield(bytes2Int(stri[49 fixLen 4], UNSIGNED, LE));
end if;
end if;
if header.dibHeaderSize >= BMP_INFOHEADER_V4 then
header.colorSpace := bytes2Int(stri[ 53 fixLen 4], UNSIGNED, LE);
header.redGamma := bytes2Int(stri[ 93 fixLen 4], UNSIGNED, LE);
header.greenGamma := bytes2Int(stri[ 97 fixLen 4], UNSIGNED, LE);
header.blueGamma := bytes2Int(stri[101 fixLen 4], UNSIGNED, LE);
end if;
end if;
end if;
else
raise RANGE_ERROR;
end if;
end func;
const proc: readHeader (inout file: bmpFile, inout bmpHeader: header) is func
local
const integer: STRI_SIZE is BMP_FILE_HEADER_SIZE - length(BMP_MAGIC) + 4;
var string: stri is "";
begin
stri := gets(bmpFile, STRI_SIZE);
if length(stri) = STRI_SIZE then
header.calculatedOffset := BMP_FILE_HEADER_SIZE;
header.bmpFileSize := bytes2Int(stri[ 1 fixLen 4], UNSIGNED, LE);
header.offset := bytes2Int(stri[ 9 fixLen 4], UNSIGNED, LE);
header.dibHeaderSize := bytes2Int(stri[13 fixLen 4], UNSIGNED, LE);
readDibHeader(bmpFile, header);
else
raise RANGE_ERROR;
end if;
end func;
const proc: computeNumberOfPaletteColors (inout bmpHeader: header,
in integer: colorEntrySize) is func
begin
if header.calculatedOffset < header.offset then
header.paletteColors :=
(header.offset - header.calculatedOffset) mdiv colorEntrySize;
elsif header.offset = 0 then
header.paletteColors := 2 ** header.bitsPerPixel;
end if;
end func;
const proc: readPaletteData (inout file: bmpFile, inout bmpHeader: header,
in integer: colorEntrySize) is func
local
var integer: numOfPaletteBytes is 0;
var string: stri is "";
var integer: index is 0;
var integer: byteIndex is 1;
begin
numOfPaletteBytes := header.paletteColors * colorEntrySize;
header.paletteColors := min(header.paletteColors, 256);
header.palette := colorLookupTable[.. pred(header.paletteColors)] times pixel.value;
stri := gets(bmpFile, numOfPaletteBytes);
if length(stri) = numOfPaletteBytes then
header.calculatedOffset +:= numOfPaletteBytes;
for index range 0 to pred(header.paletteColors) do
header.palette[index] := rgbPixel(ord(stri[byteIndex + 2]) * 256,
ord(stri[succ(byteIndex)]) * 256,
ord(stri[byteIndex]) * 256);
byteIndex +:= colorEntrySize;
end for;
else
raise RANGE_ERROR;
end if;
end func;
const proc: readPalette (inout file: bmpFile, inout bmpHeader: header) is func
local
var integer: colorEntrySize is 0;
begin
colorEntrySize := header.dibHeaderSize = BMP_COREHEADER ? 3 : 4;
if header.bitsPerPixel <> 0 and header.bitsPerPixel <= 8 and
header.paletteColors = 0 then
computeNumberOfPaletteColors(header, colorEntrySize);
end if;
if header.paletteColors > 0 then
readPaletteData(bmpFile, header, colorEntrySize);
end if;
end func;
const proc: readBmpImage1Bit (inout file: bmpFile, inout bmpHeader: header,
inout pixelImage: image) is func
local
var string: stri is "";
var integer: padding is 0;
var integer: line is 0;
var integer: column is 0;
var integer: byteIndex is 0;
var integer: currentByte is 0;
var integer: rshift is 0;
begin
padding := -succ(pred(header.width) mdiv 8) mod 4;
for line range header.height downto 1 do
stri := gets(bmpFile, succ(pred(header.width) mdiv 8) + padding);
byteIndex := 1;
for column range 1 to (header.width - 7) step 8 do
currentByte := ord(stri[byteIndex]);
image[line][column] := header.palette[ currentByte >> 7];
image[line][succ(column)] := header.palette[(currentByte >> 6) mod 2];
image[line][column + 2] := header.palette[(currentByte >> 5) mod 2];
image[line][column + 3] := header.palette[(currentByte >> 4) mod 2];
image[line][column + 4] := header.palette[(currentByte >> 3) mod 2];
image[line][column + 5] := header.palette[(currentByte >> 2) mod 2];
image[line][column + 6] := header.palette[(currentByte >> 1) mod 2];
image[line][column + 7] := header.palette[ currentByte mod 2];
incr(byteIndex);
end for;
if header.width mod 8 <> 0 then
currentByte := ord(stri[byteIndex]);
rshift := 7;
for column range succ(header.width - header.width mod 8) to header.width do
image[line][column] := header.palette[(currentByte >> rshift) mod 2];
decr(rshift);
end for;
incr(byteIndex);
end if;
end for;
end func;
const proc: readBmpImage2Bit (inout file: bmpFile, inout bmpHeader: header,
inout pixelImage: image) is func
local
var string: stri is "";
var integer: padding is 0;
var integer: line is 0;
var integer: column is 0;
var integer: byteIndex is 0;
var integer: currentByte is 0;
var integer: rshift is 0;
begin
padding := -succ(pred(header.width) mdiv 4) mod 4;
for line range header.height downto 1 do
stri := gets(bmpFile, succ(pred(header.width) mdiv 4) + padding);
byteIndex := 1;
for column range 1 to (header.width - 3) step 4 do
currentByte := ord(stri[byteIndex]);
image[line][column] := header.palette[ currentByte >> 6];
image[line][succ(column)] := header.palette[(currentByte >> 4) mod 4];
image[line][column + 2] := header.palette[(currentByte >> 2) mod 4];
image[line][column + 3] := header.palette[ currentByte mod 4];
incr(byteIndex);
end for;
if header.width mod 4 <> 0 then
currentByte := ord(stri[byteIndex]);
rshift := 6;
for column range succ(header.width - header.width mod 4) to header.width do
image[line][column] := header.palette[(currentByte >> rshift) mod 4];
rshift -:= 2;
end for;
incr(byteIndex);
end if;
end for;
end func;
const proc: readBmpImage4Bit (inout file: bmpFile, inout bmpHeader: header,
inout pixelImage: image) is func
local
var string: stri is "";
var integer: padding is 0;
var integer: line is 0;
var integer: column is 0;
var integer: byteIndex is 0;
var integer: pixelColor is 0;
begin
padding := -succ(pred(header.width) mdiv 2) mod 4;
for line range header.height downto 1 do
stri := gets(bmpFile, succ(pred(header.width) mdiv 2) + padding);
byteIndex := 1;
for column range 1 to header.width do
if odd(column) then
image[line][column] := header.palette[ord(stri[byteIndex]) >> 4];
else
image[line][column] := header.palette[ord(stri[byteIndex]) mod 16];
incr(byteIndex);
end if;
end for;
end for;
end func;
const proc: readBmpImage8Bit (inout file: bmpFile, inout bmpHeader: header,
inout pixelImage: image) is func
local
var string: stri is "";
var integer: padding is 0;
var integer: line is 0;
var integer: column is 0;
var integer: byteIndex is 0;
var integer: pixelColor is 0;
begin
padding := -header.width mod 4;
for line range header.height downto 1 do
stri := gets(bmpFile, header.width + padding);
byteIndex := 1;
for column range 1 to header.width do
pixelColor := ord(stri[byteIndex]);
image[line][column] := header.palette[pixelColor];
incr(byteIndex);
end for;
end for;
end func;
const proc: readBmpImage16Bit (inout file: bmpFile, inout bmpHeader: header,
inout pixelImage: image) is func
local
var string: stri is "";
var integer: padding is 0;
var integer: line is 0;
var integer: column is 0;
var integer: byteIndex is 0;
var integer: pixelColor is 0;
begin
padding := -(2 * header.width) mod 4;
if header.redBitfield.mask <> 0 or
header.greenBitfield.mask <> 0 or
header.blueBitfield.mask <> 0 then
for line range header.height downto 1 do
stri := gets(bmpFile, 2 * header.width + padding);
byteIndex := 1;
for column range 1 to header.width do
pixelColor := bytes2Int(stri[byteIndex fixLen 2], UNSIGNED, LE);
image[line][column] := rgbPixel(toColor(header.redBitfield, pixelColor),
toColor(header.greenBitfield, pixelColor),
toColor(header.blueBitfield, pixelColor));
byteIndex +:= 2;
end for;
end for;
else
for line range header.height downto 1 do
stri := gets(bmpFile, 2 * header.width + padding);
byteIndex := 1;
for column range 1 to header.width do
pixelColor := bytes2Int(stri[byteIndex fixLen 2], UNSIGNED, LE);
image[line][column] := rgbPixel(((pixelColor >> 10) mod 32) * 2114,
((pixelColor >> 5) mod 32) * 2114,
( pixelColor mod 32) * 2114);
byteIndex +:= 2;
end for;
end for;
end if;
end func;
const proc: readBmpImage24Bit (inout file: bmpFile, inout bmpHeader: header,
inout pixelImage: image) is func
local
var string: stri is "";
var integer: padding is 0;
var integer: line is 0;
var integer: column is 0;
var integer: byteIndex is 0;
begin
padding := -(3 * header.width) mod 4;
for line range header.height downto 1 do
stri := gets(bmpFile, 3 * header.width + padding);
byteIndex := 1;
for column range 1 to header.width do
image[line][column] := rgbPixel(ord(stri[byteIndex + 2]) * 256,
ord(stri[byteIndex + 1]) * 256,
ord(stri[byteIndex]) * 256);
byteIndex +:= 3;
end for;
end for;
end func;
const proc: readBmpImage32Bit (inout file: bmpFile, inout bmpHeader: header,
inout pixelImage: image) is func
local
var string: stri is "";
var integer: padding is 0;
var integer: line is 0;
var integer: column is 0;
var integer: byteIndex is 0;
var integer: pixelColor is 0;
begin
padding := -(4 * header.width) mod 4;
if header.redBitfield.mask <> 0 or
header.greenBitfield.mask <> 0 or
header.blueBitfield.mask <> 0 then
for line range header.height downto 1 do
stri := gets(bmpFile, 4 * header.width + padding);
byteIndex := 1;
for column range 1 to header.width do
pixelColor := bytes2Int(stri[byteIndex fixLen 4], UNSIGNED, LE);
image[line][column] := rgbPixel(toColor(header.redBitfield, pixelColor),
toColor(header.greenBitfield, pixelColor),
toColor(header.blueBitfield, pixelColor));
byteIndex +:= 4;
end for;
end for;
else
for line range header.height downto 1 do
stri := gets(bmpFile, 4 * header.width + padding);
byteIndex := 1;
for column range 1 to header.width do
image[line][column] := rgbPixel(ord(stri[byteIndex + 2]) * 256,
ord(stri[byteIndex + 1]) * 256,
ord(stri[byteIndex]) * 256);
byteIndex +:= 4;
end for;
end for;
end if;
end func;
const proc: readBmpImageRle4 (inout file: bmpFile, inout bmpHeader: header,
inout pixelImage: image) is func
local
var char: aByte is ' ';
var integer: line is 0;
var integer: column is 1;
var integer: count is 0;
var integer: index is 0;
var boolean: endOfBitmap is FALSE;
begin
line := header.height;
repeat
aByte := getc(bmpFile);
if aByte = '\0;' then
aByte := getc(bmpFile);
case aByte of
when {'\0;'}:
decr(line);
column := 1;
when {'\1;'}:
endOfBitmap := TRUE;
when {'\2;'}:
column +:= ord(getc(bmpFile));
line -:= ord(getc(bmpFile));
otherwise:
count := ord(aByte);
for index range 0 to pred(count) do
if odd(index) then
image[line][column + index] := header.palette[ord(aByte) mod 16];
else
aByte := getc(bmpFile);
image[line][column + index] := header.palette[ord(aByte) >> 4];
end if;
end for;
column +:= count;
if odd(succ(count) div 2) then
aByte := getc(bmpFile);
end if;
end case;
elsif aByte = EOF then
endOfBitmap := TRUE;
else
count := ord(aByte);
aByte := getc(bmpFile);
for index range 0 to pred(count) do
if odd(index) then
image[line][column + index] := header.palette[ord(aByte) mod 16];
else
image[line][column + index] := header.palette[ord(aByte) >> 4];
end if;
end for;
column +:= count;
end if;
until endOfBitmap;
end func;
const proc: readBmpImageRle8 (inout file: bmpFile, inout bmpHeader: header,
inout pixelImage: image) is func
local
var char: aByte is ' ';
var integer: line is 0;
var integer: column is 1;
var integer: count is 0;
var integer: index is 0;
var boolean: endOfBitmap is FALSE;
begin
line := header.height;
repeat
aByte := getc(bmpFile);
if aByte = '\0;' then
aByte := getc(bmpFile);
case aByte of
when {'\0;'}:
decr(line);
column := 1;
when {'\1;'}:
endOfBitmap := TRUE;
when {'\2;'}:
column +:= ord(getc(bmpFile));
line -:= ord(getc(bmpFile));
otherwise:
count := ord(aByte);
for index range column to column + pred(count) do
image[line][index] := header.palette[ord(getc(bmpFile))];
end for;
column +:= count;
if odd(count) then
aByte := getc(bmpFile);
end if;
end case;
elsif aByte = EOF then
endOfBitmap := TRUE;
else
count := ord(aByte);
aByte := getc(bmpFile);
for index range column to column + pred(count) do
image[line][index] := header.palette[ord(aByte)];
end for;
column +:= count;
end if;
until endOfBitmap;
end func;
const func PRIMITIVE_WINDOW: readBmp (inout file: bmpFile, inout bmpHeader: header) is func
result
var PRIMITIVE_WINDOW: pixmap is PRIMITIVE_WINDOW.value;
local
var pixelImage: image is pixelImage.value;
begin
readPalette(bmpFile, header);
if header.calculatedOffset < header.offset then
ignore(gets(bmpFile, header.offset - header.calculatedOffset));
elsif header.offset <> 0 and header.calculatedOffset > header.offset then
raise RANGE_ERROR;
end if;
if header.compressionMethod = BMP_BI_JPEG then
pixmap := readJpeg(bmpFile);
elsif header.compressionMethod = BMP_BI_PNG then
pixmap := readPng(bmpFile);
else
if header.compressionMethod not in {BMP_BI_RLE4, BMP_BI_RLE8} and
length(bmpFile) - header.offset <
(header.height * header.width * header.bitsPerPixel + 7) div 8 then
raise MEMORY_ERROR;
end if;
image := pixelImage[.. header.height] times
pixelArray[.. header.width] times pixel.value;
case header.bitsPerPixel of
when {1}:
readBmpImage1Bit(bmpFile, header, image);
when {2}:
readBmpImage2Bit(bmpFile, header, image);
when {4}:
if header.compressionMethod = BMP_BI_RLE4 then
readBmpImageRle4(bmpFile, header, image);
else
readBmpImage4Bit(bmpFile, header, image);
end if;
when {8}:
if header.compressionMethod = BMP_BI_RLE8 then
readBmpImageRle8(bmpFile, header, image);
else
readBmpImage8Bit(bmpFile, header, image);
end if;
when {16}:
readBmpImage16Bit(bmpFile, header, image);
when {24}:
readBmpImage24Bit(bmpFile, header, image);
when {32}:
readBmpImage32Bit(bmpFile, header, image);
otherwise:
raise RANGE_ERROR;
end case;
pixmap := getPixmap(image);
end if;
end func;
const func PRIMITIVE_WINDOW: readBmp (inout file: bmpFile) is func
result
var PRIMITIVE_WINDOW: pixmap is PRIMITIVE_WINDOW.value;
local
var string: magic is "";
var bmpHeader: header is bmpHeader.value;
begin
magic := gets(bmpFile, length(BMP_MAGIC));
if magic = BMP_MAGIC then
readHeader(bmpFile, header);
pixmap := readBmp(bmpFile, header);
end if;
end func;
const func PRIMITIVE_WINDOW: readBmp (in string: bmpFileName) is func
result
var PRIMITIVE_WINDOW: pixmap is PRIMITIVE_WINDOW.value;
local
var file: bmpFile is STD_NULL;
begin
bmpFile := open(bmpFileName, "r");
if bmpFile <> STD_NULL then
pixmap := readBmp(bmpFile);
close(bmpFile);
end if;
end func;
const func string: str (in PRIMITIVE_WINDOW: pixmap, BMP) is func
result
var string: stri is BMP_MAGIC;
local
var integer: width is 0;
var integer: height is 0;
var integer: padding is 0;
var integer: rawDataSize is 0;
var pixelImage: image is pixelImage.value;
var integer: line is 0;
var pixel: pix is pixel.value;
var color: col is color.value;
begin
width := width(pixmap);
height := height(pixmap);
padding := -(3 * width) mod 4;
rawDataSize := height * (3 * width + padding);
stri &:= bytes(rawDataSize + 54, UNSIGNED, LE, 4) &
"\0;" mult 4 &
bytes(54, UNSIGNED, LE, 4) &
bytes(BMP_INFOHEADER, UNSIGNED, LE, 4) &
bytes(width, UNSIGNED, LE, 4) &
bytes(height, UNSIGNED, LE, 4) &
bytes(1, UNSIGNED, LE, 2) &
bytes(24, UNSIGNED, LE, 2) &
bytes(BMP_BI_RGB, UNSIGNED, LE, 4) &
bytes(rawDataSize, UNSIGNED, LE, 4) &
bytes(2835, UNSIGNED, LE, 4) &
bytes(2835, UNSIGNED, LE, 4) &
bytes(0, UNSIGNED, LE, 4) &
bytes(0, UNSIGNED, LE, 4);
image := getPixelImage(pixmap);
for line range height downto 1 do
for pix range image[line] do
col := pixelToColor(pix);
stri &:= chr(col.blueLight mdiv 256);
stri &:= chr(col.greenLight mdiv 256);
stri &:= chr(col.redLight mdiv 256);
end for;
stri &:= "\0;" mult padding;
end for;
end func;
const proc: writeBmp (in string: bmpFileName, in PRIMITIVE_WINDOW: pixmap) is func
local
var file: bmpFile is STD_NULL;
begin
bmpFile := open(bmpFileName, "w");
if bmpFile <> STD_NULL then
write(bmpFile, str(pixmap, BMP));
close(bmpFile);
end if;
end func;