// Kompresja RLE (Run Length Encoding)
// www.algorytm.org
// (c) 2007 by Tomasz Lubinski

program RLE;
{$APPTYPE CONSOLE}
uses
  SysUtils;

// kompresja RLE
procedure compress(inFile: Integer; outFile: Integer);
var
   cur, prev, tmp: Byte	;
   cnt: Byte;
   cont: Integer;
begin

   cnt := 0;
   cont := FileRead(inFile, cur, 1);
   prev := not(cur);
   while cont = 1 do
   begin
      if (prev <> cur) then
         if (cnt = 0) then
            // znaki obok siebie rozne wrzuc do pliku wyjsciowego
            FileWrite(outFile, cur, 1)
         else
         begin
            // skonczyla sie sekwencja powtarzajcych sie znakow
            cnt := cnt-1;
            FileWrite(outFile, prev, 1);
            FileWrite(outFile, cnt, 1);
            FileWrite(outFile, cur, 1);
            cnt := 0;
         end
      else
         // liczbe powtarzajacych sie znakow zapisujemy na jednym bajcie
         //  wypisz sekwencje jezeli ma ona maksymalna dlugosc
         if (cnt = 255) then
         begin
            FileWrite(outFile, prev, 1);
            FileWrite(outFile, cnt, 1);
            cnt := 0;
            cont := FileRead(inFile, cur, 1);
            prev := not(cur);
            continue;
         end
         else
            // licz powtarzajace sie znaki
            cnt := cnt+1;
      // odczytaj kolejny znak z pliku wejsciowego
      cont := FileRead(inFile, tmp, 1);
      if (cont = 1) then
      begin
         prev := cur;
         cur := tmp;
      end;
   end;
   
   // jezeli plik konczy sie sekwencja wypisz ja
   if (prev = cur) then
   begin
      cnt := cnt-1;
      FileWrite(outFile, prev, 1);
      FileWrite(outFile, cnt, 1);
   end;
end;

// dekompresja RLE
procedure decompress(inFile: Integer; outFile: Integer);
var
   cur, prev, cnt: Byte;
   cont, i: Integer;
begin
   cont := FileRead(inFile, cur, 1);
   prev := not(cur);
   while (cont = 1) do
      if (prev <> cur) then
      begin
         // znaki obok siebie rozne wrzuc do pliku wyjsciowego
         FileWrite(outFile, cur, 1);
         prev := cur;
         // odczytaj kolejny znak
         cont := FileRead(inFile, cur, 1);
      end
      else
      begin
         // znaki obok siebie sa rowne - mamy sekwencje
         // odczytaj dlugosc sekwencji i wrzuc ja do pliku wyjsciowego
         FileRead(inFile, cnt, 1);
         for i:=0 to cnt do
            FileWrite(outFile, cur, 1);
         // odczytaj kolejny znak
         cont := FileRead(inFile, cur, 1);
         prev := Not(cur);
      end;
end;

var
   x: Integer;
   inPath, outPath: String;
   inFile, outFile: Integer;

begin

   Writeln('1 - kompresja');
   Writeln('2 - dekompresja');
   Readln(x);

   Writeln('Plik wejsciowy');
   Readln(inPath);
   
   Writeln('Plik wyjsciowy:');
   Readln(outPath);

   inFile := FileOpen(inPath, fmOpenRead);
   outFile := FileCreate(outPath);

   if inFile <= 0 then
   begin
      Writeln('Nie moge otworzyc pliku wejsciowego');
      exit;
   end;
   if outFile <= 0 then
   begin
      Writeln('Nie moge utworzyc pliku wyjsciowego');
      exit;
   end;

   if x = 1 then
      compress(inFile, outFile)
   else
      decompress(inFile, outFile);

   FileClose(inFile);
   FileClose(outFile);

end.