program VnejsiTrideni;
{Trideni rozsahleho souboru celych cisel metodou
jednofazoveho prirozeneho slucovani stupne 2.
Vstupem programu je textovy soubor VSTUP.DAT s cisly,
vystupem bude utrideny textovy soubor VYSTUP.DAT.}

type Soubor = file of integer;     {tvar pracovnich souboru}

var Vstup, Vystup: text;   {vstupni a vystupni soubor cisel}
    A1, A2, B1, B2: Soubor;               {pracovni soubory}
    Cislo, Stare: integer;          {pro rozdeleni na useky}
    Zapis1: boolean;          {priznak zapisu do souboru A1}
    Slevat: boolean;        {priznak, ze je jeste co slevat}
    KonecA: boolean;          {priznat, ze je vysledek v A1}

procedure Slucovani(var X1, X2, Y1, Y2: Soubor;
                    var Slevat: boolean);
{vlastni algoritmus jedne faze jednofazoveho prirozeneho
slucovani stupne 2 ze souboru X1, X2 do souboru Y1, Y2.
V parametru Slevat vraci informaci, zda je jeste treba
pokracovat v slucovani}

var C1: integer;                                {cislo z X1}
    C2: integer;                                {cislo z X2}
    Stare: integer;                      {predchozi hodnota}
    Pokr1, Pokr2: boolean;     {pokracovat cist usek z X1,2}
    Zapis1: boolean;          {priznak zapisu do souboru Y1}
    Eof1, Eof2: boolean;    {soubor X1,2 zpracovan do konce}

begin  {procedure Slucovani}
  reset(X1);
  reset(X2);
  rewrite(Y1);
  rewrite(Y2);
  Eof1 := eof(X1);
  Eof2 := eof(X2);
  read(X1, C1);
  read(X2, C2);
  Zapis1 := true;                  {zacneme zapisovat do Y1}
  Slevat := false;                    {zatim neni co slevat}
  while not (Eof1 or Eof2) do    {slucovat usporadane useky}
    begin
    Pokr1 := true;
    Pokr2 := true;
    while Pokr1 and Pokr2 do
      if C1 < C2 then
        begin
        if Zapis1 then write(Y1, C1)
                  else write(Y2, C1);
        if eof(X1) then
          begin
          Pokr1 := false;
          Eof1 := true
          end
        else
          begin
          Stare := C1;
          read(X1, C1);
          if C1 < Stare then Pokr1 := false
          end
        end
      else
        begin
        if Zapis1 then write(Y1, C2)
                  else write(Y2, C2);
        if eof(X2) then
          begin
          Pokr2 := false;
          Eof2 := true
          end
        else
          begin
          Stare := C2;
          read(X2, C2);
          if C2 < Stare then Pokr2 := false
          end
        end;
    while Pokr1 do        {dokopirovat konec useku z X1}
      begin
      if Zapis1 then write(Y1, C1)
                else write(Y2, C1);
      if eof(X1) then
        begin
        Pokr1 := false;
        Eof1 := true
        end
      else
        begin
        Stare := C1;
        read(X1, C1);
        if C1 < Stare then Pokr1 := false
        end
      end;
    while Pokr2 do        {dokopirovat konec useku z X2}
      begin
      if Zapis1 then write(Y1, C2)
                else write(Y2, C2);
      if eof(X2) then
        begin
        Pokr2 := false;
        Eof2 := true
        end
      else
        begin
        Stare := C2;
        read(X2, C2);
        if C2 < Stare then Pokr2 := false
        end
      end;
    Zapis1 := not Zapis1;
    if Zapis1 then Slevat := true   {exist. aspon dva useky}
    end;
  if not Eof1 then     {jeste prepsat posledni usek(y) z X1}
    begin
    if Zapis1 then
      write(Y1, C1)
    else
      begin
      write(Y2, C1);
      Slevat := true
      end;
    while not eof(X1) do
      begin
      Stare := C1;
      read(X1, C1);
      if C1 < Stare then
        Zapis1 := not Zapis1;
      if Zapis1 then write(Y1, C1)
                else write(Y2, C1);
      end
    end;
  if not Eof2 then     {jeste prepsat posledni usek(y) z X2}
    begin
    if Zapis1 then
      write(Y1, C2)
    else
      begin
      write(Y2, C2);
      Slevat := true
      end;
    while not eof(X2) do
      begin
      Stare := C2;
      read(X2, C2);
      if C2 < Stare then
        Zapis1 := not Zapis1;
      if Zapis1 then write(Y1, C2)
                else write(Y2, C2);
      end
    end;
  close(X1);
  close(X2);
  close(Y1);
  close(Y2);
end;  {procedure Slucovani}

procedure Prepis(var F: Soubor);
{prepsani utridenych cisel z datoveho souboru F
do vysledneho textoveho souboru Vystup}
var Cislo: integer;
begin
  reset(F);
  rewrite(Vystup);
  while not eof(F) do
    begin
    read(F, Cislo);
    write(Vystup, Cislo:6)
    end;
  close(F);
  close(Vystup);
end;  {procedure Prepis}

begin
{Prirazeni souboru:}
assign(Vstup, 'VSTUP.DAT');
assign(A1, 'A1.$$$');
assign(A2, 'A2.$$$');
assign(B1, 'B1.$$$');
assign(B2, 'B2.$$$');
assign(Vystup, 'VYSTUP.DAT');

{Pocatecni rozdeleni useku cisel ze Vstup do A1, A2:}
reset(Vstup);
rewrite(A1);
rewrite(A2);
Stare := -maxint;
Zapis1 := true;                    {zacneme zapisovat do A1}
Slevat := false;                      {zatim neni co slevat}
while not eof(Vstup) do
  begin
  read(Vstup, Cislo);
  if Cislo < Stare then
    begin
    Zapis1 := not Zapis1;    {dalsi usek do druheho souboru}
    Slevat := true                  {jsou alespon dva useky}
    end;
  if Zapis1 then
    write(A1, Cislo)
  else
    write(A2, Cislo);
  Stare := Cislo
  end;
close(Vstup);
close(A1);
close(A2);
KonecA := true;

{Vlastni slucovani mezi soubory A1, A2 a B1, B2:}
while Slevat do
  begin
  Slucovani(A1, A2, B1, B2, Slevat);
  KonecA := false;     {utridena data jsou v B1, B2}
  if Slevat then
    begin
    Slucovani(B1, B2, A1, A2, Slevat);
    KonecA := true     {utridena data jsou v A1, A2}
    end
  end;  {while Slevat}

{Zaverecne prepsani setridenych cisel
do vystupniho textoveho souboru:}
if KonecA then
  Prepis(A1)           {vysledek je v souboru A1}
else
  Prepis(B1);          {vysledek je v souboru B1}

{Zruseni pracovnich souboru:}
erase(A1);
erase(A2);
erase(B1);
erase(B2);
end.