Amiga ISO Collection/AmigaUtilCD2.iso/Programming/Pascal/MAXONPASCAL3.DMS/in.adf/DEMOS-OS1.3/Analysator/AnaIO.p

Text File | 1994-07-24 | 6.0 KB | 244 lines

MODULE AnalInOut;

{ Ein- und Ausgaberoutinen für Analysator II }

{$opt q}
{$include "ana.h" }

CONST
  CrsrDown = chr(10);
  CrsrUp = chr(11);
  CR = chr(13);
  DelKey = chr($7f);
  CrsrRight = chr($81);
  CrsrLeft = chr($82);
  CrsrToEoln = chr($83);
  CrsrToBegin = chr($84);
  CrsrSUp = chr($85);
  CrsrSDown = chr($86);
  CSI = chr($9b);


VAR
  Con:Ptr;                  EXPORT;
  histptr: integer;         EXPORT;
  History: String[histlen];
  prt:     Boolean;         EXPORT;
  pr:      text;            IMPORT;

PROCEDURE WriteC; { globale Funktion: (s:Str); EXPORT }
  BEGIN
    WriteCon( Con, s)
  END;

PROCEDURE WriteP; { globale Funktion: (s:Str); EXPORT }
  BEGIN
    WriteCon( Con, s);
    IF prt THEN write(pr, s);
  END;

PROCEDURE WriteR; { globale Funktion: (r:atyp; f:integer); EXPORT }
  VAR s:string;
  BEGIN
    s := RealStr(r,f);
    WriteCon(con,s)
  END;

PROCEDURE WritePR; { globale Funktion: (r:atyp; f:integer); EXPORT }
  VAR s:string;
  BEGIN
    s := RealStr(r,f);
    WriteP(s)
  END;

PROCEDURE WriteRF; { globale Funktion: (r:atyp; l,f:integer); EXPORT }
  { Länge l < 40 }
  VAR s:string;
  BEGIN
    s:=RealStr(r,f);
    IF Length(s) < l THEN
      s:=Copy('                                       ',1,l-Length(s))+s;
    WriteCon(con,s)
  END;


FUNCTION GetKey; { globale Funktion : char; }
  VAR c,g: char;
      sig: Long;

  PROCEDURE CSIHandling;
    VAR c1,c2: Char;
    BEGIN
      c1 := ReadCon(Con);
      CASE c1 OF
      'A': g := CrsrUp
      'B': g := CrsrDown
      'C': g := CrsrRight
      'D': g := CrsrLeft
      ' ': BEGIN
             c2 := ReadCon(Con);
             CASE c2 OF
               'A': g := CrsrToBegin;
               '@': g := CrsrToEoLN;
             OTHERWISE
               writeln(c1,ord(c1)); g := chr(0)
             END
           END
      OTHERWISE
        g := chr(0)
      END;
    END;

  BEGIN
    REPEAT
      REPEAT
        sig := Wait (-1);
        c := ReadCon (con)
      UNTIL c <> chr(0);
      CASE c OF
        BackSpace, CR, #32..#126, #160..#255 , DelKey : g := c;
        CSI: CSIHandling;
        #3: IF FromWB THEN Halt(0)
                      ELSE Error('BREAK');
      OTHERWISE
        g := chr(0)
      END;
    UNTIL g <> chr(0);
    GetKey := g
  END;


PROCEDURE ToHistory; { globale Funktion: (s: MyStr); EXPORT }
  VAR j,k: integer;
  BEGIN
    WHILE HistPtr+Length(s)+2 > HistLen DO
      BEGIN
        j := StrLen(History);  { erstes Nullbyte }
        FOR k:=j+2 TO HistPtr DO
          History[k-j-1] := History[k];
        HistPtr := HistPtr - j - 1;
        History [ HistPtr ] := chr(0);
      END;
    FOR j:=1 TO Length(s)+1 DO
      History[ HistPtr+j ] := s[ j ];
    HistPtr := HistPtr + Length(s) + 1;
  END;


PROCEDURE FromHistory; { globale Funktion: (VAR s:MyStr; i: integer) }
  VAR j,k: integer;
  BEGIN
    IF (HistPtr=0) or (i=0) THEN s:=''
    ELSE
    BEGIN
      j := i;
      k := HistPtr;
      WHILE (k>0) and (j>=1) DO
        BEGIN
          k := k-1;
          IF k=0 THEN j := j-1
                 ELSE IF History[k]=chr(0) THEN j := j-1
        END;
      IF (j >= 1) AND (k=0) THEN s:=''
      ELSE
        BEGIN
          k := k+1;
          j :=   1;
          REPEAT
            s[j] := History[k];
            j := j+1;
            k := k+1
          UNTIL History[k-1]=chr(0)
        END;
    END
  END;

PROCEDURE ReadEin; { globale Funktion: (Var b:Buffer); EXPORT }
  { Zeile nach b lesen }
  VAR i, up:     integer;
      c:         char;
      Old, Dumm: MyStr;
  BEGIN
    b.s:=''; i:=1; up:=0;
    REPEAT

      c := GetKey;
      CASE c OF
        #32..#126, #160..#255:
                IF Length(b.s) < inputLen-1 THEN
                BEGIN
                  Insert(c,b.s,i);
                  i := i+1;
                  writeC (#e'@');
                  writeC (c)
                END;
        BackSpace: IF i > 1 THEN
                     BEGIN
                       i := i-1;
                       Delete( b.s, i, 1 );
                       writeC( #8\e'P' )
                     END;
        DelKey: IF i<= Length(b.s) THEN
                  BEGIN
                    Delete(b.s,i,1);
                    WriteC(#e'P')
                  END;
        CrsrUp: BEGIN
                  IF up=0 THEN Old := b.s;
                  Dumm :=  #e'K';
                  IF i > 1 THEN Dumm := CSI + IntStr(i-1)+'D' + Dumm;
                  WriteC(Dumm);
                  FromHistory (Dumm, up+1);
                  IF Dumm <> '' THEN
                    BEGIN up := up+1; b.s := Dumm END;
                  i := Length(b.s)+1;
                  WriteC(b.s)
                END;
        CrsrLeft: IF i>1 THEN
                    BEGIN
                      i:=i-1; WriteC(#e'D')
                    END;
        CrsrRight: IF i+1<inputlen THEN
                     BEGIN
                       IF i>Length(b.s) THEN
                         BEGIN
                           b.s := b.s+' ';
                           writeC(' ')
                         END
                       ELSE
                         writeC(b.s[i]);
                       i := i+1
                     END;
        CrsrDown: IF up>=1 THEN
                    BEGIN
                      up := up-1;
                      IF up=0 THEN b.s := Old
                              ELSE FromHistory (b.s, up);
                      Dumm :=  #e'K';
                      IF i > 1 THEN Dumm := CSI + IntStr(i-1)+'D' + Dumm;
                      WriteC(Dumm);
                      WriteC(b.s);
                      i := Length(b.s)+1
                    END;
        CrsrToBegin: IF i>1 THEN
                       BEGIN
                         Dumm := #e+IntStr(i-1) + 'D';
                         writeC(Dumm);
                         i := 1
                       END;
        CrsrToEoLN: IF i <= Length(b.s) THEN
                      BEGIN
                        Dumm := #e+IntStr(Length(b.s)-i+1)+'C';
                        WriteC(Dumm);
                        i := Length(b.s) + 1
                      END;
        OTHERWISE
      END;  { Case }

    UNTIL (c = CR);
    b.p := 1;
    WriteC( LF )
  END;