include "draw.s7i";
include "bmp.s7i";
include "png.s7i";
include "pixelimage.s7i";
const string: ICO_MAGIC is "\0;\0;\1;\0;";
const integer: ICO_DIR_ENTRY_SIZE is 16;
const type: icoDirEntry is new struct
var integer: width is 0;
var integer: height is 0;
var integer: numColors is 0;
var integer: planes is 0;
var integer: bitsPerPixel is 0;
var integer: imageSize is 0;
var integer: offset is 0;
end struct;
const proc: showDirEntry (in icoDirEntry: dirEntry) is func
begin
writeln("width: " <& dirEntry.width);
writeln("height: " <& dirEntry.height);
writeln("numColors: " <& dirEntry.numColors);
writeln("planes: " <& dirEntry.planes);
writeln("bitsPerPixel: " <& dirEntry.bitsPerPixel);
writeln("imageSize: " <& dirEntry.imageSize);
writeln("offset: " <& dirEntry.offset);
end func;
const proc: readDirEntry (inout file: icoFile, inout icoDirEntry: dirEntry) is func
local
var string: stri is "";
begin
stri := gets(icoFile, ICO_DIR_ENTRY_SIZE);
if length(stri) = ICO_DIR_ENTRY_SIZE then
dirEntry.width := bytes2Int(stri[ 1 fixLen 1], UNSIGNED, LE);
dirEntry.height := bytes2Int(stri[ 2 fixLen 1], UNSIGNED, LE);
dirEntry.numColors := bytes2Int(stri[ 3 fixLen 1], UNSIGNED, LE);
dirEntry.planes := bytes2Int(stri[ 5 fixLen 2], UNSIGNED, LE);
dirEntry.bitsPerPixel := bytes2Int(stri[ 7 fixLen 2], UNSIGNED, LE);
dirEntry.imageSize := bytes2Int(stri[ 9 fixLen 4], UNSIGNED, LE);
dirEntry.offset := bytes2Int(stri[13 fixLen 4], UNSIGNED, LE);
else
raise RANGE_ERROR;
end if;
end func;
const func PRIMITIVE_WINDOW: readIco (inout file: icoFile) is func
result
var PRIMITIVE_WINDOW: pixmap is PRIMITIVE_WINDOW.value;
local
var string: magic is "";
var integer: numberOfImages is 0;
var icoDirEntry: dirEntry is icoDirEntry.value;
var bmpHeader: header is bmpHeader.value;
begin
magic := gets(icoFile, length(ICO_MAGIC));
if magic = ICO_MAGIC then
numberOfImages := bytes2Int(gets(icoFile, 2), UNSIGNED, LE);
readDirEntry(icoFile, dirEntry);
seek(icoFile, succ(dirEntry.offset));
magic := gets(icoFile, 4);
if magic = PNG_MAGIC[.. 4] then
seek(icoFile, succ(dirEntry.offset));
pixmap := readPng(icoFile);
else
header.dibHeaderSize := bytes2Int(magic, UNSIGNED, LE);
readDibHeader(icoFile, header);
header.height := dirEntry.height;
pixmap := readBmp(icoFile, header);
end if;
end if;
end func;
const func PRIMITIVE_WINDOW: readIco (in string: icoFileName) is func
result
var PRIMITIVE_WINDOW: pixmap is PRIMITIVE_WINDOW.value;
local
var file: icoFile is STD_NULL;
begin
icoFile := open(icoFileName, "r");
if icoFile <> STD_NULL then
pixmap := readIco(icoFile);
close(icoFile);
end if;
end func;
const func string: str (in PRIMITIVE_WINDOW: pixmap, ICO) is func
result
var string: stri is "";
local
var integer: width is 0;
var integer: height is 0;
var pixelImage: image is pixelImage.value;
var integer: padding is 0;
var integer: lineMaskLen is 0;
var integer: line is 0;
var pixel: pix is pixel.value;
var color: col is color.value;
begin
width := width(pixmap);
height := height(pixmap);
if width > 256 or height > 256 then
raise RANGE_ERROR;
else
stri := "\0;\0;\ # Must always be 0
\\1;\0;\
\\1;\0;" & # Number of images in the file: 1
str(chr(width mod 256)) &
str(chr(height mod 256)) &
"\0;\ # Number of palette colors, 0 for no palette.
\\0;" & # Reserved
bytes( 1, UNSIGNED, LE, 2) &
bytes(24, UNSIGNED, LE, 2) &
"\0;\0;\0;\0;" &
bytes(22, UNSIGNED, LE, 4) &
bytes(40, UNSIGNED, LE, 4) &
bytes(width, UNSIGNED, LE, 4) &
bytes(2 * height, UNSIGNED, LE, 4) &
bytes( 1, UNSIGNED, LE, 2) &
bytes(24, UNSIGNED, LE, 2) &
"\0;" mult 4 &
"\0;" mult 4 &
"\0;" mult 4 &
"\0;" mult 4 &
"\0;" mult 4 &
"\0;" mult 4;
image := getPixelImage(pixmap);
padding := -(3 * width) mod 4;
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;
lineMaskLen := succ(pred(width) mdiv 8);
padding := lineMaskLen mod 4;
for line range pred(height) downto 0 do
stri &:= "\0;" mult (lineMaskLen + padding);
end for;
stri @:= [15] bytes(length(stri) - 22, UNSIGNED, LE, 4);
end if;
end func;
const proc: writeIco (in string: icoFileName, in PRIMITIVE_WINDOW: pixmap) is func
local
var file: icoFile is STD_NULL;
begin
icoFile := open(icoFileName, "w");
if icoFile <> STD_NULL then
write(icoFile, str(pixmap, ICO));
close(icoFile);
end if;
end func;