{----------------------------------------------------------------------------}
{ GETINOUT.PAS       Colmin  Associates         { General Field Input Handler}
{----------------------------------------------------------------------------}
 (*
 General Purpose line editor. Used to input data as Strings, Reals, Integers,
 Bytes and Chars and allow Editing of the input using WordStar commands, as
 well as left-right arrow keys , Home, End, back space, etc.

 Function calls are :- GetStg, GetReal, GetInt, GetByt, GetChr.

 All above are terminated by CR, <ESC>, <UpKey>, <DnKey>, <HomeKey>, <EndKey>
                             except GetChr which is a single character input.

 General call is  X := GetXXX(TV,L,J,X,Y,F,B);  where :-
                              TV,  { transfer Variable}
                               L,  { length}
                               X,  { X co-ord}
                               Y,  { Y co-ord}
                               F,  { foreGround colour}
                               B,  { background}
                               J,  one of :-
                                         0   { blank entry (password style)}
                                         1   { no justification}
                                         >1  { right justify string}
                                         [1..X]  { no of Real decimal points}


  The Transfer Variable passes an initial field value which may be '' for
  strings, and 0 for numeric fields, or the previous values.

  When accepting a Password via GetStg it is usual to enter the function
  call with TV := '', and J := 0;

----------------------------------------------------------------------------*)
UNIT GETINOUT;

INTERFACE

USES
     Crt;

const
  NULL  = #0;
  BS    = #8;
  LF    = #10;
  CR    = #13;
  ESC   = #27;
  Space = #32;
  Tab   = ^I;

  { The following constants are based on the scheme used by the scan key
    function to convert a two key scan code sequence into one character
                 by adding 128 to the ordinal value of the second character. }

  F1       = #187;
  F2       = #188;
  F3       = #189;
  F4       = #190;
  F5       = #191;
  F6       = #192;
  F7       = #193;
  F8       = #194;
  F9       = #195;
  F10      = #196;
  UpKey    = #200;
  DownKey  = #208;
  LeftKey  = #203;
  RightKey = #205;
  PgUpKey  = #201;
  PgDnKey  = #209;
  HomeKey  = #199;
  EndKey   = #207;
  InsKey   = #210;
  DelKey   = #211;

type
  CharSet = set of char;

var
  TC       : char;                          { The Input Terminating Character}
  code     : integer;
  ChrCount : byte;                         { The number of characters entered}
  Count    : word;

{----------------------------------------------------------------------------}
procedure EditLine(var S     : String;
                       Len,
                       J     : byte;                          { Justification}
                       X, Y  : byte;
                       F,B   : byte;                { ForeGnd,BackGnd colours}
                       LegalChars,
                       Term  : CharSet;
                   var TC    : Char    );

{  EditLn implements a line editor that supports WordStar commands
   as well as left-right arrow keys , Home, End, back space, etc.
   Paramaters:

     S    : String to be edited
     Len  : Maximum characters allowed to be edited
     J    : Justification
     X, Y : Starting x and y cordinates
     B, F : BackGround, ForeGround colours
     LegalChars : Set of characters that will be accepted
     Term : Set of characters that will cause EditLine to Exit
            (Note LegalChars need not contain Term)
     TC   : Character that caused EditLnto exit                              }

function ScanKey : char;
{ Reads a key from the keyboard and converts 2 scan code escape
  sequences into 1 character. }


procedure Abort(M : String);
{ Simple fatal error reporter: Goes to the bottom of the screen,
  Prints M and terminates execution of the program. }

procedure Beep;
{ Generates a sound from the speaker to alert the user.  Useful
  for error handling routines. }

function ConstStr(C : Char; N : byte) : String;
{  ConstStr returns a string with N characters of value C }

function Exist(FN : String) : boolean;
{ Returns true if file named by FN exists }

function NumStr(Num : integer) : String;
{ Converts an integer to a string.  Function form is often more
  convenient than the Str procedure }

function UpcaseStr(S : String) : String;
{ Converts all characters in the string S to their upper case
  equivalents. }

procedure Warn;                                 { Makes a sound on the speaker}
function  GetStg(var S : string ;      Len,J,X,Y,F,B : byte) : String;
function  GetReal(var Value : real;    Len,J,X,Y,F,B : byte) : Real;
function  GetInt (var Value : integer; Len,J,X,Y,F,B : byte) : Integer;
function  GetByt (var Value : byte;    Len,J,X,Y,F,B : byte) : byte;
function  GetChr(Key        : char;        J,X,Y,F,B : byte) : char;
function  GetNum(var S : string;Len,J,X,Y,F,B:byte):string;
procedure PutStg(var S : string; Len,X,Y,F,B : byte);

IMPLEMENTATION
{$V-}

{----------------------------------------------------------------------------}
procedure Warn;                                 { Makes a sound on the speaker}

begin
  sound(1000); delay(50); sound(800); delay(50);
  sound(1000); delay(50); sound(800); delay(50);
  sound(1000); delay(50); sound(800); delay(50);
  nosound;
  delay(1500);
end;

{-----------------------------------------------------------------------------}
Procedure BakGnd;

var
    X,Y   : byte;

begin
(*
  X := WhereX;  Y := WhereY;
  inc(Count);
  gotoxy(70,01); clreol; write(Count);
  gotoxy(X,Y);
*)
end;

{----------------------------------------------------------------------------}
function ScanKey : char;
{ Reads a key from the keyboard and converts 2 scan code escape
  sequences into 1 character. }

var
  Ch : Char;

begin
  if Keypressed then
  begin
    Ch := ReadKey;
    if (Ch = #0) and KeyPressed then
    begin
      Ch := ReadKey;
      if ord(Ch) < 128 then
        Ch := Chr(Ord(Ch) + 128);
    end;
    ScanKey := Ch;
    if Ch = ^C then Abort('Program terminated by user');
  end
  else
  begin
    BakGnd;   { BackGround task goes here}
    ScanKey := #0;
  end;
end; { ScanKey }

{----------------------------------------------------------------------------}
procedure Beep;
{ Generates a sound from the speaker to alert the user.  Useful for error
                                                          handling routines. }

begin
  Sound(880);
  Delay(200);
  NoSound;
end; { Beep }

{----------------------------------------------------------------------------}
function Exist(FN : String) : boolean;
{ Returns true if file named by FN exists }

var
  F : file;
  found : boolean;

begin
  Assign(f, FN);
  {$I-}
  Reset(f);
  Found := (IOResult = 0);
  if Found then
    Close(f);
  {$I+}
  Exist := Found;
end; { Exist }

{----------------------------------------------------------------------------}
procedure Abort(M : String);
{ Simple fatal error reporter: Goes to the bottom of the screen, Prints M
                                    and terminates execution of the program. }

begin
  Window(1, 1, 80, 25);
  TextColor(White);
  TextBackground(Red);
  GotoXY(1, 25);
  Write(' ',M,' '#8);
  delay(2000);
  TextBackground(Black);
  ClrScr;
  Halt;
end; { Abort }

{----------------------------------------------------------------------------}
function NumStr(Num : integer) : String;
{ Converts an integer to a string.  Function form is often more convenient
                                                      than the Str procedure }

var
  S : string;

begin
  Str(Num:1, S);
  NumStr := S;
end;

{----------------------------------------------------------------------------}
function ConstStr(C : Char; N : byte) : String;
                   {  ConstStr returns a string with N characters of value C }

var
  S : string;

begin
  if N < 0 then N := 0;
  S[0] := Chr(N);
  FillChar(S[1],N,C);
  ConstStr := S;
end; { ConstStr }

{----------------------------------------------------------------------------}
function UpcaseStr(S : String) : String;
  { Converts all characters in the string S to their upper case equivalents. }

var
  P : byte;
begin
  for P := 1 to Length(S) do
    S[P] := Upcase(S[P]);
  UpcaseStr := S;
end;

{----------------------------------------------------------------------------}
procedure EditLine(var S : String;
                   Len,
                   J         : byte;                    { Justification value}
                   X, Y      : byte;
                   F,B       : byte;               { ForeGnd, BackGnd colours}
                   LegalChars, Term  : CharSet;
                   var TC    : Char);

{  EditLn implements a line editor that supports WordStar commands
   as well as left-right arrow keys , Home, End, back space, etc.

 Parameters:
     S    : String to be edited
     Len  : Maximum characters allowed to be edited
     J    : Justification
     X, Y : Starting x and y cordinates
     F,B  : byte;      BackGnd,ForeGnd colours
     LegalChars : Set of characters that will be accepted
     Term : Set of characters that will cause EditLine to Exit
            (Note LegalChars need not contain Term)
     TC   : Character that caused EditLn to exit }

var
  P      : byte;                                      { Position of character}
  Ch     : Char;                                                  { Character}
  first  : boolean;                                   { First character entry}
  Xo,Yo,
  oX,oY  : byte;                                      { original co-ordinates}
  I      : byte;                                            { general counter}
  TextAt1,                                           { text attribute storage}
  TextAt2: byte;                                                      { ditto}
  Ins    : boolean;                                       { Insert Key status}

begin
  Xo := WhereX;
  Yo := WhereY;                                     { store incoming position}
  TextAt1 := TextAttr;                            { Store incoming attributes}
  first := true;                          { get ready to edit first character}
  TextBackGround(B); TextColor(F);                          { set the colours}
  GotoXY(X,Y);                                            { go where required}
  write(' ':len);                                 { clear the data entry area}
  GotoXY(X,Y);
  Write(S);                                         { write the data supplied}
  P := 0;                                             { zero Position pointer}
  Ch := #0;                                              { null the character}

  repeat                                                 { getting characters}
    GotoXY(X + P,Y);
    Ch := ScanKey;
    if not (Upcase(Ch) in Term) then
    begin
      case Ch of
        #32..#126 : if (P < Len) and (ch in LegalChars) then
                    begin
                      if First then
                      begin
                        Write(' ':Len);
                        Delete(S,P + 1,Len);
                        GotoXY(X + P,Y);
                      end;

                      if Length(S) = Len then Delete(S,Len,1);
                      P := succ(P);
                      if NOT Ins then Delete(S,P,1);
                      Insert(Ch,S,P);
                      if J = 0 then write('.')
                        else Write(Copy(S,P,Len));
                    end
                    else Beep;

      ^V, InsKey  : begin
                      First := False;
                      Ins :=  Not Ins;                        { toggle insert}
                      oX := WhereX;                            { save co-ords}
                      oY := WhereY;
                      TextAt2 := TextAttr;
                      gotoxy(75,02);
                      if Ins then
                      begin
                        TextColor(F);
                        TextBackGround(B);
                        write('Ins')
                      end
                      else
                      begin
                        TextColor(White);
                        TextBackGround(Blue);
                        write('   ');
                      end;
                      gotoxy(oX,oY);                            { restore all}
                      TextAttr := TextAt2;
                    end;

      ^S, LeftKey : if P > 0 then P := pred(P);               { move left one}

      ^D, RightKey: if P < Length(S) then P := succ(P);      { move right one}

      ^A, HomeKey : P := 0;                                     { go to start}

      ^F, EndKey  : P := Length(S);                               { go to end}

      ^G, DelKey  : if P < Length(S) then                       { delete char}
                    begin
                      Delete(S,P + 1,1);
                      Write(Copy(S,P + 1,Len),' ');
                    end;

               BS : if P > 0 then                                { back space}
                    begin
                      Delete(S,P,1);
                      Write(^H,Copy(S,P,Len),' ');
                      P := pred(P);
                    end;

             ^Y   : begin                                        { delete all}
                      Write(' ':Len - P);
                      Delete(S,P + 1,Len);
                    end;
        else;
      end;  {of case}
    end;
    if (Ch <> #0) AND
      ( (Ch in LegalChars)  OR ( Ch in[RightKey,^D,LeftKey,^S]) )
         then First := false;                                 { started entry}
  until UpCase(Ch) in Term;                    { until got a terminating char}
  P := Length(S);                                   { position Pointer at end}
  gotoxy(X,Y);                                         { go to start of field}
  if J = 0 then Write('' :Len);                 { If <J>ustify = 0 then Blank}
  if J > 1 then write(S:Len);                 { If <J>ustify > 1 then Justify}
  GotoXY(X + P,Y);                                        { go to end of data}
  if J = 1 then Write('':Len - P);        { If justify = 1 then don't justify}
  TC := Upcase(Ch);              { return the character that terminated input}

  Ins := False;
  gotoxy(75,02);
  TextColor(White);
  TextBackGround(Blue);
  write('   ');

  TextAttr := TextAt1;                          { restore the text attributes}
  gotoxy(Xo,Yo);                                            { and positioning}
end; { EditLine }

{----------------------------------------------------------------------------}
function GetStg(var S : string ; Len,J : byte; X,Y : byte; F,B : byte):string;
                                      { Gets a String input from the keyboard}
var  TempValue : string;

begin
  TempValue := S;
  EditLine(S,Len,J,X,Y,F,B,[#32..#126],
             [CR,ESC,^E,UpKey,^X,DownKey,HomeKey,EndKey],TC);

  ChrCount := length(S);
  if (ChrCount = 0) OR (TC = ESC) then
  begin
    S := TempValue;
    GetStg := TempValue;
    exit;
  end;
  GetStg := S;
end;

{----------------------------------------------------------------------------}
function GetChr(Key : char; J,X,Y,F,B : byte) : char;

var ch : char;
    TextAt1 : byte;
    Xo, Yo  : byte;

begin
  Xo := WhereX;
  Yo := WhereY;                                     { store incoming position}
  TextAt1 := TextAttr;                            { Store incoming attributes}
  TextBackGround(B); TextColor(F);
  GotoXY(X,Y);
  write(Key);
  GotoXY(X,Y);
  Ch := #0;
  repeat
    Ch := ScanKey;
  until Ch <> #0;
  if Ch in[CR,ESC,^E,UpKey,^X,DownKey] then
  begin
    TC := upcase(Ch);
    Ch := Key;                                        { Don't change original}
  end
  else TC := #0;
  if J <> 0 then write(ch);
  GetChr := ch;
  TextAttr := TextAt1;
  gotoxy(Xo,Yo);
end; { EditLine }

{----------------------------------------------------------------------------}
function GetReal(var Value : real; Len,J,X,Y,F,B : byte) : real;

var  code : integer;
     TempValue : real;
     S    : string;

begin
  TempValue := Value;
  repeat
    if J = 1 then  Str(Value:1:2,S)          { No Justification, 2 dec points}
      else Str(Value:len:J,S);                                    { Justified}
    EditLine(S,Len,J,X,Y,F,B,[ '.','+','-','0'..'9'],
                              [CR,ESC,^E,UpKey,^X,DownKey],TC);
    ChrCount := length(S);
    if (ChrCount = 0) OR (TC = ESC) then
    begin
      Value   := TempValue;
      GetReal := Value;
      exit;
    end;
    val(S,Value,code);
  until code = 0;
  GetReal := Value;
end;

{----------------------------------------------------------------------------}
function GetInt(var Value : integer; Len,J,X,Y : byte; F,B : byte) : integer;

var  TempValue : integer;
     S         : String;
     ValueR    : real;

begin
  TempValue := Value;
  repeat
    Str(Value:J,S);
    EditLine(S,Len,J,X,Y,F,B,['0'..'9','+','-'],
                                     [CR,ESC,^E,UpKey,^X,DownKey],TC);
    ChrCount := length(S);
    if (ChrCount = 0) OR (TC = ESC) then
    begin
      Value  := TempValue;
      GetInt := Value;
      exit;
    end;
    val(S,ValueR,code);
    if  (ValueR < -32767) OR (ValueR > 32767) OR (Code <> 0) then Beep;
  until (ValueR > -32768) AND (ValueR < 32768) AND (Code = 0);
  Value := trunc(ValueR);
  GetInt := Value;
end;

{----------------------------------------------------------------------------}
function GetByt (var Value : byte; Len,J,X,Y,F,B : byte) : byte;

var  TempValue : byte;
     ValueI    : integer;
     S         : String;

begin
  TempValue := Value;
  repeat
    Str(Value:J,S);
    EditLine(S,Len,J,X,Y,F,B,['0'..'9'],
                  [CR,ESC,^E,UpKey,^X,DownKey],TC);
    ChrCount := length(S);
    if (ChrCount = 0) OR (TC = ESC) then
    begin
      Value  := TempValue;
      GetByt := Value;
      exit;
    end;
    val(S,ValueI,code);
    if  (ValueI < 0) OR (ValueI > 255) OR (Code <> 0) then Beep;
  until (ValueI > -1) AND (ValueI < 256) AND (Code = 0);
  Value := ValueI;
  GetByt := Value;
end;

{----------------------------------------------------------------------------}
function GetNum(var S:string;Len,J,X,Y,F,B:byte):string;
                                                      { Gets a numeric string}
var  code : integer;
     TempValue : string;
     TempR : real;

begin
  TempValue := S;
  repeat
    EditLine(S,Len,J,X,Y,F,B,[ '.','+','-','0'..'9'],
                              [CR,ESC,^E,UpKey,^X,DownKey],TC);
    ChrCount := length(S);
    if (ChrCount = 0) OR (TC = ESC) then
    begin
      S := TempValue;
      exit;
    end;

    val(S,TempR,code);
  until code = 0;
  GetNum := S;
end;

{----------------------------------------------------------------------------}
procedure PutStg(var S : string; Len,X,Y,F,B : byte);

var  TextAtto : byte;  { Original Text Attribute}
     Xo, Yo   : byte;  { Original Co-ordinates}
     Stg : string;

begin
  TextAtto := TextAttr;
  Xo := WhereX; Yo := WhereY;
  gotoxy(X,Y);
  TextColor(F); TextBackground(B);
  S := S + copy(ConstStr(' ',Len-1),length(S),Len);
  write(S);
  TextAttr := TextAtto;
  gotoxy(Xo,Yo);
end;

{----------------------------------------------------------------------------}
end.  {of Unit}