include "scanfile.s7i";
include "bytedata.s7i";
include "draw.s7i";
include "keybd.s7i";
include "pixelimage.s7i";
const string: PGM_ASCII_MAGIC is "P2";
const string: PGM_BINARY_MAGIC is "P5";
const proc: readPgmAsciiImage (inout pixelImage: image,
in integer: height, in integer: width, in integer: maximumColorValue,
inout file: pgmFile) is func
local
var integer: factor is 0;
var integer: line is 0;
var integer: column is 0;
var integer: luminance is 0;
begin
factor := pred(2 ** 16) div maximumColorValue;
for line range 1 to height do
for column range 1 to width do
skipWhiteSpace(pgmFile);
luminance := integer(getDigits(pgmFile)) * factor;
image[line][column] := rgbPixel(luminance, luminance, luminance);
end for;
end for;
end func;
const proc: readPgmBinaryImageLine8 (inout pixelArray: imageLine,
in integer: width, in integer: factor, inout file: pgmFile) is func
local
var string: pixelData is "";
var integer: byteIndex is 1;
var integer: column is 0;
var integer: luminance is 0;
begin
pixelData := gets(pgmFile, width);
for column range 1 to width do
luminance := ord(pixelData[byteIndex]) * factor;
imageLine[column] := rgbPixel(luminance, luminance, luminance);
incr(byteIndex);
end for;
end func;
const proc: readPgmBinaryImageLine16 (inout pixelArray: imageLine,
in integer: width, in integer: factor, inout file: pgmFile) is func
local
var string: pixelData is "";
var integer: byteIndex is 1;
var integer: column is 0;
var integer: luminance is 0;
begin
pixelData := gets(pgmFile, width * 2);
for column range 1 to width do
luminance :=
bytes2Int(pixelData[byteIndex fixLen 2], UNSIGNED, BE) * factor;
imageLine[column] := rgbPixel(luminance, luminance, luminance);
byteIndex +:= 2;
end for;
end func;
const proc: readPgmBinaryImage (inout pixelImage: image,
in integer: height, in integer: width, in integer: maximumColorValue,
inout file: pgmFile) is func
local
var integer: factor is 0;
var integer: line is 0;
begin
factor := pred(2 ** 16) div maximumColorValue;
if maximumColorValue <= 255 then
for line range 1 to height do
readPgmBinaryImageLine8(image[line], width, factor, pgmFile);
end for;
else
for line range 1 to height do
readPgmBinaryImageLine16(image[line], width, factor, pgmFile);
end for;
end if;
end func;
const func PRIMITIVE_WINDOW: readPgm (inout file: pgmFile) is func
result
var PRIMITIVE_WINDOW: pixmap is PRIMITIVE_WINDOW.value;
local
var string: magic is "";
var integer: width is 0;
var integer: height is 0;
var integer: maximumColorValue is 0;
var pixelImage: image is pixelImage.value;
begin
magic := gets(pgmFile, length(PGM_ASCII_MAGIC));
if magic = PGM_ASCII_MAGIC or magic = PGM_BINARY_MAGIC then
pgmFile.bufferChar := getc(pgmFile);
skipWhiteSpace(pgmFile);
while pgmFile.bufferChar = '#' do
skipLineComment(pgmFile);
pgmFile.bufferChar := getc(pgmFile);
skipWhiteSpace(pgmFile);
end while;
width := integer(getDigits(pgmFile));
skipWhiteSpace(pgmFile);
while pgmFile.bufferChar = '#' do
skipLineComment(pgmFile);
pgmFile.bufferChar := getc(pgmFile);
skipWhiteSpace(pgmFile);
end while;
height := integer(getDigits(pgmFile));
skipWhiteSpace(pgmFile);
while pgmFile.bufferChar = '#' do
skipLineComment(pgmFile);
pgmFile.bufferChar := getc(pgmFile);
skipWhiteSpace(pgmFile);
end while;
maximumColorValue := integer(getDigits(pgmFile));
image := pixelImage[.. height] times
pixelArray[.. width] times pixel.value;
if magic = PGM_ASCII_MAGIC then
readPgmAsciiImage(image, height, width, maximumColorValue,
pgmFile);
else
readPgmBinaryImage(image, height, width, maximumColorValue,
pgmFile);
end if;
pixmap := getPixmap(image);
end if;
end func;
const func PRIMITIVE_WINDOW: readPgm (in string: pgmFileName) is func
result
var PRIMITIVE_WINDOW: pixmap is PRIMITIVE_WINDOW.value;
local
var file: pgmFile is STD_NULL;
begin
pgmFile := open(pgmFileName, "r");
if pgmFile <> STD_NULL then
pixmap := readPgm(pgmFile);
close(pgmFile);
end if;
end func;
const func string: str (in PRIMITIVE_WINDOW: pixmap, PGM) is func
result
var string: stri is PGM_BINARY_MAGIC;
local
var integer: height is 0;
var integer: width 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;
var integer: luminance is 0;
begin
height := height(pixmap);
width := width(pixmap);
stri &:= "\n" <& width <& " " <& height <& "\n255\n";
image := getPixelImage(pixmap);
for line range 1 to height do
for pix range image[line] do
col := pixelToColor(pix);
luminance := round(0.299 * float(col.redLight) +
0.587 * float(col.greenLight) +
0.114 * float(col.blueLight));
luminance := luminance < 0 ? 0 :
luminance > 65535 ? 65535 : luminance;
stri &:= chr(luminance mdiv 256);
end for;
end for;
end func;
const proc: writePgm (in string: pgmFileName, in PRIMITIVE_WINDOW: pixmap) is func
local
var file: pgmFile is STD_NULL;
begin
pgmFile := open(pgmFileName, "w");
if pgmFile <> STD_NULL then
write(pgmFile, str(pixmap, PGM));
close(pgmFile);
end if;
end func;