Program Wells_Fargo;

Uses Dos,CRT,ExecSwap,FastTTT5,WinTTT5,MenuTTT5,PullTTT5,ReadTTT5;

Type WFRecord=Record
      Description   :String[40];
      Path          :String[35];
      ProgramName   :String[12];
      Password      :String[20];
      UseEMS        :Boolean;
     End;

Const PassChar    = #15;
    CursorRight = #205;
    CursorLeft  = #203;
    CursorDown  = #208;
    CursorUp    = #200;
    EnterKey    = #13;
    EscKey      = #27;
    EndKey      = #207;
    HomeKey     = #199;
    DelKey      = #211;
    Backspace   = #8;
    InsKey      = #210;
    Zap         = #160;      {Alt D to delete the field}
    MinInt              = -32768;
    MaxLongInt:longint  =  2147483647;
    MinLongInt:longint  = -2147483647;
    MaxWord             =  65535;
    MinWord             =  0;

Var wffile:file of WFRecord;
    num:integer;
    r,ar:WFRecord;
    Main_Choice,Choice,Error:integer;
    X,Y,ScanTop,ScanBot:byte;
    M1,MM:Menu_record;
    Ch:char;
    Done:Boolean;
    Cursor_X,
    Cursor_Y:byte;
    temp:String;

  Procedure Clang;
  begin
   sound(1500);
   delay(50);
   nosound;
  end;

Procedure Read_Line(X,Y,L,F,B,Format:byte; Text:String);

{
X is X coord of first character in field
Y is Y coord of field
L is the maximum length of the input field
F is the foreground color
B is the background color
Fornat Codes:      1   Any String
                   2   Force Upper String
                   3   Yes/No
                   4   Alphabetics only
                   5   Integer
                   6   LongInteger
                   7   Real
                   8   Word
                   (*   Maybe
                   9   Date    (MM/DD/YY)
                   10  Date    (DD/MM/YY)
                   *)
                   11  Echo a Password
Text is a string updated with the string equivalent of user input
}
var
    TempText : string;
    CursorPos : byte;
    InsertMode,
    Password,
    Alldone : boolean;
    FirstCharPress: boolean;
    Ch : char;

    Procedure Check_Parameters;
    begin
        TempText := Text;
        If length(TempText) > L then
           Delete(Temptext,L+1,length(TempText)-L);
        If not X in [1..80] then
           X := 1;
        If X + L - 1 > 80 then X := 81 - L;
        If not Y in [1..25] then
           Y := 1;
        If RTTT.BegCursor then
           CursorPos := 1
        else
        begin
            If length(TempText) < L then
               CursorPos := length(TempText) + 1
            else
               CursorPos := length(TempText);
        end;
        InsertMode  := RTTT.Insert;
        Alldone := False;
        If Format = 11 then
        begin
            Password := true;
            Format := 1;
        end
        else
           Password := false;
    end;  {sub Proc Check_Parameters}

    Function FillWhiteSpace(Str:string):string;
    var I : integer;
    begin
        If Password then
           Str := replicate(length(Str),PassChar);
        while length(Str) < L do
              Str := Str + RTTT.WhiteSpace;
        FillWhiteSpace := Str;
    end; {sub Func FillWhiteSpace}

    Procedure MoveTheCursor;
    begin
        GotoXY(X+CursorPos-1,Y);
    end;  {sub Proc MoveTheCursor}

    Procedure Write_String;
    begin
        Fastwrite(X,Y,attr(F,B),FillWhiteSpace(TempText));
        MoveTheCursor;
    end;

    Procedure Erase_Field;
    begin
        TempText := '';
        CursorPos := 1;
        Write_String;
    end;

    Procedure Char_Backspace;
    begin
        If CursorPos > 1 then
        begin
            CursorPos := Pred(CursorPos);
            Delete(TempText,CursorPos,1);
            Write_String;
       end;
    end;   {sub Proc Char_Backspace}

    Procedure Char_Del;
    begin
        If CursorPos <= length(TempText) then
        begin
            Delete(TempText,CursorPos,1);
            Write_String;
        end;
    end;   {sub Proc Char_Del}

    Procedure Add_Char(Ch:char);
    begin
        If InsertMode then
        begin
            If length(TempText) < L then
            begin
                Insert(Ch,TempText,CursorPos);
                If CursorPos < L then
                   CursorPos := Succ(CursorPos);
           end;
        end
        else {not insertmode}
        begin
            Delete(TempText,CursorPos,1);
            Insert(Ch,TempText,CursorPos);
            If CursorPos < L then
               CursorPos := Succ(CursorPos);
        end;   {if insert}
        Write_String;
    end;   {sub proc Add_Char}


