(* ------------------------- INPUT2.INC -------------------------------------- *)
(* Version 2.3  31.12.2021                                                     *)
(*                                                                             *)
(*  Include-File fuer Eingabebefehle auf der JOYCE unter Turbo Pascal.         *)
(*                                                                             *)
(* Abhaengigkeiten: CONVERT.INC                                                *)
(*                                                                             *)
(*  Es sind enthalten:                                                         *)
(*     procedure SetDecimalChar     -> Setzt das Dezimalzeichen ('.' oder ',') *)
(*     procedure WriteKeyMessage    -> Schreibt eine Tastendruck-Meldung       *)
(*     procedure WaitForKey         -> Wartet auf einen Tastendruck            *)
(*     procedure GetKey             -> Liest Zeichen per Tastendruck           *)
(*     procedure Beep               -> Erzeugt einen Ton                       *)
(*     procedure IsFieldInputFinished -> Ende-Taste gedrueckt?                 *)
(*     procedure InputString        -> Eingabe einer Textzeile                 *)
(* --------------------------------------------------------------------------- *)

(*$V-*)

type
  FileNameString = string(.12.);
  DateString = string(.10.);
  FieldType = (FTText, FTNumNatural, FTInteger, FTReal, FTDate, FTFileName);

const
  CH_DEL_LEFT = #127;
  CH_DEL_RIGHT = #7;
  CH_LEFT = #1;
  CH_RIGHT = #6;
  CH_UP = #31;
  CH_DOWN = #30;
  CH_BACKSPACE = #8;
  CH_TAB = #9;
  CH_RETURN = #13;
  CH_BEEP = #7;
  CH_CAN = #8;
  PLACEHOLDER = '_';

var
  input_decimalChar: char;
  input_lastChar: char;


(* Sets the decimal character. *)
procedure SetDecimalChar(ch: char);
begin
  input_decimalChar := ch;
end;


(* Writes a 'Press a key' message to the screen. *)
procedure WriteKeyMessage;
begin
  Write('<Press a key>');
end;


(* Waits for a key to be pressed. *)
procedure WaitForKey;
var ch: Char;
begin
  repeat until KeyPressed;
  Read(kbd, ch);
end;


(* Waits for a key to be pressed and returns the character typed. *)
function GetKey: Char;
var ch: Char;
begin
  repeat until KeyPressed;
  Read(kbd, ch);
  GetKey := ch;
end; (* GetKey *)


(* Emits a beep through the loudspeaker. *)
procedure Beep;
begin
  Write(CH_BEEP);
end; (* Beep *)
  
  
(* Checks if the input of a field was finished. *)
function IsFieldInputFinished(ch: char): boolean;
begin
  IsFieldInputFinished :=
        (ch = CH_RETURN)
     or (ch = CH_TAB)
     or (ch = CH_DOWN)
     or (ch = CH_UP);
end; (* IsFieldInputFinished *)


