(********************************************************************)
(*                                                                  *)
(*  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.                       *)
(*                                                                  *)
(********************************************************************)


include "text.s7i";
include "keybd.s7i";


(**
 *  [[file|File]] implementation type for input fields on console/window.
 *)
const type: fieldFile 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(fieldFile, file);


(**
 *  Open a ''fieldFile'' with the given parameters.
 *   aFieldFile := openField(KEYBOARD, info, 3, 11, 3, " 10");
 *  @param in_fil Keyboard input file.
 *  @param out_fil Text console/window file to place the field in.
 *  @param line Line of the field in ''out_fil''.
 *  @param column Column of the field in 'out_fil''.
 *  @param width Width of the field.
 *  @param defaultValue Default value of the field.
 *  @return the fieldFile opened.
 *)
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 fieldFile: field_fil is fieldFile.value;
  begin
    field_fil := fieldFile.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;


(**
 *  Read the content of the field ''field_fil''.
 *  Leading and trailing whitespace is removed from the result.
 *  When the function is left field_fil.bufferChar contains one of
 *  KEY_NL, KEY_TAB, KEY_BACKTAB, KEY_UP, KEY_DOWN and KEY_ESC.
 *  @return a word read without leading and trailing whitespace.
 *)
const func string: getwd (inout fieldFile: field_fil) is func
  result
    var string: stri is "";
  local
    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);
      if field_fil.column <= length(field_fil.field) then
        cursorOn(field_fil.out_file, field_fil.field[field_fil.column]);
      else
        cursorOn(field_fil.out_file, ' ');
      end if;
      flush(field_fil.out_file);
      ch := getc(field_fil.in_file);
      if field_fil.column <= length(field_fil.field) then
        cursorOff(field_fil.out_file, field_fil.field[field_fil.column]);
      else
        cursorOff(field_fil.out_file, ' ');
      end if;
      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 length(field_fil.field) <> field_fil.width then
            if length(field_fil.field) < field_fil.width then
              field_fil.field &:= " " mult field_fil.width - length(field_fil.field);
            else
              field_fil.field := field_fil.field[.. field_fil.width];
            end if;
            setPos(field_fil.out_file, field_fil.linePos, field_fil.columnPos);
            write(field_fil.out_file, field_fil.field);
            setPos(field_fil.out_file, field_fil.linePos, field_fil.columnPos);
          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 := trim(field_fil.field);
    field_fil.bufferChar := ch;
  end func;


(**
 *  Read the content of the field ''field_fil''.
 *  Leading and trailing whitespace is retained in the result.
 *  When the function is left field_fil.bufferChar contains one of
 *  KEY_NL, KEY_TAB, KEY_BACKTAB, KEY_UP, KEY_DOWN and KEY_ESC.
 *  @return a line with possible leading and trailing whitespace.
 *)
const func string: getln (inout fieldFile: field_fil) is func
  result
    var string: stri is "";
  local
    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);
      if field_fil.column <= length(field_fil.field) then
        cursorOn(field_fil.out_file, field_fil.field[field_fil.column]);
      else
        cursorOn(field_fil.out_file, ' ');
      end if;
      flush(field_fil.out_file);
      ch := getc(field_fil.in_file);
      if field_fil.column <= length(field_fil.field) then
        cursorOff(field_fil.out_file, field_fil.field[field_fil.column]);
      else
        cursorOff(field_fil.out_file, ' ');
      end if;
      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 length(field_fil.field) <> field_fil.width then
            if length(field_fil.field) < field_fil.width then
              field_fil.field &:= " " mult field_fil.width - length(field_fil.field);
            else
              field_fil.field := field_fil.field[.. field_fil.width];
            end if;
            setPos(field_fil.out_file, field_fil.linePos, field_fil.columnPos);
            write(field_fil.out_file, field_fil.field);
            setPos(field_fil.out_file, field_fil.linePos, field_fil.columnPos);
          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 fieldFile: 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 fieldFile: 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;


(**
 *  Write ''stri'' to the content of the field ''field_fil''.
 *  The ''stri'' is filled with spaces or truncated to the field width.
 *)
const proc: write (inout fieldFile: field_fil, in string: stri) is func
  begin
    if length(stri) < field_fil.width then
      field_fil.field := stri & " " mult field_fil.width - length(stri);
    else
      field_fil.field := stri[.. field_fil.width];
    end if;
    setPos(field_fil.out_file, field_fil.linePos, field_fil.columnPos);
    write(field_fil.out_file, field_fil.field);
    setPos(field_fil.out_file, field_fil.linePos, field_fil.columnPos);
  end func;