(********************************************************************)
(*                                                                  *)
(*  field.s7i     Filter file which reads the input fieldwise       *)
(*  Copyright (C) 1992, 1993, 1994, 2005  Thomas Mertes             *)
(*                                                                  *)
(*  This file is part of the Seed7 Runtime Library.                 *)
(*                                                                  *)
(*  The Seed7 Runtime Library is free software; you can             *)
(*  redistribute it and/or modify it under the terms of the GNU     *)
(*  Lesser General Public License as published by the Free Software *)
(*  Foundation; either version 2.1 of the License, or (at your      *)
(*  option) any later version.                                      *)
(*                                                                  *)
(*  The Seed7 Runtime Library is distributed in the hope that it    *)
(*  will be useful, but WITHOUT ANY WARRANTY; without even the      *)
(*  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR *)
(*  PURPOSE.  See the GNU Lesser General Public License for more    *)
(*  details.                                                        *)
(*                                                                  *)
(*  You should have received a copy of the GNU Lesser General       *)
(*  Public License along with this program; if not, write to the    *)
(*  Free Software Foundation, Inc., 51 Franklin Street,             *)
(*  Fifth Floor, Boston, MA  02110-1301, USA.                       *)
(*                                                                  *)
(********************************************************************)


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;