(* Inputs a String in a dynamically allocated character array.
   cp      character pointer to the input memory
   maxlen  maximum length allowed for input
   x       x position on screen
   y       y position on screen
   ftype   field type
*)
procedure InputString(cp: CharPtr; maxlen, x, y: Integer; ftype: FieldType);
var p: Integer;
    s: WorkString;
    b: Byte;

  (* Checks if the character is a digit ('0' - '9'). *)
  function isDigit(ch: char): boolean;
  begin
    isDigit := (ch >= '0') and (ch <= '9');
  end; (* isDigit *)
  
  
  (* Checks if the character is valid for the field type.
     ch     the character to check
     p      ch's position in the work string
     ftype  field type
     s      work string
  *)
  function isValid(ch: Char; p: Integer; ftype: FieldType; s: WorkString): Boolean;
  var result: Boolean;
      sDecimalChar: String(.1.);
      dotPos, maxLen: Integer;
  begin
    case ftype of
      FTText:
        result := (input_lastChar > chr(31)) and (input_lastChar < chr(126));
      FTNumNatural:
        result := isDigit(ch);
      FTInteger:
        if p = 1 then begin
          result := isDigit(ch) or (ch = '+') or (ch = '-');
        end else begin
          result := isDigit(ch);
        end;
      FTReal:
        if p = 1 then begin
          result := isDigit(ch) or (ch = '+') or (ch = '-');
        end else begin (* p > 1 *)
          if isDigit(ch) then begin
            result := true;
          end else
          if ch = input_decimalChar then begin
            sDecimalChar := input_decimalChar;
            result := (Pos(sDecimalChar, s) = 0);
          end else
          if (ch = 'E') or (ch = 'e') then begin
            result := (Pos('E', s) = 0) and (Pos('e', s) = 0);
          end else
          if (ch = '+') or (ch = '-') then begin
            result := (s(.p - 1.) = 'E') or (s(.p - 1.) = 'e');
          end else
            result := false;
        end;
      FTDate:
        case p of
          1:                 result := (ch >= '0') and (ch <= '3');
          2, 5, 7, 8, 9, 10: result := isDigit(ch);
          4:                 result := (ch = '0') or (ch = '1');
          else               result := (ch = '.');
        end;
      FTFileName:
        case ch of
          '.': result := Pos('.', s) = 0;
          ':': result := (Pos(':', s) = 0) and (p = 2);
          else begin
            if (ch > chr(31)) and (ch < chr(126)) then begin
              if s(.2.) = ':' then
                maxLen := 10
              else
                maxLen := 8;
              dotPos := Pos('.', s);
              if dotPos = 0 then begin (* no dot yet *)
                result := Length(s) < maxLen; (* max. 8 or 10 chars before the dot *)
              end else begin (* dot already typed *)
                result := Length(s) - Pos('.', s) < 3; (* max. 3 chars after the dot *)
              end;
            end else begin
              result := false;
            end;
          end;
        end; (* case ch *)
    end; (* case ftype *)
    
    isValid := result;
  end; (* isValid *)


  (* Writes a String starting at the position p. *)
  procedure writeFromPos(position: Integer);
  var p1, len: Integer;
  begin
    len := Length(s);
    for p1 := position to len do begin
      Write(s(.p1.));
    end;
  end; (* writeFromPos *)

begin
  CharPtrToString(cp, s);
  p := Length(s);
  GotoXY(x + p, y);
  p := succ(p);
  repeat
    input_lastChar := GetKey;
    
    case input_lastChar of
      CH_DEL_LEFT: begin (* <-- *)
        if (Length(s) > 0) and (p > 1) then begin
          p := pred(p);
          Delete(s, p, 1);
          GotoXY(x + p - 1, y);
          writeFromPos(p);
          Write(PLACEHOLDER); (* because we deleted one char *)
          GotoXY(x + p - 1, y);
        end else begin
          Beep;
        end;
      end;
      CH_DEL_RIGHT: begin (* Entf *)
        if (Length(s) > 0) and (p <= Length(s)) then begin
          Delete(s, p, 1);
          writeFromPos(p);
          Write(PLACEHOLDER); (* because we deleted one char *)
          GotoXY(x + p - 1, y);
        end else begin
          Beep;
        end;
      end;
      CH_LEFT: begin (* left *)
        if p > 1 then begin
          p := pred(p);
          Write(CH_BACKSPACE); (* cursor left *)
        end else begin
          Beep;
        end;
      end;
      CH_RIGHT: begin (* right *)
        if p <= Length(s) then begin
          Write(s(.p.));
          p := succ(p);
        end else begin
          Beep;
        end;
      end;
      CH_CAN: begin (* CAN button (Bild^) *)
        GotoXY(x, y);
        for b := 1 to Length(s) do Write(PLACEHOLDER);
        GotoXY(x, y);
        s := '';
        p := 1;
      end;
      else begin
        if (Length(s) < maxlen) and (input_lastChar > chr(31)) then begin
          Write(input_lastChar);
          if isValid(input_lastChar, p, ftype, s) then begin
            Insert(input_lastChar, s, p);
            p := succ(p);
            writeFromPos(p);
            GotoXY(x + p - 1, y);
          end else begin
            Write(CH_BACKSPACE, PLACEHOLDER, CH_BACKSPACE);
            Beep;
          end;
        end else begin
          if not isFieldInputFinished(input_lastChar) then begin
            GotoXY(x + p - 1, y);
            Beep;
          end;
        end;
      end;
    end (* case *)
  until isFieldInputFinished(input_lastChar);
  
  StringToCharPtr(s, cp);
end; (* InputString *)

(* ------------------ Ende von INPUT2.INC ---------------------- *)
