const type: bufferModeType is new enum
IO_FULL_BUFFERING, IO_LINE_BUFFERING, IO_NO_BUFFERING
end enum;
const proc: setbuf (ref file: aFile, in bufferModeType: mode, in integer: size) is DYNAMIC;
const proc: setbuf (in null_file: aFile, in bufferModeType: mode, in integer: size) is noop;
const proc: setbuf (in clib_file: aFile, in integer: mode, in integer: size) is action "FIL_SETBUF";
const proc: setbuf (in external_file: aFile, in bufferModeType: mode, in integer: size) is func
begin
setbuf(aFile.ext_file, ord(mode), size);
end func;
const type: bufferFile is sub null_file struct
var file: baseFile is STD_NULL;
var bufferModeType: bufferMode is IO_LINE_BUFFERING;
var integer: bufferSize is 2**16;
var string: inBuffer is "";
var string: outBuffer is "";
var integer: position is 1;
end struct;
type_implements_interface(bufferFile, file);
const func file: openBufferFile (in file: baseFile) is func
result
var file: newFile is STD_NULL;
local
var bufferFile: new_bufferFile is bufferFile.value;
begin
if baseFile <> STD_NULL then
new_bufferFile.baseFile := baseFile;
newFile := toInterface(new_bufferFile);
end if;
end func;
const proc: close (inout bufferFile: aBufferFile) is func
begin
write(aBufferFile.baseFile, aBufferFile.outBuffer);
close(aBufferFile.baseFile);
end func;
const proc: flush (inout bufferFile: aBufferFile) is func
begin
write(aBufferFile.baseFile, aBufferFile.outBuffer);
aBufferFile.outBuffer := "";
flush(aBufferFile.baseFile);
aBufferFile.inBuffer := "";
aBufferFile.position := 1;
end func;
const proc: setbuf (inout bufferFile: aBufferFile, in bufferModeType: mode, in integer: size) is func
begin
aBufferFile.bufferMode := mode;
aBufferFile.bufferSize := size;
end func;
const proc: write (inout bufferFile: outBufferFile, in string: stri) is func
local
var integer: nlPos is 0;
begin
if outBufferFile.bufferMode = IO_NO_BUFFERING then
write(outBufferFile.baseFile, stri);
else
outBufferFile.outBuffer &:= stri;
if outBufferFile.bufferMode = IO_LINE_BUFFERING then
nlPos := rpos(outBufferFile.outBuffer, '\n');
if nlPos <> 0 then
writeln(outBufferFile.baseFile, outBufferFile.outBuffer[.. pred(nlPos)]);
outBufferFile.outBuffer := outBufferFile.outBuffer[succ(nlPos) ..];
end if;
else
if length(outBufferFile.outBuffer) > outBufferFile.bufferSize then
write(outBufferFile.baseFile, outBufferFile.outBuffer);
outBufferFile.outBuffer := "";
end if;
end if;
end if;
end func;
const proc: moveLeft (inout bufferFile: outBufferFile, in string: stri) is func
begin
if length(outBufferFile.outBuffer) >= length(stri) then
outBufferFile.outBuffer :=
outBufferFile.outBuffer[.. length(outBufferFile.outBuffer) - length(stri)];
else
moveLeft(outBufferFile.baseFile,
stri[succ(length(stri) - length(outBufferFile.outBuffer)) ..]);
outBufferFile.outBuffer := "";
end if;
end func;
const func char: getc (inout bufferFile: inBufferFile) is func
result
var char: charRead is EOF;
begin
if inBufferFile.position > length(inBufferFile.inBuffer) then
inBufferFile.inBuffer := gets(inBufferFile.baseFile, inBufferFile.bufferSize);
if inBufferFile.inBuffer <> "" then
charRead := inBufferFile.inBuffer[1];
inBufferFile.position := 2;
end if;
else
charRead := inBufferFile.inBuffer[inBufferFile.position];
incr(inBufferFile.position);
end if;
end func;
const func string: gets (inout bufferFile: inBufferFile, in integer: maxLength) is func
result
var string: striRead is "";
local
var integer: charsPresent is 0;
var integer: missing is integer.last;
begin
if maxLength <= 0 then
if maxLength <> 0 then
raise RANGE_ERROR;
end if;
else
charsPresent := succ(length(inBufferFile.inBuffer) - inBufferFile.position);
if maxLength <= charsPresent then
striRead := inBufferFile.inBuffer[inBufferFile.position fixLen maxLength];
inBufferFile.position +:= maxLength;
else
if charsPresent >= 0 or
(charsPresent < 0 and maxLength - integer.last <= charsPresent) then
missing := maxLength - charsPresent;
end if;
if missing < inBufferFile.bufferSize then
striRead := inBufferFile.inBuffer[inBufferFile.position ..];
inBufferFile.inBuffer := gets(inBufferFile.baseFile, inBufferFile.bufferSize);
striRead &:= inBufferFile.inBuffer[.. missing];
if length(inBufferFile.inBuffer) >= missing then
inBufferFile.position := succ(missing);
else
inBufferFile.position := succ(length(inBufferFile.inBuffer));
end if;
else
striRead := inBufferFile.inBuffer[inBufferFile.position ..] &
gets(inBufferFile.baseFile, missing);
inBufferFile.inBuffer := "";
inBufferFile.position := 1;
end if;
end if;
end if;
end func;
const func boolean: eof (in bufferFile: inBufferFile) is
return inBufferFile.position > length(inBufferFile.inBuffer) and
eof(inBufferFile.baseFile);
const func boolean: hasNext (inout bufferFile: inBufferFile) is
return inBufferFile.position <= length(inBufferFile.inBuffer) or
hasNext(inBufferFile.baseFile);
const func integer: length (inout bufferFile: aBufferFile) is
return length(aBufferFile.baseFile);
const func boolean: seekable (in bufferFile: aBufferFile) is
return seekable(aBufferFile.baseFile);
const proc: seek (inout bufferFile: aBufferFile, in integer: position) is func
begin
if position <= 0 then
raise RANGE_ERROR;
else
write(aBufferFile.baseFile, aBufferFile.outBuffer);
aBufferFile.outBuffer := "";
seek(aBufferFile.baseFile, position);
aBufferFile.inBuffer := "";
aBufferFile.position := 1;
end if;
end func;
const func integer: tell (in bufferFile: aBufferFile) is func
result
var integer: position is 0;
begin
if aBufferFile.outBuffer <> "" then
position := tell(aBufferFile.baseFile) + length(aBufferFile.outBuffer);
else
position := tell(aBufferFile.baseFile) - length(aBufferFile.inBuffer) +
aBufferFile.position - 1;
end if;
end func;