(****************************************************************************)
(*        File-Editor zum Problemlosen Editieren von Diskettendateien       *)
(*                       Version 1.0 (c) U.K. 1986                          *)
(****************************************************************************)

PROGRAM File_Editor;

(*$I BYTEFILE.BIB *)                 (* Nur bei CP/M *)

TYPE str20 = STRING[20];

CONST HexZiffern : SET OF char = ['0'..'9','A'..'F'];
      AlphaZeichen : SET OF char = [#32..#126,#128..#255];

VAR f : ByteFile;                    (* Nur bei CP/M, sonst FILE OF BYTE *)
                                     (* Fuer MS-DOS:                     *)
                                     (*  Alle Vorkommen von 'ByteFile'   *)
                                     (*  ersatzlos streichen!            *)
    Block, ByteNr, last, MaxByte : integer;
    Eingabe : char;
    Modus : (Alpha,Hex);
    SuchZeile : STRING[40];
    locked : boolean;
    FileGroesse : real;
    UpperCase : boolean;

(****************************************************************************)
(*                           Hilfsprozeduren                                *)
(****************************************************************************)

PROCEDURE LiesZeichen(VAR c : char);   (* Ihre spezielle Anpassung fuer die *)
  BEGIN                                (* Cursor-Tasten. Siehe Turboheft 3  *)
    read(kbd,c);
  END; (* LiesZeichen *)

PROCEDURE WarteAufESC(Meldung : str20);
  VAR c : char;
  BEGIN
    write(Meldung,' <ESC>');
    REPEAT read(kbd,c) UNTIL c=#27
  END; (* WarteAufESC *)

FUNCTION MAX(x,y:integer):integer;
  BEGIN
    IF x>y THEN MAX:=x ELSE MAX:=y
  END; (* MAX *)

FUNCTION MIN(x,y:integer):integer;
  BEGIN
    IF x<y THEN MIN:=x ELSE MIN:=y
  END; (* MIN *)

PROCEDURE writeHex(b : byte);
  CONST HexZiffer:ARRAY[0..15] OF char = '0123456789ABCDEF';
  BEGIN
    write(HexZiffer[b SHR 4],HexZiffer[b AND 15])
  END; (* writeHex *)

(****************************************************************************)
(*                 Bildschirm-Handling und Cursor-Steuerung                 *)
(****************************************************************************)

PROCEDURE ShowPage;
 VAR i,j : integer; AlfaZeile : STRING[16]; b : byte; r : real;
 BEGIN
   gotoxy(44,1); write(succ(Block),'':5-trunc(ln(1+Block)/ln(10)));
   LongSeekByteFile(f,128.0*Block);
   r:=FileGroesse-128.0*Block;
   IF r>=256 THEN MaxByte:=255 ELSE MaxByte:=pred(trunc(r));
   IF locked THEN LowVideo;
   FOR i:=1 TO 16 DO
     BEGIN
       gotoxy(1,i+2 ); AlfaZeile:='';
       FOR j:=1 TO 16 DO IF (pred(i) SHL 4) OR pred(j)<=MaxByte THEN
         BEGIN
           readByteFile(f,b);
           writeHex(b); write(' ');
           IF chr(b) IN AlphaZeichen
             THEN AlfaZeile:=AlfaZeile+chr(b)
             ELSE AlfaZeile:=AlfaZeile+'.';
         END ELSE write('   ');
       gotoxy(53,i+2); write(AlfaZeile); ClrEol;
     END; (* FOR *)
   NormVideo;
 END; (* ShowPage *)

PROCEDURE SeiteHoch;
  BEGIN
    IF Block>0
      THEN BEGIN Block:=MAX(Block-2,0); ShowPage END
      ELSE write(^G)
  END; (* SeiteHoch *)

PROCEDURE SeiteTief;
  BEGIN
    IF Block<pred(last)
      THEN BEGIN Block:=MIN(Block+2,last); ShowPage END
      ELSE write(^G)
 END; (* SeiteTief *)

PROCEDURE ChangeModus;
  BEGIN
    IF Modus=Hex THEN Modus:=Alpha ELSE Modus:=Hex;
    gotoxy(29,1); IF Modus=Alpha THEN write('Alpha') ELSE write('Hex  ')
  END; (* ChangeModus *)

PROCEDURE HauptBildschirm;
  BEGIN
    ClrScr; LowVideo; write('FILE:');
    gotoxy(22,1); write('MODUS:'); gotoxy(37,1); write('BLOCK:');
    gotoxy(50,1); write('BYTE:'); gotoxy(63,1); write('GESAMT:');
    NormVideo;
    gotoxy(7,1); write(ParamStr(1));
    gotoxy(71,1); write(succ(last));
    Modus:=Alpha; ChangeModus; LowVideo;
    gotoxy(1,20); writeln('Kommandos:');
    write('  ^E : Zeile hoch,   ^X : Zeile tief,  ');
    write('  ^S : Byte links,   ^D : Byte rechts  '); writeln;
    write('  ^A : Zeilenanfang, ^F : Zeilenende,  ');
    write('  ^C : Seite tief,   ^R : Seite hoch,  '); writeln;
    write('^Q^R : Fileanfang, ^Q^C : Fileende     ');
    write('^Q^F : suchen,     ^Q^U : Schreibschutz'); writeln;
    write('  ^V : Alpha/Hex,    ^L : weitersuchen ');
    write('                     ^Z : Ende-Edit    ');
    NormVideo
  END; (* HauptBildschirm *)

(****************************************************************************)
(*                        Editieren und Suchen                              *)
(****************************************************************************)

PROCEDURE LiesByte;
  LABEL EXIT;
  VAR z : char; b : byte; t,fc : integer;
  BEGIN
    CASE Modus OF
      Alpha : b:=ord(Eingabe);
      Hex   : BEGIN
                Eingabe:=upcase(Eingabe);
                IF NOT (Eingabe IN HexZiffern)
                THEN BEGIN write(^G); GOTO EXIT END
                ELSE BEGIN
                       write(Eingabe);
                       REPEAT
                         read(kbd,z); z:=upcase(z)
                       UNTIL z IN HexZiffern+[#27];
                       IF z=#27
                         THEN BEGIN
                                LongSeekByteFile(f,128.0*Block+ByteNr);
                                readByteFile(f,b)
                              END
                         ELSE BEGIN val('$'+Eingabe+z,t,fc); b:=LO(t) END
                     END (* ELSE *)
              END (* BEGIN *)
    END; (* CASE *)
    LongSeekByteFile(f,128.0*Block+ByteNr); writeByteFile(f,b);
    gotoxy(1+(ByteNr AND 15)*3,3+(ByteNr SHR 4)); writeHex(b);
    gotoxy(53+(ByteNr AND 15),3+(ByteNr SHR 4));
    IF chr(b) IN AlphaZeichen THEN write(chr(b)) ELSE write('.');
    ByteNr:=succ(ByteNr);
    EXIT:
  END; (* LiesByte *)

PROCEDURE Suche(neu:boolean); (* Sucht nach STRING oder BYTE-Folge *)
  LABEL EXIT;
  VAR Position, Laenge, Fehlercode, Seite : integer;
      gefunden, ShowFlag, Fehler : boolean;
      BytePosition : real;
      temp : STRING[40];
      c : char; i : integer;
      AnfangsByte, SuchByte, VergleichsByte : byte;

  PROCEDURE KonvertHexLine(VAR Fehler : boolean);
    VAR HexLine : STRING[20];
        HexZahl : integer;
    BEGIN
      temp:=SuchZeile;
      WHILE pos( ' ',temp)>0 DO delete(temp,pos(' ',temp),1);
      HexLine:=''; Fehler:=false;
      WHILE (length(temp)>1) AND (NOT Fehler) DO
        BEGIN
          val('$'+copy(temp,1,2),HexZahl,Fehlercode);
          Fehler:=FehlerCode<>0; HexLine:=HexLine+chr(LO(HexZahl));
          delete(temp,1,2)
        END; (* WHILE *)
      IF temp<>'' THEN Fehler:=true;
      temp:=HexLine; Laenge:=length(temp)
    END; (* KonvertHexLine *)

  BEGIN (* suche *)
    gotoxy(1,2); LowVideo;
    IF Modus=Alpha THEN write('Suchbegriff: ') ELSE write('Bytefolge: ');
    NormVideo;
    IF neu
      THEN BEGIN
             read(SuchZeile);
             IF Modus=Alpha THEN
               BEGIN
                 write(' Gross/Klein-unterscheiden? ');
                 REPEAT read(kbd,c); c:=upcase(c) UNTIL (c='J') OR (c='N');
                 UpperCase:=c='N';
                 IF UpperCase THEN FOR i:=1 TO length(SuchZeile) DO
                   SuchZeile[i]:=upcase(SuchZeile[i]);
                 gotoxy(14,2); write(SuchZeile); ClrEol
               END
           END
      ELSE write(SuchZeile);
    IF SuchZeile='' THEN GOTO EXIT ELSE Laenge:=length(SuchZeile);
    ShowFlag:=false; Fehler:=false; gefunden:=false;
    IF Modus=Alpha
      THEN temp:=SuchZeile
      ELSE IF SuchZeile[1]='='
             THEN BEGIN
                    val(copy(suchZeile,2,pred(Laenge)),Seite,Fehlercode);
                    IF (FehlerCode=0) AND (Seite<=succ(last)) AND (Seite>0)
                      THEN BEGIN
                             ShowFlag:=true; Block:=pred(Seite); GOTO EXIT
                           END
                      ELSE BEGIN WarteAufESC(' ???'); GOTO EXIT END
                  END
             ELSE KonvertHexLine(Fehler);
    IF Fehler THEN BEGIN WarteAufESC(' ???'); GOTO EXIT END;
    BytePosition:=128.0*Block+ByteNr; LongSeekByteFile(f,BytePosition);
    Position:=1; AnfangsByte:=ord(temp[Position]);
    VergleichsByte:=AnfangsByte;
    WHILE (NOT EOFByteFile(f)) AND (NOT gefunden) DO
      BEGIN
        IF keypressed THEN
          BEGIN
            read(kbd,c);
            IF c=^U THEN
              BEGIN WarteAufESC(' ABBRUCH!'); GOTO EXIT END
          END; (* IF * )
        readByteFile(f,SuchByte);
        IF UpperCase THEN SuchByte:=ord(upcase(chr(SuchByte)));
        IF SuchByte=VergleichsByte
          THEN IF Position=Laenge
                 THEN gefunden:=true
                 ELSE BEGIN
                        Position:=succ(Position);
                        VergleichsByte:=ord(temp[Position])
                      END
          ELSE IF Position>1
                 THEN BEGIN
                        LongSeekByteFile(f,LongFilePosByteFile(f)+1-Position);
                        Position:=1;
                        VergleichsByte:=AnfangsByte
                      END
      END; (* WHILE *)
    IF gefunden
      THEN BEGIN
             BytePosition:=LongFilePosByteFile(f);
             Seite:=trunc(BytePosition/128);
             ByteNr:=trunc(BytePosition-128.0*Seite);
             IF Block=pred(Seite)
               THEN ByteNr:=ByteNr+128
               ELSE IF Block<>Seite
                      THEN BEGIN ShowFlag:=true; Block:=Seite END;
             IF Block>last THEN BEGIN Block:=last; ByteNr:=127 END;
             IF Block=last THEN IF last>0
               THEN BEGIN Block:=pred(Block); ByteNr:=128+ByteNr END
           END (* IF...THEN *)
      ELSE WarteAufESC(' ... nicht gefunden');
     END;
    EXIT: gotoxy(1,2); ClrEol; IF ShowFlag THEN ShowPage
  END; (* suche *)

PROCEDURE HoleZeichen(erstes : char; VAR c : char);
  BEGIN
    gotoxy(1,1); LowVideo; write('^',erstes,'   '); gotoxy(3,1);
    read(kbd,c);
    gotoxy(1,1); write('FILE:'); NormVideo
  END; (* HoleZeichen *)

PROCEDURE Lock_Unlock; (* Macht ein Veraendern der Datei unmoeglich *)
  BEGIN
    locked:=NOT locked; gotoxy(34,1);
    IF locked THEN write('/L') ELSE write('  '); ShowPage;
  END; (* Lock_Unlock *)

PROCEDURE Ctrl_Q_Menue;
  VAR Auswahl : char;

  PROCEDURE ZumAnfang;
    BEGIN
      Block:=0; ByteNr:=0; ShowPage
    END; (* ZumAnfang *)

  PROCEDURE ZumEnde;
    BEGIN
      Block:=MAX(last-1,0); ShowPage; ByteNr:=MaxByte
    END; (* ZumEnde *)

  BEGIN (* Ctrl_Q_Menue *)
    HoleZeichen('Q',Auswahl);
    CASE upcase(Auswahl) OF
      ^R, 'R' : ZumAnfang;
      ^C, 'C' : ZumEnde;
      ^F, 'F' : Suche(true);
      ^U, 'U' : Lock_Unlock
    END
  END;

(****************************************************************************)
(*                        Das Hauptprogramm                                 *)
(****************************************************************************)

BEGIN
  IF ParamCount=0 THEN BEGIN writeln('Parameter fehlen'); halt END;
  assignByteFile(f,ParamStr(1)); (*$I-*) resetByteFile(f) (*$I+*);
  IF IOResultByteFile<>0 THEN BEGIN writeln('Kein File!'); halt END;
  FileGroesse:=LongFileSizeByteFile(f);
  last:=pred(trunc(FileGroesse/128)); Block:=0; ByteNr:=0;
  SuchZeile:=''; locked:=false; cbreak:=false;
  HauptBildschirm; Lock_Unlock;
  REPEAT
    IF ByteNr<0
      THEN IF Block>0 THEN BEGIN SeiteHoch; ByteNr:=256+ByteNr END
                      ELSE BEGIN ByteNr:=0; write(^G) END;
    IF ByteNr>MaxByte
      THEN IF MaxByte<255 THEN BEGIN ByteNr:=MaxByte; write(^G) END
                          ELSE BEGIN SeiteTief; ByteNr:=ByteNr AND 255 END;
    gotoxy(56,1); write(succ(ByteNr):3);
    IF Modus=Hex THEN gotoxy(1+(ByteNr AND 15)*3,3+(ByteNr SHR 4))
                 ELSE gotoxy(53+(ByteNr AND 15),3+(ByteNr SHR 4));
    LiesZeichen(Eingabe);
    CASE Eingabe OF
      ^D : ByteNr:=succ(ByteNr);
      ^S : ByteNr:=pred(ByteNr);
      ^X : ByteNr:=ByteNr+16;
      ^E : ByteNr:=ByteNr-16;
      ^R : SeiteHoch;
      ^C : SeiteTief;
      ^A : ByteNr:=ByteNr AND $F0;
      ^F : ByteNr:=ByteNr OR 15;
      ^V : ChangeModus;
      ^Q : Ctrl_Q_Menue;
      ^L : Suche(false);
      ^Z : ;
      ELSE IF Eingabe>=#32 THEN IF NOT locked THEN LiesByte ELSE write(^G)
    END
  UNTIL Eingabe=^Z;
  closeByteFile(f); ClrScr
END. (* File_Editor *)