include "bytedata.s7i";
include "bin32.s7i";
include "crc32.s7i";
include "draw.s7i";
include "gzip.s7i";
include "pixelimage.s7i";
include "exif.s7i";
const string: PNG_MAGIC is "\137;PNG\r\n\26;\n";
const integer: PNG_HEADER_SIZE is 13;
const integer: PNG_COLOR_TYPE_GRAYSCALE is 0;
const integer: PNG_COLOR_TYPE_RGB is 2;
const integer: PNG_COLOR_TYPE_PALETTE is 3;
const integer: PNG_COLOR_TYPE_GRAYSCALE_ALPHA is 4;
const integer: PNG_COLOR_TYPE_RGB_ALPHA is 6;
const type: pngHeader is new struct
var integer: width is 0;
var integer: height is 0;
var integer: bitDepth is 0;
var integer: colorType is 0;
var integer: compressionMethod is 0;
var integer: filterMethod is 0;
var integer: interlaceMethod is 0;
var integer: bytesPerPixel is 0;
var integer: bytesPerScanline is 0;
var exifDataType: exifData is exifDataType.value;
end struct;
const proc: showHeader (in pngHeader: header) is func
begin
writeln("width: " <& header.width);
writeln("height: " <& header.height);
writeln("bitDepth: " <& header.bitDepth);
writeln("colorType: " <& header.colorType);
writeln("compressionMethod: " <& header.compressionMethod);
writeln("filterMethod: " <& header.filterMethod);
writeln("interlaceMethod: " <& header.interlaceMethod);
writeln("bytesPerPixel: " <& header.bytesPerPixel);
writeln("bytesPerScanline: " <& header.bytesPerScanline);
end func;
const func pngHeader: pngHeader (in string: stri) is func
result
var pngHeader: header is pngHeader.value;
begin
if length(stri) = PNG_HEADER_SIZE then
header.width := bytes2Int(stri[ 1 fixLen 4], UNSIGNED, BE);
header.height := bytes2Int(stri[ 5 fixLen 4], UNSIGNED, BE);
header.bitDepth := bytes2Int(stri[ 9 fixLen 1], UNSIGNED, BE);
header.colorType := bytes2Int(stri[10 fixLen 1], UNSIGNED, BE);
header.compressionMethod := bytes2Int(stri[11 fixLen 1], UNSIGNED, BE);
header.filterMethod := bytes2Int(stri[12 fixLen 1], UNSIGNED, BE);
header.interlaceMethod := bytes2Int(stri[13 fixLen 1], UNSIGNED, BE);
else
raise RANGE_ERROR;
end if;
end func;
const func string: str (in pngHeader: header) is
return bytes(header.width, UNSIGNED, BE, 4) &
bytes(header.height, UNSIGNED, BE, 4) &
bytes(header.bitDepth, UNSIGNED, BE, 1) &
bytes(header.colorType, UNSIGNED, BE, 1) &
bytes(header.compressionMethod, UNSIGNED, BE, 1) &
bytes(header.filterMethod, UNSIGNED, BE, 1) &
bytes(header.interlaceMethod, UNSIGNED, BE, 1);
const func boolean: isOkay (in pngHeader: header) is
return (header.colorType = PNG_COLOR_TYPE_GRAYSCALE or
header.colorType = PNG_COLOR_TYPE_RGB or
header.colorType = PNG_COLOR_TYPE_GRAYSCALE_ALPHA or
header.colorType = PNG_COLOR_TYPE_RGB_ALPHA) and
(header.bitDepth = 8 or header.bitDepth = 16) or
(header.colorType = PNG_COLOR_TYPE_GRAYSCALE or
header.colorType = PNG_COLOR_TYPE_PALETTE) and
(header.bitDepth = 1 or header.bitDepth = 2 or
header.bitDepth = 4 or header.bitDepth = 8);
const proc: computeBytesPerPixel (inout pngHeader: header) is func
begin
case header.colorType of
when {PNG_COLOR_TYPE_GRAYSCALE}: header.bytesPerPixel := 1;
when {PNG_COLOR_TYPE_RGB}: header.bytesPerPixel := 3;
when {PNG_COLOR_TYPE_PALETTE}: header.bytesPerPixel := 1;
when {PNG_COLOR_TYPE_GRAYSCALE_ALPHA}: header.bytesPerPixel := 2;
when {PNG_COLOR_TYPE_RGB_ALPHA}: header.bytesPerPixel := 4;
otherwise: raise RANGE_ERROR;
end case;
if header.bitDepth = 16 then
header.bytesPerPixel *:= 2;
end if;
end func;
const proc: computeBytesPerScanline (inout pngHeader: header) is func
begin
if header.bitDepth = 1 then
header.bytesPerScanline := succ((header.width + 7) mdiv 8);
elsif header.bitDepth = 2 then
header.bytesPerScanline := succ((header.width + 3) mdiv 4);
elsif header.bitDepth = 4 then
header.bytesPerScanline := succ(succ(header.width) mdiv 2);
else
header.bytesPerScanline := succ(header.width * header.bytesPerPixel);
end if;
end func;
const func string: readPngChunk (inout file: pngFile, inout string: chunkType) is func
result
var string: chunkData is "";
local
var string: stri is "";
var integer: length is 0;
var string: crc is "";
begin
stri := gets(pngFile, 8);
if length(stri) = 8 then
length := bytes2Int(stri[1 fixLen 4], UNSIGNED, BE);
chunkType := stri[5 fixLen 4];
chunkData := gets(pngFile, length);
crc := gets(pngFile, 4);
if length(chunkData) <> length or length(crc) <> 4 then
raise RANGE_ERROR;
elsif bin32(bytes2Int(crc, UNSIGNED, BE)) <>
crc32(chunkType & chunkData) and
chunkType in {"IHDR", "PLTE", "IDAT", "IEND"} then
raise RANGE_ERROR;
end if;
else
raise RANGE_ERROR;
end if;
end func;
const func integer: paethPredictor (in integer: a, in integer: b, in integer: c) is func
result
var integer: predicted is 0;
local
var integer: pa is 0;
var integer: pb is 0;
var integer: pc is 0;
begin
pa := abs(b - c);
pb := abs(a - c);
pc := abs(a + b - 2 * c);
if pa <= pb and pa <= pc then
predicted := a;
elsif pb <= pc then
predicted := b;
else
predicted := c;
end if;
end func;
const proc: filterPngData (in pngHeader: header, inout string: uncompressed) is func
local
var integer: line is 0;
var integer: column is 0;
var integer: byteIndex is 1;
var integer: filterType is 0;
var integer: deltaUpLeft is 0;
begin
for line range 0 to pred(header.height) do
byteIndex := succ(line * header.bytesPerScanline);
filterType := ord(uncompressed[byteIndex]);
incr(byteIndex);
case filterType of
when {0}:
noop;
when {1}:
for column range byteIndex + header.bytesPerPixel to byteIndex + header.bytesPerScanline - 2 do
uncompressed @:= [column] chr((ord(uncompressed[column]) +
ord(uncompressed[column - header.bytesPerPixel])) mod 256);
end for;
when {2}:
if line <> 0 then
for column range byteIndex to byteIndex + header.bytesPerScanline - 2 do
uncompressed @:= [column] chr((ord(uncompressed[column]) +
ord(uncompressed[column - header.bytesPerScanline])) mod 256);
end for;
end if;
when {3}:
if line = 0 then
for column range byteIndex + header.bytesPerPixel to byteIndex + header.bytesPerScanline - 2 do
uncompressed @:= [column] chr((ord(uncompressed[column]) +
ord(uncompressed[column - header.bytesPerPixel]) mdiv 2) mod 256);
end for;
else
for column range byteIndex to byteIndex + header.bytesPerPixel - 1 do
uncompressed @:= [column] chr((ord(uncompressed[column]) +
ord(uncompressed[column - header.bytesPerScanline]) mdiv 2) mod 256);
end for;
for column range byteIndex + header.bytesPerPixel to byteIndex + header.bytesPerScanline - 2 do
uncompressed @:= [column] chr((ord(uncompressed[column]) +
(ord(uncompressed[column - header.bytesPerPixel]) +
ord(uncompressed[column - header.bytesPerScanline])) mdiv 2) mod 256);
end for;
end if;
when {4}:
if line = 0 then
for column range byteIndex + header.bytesPerPixel to byteIndex + header.bytesPerScanline - 2 do
uncompressed @:= [column] chr((ord(uncompressed[column]) +
paethPredictor(ord(uncompressed[column - header.bytesPerPixel]),
0, 0)) mod 256);
end for;
else
for column range byteIndex to byteIndex + header.bytesPerPixel - 1 do
uncompressed @:= [column] chr((ord(uncompressed[column]) +
paethPredictor(0,
ord(uncompressed[column - header.bytesPerScanline]),
0)) mod 256);
end for;
deltaUpLeft := header.bytesPerScanline + header.bytesPerPixel;
for column range byteIndex + header.bytesPerPixel to byteIndex + header.bytesPerScanline - 2 do
uncompressed @:= [column] chr((ord(uncompressed[column]) +
paethPredictor(ord(uncompressed[column - header.bytesPerPixel]),
ord(uncompressed[column - header.bytesPerScanline]),
ord(uncompressed[column - deltaUpLeft]))) mod 256);
end for;
end if;
end case;
end for;
end func;
const proc: fillPngImageLine1Bit (inout pixelArray: imageLine, in string: pixelData,
inout integer: byteIndex, in colorLookupTable: palette, in integer: width) is func
local
var integer: column is 0;
var integer: currentByte is 0;
var integer: rshift is 0;
begin
incr(byteIndex);
for column range 1 to (width - 7) step 8 do
currentByte := ord(pixelData[byteIndex]);
imageLine[column] := palette[ currentByte >> 7];
imageLine[succ(column)] := palette[(currentByte >> 6) mod 2];
imageLine[column + 2] := palette[(currentByte >> 5) mod 2];
imageLine[column + 3] := palette[(currentByte >> 4) mod 2];
imageLine[column + 4] := palette[(currentByte >> 3) mod 2];
imageLine[column + 5] := palette[(currentByte >> 2) mod 2];
imageLine[column + 6] := palette[(currentByte >> 1) mod 2];
imageLine[column + 7] := palette[ currentByte mod 2];
incr(byteIndex);
end for;
if width mod 8 <> 0 then
currentByte := ord(pixelData[byteIndex]);
rshift := 7;
for column range succ(width - width mod 8) to width do
imageLine[column] := palette[(currentByte >> rshift) mod 2];
decr(rshift);
end for;
incr(byteIndex);
end if;
end func;
const proc: fillPngImage1Bit (inout pixelImage: image, in string: pixelData,
in colorLookupTable: palette, in integer: height, in integer: width) is func
local
var integer: line is 0;
var integer: byteIndex is 1;
begin
for line range 1 to height do
fillPngImageLine1Bit(image[line], pixelData, byteIndex, palette, width);
end for;
end func;
const proc: fillPngImageLine2Bit (inout pixelArray: imageLine, in string: pixelData,
inout integer: byteIndex, in colorLookupTable: palette, in integer: width) is func
local
var integer: column is 0;
var integer: currentByte is 0;
var integer: rshift is 0;
begin
incr(byteIndex);
for column range 1 to (width - 3) step 4 do
currentByte := ord(pixelData[byteIndex]);
imageLine[column] := palette[ currentByte >> 6];
imageLine[succ(column)] := palette[(currentByte >> 4) mod 4];
imageLine[column + 2] := palette[(currentByte >> 2) mod 4];
imageLine[column + 3] := palette[ currentByte mod 4];
incr(byteIndex);
end for;
if width mod 4 <> 0 then
currentByte := ord(pixelData[byteIndex]);
rshift := 6;
for column range succ(width - width mod 4) to width do
imageLine[column] := palette[(currentByte >> rshift) mod 4];
rshift -:= 2;
end for;
incr(byteIndex);
end if;
end func;
const proc: fillPngImage2Bit (inout pixelImage: image, in string: pixelData,
in colorLookupTable: palette, in integer: height, in integer: width) is func
local
var integer: line is 0;
var integer: byteIndex is 1;
begin
for line range 1 to height do
fillPngImageLine2Bit(image[line], pixelData, byteIndex, palette, width);
end for;
end func;
const proc: fillPngImageLine4Bit (inout pixelArray: imageLine, in string: pixelData,
inout integer: byteIndex, in colorLookupTable: palette, in integer: width) is func
local
var integer: column is 0;
var integer: currentByte is 0;
begin
incr(byteIndex);
for column range 1 to pred(width) step 2 do
currentByte := ord(pixelData[byteIndex]);
imageLine[column] := palette[currentByte >> 4];
imageLine[succ(column)] := palette[currentByte mod 16];
incr(byteIndex);
end for;
if odd(width) then
imageLine[width] := palette[ord(pixelData[byteIndex]) >> 4];
incr(byteIndex);
end if;
end func;
const proc: fillPngImage4Bit (inout pixelImage: image, in string: pixelData,
in colorLookupTable: palette, in integer: height, in integer: width) is func
local
var integer: line is 0;
var integer: byteIndex is 1;
begin
for line range 1 to height do
fillPngImageLine4Bit(image[line], pixelData, byteIndex, palette, width);
end for;
end func;
const proc: fillPngImageLine8Bit (inout pixelArray: imageLine, in string: pixelData,
inout integer: byteIndex, in colorLookupTable: palette, in integer: width) is func
local
var integer: column is 0;
begin
incr(byteIndex);
for column range 1 to width do
imageLine[column] := palette[ord(pixelData[byteIndex])];
incr(byteIndex);
end for;
end func;
const proc: fillPngImage8Bit (inout pixelImage: image, in string: pixelData,
in colorLookupTable: palette, in integer: height, in integer: width) is func
local
var integer: line is 0;
var integer: byteIndex is 1;
begin
for line range 1 to height do
fillPngImageLine8Bit(image[line], pixelData, byteIndex, palette, width);
end for;
end func;
const proc: fillPngImageLine8Bit (inout pixelArray: imageLine, in string: pixelData,
inout integer: byteIndex, in integer: bytesPerPixel, in integer: width) is func
local
var integer: column is 0;
var integer: grayIntensity is 0;
begin
incr(byteIndex);
for column range 1 to width do
grayIntensity := ord(pixelData[byteIndex]) * 256;
imageLine[column] := rgbPixel(grayIntensity, grayIntensity, grayIntensity);
byteIndex +:= bytesPerPixel;
end for;
end func;
const proc: fillPngImage8Bit (inout pixelImage: image, in string: pixelData,
in integer: bytesPerPixel, in integer: height, in integer: width) is func
local
var integer: line is 0;
var integer: byteIndex is 1;
begin
for line range 1 to height do
fillPngImageLine8Bit(image[line], pixelData, byteIndex, bytesPerPixel, width);
end for;
end func;
const proc: fillPngImageLine16Bit (inout pixelArray: imageLine, in string: pixelData,
inout integer: byteIndex, in integer: bytesPerPixel, in integer: width) is func
local
var integer: column is 0;
var integer: grayIntensity is 0;
begin
incr(byteIndex);
for column range 1 to width do
grayIntensity := ord(pixelData[byteIndex]) * 256 + ord(pixelData[succ(byteIndex)]);
imageLine[column] := rgbPixel(grayIntensity, grayIntensity, grayIntensity);
byteIndex +:= bytesPerPixel;
end for;
end func;
const proc: fillPngImage16Bit (inout pixelImage: image, in string: pixelData,
in integer: bytesPerPixel, in integer: height, in integer: width) is func
local
var integer: line is 0;
var integer: byteIndex is 1;
begin
for line range 1 to height do
fillPngImageLine16Bit(image[line], pixelData, byteIndex, bytesPerPixel, width);
end for;
end func;
const proc: fillPngImageLine24Bit (inout pixelArray: imageLine, in string: pixelData,
inout integer: byteIndex, in integer: bytesPerPixel, in integer: width) is func
local
var integer: column is 0;
begin
incr(byteIndex);
for column range 1 to width do
imageLine[column] := rgbPixel(ord(pixelData[byteIndex]) * 256,
ord(pixelData[byteIndex + 1]) * 256,
ord(pixelData[byteIndex + 2]) * 256);
byteIndex +:= bytesPerPixel;
end for;
end func;
const proc: fillPngImage24Bit (inout pixelImage: image, in string: pixelData,
in integer: bytesPerPixel, in integer: height, in integer: width) is func
local
var integer: line is 0;
var integer: byteIndex is 1;
begin
for line range 1 to height do
fillPngImageLine24Bit(image[line], pixelData, byteIndex, bytesPerPixel, width);
end for;
end func;
const proc: fillPngImageLine48Bit (inout pixelArray: imageLine, in string: pixelData,
inout integer: byteIndex, in integer: bytesPerPixel, in integer: width) is func
local
var integer: column is 0;
begin
incr(byteIndex);
for column range 1 to width do
imageLine[column] := rgbPixel(bytes2Int(pixelData[byteIndex fixLen 2], UNSIGNED, BE),
bytes2Int(pixelData[byteIndex + 2 fixLen 2], UNSIGNED, BE),
bytes2Int(pixelData[byteIndex + 4 fixLen 2], UNSIGNED, BE));
byteIndex +:= bytesPerPixel;
end for;
end func;
const proc: fillPngImage48Bit (inout pixelImage: image, in string: pixelData,
in integer: bytesPerPixel, in integer: height, in integer: width) is func
local
var integer: line is 0;
var integer: byteIndex is 1;
begin
for line range 1 to height do
fillPngImageLine48Bit(image[line], pixelData, byteIndex, bytesPerPixel, width);
end for;
end func;
const func pixelImage: pixelDataToImage (in pngHeader: header,
in string: pixelData, in colorLookupTable: palette) is func
result
var pixelImage: image is pixelImage.value;
local
var colorLookupTable: grayscalePalette is colorLookupTable.value;
begin
image := pixelImage[.. header.height] times
pixelArray[.. header.width] times pixel.value;
if header.colorType = PNG_COLOR_TYPE_GRAYSCALE or
header.colorType = PNG_COLOR_TYPE_GRAYSCALE_ALPHA then
if header.bitDepth = 1 then
grayscalePalette := colorLookupTable[.. 1] times pixel.value;
grayscalePalette[0] := rgbPixel( 0, 0, 0);
grayscalePalette[1] := rgbPixel(65535, 65535, 65535);
fillPngImage1Bit(image, pixelData, grayscalePalette, header.height, header.width);
elsif header.bitDepth = 2 then
grayscalePalette := colorLookupTable[.. 3] times pixel.value;
grayscalePalette[0] := rgbPixel( 0, 0, 0);
grayscalePalette[1] := rgbPixel(21845, 21845, 21845);
grayscalePalette[2] := rgbPixel(43690, 43690, 43690);
grayscalePalette[3] := rgbPixel(65535, 65535, 65535);
fillPngImage2Bit(image, pixelData, grayscalePalette, header.height, header.width);
elsif header.bitDepth = 4 then
grayscalePalette := colorLookupTable[.. 15] times pixel.value;
grayscalePalette[ 0] := rgbPixel( 0, 0, 0);
grayscalePalette[ 1] := rgbPixel( 4369, 4369, 4369);
grayscalePalette[ 2] := rgbPixel( 8738, 8738, 8738);
grayscalePalette[ 3] := rgbPixel(13107, 13107, 13107);
grayscalePalette[ 4] := rgbPixel(17476, 17476, 17476);
grayscalePalette[ 5] := rgbPixel(21845, 21845, 21845);
grayscalePalette[ 6] := rgbPixel(26214, 26214, 26214);
grayscalePalette[ 7] := rgbPixel(30583, 30583, 30583);
grayscalePalette[ 8] := rgbPixel(34952, 34952, 34952);
grayscalePalette[ 9] := rgbPixel(39321, 39321, 39321);
grayscalePalette[10] := rgbPixel(43690, 43690, 43690);
grayscalePalette[11] := rgbPixel(48059, 48059, 48059);
grayscalePalette[12] := rgbPixel(52428, 52428, 52428);
grayscalePalette[13] := rgbPixel(56797, 56797, 56797);
grayscalePalette[14] := rgbPixel(61166, 61166, 61166);
grayscalePalette[15] := rgbPixel(65535, 65535, 65535);
fillPngImage4Bit(image, pixelData, grayscalePalette, header.height, header.width);
elsif header.bitDepth = 8 then
fillPngImage8Bit(image, pixelData, header.bytesPerPixel, header.height, header.width);
else
fillPngImage16Bit(image, pixelData, header.bytesPerPixel, header.height, header.width);
end if;
elsif header.colorType = PNG_COLOR_TYPE_RGB or
header.colorType = PNG_COLOR_TYPE_RGB_ALPHA then
if header.bitDepth = 8 then
fillPngImage24Bit(image, pixelData, header.bytesPerPixel, header.height, header.width);
else
fillPngImage48Bit(image, pixelData, header.bytesPerPixel, header.height, header.width);
end if;
elsif header.colorType = PNG_COLOR_TYPE_PALETTE then
if header.bitDepth = 1 then
fillPngImage1Bit(image, pixelData, palette, header.height, header.width);
elsif header.bitDepth = 2 then
fillPngImage2Bit(image, pixelData, palette, header.height, header.width);
elsif header.bitDepth = 4 then
fillPngImage4Bit(image, pixelData, palette, header.height, header.width);
else
fillPngImage8Bit(image, pixelData, palette, header.height, header.width);
end if;
end if;
end func;
const func pixelImage: interlaceToImage (in pngHeader: header,
in string: pixelData, in colorLookupTable: palette) is func
result
var pixelImage: image is pixelImage.value;
local
var integer: pass is 0;
var pngHeader: passHeader is pngHeader.value;
var integer: passStartPos is 1;
var string: passData is "";
var pixelImage: passImage is pixelImage.value;
var integer: line is 0;
var integer: column is 0;
var integer: passLine is 0;
var integer: passColumn is 0;
var integer: startLine is 0;
var integer: startColumn is 0;
var integer: lineDelta is 0;
var integer: columnDelta is 0;
begin
image := pixelImage[.. header.height] times
pixelArray[.. header.width] times pixel.value;
for pass range 1 to 7 do
case pass of
when {1}:
startLine := 1;
startColumn := 1;
lineDelta := 8;
columnDelta := 8;
when {2}:
startLine := 1;
startColumn := 5;
lineDelta := 8;
columnDelta := 8;
when {3}:
startLine := 5;
startColumn := 1;
lineDelta := 8;
columnDelta := 4;
when {4}:
startLine := 1;
startColumn := 3;
lineDelta := 4;
columnDelta := 4;
when {5}:
startLine := 3;
startColumn := 1;
lineDelta := 4;
columnDelta := 2;
when {6}:
startLine := 1;
startColumn := 2;
lineDelta := 2;
columnDelta := 2;
when {7}:
startLine := 2;
startColumn := 1;
lineDelta := 2;
columnDelta := 1;
end case;
if startLine <= header.height and startColumn <= header.width then
passHeader.width := (header.width + columnDelta - startColumn) div columnDelta;
passHeader.height := (header.height + lineDelta - startLine) div lineDelta;
passHeader.bitDepth := header.bitDepth;
passHeader.colorType := header.colorType;
passHeader.bytesPerPixel := header.bytesPerPixel;
computeBytesPerScanline(passHeader);
passData := pixelData[passStartPos ..];
filterPngData(passHeader, passData);
passImage := pixelDataToImage(passHeader, passData, palette);
line := startLine;
for passLine range 1 to passHeader.height do
column := startColumn;
for passColumn range 1 to passHeader.width do
image[line][column] := passImage[passLine][passColumn];
column +:= columnDelta;
end for;
line +:= lineDelta;
end for;
passStartPos +:= passHeader.height * passHeader.bytesPerScanline;
end if;
end for;
end func;
const func PRIMITIVE_WINDOW: readPng (inout file: pngFile) is func
result
var PRIMITIVE_WINDOW: pixmap is PRIMITIVE_WINDOW.value;
local
var string: magic is "";
var string: chunkType is "";
var string: chunkData is "";
var pngHeader: header is pngHeader.value;
var string: compressed is "";
var string: uncompressed is "";
var integer: paletteIndex is 0;
var integer: byteIndex is 1;
var colorLookupTable: palette is colorLookupTable.value;
var pixelImage: image is pixelImage.value;
begin
magic := gets(pngFile, length(PNG_MAGIC));
if magic = PNG_MAGIC then
repeat
chunkData := readPngChunk(pngFile, chunkType);
case chunkType of
when {"IHDR"}:
header := pngHeader(chunkData);
when {"PLTE"}:
palette := colorLookupTable[.. pred(length(chunkData) div 3)] times pixel.value;
byteIndex := 1;
for paletteIndex range 0 to pred(length(chunkData) div 3) do
palette[paletteIndex] := rgbPixel(ord(chunkData[byteIndex]) * 256,
ord(chunkData[byteIndex + 1]) * 256,
ord(chunkData[byteIndex + 2]) * 256);
byteIndex +:= 3;
end for;
when {"IDAT"}:
compressed &:= chunkData;
when {"eXIf"}:
readExifData(chunkData, header.exifData);
end case;
until chunkType = "IEND";
if isOkay(header) then
computeBytesPerPixel(header);
computeBytesPerScanline(header);
uncompressed := gzuncompress(compressed);
if header.interlaceMethod = 0 then
filterPngData(header, uncompressed);
image := pixelDataToImage(header, uncompressed, palette);
else
image := interlaceToImage(header, uncompressed, palette);
end if;
if header.exifData.orientation > EXIF_ORIENTATION_NORMAL and
header.exifData.orientation < EXIF_ORIENTATION_UNDEFINED then
changeOrientation(image, header.exifData.orientation);
end if;
pixmap := getPixmap(image);
else
raise RANGE_ERROR;
end if;
end if;
end func;
const func PRIMITIVE_WINDOW: readPng (in string: pngFileName) is func
result
var PRIMITIVE_WINDOW: pixmap is PRIMITIVE_WINDOW.value;
local
var file: pngFile is STD_NULL;
begin
pngFile := open(pngFileName, "r");
if pngFile <> STD_NULL then
pixmap := readPng(pngFile);
close(pngFile);
end if;
end func;
const func string: imageToPixelData (in pixelImage: image) is func
result
var string: pixelData is "";
local
var integer: line is 0;
var pixel: pix is pixel.value;
var color: col is color.value;
begin
for line range 1 to length(image) do
pixelData &:= '\0;';
for pix range image[line] do
col := pixelToColor(pix);
pixelData &:= chr(col.redLight mdiv 256);
pixelData &:= chr(col.greenLight mdiv 256);
pixelData &:= chr(col.blueLight mdiv 256);
end for;
end for;
end func;
const proc: doFilter0 (in pngHeader: header, inout string: scanline0,
inout integer: sumOfDifferences) is func
local
var integer: column is 0;
var integer: delta is 0;
begin
for column range 1 to pred(header.bytesPerScanline) do
delta := ord(scanline0[column]);
if delta >= 128 then
sumOfDifferences +:= 256 - delta;
else
sumOfDifferences +:= delta;
end if;
end for;
end func;
const proc: doFilter1 (in pngHeader: header, inout string: scanline1,
inout integer: sumOfDifferences) is func
local
var integer: column is 0;
var integer: delta is 0;
begin
for column range pred(header.bytesPerScanline) downto succ(header.bytesPerPixel) do
delta := (ord(scanline1[column]) -
ord(scanline1[column - header.bytesPerPixel])) mod 256;
scanline1 @:= [column] chr(delta);
if delta >= 128 then
sumOfDifferences +:= 256 - delta;
else
sumOfDifferences +:= delta;
end if;
end for;
end func;
const proc: doFilter2 (in pngHeader: header, in string: upperScanline,
inout string: scanline2, inout integer: sumOfDifferences) is func
local
var integer: column is 0;
var integer: delta is 0;
begin
for column range 1 to pred(header.bytesPerScanline) do
delta := (ord(scanline2[column]) -
ord(upperScanline[column])) mod 256;
scanline2 @:= [column] chr(delta);
if delta >= 128 then
sumOfDifferences +:= 256 - delta;
else
sumOfDifferences +:= delta;
end if;
end for;
end func;
const proc: doFilter3 (in pngHeader: header, inout string: scanline3,
inout integer: sumOfDifferences) is func
local
var integer: column is 0;
var integer: delta is 0;
begin
for column range pred(header.bytesPerScanline) downto succ(header.bytesPerPixel) do
delta := (ord(scanline3[column]) -
ord(scanline3[column - header.bytesPerPixel]) mdiv 2) mod 256;
scanline3 @:= [column] chr(delta);
if delta >= 128 then
sumOfDifferences +:= 256 - delta;
else
sumOfDifferences +:= delta;
end if;
end for;
end func;
const proc: doFilter3 (in pngHeader: header, in string: upperScanline,
inout string: scanline3, inout integer: sumOfDifferences) is func
local
var integer: column is 0;
var integer: delta is 0;
begin
for column range pred(header.bytesPerScanline) downto succ(header.bytesPerPixel) do
delta := (ord(scanline3[column]) -
(ord(scanline3[column - header.bytesPerPixel]) +
ord(upperScanline[column])) mdiv 2) mod 256;
scanline3 @:= [column] chr(delta);
if delta >= 128 then
sumOfDifferences +:= 256 - delta;
else
sumOfDifferences +:= delta;
end if;
end for;
for column range header.bytesPerPixel downto 1 do
delta := (ord(scanline3[column]) -
ord(upperScanline[column]) mdiv 2) mod 256;
scanline3 @:= [column] chr(delta);
if delta >= 128 then
sumOfDifferences +:= 256 - delta;
else
sumOfDifferences +:= delta;
end if;
end for;
end func;
const proc: doFilter4 (in pngHeader: header, inout string: scanline4,
inout integer: sumOfDifferences) is func
local
var integer: column is 0;
var integer: delta is 0;
begin
for column range pred(header.bytesPerScanline) downto succ(header.bytesPerPixel) do
delta := (ord(scanline4[column]) -
paethPredictor(ord(scanline4[column - header.bytesPerPixel]),
0, 0)) mod 256;
scanline4 @:= [column] chr(delta);
if delta >= 128 then
sumOfDifferences +:= 256 - delta;
else
sumOfDifferences +:= delta;
end if;
end for;
end func;
const proc: doFilter4 (in pngHeader: header, in string: upperScanline,
inout string: scanline4, inout integer: sumOfDifferences) is func
local
var integer: column is 0;
var integer: delta is 0;
begin
for column range pred(header.bytesPerScanline) downto succ(header.bytesPerPixel) do
delta := (ord(scanline4[column]) -
paethPredictor(ord(scanline4[column - header.bytesPerPixel]),
ord(upperScanline[column]),
ord(upperScanline[column - header.bytesPerPixel]))) mod 256;
scanline4 @:= [column] chr(delta);
if delta >= 128 then
sumOfDifferences +:= 256 - delta;
else
sumOfDifferences +:= delta;
end if;
end for;
for column range header.bytesPerPixel downto 1 do
delta := (ord(scanline4[column]) -
paethPredictor(0,
ord(upperScanline[column]),
0)) mod 256;
scanline4 @:= [column] chr(delta);
if delta >= 128 then
sumOfDifferences +:= 256 - delta;
else
sumOfDifferences +:= delta;
end if;
end for;
end func;
const proc: setPngFilter (in pngHeader: header, inout string: pixelData,
in integer: line) is func
local
var integer: byteIndex is 1;
var string: scanline1 is "";
var string: scanline2 is "";
var string: scanline3 is "";
var string: scanline4 is "";
var integer: sumOfDifferences0 is 0;
var integer: sumOfDifferences1 is 0;
var integer: sumOfDifferences2 is 0;
var integer: sumOfDifferences3 is 0;
var integer: sumOfDifferences4 is 0;
var integer: filterZeroMin is 0;
begin
byteIndex := line * header.bytesPerScanline + 2;
scanline1 := pixelData[byteIndex len pred(header.bytesPerScanline)];
doFilter0(header, scanline1, sumOfDifferences0);
doFilter1(header, scanline1, sumOfDifferences1);
if line <> 0 then
scanline2 := pixelData[byteIndex len pred(header.bytesPerScanline)];
doFilter2(header,
pixelData[byteIndex - header.bytesPerScanline
len pred(header.bytesPerScanline)],
scanline2, sumOfDifferences2);
else
sumOfDifferences2 := integer.last;
end if;
scanline3 := pixelData[byteIndex len pred(header.bytesPerScanline)];
if line = 0 then
doFilter3(header, scanline3, sumOfDifferences3);
else
doFilter3(header,
pixelData[byteIndex - header.bytesPerScanline
len pred(header.bytesPerScanline)],
scanline3, sumOfDifferences3);
end if;
scanline4 := pixelData[byteIndex len pred(header.bytesPerScanline)];
if line = 0 then
doFilter4(header, scanline4, sumOfDifferences4);
else
doFilter4(header,
pixelData[byteIndex - header.bytesPerScanline
len pred(header.bytesPerScanline)],
scanline4, sumOfDifferences4);
end if;
filterZeroMin := min(min(sumOfDifferences0, sumOfDifferences1),
min(sumOfDifferences2, min(sumOfDifferences3, sumOfDifferences4)));
if sumOfDifferences0 = filterZeroMin then
noop;
elsif sumOfDifferences1 = filterZeroMin then
pixelData @:= [pred(byteIndex)] '\1;';
pixelData @:= [byteIndex] scanline1;
elsif sumOfDifferences2 = filterZeroMin then
pixelData @:= [pred(byteIndex)] '\2;';
pixelData @:= [byteIndex] scanline2;
elsif sumOfDifferences3 = filterZeroMin then
pixelData @:= [pred(byteIndex)] '\3;';
pixelData @:= [byteIndex] scanline3;
else
pixelData @:= [pred(byteIndex)] '\4;';
pixelData @:= [byteIndex] scanline4;
end if;
end func;
const proc: setPngFilter (in pngHeader: header, inout string: pixelData) is func
local
var integer: line is 0;
begin
for line range pred(header.height) downto 0 do
setPngFilter(header, pixelData, line);
end for;
end func;
const func string: genPngChunk (in string: chunkType, in string: chunkData) is
return bytes(length(chunkData), UNSIGNED, BE, 4) &
chunkType & chunkData &
bytes(integer(crc32(chunkType & chunkData)), UNSIGNED, BE, 4);
const func string: str (in PRIMITIVE_WINDOW: pixmap, PNG) is func
result
var string: stri is PNG_MAGIC;
local
var pngHeader: header is pngHeader.value;
var pixelImage: image is pixelImage.value;
var string: pixelData is "";
begin
header.width := width(pixmap);
header.height := height(pixmap);
header.bitDepth := 8;
header.colorType := PNG_COLOR_TYPE_RGB;
header.compressionMethod := 0;
header.filterMethod := 0;
header.interlaceMethod := 0;
header.bytesPerPixel := 3;
header.bytesPerScanline := succ(header.width * header.bytesPerPixel);
image := getPixelImage(pixmap);
pixelData := imageToPixelData(image);
setPngFilter(header, pixelData);
stri &:= genPngChunk("IHDR", str(header)) &
genPngChunk("IDAT", gzcompress(pixelData)) &
genPngChunk("IEND", "");
end func;
const proc: writePng (in string: pngFileName, in PRIMITIVE_WINDOW: pixmap) is func
local
var file: pngFile is STD_NULL;
begin
pngFile := open(pngFileName, "w");
if pngFile <> STD_NULL then
write(pngFile, str(pixmap, PNG));
close(pngFile);
end if;
end func;