PROGRAM PCQTrans;

{
    Konvertiert A68k-Fehlerdateien für MegaEd
    von Wurzelsepp, 100% PD
}

{$I "include:exec/memory.i" }
{$I "include:libraries/dosextens.i" }
{$I "include:utils/Stringlib.i" }

CONST
    file1   :   String  =   "T:MegaEdMake-ErrFile";
    file2   :   String  =   "T:MegaEdMake-Errors";
    error   :   String  =   "E";
    back    :   String  =   "/";
    ret     :   Char    =   CHR(10);

    ver_text : String = "\0$VER: MegaEd-TransA68k V1.0 (16.03.95)";

VAR
    fileh       :   FileHandle;
    meldung     :   BOOLEAN;
    zeile,
    spalte      :   String;
    las,
    len,
    dummy       :   INTEGER;
    old         :   Address;
    off         :   ^Char;

PROCEDURE TickleOn;

BEGIN
 Inc(las);
 off:=Address(Integer(off)+1);
END;

BEGIN

 IF DeleteFile(file2) THEN ;

 zeile:=AllocString (255);
 spalte:=AllocString (255);

 meldung:=FALSE;
 fileh:=DOSOpen (file1,MODE_OLDFILE);
 IF fileh<>NIL THEN
 BEGIN
  dummy:=Seek(fileh,0,OFFSET_END);
  len:=Seek(fileh,0,OFFSET_BEGINNING);
  if len>0 THEN
  BEGIN
   old:=AllocMem (len,MEMF_PUBLIC+MEMF_CLEAR);
   IF old=NIL THEN
   BEGIN
    DOSClose (fileh);
    Exit;
   END;
   IF DOSRead(fileh,old,len)<>len THEN
   BEGIN
    FreeMem(old,len);
    DOSClose(fileh);
    Exit;
   END;
  END;
  DOSClose(fileh);
  IF (len=0) THEN Exit;

  fileh:=DOSOpen (file2,MODE_NEWFILE);
  IF fileh<>NIL THEN
  BEGIN

   las:=0;
   off:=old;
   WHILE las<len DO
   BEGIN
    WHILE (off^<>ret) AND (las<len) DO
     TickleOn;
    IF las<len THEN
    BEGIN
     TickleOn;  { Return überspringen }

     WHILE (off^<>ret) AND (las<len) DO
      TickleOn;
     IF las<len THEN
     BEGIN
      { Return der Einleitungszeile (mit Filenamen) überspringen }
      TickleOn;

      WHILE (off^=' ') AND (las<len) DO
       TickleOn;
      meldung:=TRUE;
      FOR dummy:=0 TO 200 DO zeile[dummy]:=CHR(0);
      WHILE (off^<>' ') AND (off^<>CHR(9)) AND (las<len) DO
      BEGIN
       zeile[StrLen(zeile)]:=off^;
       TickleOn;
      END;
      IF las<len THEN
      BEGIN
       WHILE (off^<>ret) AND (las<len) DO
        TickleOn;
       TickleOn; { Wiederholung des Sources + Return überspringen }
       IF las<len THEN
       BEGIN
        WHILE (off^<>ret) AND (las<len) DO
        BEGIN
         { große Schleife zum Auslesen mehrerer Fehler in einer Zeile }
         dummy:=0;
         WHILE (off^<>'^') AND (las<len) DO
         BEGIN
          Inc(dummy);
          TickleOn;
         END;
         IF las<len THEN
         BEGIN
          { "^" und " " überspringen }
          TickleOn;
          TickleOn;
          IF IntToStr (spalte,dummy)=0 THEN ;
          dummy:=DOSWrite (fileh,error,StrLen(error));
          dummy:=DOSWrite (fileh,zeile,StrLen(zeile));
          dummy:=DOSWrite (fileh,back,StrLen(back));
          dummy:=DOSWrite (fileh,spalte,StrLen(spalte));
          dummy:=DOSWrite (fileh,Adr(ret),1);
          WHILE (off^<>ret) AND (las<len) DO
          BEGIN
           dummy:=DOSWrite (fileh,off,1);
           TickleOn;
          END;
          TickleOn; { Return überspringen }
          dummy:=DOSWrite (fileh,Adr(ret),1);
         END;
        END;
       END;
      END;
     END;
    END;
   END;
   DOSClose (fileh);
  END;

  FreeMem(old,len);

 END;

 IF meldung=FALSE THEN
  IF DeleteFile(file2) THEN ;

END.