const type: field_file is sub null_file struct
var file: in_file is STD_NULL;
var text: out_file is STD_NULL;
var integer: linePos is 0;
var integer: columnPos is 0;
var integer: width is 0;
var integer: column is 0;
var string: defaultValue is "";
var string: field is "";
end struct;
type_implements_interface(field_file, file);
const func file: openField (in file: in_fil, inout text: out_fil,
in integer: line, in integer: column, in integer: width, in string: defaultValue) is func
result
var file: newFile is STD_NULL;
local
var field_file: field_fil is field_file.value;
begin
field_fil := field_file.value;
field_fil.in_file := in_fil;
field_fil.out_file := out_fil;
field_fil.linePos := line;
field_fil.columnPos := column;
field_fil.width := width;
field_fil.field := (defaultValue & " " mult width)[ .. width];
setPos(out_fil, line, column);
write(out_fil, defaultValue[.. width]);
newFile := toInterface(field_fil);
end func;
const func string: getwd (inout field_file: field_fil) is func
result
var string: stri is "";
local
var boolean: input_done is FALSE;
var char: ch is ' ';
begin
field_fil.column := 1;
repeat
setPos(field_fil.out_file, field_fil.linePos, field_fil.columnPos + field_fil.column - 1);
ch := getc(field_fil.in_file);
case ch of
when {KEY_LEFT}:
if field_fil.column > 1 then
decr(field_fil.column);
end if;
when {KEY_RIGHT}:
if field_fil.column < field_fil.width then
incr(field_fil.column);
end if;
when {KEY_BS}:
if field_fil.column = field_fil.width and field_fil.field[field_fil.width] <> ' ' then
field_fil.field @:= [field_fil.column] ' ';
setPos(field_fil.out_file, field_fil.linePos, field_fil.columnPos + field_fil.column - 1);
write(field_fil.out_file, ' ');
elsif field_fil.column > 1 then
decr(field_fil.column);
field_fil.field @:= [field_fil.column] ' ';
setPos(field_fil.out_file, field_fil.linePos, field_fil.columnPos + field_fil.column - 1);
write(field_fil.out_file, ' ');
end if;
when {KEY_DEL}:
field_fil.field @:= [field_fil.column] ' ';
write(field_fil.out_file, ' ');
when {' ' .. '~'}:
if not input_done and field_fil.column = 1 then
field_fil.field := " " mult field_fil.width;
setPos(field_fil.out_file, field_fil.linePos, field_fil.columnPos);
write(field_fil.out_file, " " mult field_fil.width);
setPos(field_fil.out_file, field_fil.linePos, field_fil.columnPos);
input_done := TRUE;
end if;
field_fil.field @:= [field_fil.column] ch;
write(field_fil.out_file, ch);
if field_fil.column < field_fil.width then
incr(field_fil.column);
end if;
end case;
until ch in {KEY_NL, KEY_TAB, KEY_BACKTAB, KEY_UP, KEY_DOWN, KEY_ESC};
stri := field_fil.field;
while length(stri) >= 1 and stri[1] = ' ' do
stri := stri[2 ..];
end while;
while length(stri) >= 1 and stri[length(stri)] = ' ' do
stri := stri[.. pred(length(stri))];
end while;
field_fil.bufferChar := ch;
end func;
const func string: getln (inout field_file: field_fil) is func
result
var string: stri is "";
local
var boolean: input_done is FALSE;
var char: ch is ' ';
begin
field_fil.column := 1;
repeat
setPos(field_fil.out_file, field_fil.linePos, field_fil.columnPos + field_fil.column - 1);
ch := getc(field_fil.in_file);
case ch of
when {KEY_LEFT}:
if field_fil.column > 1 then
decr(field_fil.column);
end if;
when {KEY_RIGHT}:
if field_fil.column < field_fil.width then
incr(field_fil.column);
end if;
when {KEY_BS}:
if field_fil.column = field_fil.width and field_fil.field[field_fil.width] <> ' ' then
field_fil.field @:= [field_fil.column] ' ';
setPos(field_fil.out_file, field_fil.linePos, field_fil.columnPos + field_fil.column - 1);
write(field_fil.out_file, ' ');
elsif field_fil.column > 1 then
decr(field_fil.column);
field_fil.field @:= [field_fil.column] ' ';
setPos(field_fil.out_file, field_fil.linePos, field_fil.columnPos + field_fil.column - 1);
write(field_fil.out_file, ' ');
end if;
when {KEY_DEL}:
field_fil.field @:= [field_fil.column] ' ';
write(field_fil.out_file, ' ');
when {' ' .. '~'}:
if not input_done and field_fil.column = 1 then
field_fil.field := " " mult field_fil.width;
setPos(field_fil.out_file, field_fil.linePos, field_fil.columnPos);
write(field_fil.out_file, " " mult field_fil.width);
setPos(field_fil.out_file, field_fil.linePos, field_fil.columnPos);
input_done := TRUE;
end if;
field_fil.field @:= [field_fil.column] ch;
write(field_fil.out_file, ch);
if field_fil.column < field_fil.width then
incr(field_fil.column);
end if;
end case;
until ch in {KEY_NL, KEY_TAB, KEY_BACKTAB, KEY_UP, KEY_DOWN, KEY_ESC};
stri := field_fil.field;
field_fil.bufferChar := ch;
end func;
const func char: getc (inout field_file: field_fil) is func
result
var char: ch is ' ';
begin
if field_fil.field = "" then
field_fil.field := getln(field_fil) & "\n";
end if;
ch := field_fil.field[1];
field_fil.field := field_fil.field[2 .. ];
end func;
const func string: gets (inout field_file: field_fil, in integer: length) is func
result
var string: stri is "";
begin
while length(field_fil.field) < length do
field_fil.field &:= getln(field_fil) & "\n";
end while;
stri := field_fil.field[ .. length];
field_fil.field := field_fil.field[succ(length) .. ];
end func;