include "bytedata.s7i";
include "draw.s7i";
include "lzw.s7i";
include "pixelimage.s7i";
const string: GIF_MAGIC_87 is "GIF87a";
const string: GIF_MAGIC_89 is "GIF89a";
const integer: GIF_SCREEN_DESCRIPTOR_SIZE is 7;
const integer: GIF_IMAGE_DESCRIPTOR_SIZE is 9;
const type: gifHeader is new struct
var integer: screenWidth is 0;
var integer: screenHeight is 0;
var integer: bitsOfColorResolution is 0;
var integer: globalBitsPerPixel is 0;
var colorLookupTable: globalColorMap is colorLookupTable.value;
end struct;
const type: gifImageHeader is new struct
var integer: leftPosition is 0;
var integer: topPosition is 0;
var integer: width is 0;
var integer: height is 0;
var boolean: interlacedOrder is FALSE;
var integer: bitsPerPixel is 0;
var boolean: hasLocalColorMap is FALSE;
var colorLookupTable: localColorMap is colorLookupTable.value;
end struct;
const type: gifExtensions is new struct
var integer: disposalMethod is 0;
var boolean: userInputFlag is FALSE;
var boolean: transparentColorFlag is FALSE;
var integer: delayTime is 0;
var integer: transparentColorIndex is 0;
var boolean: loopCountPresent is FALSE;
var integer: loopCount is 0;
end struct;
const proc: readHeader (inout file: gifFile, inout gifHeader: header) is func
local
var string: screenDescriptor is "";
var boolean: globalColorMapFollows is FALSE;
var integer: maxColorMapIndex is 0;
var integer: colorMapIndex is 0;
var string: rgbData is "";
var integer: byteIndex is 1;
begin
screenDescriptor := gets(gifFile, GIF_SCREEN_DESCRIPTOR_SIZE);
if length(screenDescriptor) = GIF_SCREEN_DESCRIPTOR_SIZE then
header.screenWidth := bytes2Int(screenDescriptor[1 fixLen 2], UNSIGNED, LE);
header.screenHeight := bytes2Int(screenDescriptor[3 fixLen 2], UNSIGNED, LE);
globalColorMapFollows := ord(screenDescriptor[5]) >= 128;
header.bitsOfColorResolution := succ((ord(screenDescriptor[5]) >> 4) mod 8);
header.globalBitsPerPixel := succ(ord(screenDescriptor[5]) mod 8);
if globalColorMapFollows then
maxColorMapIndex := pred(2 ** header.globalBitsPerPixel);
header.globalColorMap := colorLookupTable[.. maxColorMapIndex] times pixel.value;
rgbData := gets(gifFile, succ(maxColorMapIndex) * 3);
for colorMapIndex range 0 to maxColorMapIndex do
header.globalColorMap[colorMapIndex] := rgbPixel(ord(rgbData[byteIndex]) * 256,
ord(rgbData[succ(byteIndex)]) * 256,
ord(rgbData[byteIndex + 2]) * 256);
byteIndex +:= 3;
end for;
end if;
else
raise RANGE_ERROR;
end if;
end func;
const proc: readImageHeader (inout file: gifFile, inout gifImageHeader: header) is func
local
var string: imageDescriptor is "";
var integer: maxColorMapIndex is 0;
var integer: colorMapIndex is 0;
var string: rgbData is "";
var integer: byteIndex is 1;
begin
imageDescriptor := gets(gifFile, GIF_IMAGE_DESCRIPTOR_SIZE);
if length(imageDescriptor) = GIF_IMAGE_DESCRIPTOR_SIZE then
header.leftPosition := bytes2Int(imageDescriptor[1 fixLen 2], UNSIGNED, LE);
header.topPosition := bytes2Int(imageDescriptor[3 fixLen 2], UNSIGNED, LE);
header.width := bytes2Int(imageDescriptor[5 fixLen 2], UNSIGNED, LE);
header.height := bytes2Int(imageDescriptor[7 fixLen 2], UNSIGNED, LE);
header.hasLocalColorMap := ord(imageDescriptor[9]) >= 128;
header.interlacedOrder := (ord(imageDescriptor[9]) >> 6) mod 2 <> 0;
header.bitsPerPixel := succ(ord(imageDescriptor[9]) mod 8);
if header.hasLocalColorMap then
maxColorMapIndex := pred(2 ** header.bitsPerPixel);
header.localColorMap := colorLookupTable[.. maxColorMapIndex] times pixel.value;
rgbData := gets(gifFile, succ(maxColorMapIndex) * 3);
for colorMapIndex range 0 to maxColorMapIndex do
header.localColorMap[colorMapIndex] := rgbPixel(ord(rgbData[byteIndex]) * 256,
ord(rgbData[succ(byteIndex)]) * 256,
ord(rgbData[byteIndex + 2]) * 256);
byteIndex +:= 3;
end for;
end if;
else
raise RANGE_ERROR;
end if;
end func;
const func string: readSubBlockSeries (inout file: gifFile) is func
result
var string: data is "";
local
var integer: blockSize is 0;
begin
blockSize := ord(getc(gifFile));
while blockSize <> 0 do
data &:= gets(gifFile, blockSize);
blockSize := ord(getc(gifFile));
end while;
end func;
const proc: readExtensionBlock (inout file: gifFile, inout gifExtensions: extensions) is func
local
var char: typeOfExtension is ' ';
var integer: dataSize is 0;
var string: extensionData is "";
begin
typeOfExtension := getc(gifFile);
extensionData := readSubBlockSeries(gifFile);
case ord(typeOfExtension) of
when {16#f9}:
extensions.disposalMethod := (ord(extensionData[1]) >> 2) mod 8;
extensions.userInputFlag := odd(ord(extensionData[1]) >> 1);
extensions.transparentColorFlag := odd(ord(extensionData[1]));
extensions.delayTime := bytes2Int(extensionData[2 fixLen 2], UNSIGNED, LE);
if extensions.transparentColorFlag then
extensions.transparentColorIndex := ord(extensionData[4]);
end if;
when {16#ff}:
if startsWith(extensionData, "NETSCAPE2.0\1;") or
startsWith(extensionData, "ANIMEXTS1.0\1;") then
extensions.loopCountPresent := TRUE;
extensions.loopCount := bytes2Int(extensionData[13 fixLen 2], UNSIGNED, LE);
elsif startsWith(extensionData, "NETSCAPE2.0\2;") then
noop;
end if;
when {16#fe}:
noop;
when {16#01}:
noop;
otherwise:
raise RANGE_ERROR;
end case;
end func;
const proc: fillGifImage8Bit (inout pixelImage: image, in string: pixelData,
in colorLookupTable: palette, in gifImageHeader: imageHeader) is func
local
var char: colorIndex is '\0;';
var integer: line is 0;
var integer: column is 0;
var integer: columnBeyond is 0;
begin
line := succ(imageHeader.topPosition);
column := succ(imageHeader.leftPosition);
columnBeyond := succ(imageHeader.leftPosition + imageHeader.width);
for colorIndex range pixelData do
image[line][column] := palette[ord(colorIndex)];
incr(column);
if column = columnBeyond then
incr(line);
column := succ(imageHeader.leftPosition);
end if;
end for;
end func;
const proc: fillGifImage8Bit (inout pixelImage: image, in string: pixelData,
in colorLookupTable: palette, in integer: transparentColorIndex,
in gifImageHeader: imageHeader) is func
local
var char: colorIndex is '\0;';
var integer: line is 0;
var integer: column is 0;
var integer: columnBeyond is 0;
begin
line := succ(imageHeader.topPosition);
column := succ(imageHeader.leftPosition);
columnBeyond := succ(imageHeader.leftPosition + imageHeader.width);
for colorIndex range pixelData do
if ord(colorIndex) <> transparentColorIndex then
image[line][column] := palette[ord(colorIndex)];
end if;
incr(column);
if column = columnBeyond then
incr(line);
column := succ(imageHeader.leftPosition);
end if;
end for;
end func;
const proc: fillGifImage8BitInterlaced (inout pixelImage: image,
in string: pixelData, in colorLookupTable: palette,
in gifImageHeader: imageHeader) is func
local
var char: colorIndex is '\0;';
var integer: line is 0;
var integer: lineBeyond is 0;
var integer: lineDelta is 8;
var integer: column is 0;
var integer: columnBeyond is 0;
var integer: interlace is 1;
begin
line := succ(imageHeader.topPosition);
lineBeyond := succ(imageHeader.topPosition + imageHeader.height);
column := succ(imageHeader.leftPosition);
columnBeyond := succ(imageHeader.leftPosition + imageHeader.width);
for colorIndex range pixelData do
image[line][column] := palette[ord(colorIndex)];
incr(column);
if column = columnBeyond then
line +:= lineDelta;
if line >= lineBeyond then
incr(interlace);
case interlace of
when {2}: line := imageHeader.topPosition + 5;
lineDelta := 8;
when {3}: line := imageHeader.topPosition + 3;
lineDelta := 4;
when {4}: line := imageHeader.topPosition + 2;
lineDelta := 2;
end case;
end if;
column := succ(imageHeader.leftPosition);
end if;
end for;
end func;
const proc: fillGifImage8BitInterlaced (inout pixelImage: image,
in string: pixelData, in colorLookupTable: palette,
in integer: transparentColorIndex, in gifImageHeader: imageHeader) is func
local
var char: colorIndex is '\0;';
var integer: line is 0;
var integer: lineBeyond is 0;
var integer: lineDelta is 8;
var integer: column is 0;
var integer: columnBeyond is 0;
var integer: interlace is 1;
begin
line := succ(imageHeader.topPosition);
lineBeyond := succ(imageHeader.topPosition + imageHeader.height);
column := succ(imageHeader.leftPosition);
columnBeyond := succ(imageHeader.leftPosition + imageHeader.width);
for colorIndex range pixelData do
if ord(colorIndex) <> transparentColorIndex then
image[line][column] := palette[ord(colorIndex)];
end if;
incr(column);
if column = columnBeyond then
line +:= lineDelta;
if line >= lineBeyond then
incr(interlace);
case interlace of
when {2}: line := imageHeader.topPosition + 5;
lineDelta := 8;
when {3}: line := imageHeader.topPosition + 3;
lineDelta := 4;
when {4}: line := imageHeader.topPosition + 2;
lineDelta := 2;
end case;
end if;
column := succ(imageHeader.leftPosition);
end if;
end for;
end func;
const func PRIMITIVE_WINDOW: readGif (inout file: gifFile) is func
result
var PRIMITIVE_WINDOW: pixmap is PRIMITIVE_WINDOW.value;
local
var string: magic is "";
var gifHeader: header is gifHeader.value;
var gifImageHeader: imageHeader is gifImageHeader.value;
var gifExtensions: extensions is gifExtensions.value;
var char: sentinel is ' ';
var integer: initialNumberOfLzwBits is 0;
var string: uncompressed is "";
var pixelImage: image is pixelImage.value;
begin
magic := gets(gifFile, length(GIF_MAGIC_87));
if magic = GIF_MAGIC_87 or magic = GIF_MAGIC_89 then
readHeader(gifFile, header);
image := pixelImage[.. header.screenHeight] times
pixelArray[.. header.screenWidth] times pixel.value;
sentinel := getc(gifFile);
while sentinel <> ';' do
if sentinel = '!' then
readExtensionBlock(gifFile, extensions);
elsif sentinel = ',' then
readImageHeader(gifFile, imageHeader);
initialNumberOfLzwBits := ord(getc(gifFile));
uncompressed := lzwDecompressLsb(readSubBlockSeries(gifFile),
initialNumberOfLzwBits);
if imageHeader.hasLocalColorMap then
if extensions.transparentColorFlag then
if imageHeader.interlacedOrder then
fillGifImage8BitInterlaced(image, uncompressed, imageHeader.localColorMap,
extensions.transparentColorIndex, imageHeader);
else
fillGifImage8Bit(image, uncompressed, imageHeader.localColorMap,
extensions.transparentColorIndex, imageHeader);
end if;
else
if imageHeader.interlacedOrder then
fillGifImage8BitInterlaced(image, uncompressed,
imageHeader.localColorMap, imageHeader);
else
fillGifImage8Bit(image, uncompressed, imageHeader.localColorMap,
imageHeader);
end if;
end if;
else
if extensions.transparentColorFlag then
if imageHeader.interlacedOrder then
fillGifImage8BitInterlaced(image, uncompressed, header.globalColorMap,
extensions.transparentColorIndex, imageHeader);
else
fillGifImage8Bit(image, uncompressed, header.globalColorMap,
extensions.transparentColorIndex, imageHeader);
end if;
else
if imageHeader.interlacedOrder then
fillGifImage8BitInterlaced(image, uncompressed,
header.globalColorMap, imageHeader);
else
fillGifImage8Bit(image, uncompressed, header.globalColorMap,
imageHeader);
end if;
end if;
end if;
extensions.transparentColorFlag := FALSE;
else
raise RANGE_ERROR;
end if;
sentinel := getc(gifFile);
end while;
pixmap := getPixmap(image);
end if;
end func;
const func PRIMITIVE_WINDOW: readGif (in string: gifFileName) is func
result
var PRIMITIVE_WINDOW: pixmap is PRIMITIVE_WINDOW.value;
local
var file: gifFile is STD_NULL;
begin
gifFile := open(gifFileName, "r");
if gifFile <> STD_NULL then
pixmap := readGif(gifFile);
close(gifFile);
end if;
end func;