Uses Dos;
{ Copyright 2001 Peter Fila, distribute under GPLv2 }
{$I-}

Type Zastavka = ^Stop;
     Stop = Record Info : String;
                   Cas : String[5];
                   Dalsi : Zastavka;
            End;

    I_Spoj = Record Zastavky : Zastavka;
                    Meno, Info, Cas, Komentar : String;
             End;

Var Pid, Spoj : File Of Char;
    C_Spoj : I_Spoj;
    Kon, Pom : Zastavka;
    Odc, Iod, pomocna : Integer;
    Vstup, Vystup : string;

Procedure Citaj(var C : char);
begin read(pid, c);
end;

Procedure Vypis(c : char);
begin if vystup <> '-' then write(pid, c) else write(c);
end;

Procedure Nacitajs;
Var C : Char;
    S : String;

Begin S := '';
      Citaj(C);
      While C <> #9 Do Begin
       S := S + C;
       Citaj(C)
      End;
      C_Spoj.Meno := S;
      S := '';
      Citaj(C);
      While C <> #9 Do Begin
       S := S + C;
       Citaj(C)
      End;
      C_Spoj.Cas := S;

      New(Pom);
      C_Spoj.Zastavky := Pom;
      Kon := Pom;
      Pom^.Dalsi := Nil;
      Pom^.Cas := '+0';

      S := '';
      While C <> #10 Do Begin
       S := S+C;
       Citaj(C);
      End;
      Pom^.Info := S;

      Citaj(C);
      While C = #9 Do Begin
       New(Pom);
       Kon^.Dalsi := Pom;
       Pom^.Dalsi := Nil;
       Kon := Pom;

       S := '';
       Citaj(C);
       While C <> #9 Do Begin
        S := S + C;
        Citaj(C);
       End;
       If S[1] = '+' Then Pom^.Cas := S
        Else Pom^.Cas := '+0';
       S := '';
       While C <> #10 Do Begin
        S := S + C;
        Citaj(C);
       End;
       Pom^.Info := S;
       Citaj(C);
      End;

      New(Pom);
      Pom^.Dalsi := Nil;
      Kon^.Dalsi := Pom;
      Kon := Pom;
      S := '';
      While C <> #9 Do Begin
       S := S + C;
       Citaj(C);
      End;
      If S[1] = '+' Then Pom^.Cas := S
       Else Pom^.Cas := '+0';

      S := '';
      While C <> #10 Do Begin
       S := S + C;
       Citaj(C);
      End;
      Pom^.Info := S;

      S := '';
      Citaj(C);
      While (C <> #10) And (Not Eof(Pid)) Do Begin
       S := S + C;
       Citaj(C);
      End;
      If Eof(Pid) Then S := S + C;
      C_Spoj.Info := S;
      S := '';
      If Not Eof(Pid) Then Begin
       Citaj(C);
       If C = 'R' Then Begin
        While (C <> #10) And Not Eof(Pid) Do Begin
         S := S + C;
         Citaj(C);
        End;
        If Eof(Pid) Then S := S + C;
       End Else Seek(Pid, Filepos(Pid)-1);
      End;
      C_Spoj.Komentar := S;
End;

Function Porovnaj : Integer;
Var S : String;
    C : Char;
    Cit, Pam, I, J : Integer;
Begin
      Reset(Spoj);
      If Ioresult <> 0 Then Begin
       Rewrite(Spoj);
       Porovnaj := 1;
       Close(Spoj);
       Exit
      End Else Begin
       Cit := 0;
       Pam := 0;
       Pom := C_Spoj.Zastavky;
       Read(Spoj, C);
       While C = #9 Do Begin
        S := '';
        Read(Spoj, C);
        While C <> #9 Do Begin
         S := S + C;
         Read(Spoj, C);
        End;
        Val(S, I, J);
        Cit := Cit + I;
        Val(Pom^.Cas, I, J);
        Pam := Pam + I;
        If Abs(Cit-Pam) > Odc Then Begin
         Porovnaj := 0;
         Close(Spoj);
         Exit;
        End;
        S := '';
        While C <> #10 Do Begin
         S := S + C;
         Read(Spoj, C);
        End;
        If S <> Pom^.Info Then Begin
         Porovnaj := 0;
         Close(Spoj);
         Exit;
        End;
        Read(Spoj, C);
        Pom := Pom^.Dalsi;
       End;

       S := '';
       While C <> #9 Do Begin
        S := S + C;
        Read(Spoj, C);
       End;
       Val(S, I, J);
       Cit := Cit + I;
       Val(Pom^.Cas, I, J);
       Pam := Pam + I;
       If Abs(Cit-Pam) > Odc Then Begin
        Porovnaj := 0;
        Close(Spoj);
        Exit;
       End;
       S := '';
        While C <> #10 Do Begin
        S := S + C;
        Read(Spoj, C);
       End;
       If S <> Pom^.Info Then Begin
        Porovnaj := 0;
        Close(Spoj);
        Exit;
       End;

       S := '';
       Read(Spoj, C);
       While C <> #10 Do Begin
        S := S + C;
        Read(Spoj, C);
       End;
       If C_Spoj.Info <> S Then Begin
         Porovnaj := 0;
         Close(Spoj);
         Exit;
        End;

       S := '';
       Read(Spoj, C);
       If C = 'R' Then Begin
        While C <> #10 Do Begin
         S := S + C;
         Read(Spoj, C);
        End;
        If C_Spoj.Komentar <> S Then Begin
         Porovnaj := 0;
         Close(Spoj);
         Exit;
        End;
       End Else If C_Spoj.Komentar <> '' Then Begin
        Porovnaj := 0;
        Close(Spoj);
        Exit;
       End;
      End;
      Porovnaj := 2;
End;

Procedure Ulozs;
Var S, Ex : String;
    C : Char;
    I, J : Integer;
Begin S := C_Spoj.Meno;
      Delete(S, 1, 2);
      I := pos('__AAA', s);
      Delete(S, i, length(s)-I+1);
      I := 0;
      Repeat
       I := I + 1;
       Str(I, Ex);
       Ex := '.'+Ex;
       Assign(Spoj, 'TMPPID_Y/'+S+Ex);
       J := Porovnaj
      Until J > 0;
      Reset(Spoj);
      If J = 1 Then Begin
       Pom := C_Spoj.Zastavky;
       While Pom^.Dalsi <> Nil Do Begin
        C := #9;
        Write(Spoj, C);
        For I := 1 To Length(Pom^.Cas) Do Begin
         C := Pom^.Cas[I];
         Write(Spoj, C);
        End;
        For I := 1 To Length(Pom^.Info) Do Begin
         C := Pom^.Info[I];
         Write(Spoj, C);
        End;
        C := #10;
        Write(Spoj, C);
        Pom := Pom^.Dalsi;
       End;
       For I := 1 To Length(Pom^.Cas) Do Begin
        C := Pom^.Cas[I];
        Write(Spoj, C);
       End;
       For I := 1 To Length(Pom^.Info) Do Begin
        C := Pom^.Info[I];
        Write(Spoj, C);
       End;
       C := #10;
       Write(Spoj, C);
       For I := 1 To Length(C_Spoj.Info) Do Begin
        C := C_Spoj.Info[I];
        Write(Spoj, C);
       End;
       C := #10;
       Write(Spoj, C);
       If C_Spoj.Komentar <> '' Then Begin
        For I := 1 To Length(C_Spoj.Komentar) Do Begin
         C := C_Spoj.Komentar[I];
         Write(Spoj, C);
        End;
        C := #10;
        Write(Spoj, C);
       End;
      End Else Seek(Spoj, Filesize(Spoj));
      For I := 1 To Length(C_Spoj.Cas) Do Begin
       C := C_Spoj.Cas[I];
       Write(Spoj, C);
      End;
      C := #9;
      Write(Spoj, C);
      Close(Spoj);
      Pom := C_Spoj.Zastavky;
      While Pom <> Nil Do Begin
       Kon := Pom;
       Pom := Pom^.Dalsi;
       Dispose(Kon);
      End;
End;

Procedure Pridaj(S : String);
Type Casy = ^Cas;
     Cas = Record T, R, P, I : Integer;
                  S : String[7];
                  D : Casy;
           End;
Var C : Char;
    I, J : Integer;
    Tim, P, X : Casy;

Function Cekni(Z : Casy; Od : Integer) : Boolean;
Var T : Casy;
    Cas, C2, I : Integer;

Begin Cekni := False;
      T := Z^.D;
      Cas := 0;
      C2 := 0;
      I := 1;
      While (T <> Nil) And (I <= Z^.P) Do Begin
       C2 := C2 + T^.R;
       Cas := Cas + Od;
       If Abs(Cas-C2) > Iod Then Begin
        Cekni := True;
        Break
       End;
       T := T^.D;
       I := I + 1
      End
End;

Procedure Natajmuj;
Begin P := Tim^.D;
      X := Tim;
      While P <> Nil Do Begin
       P^.R := P^.T - X^.T;
       X := P;
       P := P^.D
      End;

      P := Tim^.D;
      While P <> Nil Do Begin
       P^.P := 1;
       J := P^.R;
       P^.I := J;
       X := P;
       If P^.D = Nil Then Break;
       While P^.D <> Nil Do Begin
        P := P^.D;
        P^.P := 0;
        J := J + P^.R;
        If Cekni(X, Round(J/(X^.P+1))) Then Break;
        X^.P := X^.P + 1;
        X^.I := Round(J/X^.P);
        If P^.D = Nil Then Exit
       End
      End
End;

Procedure Utried(Var Z : Casy);
Var L, P, M, X : Casy;
Begin L := Nil;
      P := Nil;
      If (Z = Nil) Or (Z^.D = Nil) Then Exit Else Begin
       M := Z;
       Z := Z^.D;
       While Z <> Nil Do Begin
        X := Z^.D;
        If Z^.T < M^.T Then Begin
         Z^.D := L;
         L := Z;
        End Else Begin
         Z^.D := P;
         P := Z;
        End;
        Z := X;
       End;
       Utried(L);
       Utried(P);
       M^.D := P;
       If L = Nil Then L := M Else Begin
        X := L;
        While X^.D <> Nil Do X := X^.D;
        X^.D := M;
       End;
       Z := L;
      End;
End;

Begin Seek(Pid, Filesize(Pid));
      Assign(Spoj, 'TMPPID_Y/'+S);
      Reset(Spoj);
      Delete(S, Pos('.', S), 3);
      S := '# '+S+'__AAA'+#10;
      For I := 1 To Length(S) Do Begin
       C := S[I];
       Vypis(C);
      End;
      Read(Spoj, C);
      While C = #9 Do Begin
       While C <> #10 Do Read(Spoj, C);
       Read(Spoj, C);
      End;
      While C <> #10 Do Read(Spoj, C);
      Read(Spoj, C);
      While C <> #10 Do Read(Spoj, C);
      Read(Spoj, C);
      If C = 'R' Then While C <> #10 Do Read(Spoj, C)
       Else Seek(Spoj, Filepos(Spoj)-1);

      Tim := Nil;
      While Not Eof(Spoj) Do Begin
       New(P);
       P^.D := Tim;
       Tim := P;
       S := '';
       Read(Spoj, C);
       While C <> ':' Do Begin
        S := S + C;
        Read(Spoj, C);
       End;
       Val(S, I, J);
       P^.T := I*60;
       P^.S := S;
       S := '';
       Read(Spoj, C);
       While C <> #9 Do Begin
        S := S + C;
        Read(Spoj, C);
       End;
       Val(S, I, J);
       P^.T := P^.T + I;
       P^.S := P^.S + ':' + S;
      End;

      Utried(Tim);
      Natajmuj;

      P := Tim^.D;
      If Tim^.s[1] = #10 then delete(Tim^.S, 1, 1);
      For I := 1 To Length(Tim^.S) Do Begin
       C := Tim^.S[I];
       Vypis(C);
      End;

      X := P;
      While X <> Nil Do Begin
       X := X^.D;
       If P^.P > 0 Then Begin
        C := #9;
        Vypis(C);
        Str(P^.P, S);
        For I := 1 To Length(S) Do Begin
         C := S[I];
         Vypis(C)
        End;
        C := 'x';
        Vypis(C);
        Str(P^.I, S);
        For I := 1 To Length(S) Do Begin
         C := S[I];
         Vypis(C);
        End;
       End;
       Dispose(P);
       P := X;
      End;
      Vypis(#10);

      seek(spoj, 0);

      Read(Spoj, C);
      While C = #9 Do Begin
       While C <> #10 Do Begin
        Vypis(C);
        Read(Spoj, C);
       End;
       Vypis(C);
       Read(Spoj, C);
      End;
      While C <> #10 Do Begin
       Vypis(C);
       Read(Spoj, C);
      End;
      Vypis(C);
      Read(Spoj, C);
      While C <> #10 Do Begin
       Vypis(C);
       Read(Spoj, C);
      End;
      Vypis(C);
      Read(Spoj, C);
      If C = 'R' Then Begin
       While C <> #10 Do Begin
        Vypis(C);
        Read(Spoj, C);
       End;
       Vypis(C);
      End;

      Close(Spoj);
      Erase(Spoj);
End;

{$I+}
Procedure Unite;
Var Fajl : Searchrec;
Begin If vystup <> '-' then begin
       Assign(Pid, vystup);
       Rewrite(Pid);
      end;
      Findfirst('TMPPID_Y/Tram*.*', Archive, Fajl);
      While Doserror = 0 Do Begin
       Pridaj(Fajl.Name);
       Findnext(Fajl);
      End;
      Findfirst('TMPPID_Y/Bus*.*', Archive, Fajl);
      While Doserror = 0 Do Begin
       Pridaj(Fajl.Name);
       Findnext(Fajl);
      End;
      Findfirst('TMPPID_Y/Metro*.*', Archive, Fajl);
      While Doserror = 0 Do Begin
       Pridaj(Fajl.Name);
       Findnext(Fajl);
      End;
      Findfirst('TMPPID_Y/Lan*.*', Archive, Fajl);
      While Doserror = 0 Do Begin
       Pridaj(Fajl.Name);
       Findnext(Fajl);
      End;
End; { Unite }
{$I-}

Procedure ErrorMsg;
begin Writeln('Pouzitie : Approx.exe <vstup> <vystup> <od1> <od2>');
      writeln('  vstup   musi byt existujuci subor');
      writeln('  vystup  novy vystupny subor (- standardny vystup)');
      writeln('  od1     zlucovacia odchylka, nezaporne cele cislo');
      writeln('  od2     intervalova odchylka, nezaporne cele cislo');
      halt;
end;

Begin If paramcount <> 4 then ErrorMsg;
      Vstup := ParamStr(1);
      Vystup := ParamStr(2);
      val(ParamStr(3), odc, pomocna);
      if pomocna <> 0 then ErrorMsg;
      val(ParamStr(4), Iod, pomocna);
      if pomocna <> 0 then ErrorMsg;
      MkDir('TMPPID_Y');
      Assign(Pid, vstup);
      Reset(Pid);
      While Not Eof(Pid) Do Begin
       Nacitajs;
       Ulozs;
      End;
      Unite;
      RmDir('TMPPID_Y');
      If vystup <> '-' then Close(Pid);
End.