Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/BELA.ZIP/EDIT.PAS

Pascal/Delphi Source File | 1985-01-30 | 5.0 KB | 206 lines

{ Written by Bela Lubkin
             Borland International Technical Support
             12/6/84

  This is a set of three routines that can be used in a Turbo Pascal program
  to input data from the user.  Each routine provides WordStar-like editing of
  the input, an undo function, and pre-setting of the input buffer.  I usually
  pre-set the buffer to the old value of the variable.  Then the user can call
  up the old value by simply typing ^R.

  Here is a list of the control characters used:

  ^A  Move to beginning of line, nondestructive
  ^B  Save current buffer in undo buffer
  ^D  Move forward one
  ^F  Move to end of line (same as ^R)
  ^G  Delete character forward
  ^H  Move back 1, destructive (same as DEL)
  ^M  End of input; accept what is currently visible
  ^N  End of input; accept entire buffer
  ^P  Accept next character as-is (control character prefix)
  ^R  Move to end of line (same as ^F)
  ^S  Move back 1, nondestructive
  ^T  Delete line forward
  ^U  Copy undo buffer into current buffer (undo)
  ^V  Insert on/off
  ^X  Move to beginning of line, destructive
  ^Y  Delete line
  DEL Move back 1, destructive (same as ^H)

  The initial contents of both the current buffer and the undo buffer are set
  by the parameter Param.

  These routines will work on any version of Turbo Pascal.
}

  Type
    Buffer=String[255];


  Function AskString(Prompt,Param: Buffer): Buffer;

    Var
      AS: Buffer;
      Cursor: Integer;


    Procedure PutC;
      Var
        C: Char;

      Begin
        C:=AS[Cursor];
        If C<' ' Then Write('^',Chr(Ord(C)+64))
        Else Write(C);
      End;


    Procedure UnPutC;
      Var
        C: Char;

      Begin
        C:=AS[Cursor];
        Write(#8' '#8);
        If C<' ' Then Write(#8' '#8);
      End;


    Const
      InsertFlag: Boolean=True;

    Var
      Ch: Char;
      WasChar: Boolean;

    Begin
      Write(Prompt);
      AS:=Param;
      Cursor:=0;
      Repeat
        Read(Kbd,Ch);
        WasChar:=False;
        Case Ch Of
          ^A,^U,^X,^Y: Begin
                         While Cursor>0 Do
                          Begin
                           UnPutC;
                           If Ch=^X Then Delete(AS,Cursor,1);
                           Cursor:=Cursor-1;
                          End;
                         If Ch=^U Then AS:=Param
                         Else If Ch=^Y Then AS:='';
                       End;
          ^B: Param:=AS;
          ^D: If Length(AS)>Cursor Then
               Begin
                Cursor:=Cursor+1;
                PutC;
               End;
          ^F,^R,^N: While Length(AS)>Cursor Do
                     Begin
                      Cursor:=Cursor+1;
                      PutC;
                     End;
          ^G: Delete(AS,Cursor+1,1);
          ^H,^S,#127: If Cursor>0 Then
                       Begin
                        UnPutC;
                        If Ch<>^S Then Delete(AS,Cursor,1);
                        Cursor:=Cursor-1;
                       End;
          ^M:;
          ^P: Begin
                Read(Kbd,Ch);
                WasChar:=True;
              End;
          ^T: Delete(AS,Cursor+1,Length(AS));
          ^V: InsertFlag:=Not InsertFlag;
          Else WasChar:=True;
         End;
        If WasChar And (Length(AS)<255) Then
         Begin
          Cursor:=Cursor+1;
          If InsertFlag Then Insert(Ch,AS,Cursor)
          Else AS[Cursor]:=Ch;
          If Cursor>Length(AS) Then AS[0]:=Chr(Cursor);
          PutC;
         End
        Else If WasChar Then Write(^G);
       Until ((Ch=^M) Or (Ch=^N)) And Not WasChar;
      AskString:=Copy(AS,1,Cursor);
    End;


  Function AskInt(Prompt: Buffer; Param: Integer): Integer;

    Var
      Temp: Buffer;
      P,I: Integer;

    Begin
      Str(Param,Temp);
      Temp:=AskString(Prompt,Temp);
      Val(Temp,P,I);
      If I=0 Then AskInt:=P
      Else If Length(Temp)=0 Then AskInt:=0
      Else AskInt:=Param;
    End;


  Function AskReal(Prompt: Buffer; Param: Real): Real;

    Var
      Temp: Buffer;
      P: Real;
      I: Integer;

    Begin
      Str(Param:1:12,Temp);
      I:=14;
      While Temp[I]='0' Do I:=I-1;
      Temp:=AskString(Prompt,Copy(Temp,1,I));
      Val(Temp,P,I);
      If I=0 Then AskReal:=P
      Else If Length(Temp)=0 Then AskReal:=0.0
      Else AskReal:=Param;
    End;


{ A program to test the routines... remove the next line to enable. }
(*

  Var
    X: String[40];
    Y: Integer;
    Z: Real;

Begin
  X:='This is a test.';
  Repeat
    X:=AskString('Edit the buffer: ',X);
    WriteLn;
    WriteLn(X);
  Until X='';
  Y:=100;
  Repeat
    Y:=AskInt('Edit the integer: ',Y);
    WriteLn;
    WriteLn(Y);
  Until Y=0;
  Z:=Pi;
  Repeat
    Z:=AskReal('Edit the real: ',Z);
    WriteLn;
    WriteLn(Z:1:11);
  Until Z=0.0;
End.
(**)


  Z:=Pi;
  Repeat
    Z:=AskReal('Edit the real: ',Z);
    WriteLn;
    WriteLn