home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / CRYP60.ZIP / PROMPT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-11-15  |  31.8 KB  |  1,137 lines
  1. {Start of file Prompt.Pas **************************************************}
  2.  
  3. unit Prompt; {Utilities to operate with strings and Prompts to
  4.               get input from the keyboard}
  5.  
  6. { Version = 'Version 2.10, last revised: 1992-11-15 1400 hours';
  7.   Author  = 'Copyright (c) 1981-1992 by author: Harry J. Smith,';
  8.   Address = '19628 Via Monte Dr., Saratoga, CA 95070.  All rights reserved.';
  9. }
  10. {***************************************************************************}
  11.  
  12. {$I-} {Do our own i/o error checks}
  13. {$N+} {Uses numeric coprocessor}
  14. {$R-} {No index Range checking}
  15. {$V-} {Parameter string length need not match}
  16.  
  17. {Developed in TURBO Pascal 5.5, maintained in 6.0}
  18.  
  19. interface
  20.  
  21. uses  Crt; {Turbo Pascal interface}
  22.  
  23. const
  24.   Space = ' ';
  25.   HisMax = 20;  { Max # of previous History entries }
  26.  
  27. type
  28.   HisRec = record   { History previous entries }
  29.     St   : ^String; { Previous entry }
  30.     Lock : Char;    { = ■ if entry is locked from delete }
  31.     Plus : Char;    { = + if entry is longer than con be displayed }
  32.   end;
  33.   ScreenPtr = ^ScreenType;
  34.   ScreenType = Record
  35.     Pos : Array [1..80, 1..25] of Record
  36.       Ch : Char;
  37.       At : Byte;
  38.     End;
  39.     CursX,
  40.     CursY : Integer;
  41.   End;
  42.  
  43.   HotHelpT = procedure(I : Integer); {Hot help for F1..F10}
  44.  
  45.   Directions = (DUp, DDown, DLeft, DRight, DCenter);
  46.   CharSet    = set of Char;
  47.   ScrCommand = (NullCmd, ClrLine, ClrScreen);
  48.   CtrlType   =
  49.     (NotCtrl,  DupChr,   BackUp,  InsChr,   BegFld,  EndFld,
  50.      DelChr,   ClrToEnd, Accept,  Truncate, Restore, Escape,
  51.      Helper,   Stopper,  NextWrd, PrevWrd,  DelBack, ClrToBeg,
  52.      ClrNxWrd, ClrPrWrd, UpHis,   DwnHis);
  53.  
  54. var
  55.   Screen : ScreenPtr;  {The real screen}
  56.   Screen1: ScreenPtr;  {A copy of the screen}
  57.   MonoScr: Boolean;    {True if not a color screen}
  58.   HotKey : Boolean;    {A Hot Key was input}
  59.   EchoPtr: ^Text;      {If <> nil, pointer to Text file to echo help}
  60.   FirstX : Byte;       {Used to go to first column of Crt window}
  61.   FirstY : Byte;       {Used to go to first row of Crt window}
  62.   LastX  : Byte;       {Used to go to last column of Crt window}
  63.   LastY  : Byte;       {Used to go to last row of Crt window}
  64.   NumX   : Byte;       {Number of columns in Crt window}
  65.   NumY   : Byte;       {Number of rows Crt window}
  66.   CtrlChr, NormalChr, NullSet, WhiteSpace : CharSet;
  67.   Ctrl : packed array[0..255] of CtrlType;
  68.   Null, Bell, BS, Tab, LF, FF, CR, HelpC, StopC, ESC, FillC : Char;{Constants}
  69.   EscTyped, HelpTyped, StopTyped : Boolean;
  70.   Background : Char;
  71.   NullStrg : String[1];
  72.   RspChr : Char;
  73.   His    : array[0..HisMax] of HisRec;  { History of previous entries }
  74.   HisPtr : Integer; { Index to currently selected previous entry }
  75.   HisTN  : Integer; { Number of entries in HisTab }
  76.   HisLN  : Integer; { Number of locked entries in HisTab }
  77.  
  78. {The following procedures can be called externally:}
  79.  
  80. procedure AddHis( Response : String; Lock : Char);
  81.   {Add a response to the History of previous entries}
  82.  
  83. procedure InitScr;
  84.   {Clear screen, home cursor, and init screen constants}
  85.  
  86. function ReadKeyM( HotHelpA : HotHelpT) : Char;
  87.   {Read key and map to 0 - 255}
  88.  
  89. procedure GetYesNo( var Value : Boolean;
  90.    HotHelpA : HotHelpT); {Get yes/no answer from operator}
  91.  
  92. procedure MoreLn( St : String;
  93.    HotHelpA : HotHelpT); {WriteLn but stop for more on last line}
  94.  
  95. procedure HelpProm;
  96.   {Give operator a help message for using Prom.}
  97.  
  98. procedure GoToXYI( Col, Row : Integer);
  99.   {Move the cursor to a specified position on the screen, Col>LastX is wrapped}
  100.  
  101. procedure GetChr( NumDelays: Integer; WithBells: Boolean; ValidChr: CharSet;
  102.    HotHelpA : HotHelpT);
  103.   {Detect or await typing of a key.}
  104.  
  105. procedure ChgLen( var Strg: String; MaxLen, NewLen: Integer);
  106.   {Change the length of Strg to NewLen.}
  107.  
  108. procedure Justify( var SrcStrg: String; var DstStrg: String;
  109.           HowJust: Directions; PadChr: Char; OldLen, NewLen: Integer);
  110.   {Left/right/center justify a string for the specified length using PadChr.}
  111.  
  112. procedure ScreenMsg( XPos, YPos: Integer; Command: ScrCommand;
  113.           var Message: String);
  114.   {Display a message at a specified cursor position.}
  115.  
  116. procedure Prom( RspX, RspY, RspLen: Integer; var Default: String;
  117.                var Response: String; HotHelpA : HotHelpT);
  118.   {Prompt the operator for an input.}
  119.  
  120. procedure EditLn( Prompt : String; RspLen : Integer; var PrSt, St : String;
  121.    HotHelpA : HotHelpT);
  122.   {Edit a long line of input using Prom}
  123.  
  124. {************************************************************}
  125.  
  126. implementation
  127.  
  128.   {--------------------------------------}
  129.   procedure AddHis( Response : String; Lock : Char);
  130.   var
  131.     Dupe  : Boolean;
  132.     HisHi : Integer;
  133.   begin {AddHis}
  134.     HisHi:= 0;  Dupe:= False;
  135.     while (HisHi < HisTN) and (not Dupe) do begin
  136.       Inc( HisHi);
  137.       if Response = His[ HisHi].St^ then  Dupe:= True;
  138.     end;
  139.     His[0]:= His[ HisHi];
  140.     if (not Dupe) then begin
  141.       if (HisTN = HisMax) and (not Dupe) then begin
  142.         while (His[ HisHi].Lock <> ' ') do  Dec( HisHi);
  143.         FreeMem( His[ HisHi].St, Length( His[ HisHi].St^) + 1);
  144.         Dec( HisTN);
  145.       end
  146.       else  Inc( HisHi);
  147.     end;
  148.     for HisPtr:= HisHi downto 2 do begin
  149.       His[ HisPtr]:= His[ HisPtr - 1];
  150.     end;
  151.     if Dupe then begin
  152.       His[1]:= His[0];
  153.     end
  154.     else begin
  155.       GetMem( His[1].St, Length( Response) + 1);
  156.       His[1].St^:= Response;
  157.       His[1].Lock:= Lock;
  158.       if (Length( Response) > 70) then    His[1].Plus:= '+'
  159.       else  His[1].Plus:= ' ';
  160.       Inc( HisTn);
  161.     end;
  162.     His[0].St:= nil;
  163.     His[0].Lock:= ' ';
  164.     His[0].Plus:= ' ';
  165.     HisPtr:= 1;
  166.   end; {AddHis}
  167.  
  168. {-----------------------------}
  169. procedure InitScr; {Clear screen, home cursor, and init screen constants}
  170. var
  171.   I : Integer;
  172. begin
  173.   ClrScr;
  174.   FirstX:= WhereX;
  175.   FirstY:= WhereY;
  176.   repeat
  177.     LastX:= WhereX;
  178.     Write(' ');  I:= WhereX;
  179.   until LastX >= I;
  180.   repeat
  181.     LastY:= WhereY;
  182.     WriteLn;  I:= WhereY;
  183.   until LastY >= I;
  184.   NumX:= LastX - FirstX + 1;
  185.   NumY:= LastY - FirstY + 1;
  186.   GoToXY( FirstX, FirstY);
  187. end; {InitScr}
  188.  
  189. {--------------------------------------}
  190. function ReadKeyM( HotHelpA : HotHelpT) : Char; {Read key and map to 0 - 255}
  191. var
  192.   I : Integer;
  193.   Ch : Char;
  194.   XL, YL : Byte;
  195. begin
  196.   repeat
  197.     HotKey:= False;
  198.     Ch:= ReadKey;
  199.     XL:= WhereX;  YL:= WhereY;
  200.     GoToXY( LastX-5, 1);  Write('      ');  GoToXY( LastX-4, 1);
  201.     if Ch = Char(0) then begin
  202.       Ch:= Chr( Ord( ReadKey));
  203.       Write('0:', Ord( Ch));
  204.       I:= Ord( Ch);
  205.       if (59 <= I) and (I <= 68) then begin
  206.     HotKey:= True;  GoToXY( XL, YL);  HotHelpA(I); {User can change HotKey}
  207.       end;
  208.       Inc(I, 128);
  209.       if I > 255 then  I:= 0;
  210.       Ch:= Chr(I);
  211.     end
  212.     else begin
  213.       Write( Ord( Ch));
  214.     end;
  215.   until not HotKey;
  216.   ReadKeyM:= Ch;
  217.   GoToXY( XL, YL);
  218. end; {ReadKeyM}
  219.  
  220. {-----------------------------}
  221. procedure GetYesNo( var Value : Boolean;
  222.    HotHelpA : HotHelpT); {Get yes/no answer from operator}
  223. var Ch : Char;  Done : Boolean;
  224. begin
  225.   Write('Y', BS);
  226.   repeat
  227.     Ch:= ReadKeyM( HotHelpA);
  228. {   if Ch = ESC  then  Ch:= 'N'; . Don't allow a true ESC, use F4 only }
  229. {   if Ch = #190 then  Ch:= ESC; . ESC means No now on Yes/No request }
  230.     Done:= Ch in ['Y', 'y', 'N', 'n', CR, ESC, StopC];
  231. {   if not Done then Write( Bell); }
  232.   until Done;
  233.   EscTyped:= (Ch = ESC);
  234.   StopTyped:= (Ch = StopC);
  235.   Value:= Ch in ['Y', 'y', CR];
  236.   if Value then WriteLn('Yes')
  237.   else WriteLn('No');
  238. end; {GetYesNo}
  239.  
  240. {-----------------------------}
  241. procedure MoreLn( St : String;
  242.    HotHelpA : HotHelpT); {WriteLn but stop for more on last line}
  243. var
  244.   Ch : Char;
  245. begin
  246.   if WhereY = LastY then begin
  247.     Write('--More--');
  248.     Ch:= ReadKeyM( HotHelpA);
  249.     ClrScr;
  250.   end;
  251.   WriteLn( St);
  252.   if EchoPtr <> nil then  WriteLn( EchoPtr^, St);
  253. end; {MoreLn}
  254.  
  255. {-----------------------------}
  256. procedure HelpProm; {Help Prom}
  257. var
  258.   I  : Integer;
  259.   Ch : Char;
  260. begin
  261.   ClrScr;
  262.   GoToXY(1, 2);
  263.   WriteLn(
  264.     'The active control characters for editing (^ = Ctrl, BS = Backspace):');
  265.   WriteLn;
  266.   WriteLn(' 0) Down   or Up => Retrieve history of previous operator entries');
  267.   WriteLn(' 1) ^Right or ^F => Jump to beginning of next word');
  268.   WriteLn(' 2) ^Left  or ^A => Jump to beginning of previous word');
  269.   WriteLn(' 3) Right  or ^D => Retype the character at current position');
  270.   WriteLn(' 4) Left   or ^S => Back up a space and delete if inserting');
  271.   WriteLn(' 5) Del    or ^G => Delete the character at current position');
  272.   WriteLn(' 6) BS     or ^H => Delete the character to left of cursor');
  273.   WriteLn(' 7) End    or ^X => Jump to end of input');
  274.   WriteLn(' 8) Home   or ^E => Jump to beginning of input');
  275.   WriteLn(' 9) ^End   or ^Y => Clear input from current position to end');
  276.   WriteLn('10) ^Home  or ^B => Clear input to left of cursor');
  277.   WriteLn('11) PgDn   or ^T => Clear word to right');
  278.   WriteLn('12) PgUp   or ^W => Clear word to left');
  279.   WriteLn('13) Ins    or ^V => Toggle insert mode');
  280.   WriteLn('14) Enter  or ^M => Accept the entire input as is');
  281.   WriteLn(
  282.      '15) ^Enter or ^J => Accept input, truncate if not at beginning or end');
  283.   WriteLn('16)           F2 => Quit and exit to operating system');
  284.   WriteLn('17)           F3 => Restore previous input');
  285.   WriteLn('18)           F4 => Restore previous input and accept');
  286.   WriteLn('19)           F5 => This menu: Help with input key control');
  287.   WriteLn;
  288. end; {HelpProm}
  289.  
  290. {--------------------------------------}
  291. procedure GoToXYI( Col, Row : Integer); {Move the cursor to a specified
  292.   position on the screen, Col > LastX is wrapped}
  293. begin
  294.   while Col > LastX do begin
  295.     Dec( Col, NumX);  Inc( Row);
  296.   end;
  297.   GoToXY( Col, Row);
  298. end; {GoToXYI}
  299.  
  300. {--------------------------------------}
  301. procedure GetChr( NumDelays: Integer; WithBells: Boolean; ValidChr: CharSet;
  302.    HotHelpA : HotHelpT);
  303. {Detects or awaits typing of a key, optionally issuing bells while waiting.
  304.  RspChr is Null or the character typed.
  305.  if NumDelays < 0,
  306.    GetChr will wait until user types a valid character
  307.    (any character, if ValidChr = NullSet)
  308.  if NumDelays = 0,
  309.    GetChr will return the last character typed prior to the call
  310.  if NumDelays > 0,
  311.    GetChr will wait the specified number of delays or exit when a key is
  312.    typed.
  313. }
  314. var
  315.   ValidKey : Boolean;
  316. begin {GetChr}
  317.   ValidKey:= True;
  318.   ValidKey:= (ValidChr = NullSet);
  319.   if (ValidChr = NullSet)
  320.     then ValidKey:= True
  321.     else ValidKey:= False;
  322.   {Write( Chr(5)); Turn on cursor if you can}
  323.   repeat
  324.     while (NumDelays <> 0) and (not KeyPressed) do begin
  325.       if WithBells then {Write( Bell)};
  326.       Delay( 300); {Wait a bit}
  327.       {Decrease NumDelays BY 1 if Positive}
  328.       Dec( NumDelays, Ord( NumDelays > 0));
  329.     end; {while}
  330.     if  KeyPressed or (NumDelays = 0) then
  331.     begin
  332.       {Get a character from the keyboard}
  333.       RspChr:= ReadKeyM( HotHelpA);
  334.       {Write( Chr(5)); Turn on cursor if you can}
  335. {     if EoLn( Kbd) then RspChr:= CR; This did not work with
  336.       Turbo Pascal v 3.01a
  337. }     if not ValidKey then
  338.         if (RspChr in ValidChr) then
  339.           ValidKey:= True
  340.         else
  341.           {Write( Bell)};
  342.     end
  343.     else
  344.       RspChr:= Null;
  345.   until ValidKey;
  346.   EscTyped:= (RspChr = ESC) or (RspChr = #190);
  347. end; {GetChr}
  348.  
  349. {--------------------------------------}
  350. procedure ChgLen( var Strg: String; MaxLen, NewLen: Integer);
  351.   {Change the Length of Strg to NewLen.}
  352. var I : Integer;
  353. begin
  354.   if NewLen < MaxLen then  Strg[0]:= Char( NewLen)
  355.   else  Strg[0]:= Char( MaxLen);
  356. end; {ChgLen}
  357.  
  358. {--------------------------------------}
  359. procedure Justify( var SrcStrg: String; var DstStrg: String;
  360.                   HowJust: Directions; PadChr: Char; OldLen,
  361.                   NewLen: Integer);
  362. {Left/Right/Center Justify a String for the specified Length using PadChr}
  363. var
  364.   Len   : Integer;
  365.   StPos : Integer;
  366.   I, J  : Integer;
  367. begin {Justify}
  368.   {If SrcStrg is too long, shorten it}
  369.   if OldLen >= NewLen then Len:= NewLen
  370.   else begin
  371.     Len:= OldLen;
  372.     {Fill the destination String with PadChr}
  373.     for I:= 1 to NewLen do DstStrg[I]:= PadChr;
  374.   end;
  375.   {Determine where in the destination String to begin
  376.      moving the source String}
  377.   if Len > 0 then begin
  378.     case HowJust of
  379.       DLeft:   StPos:= 1;
  380.       DRight:  StPos:= NewLen - Len + 1;
  381.       DCenter: StPos:= (NewLen - Len) DIV 2 + 1;
  382.     end; {case}
  383.     {Move the source String into the destination String}
  384.     J:= StPos;
  385.     for I:= 1 to Len do begin
  386.       DstStrg[J]:= SrcStrg[I];
  387.       Inc(J);
  388.     end;
  389.   end; {if}
  390.   {Make the destination String the proper Length}
  391.   ChgLen( DstStrg, NewLen, NewLen);
  392. end; {Justify}
  393.  
  394. {--------------------------------------}
  395. procedure InitCtrl;
  396. {Initialize the Prompt control characters}
  397. var
  398.   TmpChr : Char;
  399.  
  400.   {--------------------------------------}
  401.   procedure AddToCtrl( ASCIIVal: Integer; CtrlKind: CtrlType);
  402.   begin {AddToCtrl}
  403.     Ctrl[ ASCIIVal]:= CtrlKind;
  404.     CtrlChr:= CtrlChr + [Chr( ASCIIVal)];
  405.   end; {AddToCtrl}
  406.  
  407. begin {InitCtrl}
  408.   CtrlChr:= NullSet;
  409.   NormalChr:= NullSet;
  410.   for TmpChr:= Space to Chr( 126) do  NormalChr:= NormalChr + [TmpChr];
  411.  
  412.   AddToCtrl( 4,   DupChr);   {^D}
  413.   AddToCtrl( 205, DupChr);   {RightArrow}
  414.  
  415.   AddToCtrl( 19,  BackUp);   {^S}
  416.   AddToCtrl( 203, BackUp);   {LeftArrow}
  417.  
  418.   AddToCtrl( 7,   DelChr);   {^G}
  419.   AddToCtrl( 211, DelChr);   {Del}
  420.  
  421.   AddToCtrl( 8,   DelBack);  {^H = BackSpace}
  422.  
  423.   AddToCtrl( 24,  EndFld);   {^X}
  424.   AddToCtrl( 207, EndFld);   {End}
  425.  
  426.   AddToCtrl( 5,   BegFld);   {^E}
  427.   AddToCtrl( 199, BegFld);   {Home}
  428.  
  429.   AddToCtrl( 6,   NextWrd);  {^F}
  430.   AddToCtrl( 244, NextWrd);  {^RightArrow}
  431.   AddToCtrl( 208, DwnHis);   {DownArrow}
  432.  
  433.   AddToCtrl( 1,   PrevWrd);  {^A}
  434.   AddToCtrl( 243, PrevWrd);  {^LeftArrow}
  435.   AddToCtrl( 200, UpHis);    {UpArrow}
  436.  
  437.   AddToCtrl( 25,  ClrToEnd); {^Y}
  438.   AddToCtrl( 245, ClrToEnd); {^End}
  439.  
  440.   AddToCtrl( 2,   ClrToBeg); {^B}
  441.   AddToCtrl( 247, ClrToBeg); {^Home}
  442.  
  443.   AddToCtrl( 20,  ClrNxWrd); {^T}
  444.   AddToCtrl( 209, ClrNxWrd); {PgDn}
  445.  
  446.   AddToCtrl( 23,  ClrPrWrd); {^W}
  447.   AddToCtrl( 201, ClrPrWrd); {PgUp}
  448.  
  449.   AddToCtrl( 22,  InsChr);   {^V}
  450.   AddToCtrl( 210, InsChr);   {Ins}
  451.  
  452.   AddToCtrl( 13,  Accept);   {^M = CR}
  453.  
  454. { AddToCtrl( 18,  Restore);  .^R}
  455.   AddToCtrl( 189, Restore);  {F3}
  456.  
  457. { AddToCtrl( 144, Stopper);   .Alt-Q}
  458.   AddToCtrl( 188, Stopper);   {F2}
  459.  
  460.   AddToCtrl( 10,  Truncate); {^J = ^CR = LF}
  461.  
  462. { AddToCtrl( 27,  Escape);   .^[ = ESC}
  463.   AddToCtrl( 190, Escape);   {F4}
  464.  
  465. { AddToCtrl( 17,  Helper); } {^Q}
  466. { AddToCtrl( 187, Helper); } {F1}
  467.  
  468.   CtrlChr:= CtrlChr + [Chr( 127)];
  469. end; {InitCtrl}
  470.  
  471. {--------------------------------------}
  472. procedure ScreenMsg( XPos, YPos: Integer; Command: ScrCommand;
  473.                     var Message: String);
  474. begin {ScreenMsg}
  475.   GoToXY( XPos, YPos);
  476.   case Command of
  477.     ClrLine:   ClrEol;
  478.     ClrScreen: ClrScr;
  479.   end; {case}
  480.   Write( Message);
  481. end; {ScreenMsg}
  482.  
  483. {--------------------------------------}
  484. procedure Prom( RspX, RspY, RspLen: Integer; var Default:
  485.                String; var Response: String; HotHelpA : HotHelpT);
  486. var
  487.   Inserting, Terminated, TmpBool : Boolean;
  488.   FmtLen, InsPos, RspPos : Integer;
  489.   CtrlKind : CtrlType;
  490.   ValidChr : CharSet;
  491.   TmpDef   : String[ 255];
  492.  
  493.   {--------------------------------------}
  494.   procedure Shift( ShiftDir: Directions);
  495.   begin {Shift}
  496.     case ShiftDir of
  497.       DLeft: begin
  498.         if RspPos < Length( Response) then
  499.           Delete( Response,
  500.                      RspPos + Ord( (CtrlKind <> NotCtrl) and
  501.                      ((CtrlKind <> BackUp) or
  502.                      (RspPos = InsPos))), 1);
  503.           ScreenMsg( RspX, RspY, NullCmd, Response);
  504.           Write( FillC);
  505.       end; {case DLeft}
  506.  
  507.       DRight: begin
  508.         Insert('^', Response, RspPos + 1);
  509.         ScreenMsg( RspX, RspY, NullCmd, Response);
  510.       end; {case DRight}
  511.     end; {case}
  512.   end; {Shift}
  513.  
  514.   {--------------------------------------}
  515.   function CharAt( ChrPos: Integer) : Char;
  516.   {Returns the character at position ChrPos in Response}
  517.   begin {CharAt}
  518.     if ChrPos > Length( Response) then
  519.       CharAt:= FillC
  520.     else
  521.       CharAt:= Response[ ChrPos];
  522.     end; {CharAt}
  523.  
  524.     {--------------------------------------}
  525.     procedure DoInsChr;
  526.     LABEL 1;
  527.     begin {DoInsChr}
  528.       case Inserting of
  529.         False: begin
  530.           if Length( Response) < RspLen then begin
  531.             if RspLen > (RspPos + 1) then
  532.               Shift( DRight)
  533.             else
  534.               Write('^');
  535.             InsPos:= RspPos;
  536.             Inserting:= True;
  537.           end
  538.           else
  539.             {Write( Bell)};
  540.         end; {case False}
  541.         True: begin
  542.           if RspLen > RspPos then
  543.             if (CtrlKind = NotCtrl) then
  544.               Response[ RspPos + 1]:= RspChr
  545.             else
  546.               Shift( DLeft);
  547.             Inserting:= False;
  548.             TmpDef:= Response;
  549.         end; {case True}
  550.       end; {case}
  551. 1:
  552.   end; {DoInsChr}
  553.  
  554.   {--------------------------------------}
  555.   procedure DoNotCtrl;
  556.   LABEL 1;
  557.   var
  558.     ERROR : Boolean;
  559.   begin {DoNotCtrl}
  560.     {Little bell}
  561.     ERROR:= False;
  562.     if RspPos = RspLen then
  563.     begin
  564.       if Inserting then DoInsChr;
  565.       ERROR:= True;
  566.     end;
  567.     if ERROR then
  568.     begin
  569.       {Write( Bell)};
  570.       GOTO 1; {Exit( DoNotCtrl);}
  571.     end; {if}
  572.     if Inserting then
  573.       if Length( Response) = RspLen then
  574.         DoInsChr
  575.       else
  576.         if RspLen > (RspPos + 1) then
  577.           Shift( DRight);
  578.         GoToXYI( RspX + RspPos, RspY);
  579.         if RspChr in NormalChr then
  580.           Write( RspChr);
  581.         Inc( RspPos);
  582.         if RspPos > Length( Response) then
  583.           ChgLen( Response, FmtLen, RspPos);
  584.         Response[ RspPos]:= RspChr;
  585. 1:
  586.   end; {DoNotCtrl}
  587.  
  588.   {--------------------------------------}
  589.   procedure DoDupChr;
  590.   begin {DoDupChr}
  591.     if RspPos < Length( Response) then
  592.       Inc( RspPos)
  593.     else
  594.       {Write( Bell)};
  595.     end; {DoDupChr}
  596.  
  597.   {--------------------------------------}
  598.   procedure DoBackUp;
  599.   var
  600.     TmpChr : Char;
  601.   begin {DoBackUp}
  602.     if RspPos = 0 then  {Write( Bell)}
  603.     else begin
  604.       if Inserting then begin
  605.         if (RspPos = InsPos) then begin
  606.           DoInsChr;
  607.           TmpChr:= CharAt( RspPos);
  608.         end else begin
  609.           Shift( DLeft);
  610.           TmpChr:= '^';
  611.         end;
  612.         Dec( RspPos);
  613.         GoToXY( RspX + RspPos, RspY);
  614.         Write( TmpChr);
  615.       end
  616.       else begin
  617.   {     if RspPos <= Length( TmpDef, FmtLen) then
  618.         begin
  619.           TmpChr:= TmpDef[ RspPos];
  620.           Response[ RspPos]:= TmpChr;
  621.         end else begin
  622.           TmpChr:= FillC;
  623.           Delete( Response, RspPos, 1);
  624.         end;
  625.  } {Removed feature to delete end of input with Left arrow}
  626.  
  627.         Dec( RspPos);
  628. {       GoToXY( RspX + RspPos, RspY);}
  629. {       Write( TmpChr);}
  630.       end;
  631.     end; {if}
  632.   end; {DoBackUp}
  633.  
  634.   {--------------------------------------}
  635.   procedure ChgPos( NewPos: Integer);
  636.   begin {ChgPos}
  637.     if RspPos = NewPos then
  638.       {Write( Bell)}
  639.     else
  640.     begin
  641.       RspPos:= NewPos;
  642.       TmpDef:= Response;
  643.     end; {if}
  644.   end; {ChgPos}
  645.  
  646.   {-----------------}
  647.   procedure DoBegFld;
  648.   begin {DoBegFld}
  649.     ChgPos(0);
  650.   end; {DoBegFld}
  651.  
  652.   {-------------------------}
  653.   procedure DoEndFld;
  654.   begin {DoEndFld}
  655.     ChgPos( Length( Response));
  656.   end; {DoEndFld}
  657.  
  658.   {--------------------------------------}
  659.   procedure DoNextWrd;
  660.   var R : Integer;
  661.   begin {DoNextWrd}
  662.     R:= RspPos;
  663.     while (R < Length( Response)) and
  664.           (Response[ R+1] <> ' ') and (Response[ R+1] <> '.') do Inc(R);
  665.     while (R < Length( Response)) and
  666.          ((Response[ R+1] =  ' ') or (Response[ R+1] =  '.')) do Inc(R);
  667.     ChgPos(R);
  668.   end; {DoNextWrd}
  669.  
  670.   {--------------------------------------}
  671.   procedure DoPrevWrd;
  672.   var  R : Integer;
  673.   begin {DoPrevWrd}
  674.     R:= RspPos;
  675.     while (R > 0) and
  676.          ((Response[R] =  ' ') or (Response[R] =  '.')) do  Dec(R);
  677.     while (R > 0) and
  678.           (Response[R] <> ' ') and (Response[R] <> '.') do  Dec(R);
  679.     ChgPos(R);
  680.   end; {DoPrevWrd}
  681.  
  682.   {--------------------------------------}
  683.   procedure DoDelChr;
  684.   begin {DoDelChr}
  685.     if RspPos < Length( Response) then
  686.     begin
  687.       Shift( DLeft);
  688.       TmpDef:= Response;
  689.     end
  690.     else
  691.       {Write( Bell)};
  692.   end; {DoDelChr}
  693.  
  694.   {--------------------------------------}
  695.   procedure DoDelBack;
  696.   begin {DoDelBack}
  697.     if RspPos > 0 then begin
  698.       Dec( RspPos);
  699.       DoDelChr;
  700.     end else {Write( Bell)};
  701.   end; {DoDelBack}
  702.  
  703.   {--------------------------------------}
  704.   procedure SetDefault;
  705.   begin
  706.     ChgLen( Response, FmtLen, RspPos);
  707.     Justify( Response, TmpDef, DLeft, FillC, RspPos, RspLen);
  708.     ScreenMsg( RspX, RspY, NullCmd, TmpDef);
  709.     TmpDef:= Response;
  710.   end; {SetDefault}
  711.  
  712.   {--------------------------------------}
  713.   procedure DoClrToEnd;
  714.   begin {DoClrToEnd}
  715.     if RspPos < Length( Response) then
  716.       SetDefault
  717.     else
  718.       {Write( Bell)};
  719.   end; {DoClrToEnd}
  720.  
  721.   {--------------------------------------}
  722.   procedure DoClrToBeg;
  723.   begin
  724.     while RspPos > 0 do begin
  725.       Delete( Response, RspPos, 1);
  726.       Dec( RspPos);
  727.     end;
  728.       Justify( Response, TmpDef, DLeft, FillC,
  729.               Length( Response), RspLen);
  730.       ScreenMsg( RspX, RspY, NullCmd, TmpDef);
  731.       TmpDef:= Response;
  732.   end; {DoClrToBeg}
  733.  
  734.   {--------------------------------------}
  735.   procedure DoClrNxWrd;
  736.   begin {DoPrevWrd}
  737.     while (RspPos < Length( Response)) and
  738.           (Response[ RspPos+1] <>  ' ') and
  739.           (Response[ RspPos+1] <>  '.') do begin
  740.       Delete( Response, RspPos+1, 1);
  741.     end;
  742.     while (RspPos < Length( Response)) and
  743.          ((Response[ RspPos+1] = ' ') or
  744.           (Response[ RspPos+1] = '.')) do begin
  745.       Delete( Response, RspPos+1, 1);
  746.     end;
  747.       Justify( Response, TmpDef, DLeft, FillC,
  748.               Length( Response), RspLen);
  749.       ScreenMsg( RspX, RspY, NullCmd, TmpDef);
  750.       TmpDef:= Response;
  751.   end; {DoClrNxWrd}
  752.  
  753.   {--------------------------------------}
  754.   procedure DoClrPrWrd;
  755.   begin {DoPrevWrd}
  756.     while (RspPos > 0) and ((Response[ RspPos] =  ' ') or
  757.           (Response[ RspPos] =  '.')) do begin
  758.       Delete( Response, RspPos, 1);
  759.       Dec( RspPos);
  760.     end;
  761.     while (RspPos > 0) and (Response[ RspPos] <> ' ') and
  762.           (Response[ RspPos] <> '.') do begin
  763.       Delete( Response, RspPos, 1);
  764.       Dec( RspPos);
  765.     end;
  766.       Justify( Response, TmpDef, DLeft, FillC,
  767.               Length( Response), RspLen);
  768.       ScreenMsg( RspX, RspY, NullCmd, TmpDef);
  769.       TmpDef:= Response;
  770.   end; {DoClrPrWrd}
  771.  
  772.   {--------------------------}
  773.   procedure DoAccept;
  774.   begin {DoAccept}
  775.     RspPos:= Length( Response);
  776.     Terminated:= True;
  777.   end; {DoAccept}
  778.  
  779.   {----------------------------}
  780.   procedure DoTruncate;
  781.   begin {DoTruncate}
  782.     if RspPos = 0 then
  783.       RspPos:= Length( Response);
  784.     Terminated:= True;
  785.   end; {DoTruncate}
  786.  
  787.   {-------------------------}
  788.   procedure InitDefault( Default : String);
  789.   begin
  790.     Response:= Default;
  791.     RspPos:= Length( Default);
  792.     SetDefault;
  793.     RspPos:= 0;
  794.   end; {InitDefault}
  795.  
  796.   {--------------------------}
  797.   procedure DoRestore;
  798.   begin {DoRestore}
  799.     if Response = Default then
  800.       {Write( Bell)}
  801.     else
  802.       InitDefault( Default);
  803.   end; {DoRestore}
  804.  
  805.   {------------------}
  806.   procedure DoEscape;
  807.   begin {DoEscape}
  808.     DoRestore;
  809.     DoAccept;
  810.   end; {DoEscape}
  811.  
  812.   {-----------------}
  813.   procedure DoHelp;
  814.   begin {DoHelp}
  815.     HelpTyped:= True;
  816.     DoAccept;
  817.   end; {DoHelp}
  818.  
  819.   {------------------}
  820.   procedure DoStop;
  821.   begin {DoStop}
  822.     StopTyped:= True;
  823.     DoAccept;
  824.   end; {DoStop}
  825.  
  826. {--------------------------------------}
  827. procedure ShowHis( var Return : Boolean);
  828. var
  829.   Done : Boolean;
  830.   Ch   : Char;
  831.   Key  : Integer;
  832.   I    : Integer;
  833.   St   : String;
  834.   Ptr  : Integer;
  835.   MaxSt: Integer;
  836.   LJ   : Integer;
  837.   RJ   : Integer;
  838. begin
  839.   Key:= 0;  Done:= False;  Return:= False;
  840.   TextBackground( Cyan);
  841.   TextColor( Black);
  842.   MaxSt:= 52;
  843.   for Ptr:= 1 to HisTN do begin
  844.     I:= Length( His[ Ptr].St^);
  845.     if (I > MaxSt) then  MaxSt:= I;
  846.   end;
  847.   if MaxSt > 70 then  MaxSt:= 70;
  848.   LJ:= (70 - MaxST) div 2;
  849.   RJ:= 70 - MaxSt - LJ;
  850.   repeat
  851.     if (Key = 82) then begin { Insert }
  852.       if (His[ HisPtr].Lock <> ' ') then begin
  853.         His[ HisPtr].Lock:= ' ';  Dec( HisLN);
  854.       end
  855.       else begin
  856.         if (HisMax - HisLN > 2) then begin
  857.           His[ HisPtr].Lock:= '■';  Inc( HisLN);
  858.         end;
  859.       end;
  860.       if HisPtr > 1 then  Dec( HisPtr)
  861.       else HisPtr:= HisTN;
  862.     end;
  863.     if (Key = 83) then begin { Delete }
  864.       if (His[ HisPtr].Lock <> ' ') then begin { Locked }
  865.         if HisPtr > 1 then  Dec( HisPtr)
  866.         else HisPtr:= HisTN;
  867.       end
  868.       else begin
  869.         FreeMem( His[ HisPtr].St, Length( His[ HisPtr].St^) + 1);
  870.         if (His[ HisPtr].Lock <> ' ') then  Dec( HisLN);
  871.         I:= HisPtr + 1;
  872.         while (I <= HisTN) do begin
  873.           His[ I-1]:= His[I];  Inc(I);
  874.         end;
  875.         His[ I-1].St:= nil;
  876.         His[ I-1].Lock:= ' ';
  877.         Dec( HisTN);
  878.         if HisPtr > 1 then  Dec( HisPtr);
  879.         if HisTN  > 0 then  Return:= True;
  880.         Exit;
  881.       end;
  882.     end;
  883.     if (Key = 72) or (Key = 75) then { Up }
  884.       if HisPtr < HisTN then
  885.         Inc( HisPtr)
  886.       else
  887.         Key:= 79; { Bottom }
  888.     if (Key = 80) or (Key = 77) then { Down }
  889.       if (HisPtr > 1) then
  890.         Dec( HisPtr)
  891.       else
  892.         Key:= 71; { Top }
  893.     if (Key = 71) or (Key = 73) then  HisPtr:= HisTN; { Top }
  894.     if (Key = 79) or (Key = 81) then  HisPtr:= 1;     { Bottom }
  895.     GoToXY( 4+LJ, 2);
  896.     Write('┌');  for I:= 1 to 17-LJ do  Write('─');
  897.     Write(' History of Previous Operator Entries ');
  898.     for I:= 1 to 17-RJ do  Write('─');  Write('┐');
  899.     for Ptr:= HisTN downto 1 do begin
  900.       GoToXY( 4+LJ, WhereY+1);
  901.       St:= His[ Ptr].St^;
  902.       for I:= Length( St) + 1 to MaxSt do  St:= St + ' ';
  903.       St:= Copy( St, 1, 70);
  904.       Write('│', His[ Ptr].Lock);
  905.       if HisPtr = Ptr then begin
  906.         TextBackground( White);
  907.         TextColor( Black);
  908.       end;
  909.       Write( St);
  910.       if HisPtr = Ptr then begin
  911.         TextBackground( Cyan);
  912.         TextColor( Black);
  913.       end;
  914.       Write( His[ Ptr].PLus, '│');
  915.     end;
  916.     GoToXY( 4+LJ, WhereY+1);
  917.     Write('└');  for I:= 1 to 10-LJ do  Write('─');
  918.     Write( Output, '> Press ESC, Enter, Up, Down, PgUp, PgDn, Ins, Del <');
  919.     for I:= 1 to 10-RJ do  Write('─');  Write('┘', BS);
  920.     Key:= 0;
  921.     Ch:= ReadKey;
  922.     if Ch = Chr(0) then begin
  923.       Key:= Ord( ReadKey);
  924.     end
  925.     else begin
  926.       if Ch = ESC then  Done:= True;
  927.       if Ch = CR  then begin
  928.         Response:= His[ HisPtr].St^;
  929.         Done:= True;
  930.       end;
  931.     end;
  932.   until Done;
  933. end; {ShowHis}
  934.  
  935.   {------------------}
  936.   procedure PopHis( var Return : Boolean);
  937.   type
  938.     ScreenPtr = ^ScreenType;
  939.     ScreenType = Record
  940.       Pos : Array [1..80, 1..25] of Record
  941.         Ch : Char;
  942.         At : Byte;
  943.       End;
  944.       CursX,
  945.       CursY : Integer;
  946.     end;
  947.   var
  948.     TextAttr1 : Byte;
  949.     WindMin1  : Word;
  950.     WindMax1  : Word;
  951.   begin {PopHis}
  952.     TextAttr1:= TextAttr;
  953.     WindMin1:= WindMin;
  954.     WindMax1:= WindMax;
  955.     Screen1^:= Screen^;
  956.     Screen1^.CursX:= WhereX;
  957.     Screen1^.CursY:= WhereY;
  958.  
  959.     ShowHis( Return);
  960.  
  961.     Screen^:= Screen1^;
  962.     TextAttr:= TextAttr1;
  963.     WindMin:= WindMin1;
  964.     WindMax:= WindMax1;
  965.     GoToXY( Screen1^.CursX, Screen1^.CursY);
  966.   end; {PopHis}
  967.  
  968.   {------------------}
  969.   procedure DoUpHis;
  970.   var Return : Boolean;
  971.   begin {DoUpHis}
  972.     if HisTN > 0 then begin
  973.       repeat
  974.         PopHis( Return);
  975.       until not Return;
  976.       RspPos:= Length( Response);
  977.       SetDefault;
  978.       RspPos:= 0;
  979.     end;
  980.   end; {DoUpHis}
  981.  
  982.   {------------------}
  983.   procedure DoDwnHis;
  984.   begin {DoDwnHis}
  985.     DoUpHis;
  986.   end; {DoDwnHis}
  987.  
  988.   {--------------------------------------}
  989.   procedure DispRsp( var SrcStrg: String; Len: Integer; ClrArea: Boolean);
  990.   begin {DispRsp}
  991.     if ClrArea then  Justify( NullStrg, TmpDef, DLeft, Space, 0, FmtLen)
  992.                else  Justify( SrcStrg, TmpDef, DLeft, Background, Len, FmtLen);
  993.     ScreenMsg( RspX, RspY, NullCmd, TmpDef);
  994.   end; {DispRsp}
  995.  
  996. {--------------------------------------}
  997. begin {Prom}
  998.   Inserting:= False;
  999.   Terminated:= False;
  1000.   RspChr:= Null;
  1001.   FmtLen:= RspLen;
  1002.   DispRsp( NullStrg, 0, True);
  1003.   ValidChr:= NormalChr + CtrlChr;
  1004.   InitDefault( Response); {Set and display original default}
  1005.   StopTyped:= False;
  1006.   HelpTyped:= False;
  1007.   repeat
  1008.     GoToXYI( RspX + RspPos, RspY);
  1009.     GetChr(0, False, ValidChr, HotHelpA);
  1010.     if RspChr in CtrlChr then
  1011.     begin
  1012.       if RspChr = Chr( 127) then RspChr:= BS;
  1013.       CtrlKind:= Ctrl[ Ord( RspChr)];
  1014.       if Inserting then
  1015.         if (CtrlKind <> InsChr) and
  1016.            (CtrlKind <> BackUp) then
  1017.           DoInsChr;
  1018.       case CtrlKind of
  1019.         DupChr:   DoDupChr;
  1020.         BackUp:   DoBackUp;
  1021.         InsChr:   DoInsChr;
  1022.         BegFld:   DoBegFld;
  1023.         EndFld:   DoEndFld;
  1024.         NextWrd:  DoNextWrd;
  1025.         PrevWrd:  DoPrevWrd;
  1026.         DelChr:   DoDelChr;
  1027.         DelBack:  DoDelBack;
  1028.         ClrToEnd: DoClrToEnd;
  1029.         ClrToBeg: DoClrToBeg;
  1030.         ClrNxWrd: DoClrNxWrd;
  1031.         ClrPrWrd: DoClrPrWrd;
  1032.         Accept:   DoAccept;
  1033.         Truncate: DoTruncate;
  1034.         Restore:  DoRestore;
  1035.         Escape:   DoEscape;
  1036.         Helper:   DoHelp;
  1037.         Stopper:  DoStop;
  1038.         UpHis:    DoUpHis;
  1039.         DwnHis:   DoDwnHis;
  1040.       end; {case}
  1041.     end else begin
  1042.       CtrlKind:= NotCtrl;
  1043.       DoNotCtrl;
  1044.     end; {if}
  1045.   until Terminated;
  1046.   ChgLen( Response, FmtLen, RspPos);
  1047.   if RspPos >= 0 then DispRsp( Response, RspPos, False);
  1048.   GoToXYI( RspX + RspPos, RspY);
  1049.   WriteLn;
  1050.   if Response <> '' then  AddHis( Response, ' ');
  1051. end; {Prom}
  1052.  
  1053. {--------------------------------------}
  1054. procedure EditLn( Prompt : String; RspLen : Integer; var PrSt, St : String;
  1055.    HotHelpA : HotHelpT);
  1056.   {Edit a long line of input using Prom}
  1057. var
  1058.   I     : Integer;
  1059.   Lines : Integer;
  1060.   Quit  : Boolean;
  1061. begin
  1062.   St:= '';
  1063.   Lines:= (Length( Prompt) + RspLen) div NumX;
  1064.   repeat
  1065.     GoToXY( FirstX, WhereY);
  1066.     Write( Prompt);
  1067.     for I:= 1 to RspLen do  Write(' ');
  1068.     Prom( FirstX+Length( Prompt), WhereY - Lines, RspLen, PrSt, St, HotHelpA);
  1069.     if EscTyped then  ;
  1070.     if StopTyped then begin
  1071.       WriteLn;
  1072.       Write('Do you wish to Quit the program ? (Y/N): ');
  1073.       GetYesNo( Quit, HotHelpA);
  1074.       WriteLn;
  1075.       if Quit then begin
  1076.         St:= '';  Exit;
  1077.       end;
  1078.     end;
  1079.     if HelpTyped then  HelpProm;
  1080.   until not HelpTyped and not StopTyped;
  1081. end; {EditLn}
  1082.  
  1083. {--------------------------------------}
  1084. function VidSeg : {Integer} Word;
  1085. Begin
  1086. MonoScr:= (Mem[ $0000:$0449] = Mono);
  1087. if MonoScr then
  1088.   VidSeg:= $B000
  1089. else
  1090.   VidSeg:= $B800;
  1091. end; {VidSeg}
  1092.  
  1093. {--------------------------------------}
  1094. {        Initialization section        }
  1095. {--------------------------------------}
  1096.  
  1097. {Prom Initialization}
  1098. begin
  1099.   StopTyped:= False;
  1100.   EchoPtr:= nil;
  1101.   Null:= Chr( 0);
  1102.   Bell:= Chr( 7);
  1103.   BS:=   Chr( 8);
  1104.   Tab:=  Chr( 9);
  1105.   LF:=   Chr( 10);
  1106.   FF:=   Chr( 12);
  1107.   CR:=   Chr( 13);
  1108.   HelpC:=Chr( 187); {F1}
  1109.   StopC:=Chr( 188); {F2}
  1110.   ESC:=  Chr( 27);
  1111.   FillC:=Chr( 95);  {Underscore}
  1112. { PrintScreenCode:= Chr( 16);  .Ctrl-P = Dle}
  1113.   Background:= Space;
  1114.   NullSet:= [];
  1115.   WhiteSpace:= [CR, LF, Tab, ' '];
  1116.   ChgLen( NullStrg, 1, 0);
  1117.   InitCtrl;
  1118.   InitScr;
  1119.   for HisPtr:= 0 to HisMax do begin
  1120.     His[ HisPtr].St:= nil;
  1121.     His[ HisPtr].Lock:= ' ';
  1122.     His[ HisPtr].Plus:= ' ';
  1123.   end;
  1124.   HisTN:= 0;  HisLN:= 0;  HisPtr:= 1;
  1125.   New( Screen1);
  1126.   Screen:= Ptr( VidSeg, $0000);
  1127. end. {Prom Initialization}
  1128.  
  1129. Revisions made -
  1130. --------
  1131. * Changes procedure GetYesNo to allow a true ESC and not allow a F4
  1132.   1992-11-15 HJS
  1133.  
  1134. --------
  1135.  
  1136. {End of file Prompt.Pas ****************************************************}
  1137.