begin                  {main Procedure Read_Line}
    Check_Parameters;
    R_Null := false;
(*    FindCursor(Cursor_X,Cursor_Y,ScanTop,ScanBot); *)
    If RTTT.Insert then
       HalfCursor
    else
       OnCursor;
    Write_String;
    FirstCharPress := true;
    Repeat
         Ch := ReadKey; (* Getkey; *)
         If Format in [2,3] then
            Ch := upcase(Ch);
         If Ch in RTTT.End_Chars then
         begin
            AllDone := True;
            If Ch <> #027 then Text := TempText;
         end
         else
         Case Ch of
         #131,              {mouseright}
         CursorRight   :  begin
                              If (CursorPos < L)
                              and (CursorPos <= length(TempText)) then
                              begin
                                  CursorPos := Succ(CursorPos);
                                  MoveTheCursor;
                              end;
                          end;
         #130,               {mouseleft}
         CursorLeft    :  begin
                              If CursorPos > 1 then
                              begin
                                  CursorPos := Pred(CursorPos);
                                  MoveTheCursor;
                              end;
                          end;
         HomeKey       :  begin
                              CursorPos := 1;
                              MoveTheCursor;
                          end;
         EndKey        :  begin
                              If CursorPos < L then
                              If length(TempText) < L then
                                  CursorPos := length(TempText) + 1
                              else
                                  CursorPos := L;
                              MoveTheCursor;
                          end;
        InsKey        :  If Format <> 3 then   {don't allow insert on Y/N!}
                         begin
                             InsertMode := not InsertMode;
                             If InsertMode then
                                HalfCursor
                             else
                                OnCursor;
                         end;
        DelKey        :  Char_Del;
        BackSpace     :  Char_Backspace;
        Zap           :  Erase_Field;
        #132,
        EscKey        :  If RTTT.AllowEsc then
                             Alldone := true;
        #133,
        EnterKey      :  begin
                             Alldone := true;
                             Text := TempText;
                             temp:=TempText;
                         end;
       #33 .. #42,                                 {! to *}
       #44,#47,                                    {, /}
       #58 .. #64,                                 {: to @}
       #91 .. #96,                                 {[ to '}
       #123 .. #126   :  If (Format in [1,2]) then {{ to ~}
                         begin
                             If FirstCharPress and RTTT.EraseDefault then
                                Erase_Field;
                             Add_Char(Ch);
                         end
                         else
                             Clang;
       #43, #45       : If (Format in [1,2])       { + - }
                        or ( (CursorPos=1) and (Format in [5,6,7])) then
                        begin
                            If FirstCharPress and RTTT.EraseDefault then
                                Erase_Field;
                            Add_Char(Ch);
                        end
                        else
                           Clang;
       #46            : If (Format in [1,2])       {.}
                        or ( (Pos('.',TempText)=0) and (Format = 7)) then
                        begin
                            If FirstCharPress and RTTT.EraseDefault then
                                Erase_Field;
                            Add_Char(Ch);
                        end
                        else
                           Clang;
       #48..#57       : If (Format in [1..2,5..8]) then {0 to 9}
                        begin
                            If FirstCharPress and RTTT.EraseDefault then
                                Erase_Field;
                            Add_Char(Ch);
                        end
                        else
                           Clang;
       #32,                                              {space}
       #65..#77,                                         {A to M}
       #79..#88,                                         {O to X}
       #90,                                              {Z}
       #97..#122      : If (Format in [1,2,4]) then      {a to z}
                        begin
                            If FirstCharPress and RTTT.EraseDefault then
                                Erase_Field;
                            Add_Char(Ch);
                        end
                        else
                           Clang;
       #78,#89        : If (Format in [1..4]) then        {N Y}
                        begin
                            Add_Char(Ch);
                            If Format = 3 then
                            begin
                                Alldone := true;
                                Text := TempText;
                            end;
                        end
                        else
                           Clang;
      #128,#129       :;    {absorb stray mouse movement to avoid Clang'n}
      else Clang;
      end; {case}
      FirstCharPress := false;
      Until Alldone;
      R_Char := Ch;
      If  RTTT.RightJustify
      and (Format > 4) then
      begin
          Fastwrite(X,Y,attr(F,B),replicate(L,RTTT.Whitespace));
          Fastwrite(X+L-Length(TempText),Y,attr(F,B),Text);
      end
      else
        Fastwrite(X,Y,attr(F,B),FillWhiteSpace(Text));
      GotoXY(Cursor_X,Cursor_Y);
      SizeCursor(ScanTop,ScanBot);
end;

function exist (n:string):boolean;
var f:file;
    i:integer;
begin
  assign (f,n);
  reset (f);
  i:=ioresult;
  exist:=i=0;
  close (f);
  i:=ioresult
end;

 function numentry:integer;
  begin
    numentry:=filesize(WFfile)
  end;

  procedure seekwffile (n:integer);
  begin
    seek (WFfile,n-1)
  end;

  procedure openwffile;
  var n:integer;
  begin
    n:=ioresult;
    assign (WFfile,'FARGO.DAT');
    reset (WFfile);
    if ioresult<>0 then begin
      close (WFfile);
      n:=ioresult;
      rewrite (WFfile)
    end
  end;

  Procedure Grand_Opening;
  Begin
   FillScreen(1,1,80,25,white,blue,chr(176));
   GrowFBox(25,10,55,17,yellow,blue,4);
   WriteCenter(12,15,1,'Wells Fargo Quick Menus');
   WriteCenter(13,15,1,'Written By: Josh Ham');
   WriteCenter(14,15,1,'Requested By: Larry Ham');
   WriteCenter(16,11,1,'Quick Menus (c)1991');
   Delay(3000);
  End;

  Procedure Entry_Box;
  Begin
   FillScreen(1,1,80,25,white,blue,char(176));
   TextAttr:=1;
   GrowFBox(15,5,65,20,blue,blue,4);
   TextAttr:=8;
   For x:=17 to 66 Do Begin Gotoxy(x,21); Write(char(219)); End;
   For y:=6 to 21 Do Begin Gotoxy(66,y); Write(char(219)+Char(219)); End;
  End;

  Procedure EC;
  Begin
   Textbackground(7);
   Textcolor(0);
  End;

  Procedure EF;
  Begin
   Textbackground(1);
   Textcolor(11);
  End;

  Procedure Add_An_Entry;
  var ch:Char;
      a,b,c,d:string;
  Begin
   Entry_Box;
   Textbackground(1);
   TextColor(14);
   Gotoxy(22,6);
   Write('Wells Fargo Quick Menus - Add an Entry');
   TextColor(9);
   For x:=15 to 65 Do Begin gotoxy(x,7); Write(char(196)); End;
   TextColor(11);
   OpenWfFile;
   num:=numentry;
   Gotoxy(17,9);  Write('Enter Filename To Execute'); ec;
   Gotoxy(17,10); Write('????????????'); ef;
   Gotoxy(17,12); Write('Enter Full Path To The Above File'); ec;
   Gotoxy(17,13); Write('????????????????????????????????????'); ef;
   Gotoxy(17,15); Write('Enter a Description Of This Entry'); ec;
   gotoxy(17,16); Write('?????????????????????????????????????????'); ef;
   gotoxy(17,18); Write('Enter a Password To Load This (Enter=None)'); ec;
   gotoxy(17,19); Write('?????????????????????');
   clang;
   r.programname:='';
   Gotoxy(17,10);ReadLine(17,10,12,0,7,r.programname);
   r.programname:=temp;
   r.path:='';
   gotoxy(17,13);ReadLine(17,13,35,0,7,r.path);
   r.path:=temp;
   r.description:='';
   gotoxy(17,16);ReadLine(17,16,40,0,7,r.description);
   r.description:=temp;
   r.password:='';
   gotoxy(17,19);ReadLine(17,19,20,0,7,r.password);
   r.password:=temp;
   GrowFBox(25,1,53,3,lightblue,blue,4);
   Clang; ef;
   textcolor(15);
   Gotoxy(27,2); Write('Save This To Disk? [Y/N]');
   Repeat
   Ch:=ReadKey;
   Until (ch='Y') or (ch='y') or (ch='N') or (ch='n');
   If (ch='Y') or (ch='y') Then Begin
   if not exist ('FARGO.DAT') then rewrite (WFfile);
   seekwffile(num+1);
   write (WFfile,r);
   End;
   ef;
   FillScreen(1,1,80,25,white,blue,chr(176));
   Close(Wffile);
   End;

   Procedure Edit_Entry;
   var howmany:integer;
   Begin
    FillScreen(1,1,80,25,white,blue,chr(176));
     GrowFBox(25,1,53,3,lightblue,blue,4);
     Clang; ef;
     textcolor(15);
     OpenWffile;
     howmany:=numentry;
     Gotoxy(27,2); Write('Edit Which Entry? [1-',howmany,']:');
     gotoxy(51,2); ReadLn(howmany);
     seekwffile(howmany+1);
     read(wffile,r);
    FillScreen(30,5,75,15,blue,blue,chr(219)); ef;
    GotoXy(42,6); Write('Wells Fargo Quick Menu Editor'); ec;
    Gotoxy(32,8); Write('????????????');
    Gotoxy(32,10); Write('????????????????????????????????????');
    gotoxy(32,12); Write('?????????????????????????????????????????');
    gotoxy(32,14); Write('?????????????????????');
    gotoxy(32,8); Write(r.programname);
    gotoxy(32,10);Write(r.path);
    gotoxy(32,12);Write(r.description);
    gotoxy(32,14);If r.password='' then Write ('N/A') Else write(r.password);
    readln;
    Close(WfFile);
   End;

   Procedure Utilitys;
   Begin
    Menu_Set(M1);
    With M1 do
    begin
        Heading1 := '- Wells Fargo Quick Menu Utilitys -';
        Heading2 := 'Quick Menus (c)1991';
        Topic[1] := '   Add a new entry';
        Topic[2] := '   Edit an existing entry';
        Topic[3] := '   Delete an existing entry ';
        Topic[4] := '   Quit Utility Section';
        TotalPicks := 4;
        PicksPerLine := 1;
        Addprefix := 0;
        TopleftXY[1] := 0;
        TopleftXY[2] := 8;
        Boxtype := 5;
        If ColorScreen then
        begin
            Colors[1] := white;
            Colors[2] := blue;
            Colors[3] := lightgray;
            Colors[4] := red;
            Colors[5] := lightgray;
        end
        else
        begin
            Colors[1] := white;
            Colors[2] := black;
            Colors[3] := black;
            Colors[4] := lightgray;
            Colors[5] := white;
        end;
        AllowEsc := false;
        Margins := 5;
end;  {with M1 do}
end; {Define_Menu1}

Procedure Utility_Menu;
Var Quit:Boolean;
Begin
    Quit:=False;
    Findcursor(X,Y,ScanTop,ScanBot);
    Main_Choice := 1;
    Done:=False;
    FillScreen(1,1,80,25,white,blue,chr(176));
    repeat
     Utilitys;
     DisplayMenu(M1,false,Main_Choice,Error);
     Case Main_Choice of
     1:Add_An_Entry;
     2:Edit_Entry;
     3:Begin End;{Delete_An_Entry;}
     4:Quit:=True;
     end;
until Quit;
FillScreen(1,1,80,24,white,blue,chr(176));
main_choice:=1;
End;

Begin
Grand_Opening;
Utility_Menu;
End.