Komprese dat pomocí Huffmanova kódování a Run-Length Encoding

{ KOMPRESE.PAS                             Copyright (c) Petr Koupy }
{                                                                   }
{ Komprese textu, verze 1.0.                                        }
{                                                                   }
{ Komprese dat pomocí Huffmanova kódování a Run-Length Encoding.    }
{ Program nemá žádné uživatelské prostředí - ovládá se výhradně     }
{ pomocí parametrů při volání z příkazového řádku.                  }
{ Algoritmus je vhodný zejména pro kompresy textu a bitmap.         }
{ Celá implementace ovšem spoléhá na 8 bitové dělení dat,           }
{ takže komprese nebude efektivní na text kódováný ve formátu       }
{ Unicode a na více než 8 bitové bitmapy.                           }
{ Program vznikl jako zápočtový program předmětu Programování I.    }
{ K programu je přiložen komentovaný zdrojový kód a malá sada       }
{ testovacích dat.                                                  }
{ Zaujímavé je grafické spracovanie pomocou systémovej jednotky crt.}
{                                                                   }
{ Datum:12.02.2008                             http://www.trsek.com }
 
program Komprese;
const povinne=4; {pocet povinnych parametru}
      celkem=6;  {celkovy mozny pocet parametru}
type bitove_pole = array[0..15] of boolean; {reprezentace byte nebo word po jednotlivych bitech}
var vstupni_soubor: file;
    vystupni_soubor: file;
    log_soubor: text;
    vypis: boolean; {logovani zapnuto/vypnuto}
 
{Interface >>>}
function KompresniPomer: string;
var ratio: real;
    temp: string;
begin
  if FileSize(vstupni_soubor)>0 then ratio:=(FileSize(vystupni_soubor))/(FileSize(vstupni_soubor))
  else ratio:=0;
  Str(ratio:4:2,temp); {temp je kvuli kompilatoru Borland Pascal}
  KompresniPomer:=temp; {pro kompilator Freepascal by stacilo dat KompresniPomer do predchozi procedury}
end;
 
procedure Zaznamenej(hlaseni: string);
begin
  if vypis=true then writeln(log_soubor,hlaseni);
end;
 
function NactiByte(var data: byte): boolean;
begin
  if not eof(vstupni_soubor) then
    begin
      BlockRead(vstupni_soubor,data,1);
      NactiByte:=true;
    end
  else NactiByte:=false;
end;
 
procedure UlozByte(data: byte);
begin
  BlockWrite(vystupni_soubor,data,1);
end;
 
function NactiWord(var data: word): boolean;
begin
  if not eof(vstupni_soubor) then
    begin
      BlockRead(vstupni_soubor,data,2);
      NactiWord:=true;
    end
  else NactiWord:=false;
end;
 
procedure UlozWord(data: word);
begin
  BlockWrite(vystupni_soubor,data,2);
end;
 
procedure UkazNa(ukazatel: longint);
begin
  Seek(vstupni_soubor,ukazatel);
end;
 
function PoziceSouboru: longint;
begin
  PoziceSouboru:=FilePos(vstupni_soubor);
end;
 
function VelikostSouboru: longint;
begin
  VelikostSouboru:=FileSize(vstupni_soubor);
end;
 
procedure RozlozByte(var vystup: bitove_pole; vstup: byte);
var i: byte;
begin
  for i:=0 to 7 do
    begin
      vystup[i]:=(vstup mod 2 = 1);
      vstup:=vstup div 2;
    end;
end;
 
procedure SlozByte(vstup: bitove_pole; var vystup: byte);
var i, rad: byte;
begin
  rad:=1;
  vystup:=0;
  for i:=0 to 7 do
    begin
      vystup:=vystup+rad*Ord(vstup[i]);
      rad:=2*rad;
    end;
end;
 
procedure RozlozWord(var vystup: bitove_pole; vstup: word);
var i: byte;
begin
  for i:=0 to 15 do
    begin
      vystup[i]:=(vstup mod 2 = 1);
      vstup:=vstup div 2;
    end;
end;
 
procedure SlozWord(vstup: bitove_pole; var vystup: word);
var i: byte;
    rad: word;
begin
  rad:=1;
  vystup:=0;
  for i:=0 to 15 do
    begin
      vystup:=vystup+rad*Ord(vstup[i]);
      rad:=2*rad;
    end;
end;
{<<< Interface}
 
{ENGINE >>>}
 
procedure HuffmanEncode;
var frekvence: array[0..510] of longint;
    {Krome frekvenci bytu obsahuje i hodnoty otcu v Huffmanove strome,
     ktere jsou tvoreny soucty svych synu. Hodnoty 0..255 jsou rezervovany
     pro frekvence bytu. Hodnoty 256..510 jsou rezervovany pro otcovske soucty.
     Cim vice se zprava blizi indexu 256, tim vetsi soucet lze ocekavat -
     tim blize je totiz otec u korene stromu.}
    halda: array[1..256] of word;
    velikost_haldy: word; {1..256 - nula by delala problemy pri praci s haldou v poli}
    {Halda bude obsahovat maximalne vsechny byty. Pri tvorbe Huffmanova
     stromu bude znicena. Budou do ni take prubezne ukladany hodnoty otcu,
     takze nestaci rozsah jednoho bytu (proto pouzit word).}
    struktura: array[0..510] of longint;
    {Pro kazdy uzel stromu obsahuje index do pole 'frekvence' na sveho otce.
     Pokud je index otce zaporny, je dany byte jeho pravym synem, jinak
     je levym synem.}
    kod: array[0..255] of word;
    delka: array[0..255] of byte;
    {Kazdy byte je reprezentovan pravymi delka[byte] cisly z binarniho cisla kod[byte].}
 
  procedure SpocitejFrekvence;
            {Vypocita frekvencni vyskyt vsech bytu a ulozi je do pole.}
  var data: byte;
      i: word;
      index, freq: string; {pomocne retezce pro logovani}
  begin
    UkazNa(0);
    for i:=0 to 510 do frekvence[i]:=0; {nulovani pole}
    while NactiByte(data) do
      if frekvence[data]<MaxLongInt then inc(frekvence[data]);
      {jen pro jistotu - aby longint pretekl, musel by uzivatel komprimovat
       soubor o velikosti vice nez 2GB, coz je vzhledem k nizkemu vykonu programu
       velmi nepravdepodobne}
    for i:=0 to 255 do {logovani}
      begin
        if frekvence[i]>0 then
          begin
            Str(i,index);
            Str(frekvence[i],freq);
            Zaznamenej('Byte '+index+' ma frekvenci '+freq);
          end;
      end;
  end;
 
  procedure BublejDolu(uzel: word);
            {Danym bytem probubla vznikajici haldu dolu. Porovnavani
             je neprime podle frekvence. Dolu probublavaji prvky
             s velkou frekvenci.}
  var syn, pom: word;
  begin
    while uzel<=(velikost_haldy div 2) do
      begin
        syn:=2*uzel;
        if (syn<velikost_haldy) and (frekvence[halda[syn]]>frekvence[halda[syn+1]]) then inc(syn);
        if frekvence[halda[uzel]]<=frekvence[halda[syn]] then break;
        pom:=halda[uzel];
        halda[uzel]:=halda[syn];
        halda[syn]:=pom;
        uzel:=syn;
      end;
  end;
 
  procedure VytvorHaldu;
            {Z bytu o nenulove frekvenci vytvori sestupnou haldu.}
  var i: word;
      index, heap, freq: string; {pomocne retezce pro logovani}
  begin
    velikost_haldy:=0;
    for i:=0 to 255 do {hledani bytu s nenulovou frekvenci}
      if frekvence[i]>0 then
        begin
          inc(velikost_haldy);
          halda[velikost_haldy]:=i;
        end;
    for i:=velikost_haldy downto 1 do BublejDolu(i); {tvorba haldy}
    for i:=1 to velikost_haldy do {logovani}
      begin
        Str(i,index);
        Str(halda[i],heap);
        Str(frekvence[halda[i]],freq);
        Zaznamenej('Halda['+index+'] obsahuje byte '+heap+' s frekvenci '+freq);
      end;
  end;
 
  procedure HuffmanTree;
            {Vytvori Huffmanuv strom, kde listy jsou byty a jednotlive
             uzly jsou soucty svych synu. Postupne se likviduje halda
             odebiranim dvou nejmensich prvku a pridanim jejich souctu.
             Nakonec v halde zbyde pouze soucet pres vsechny jeji prvky.
             Pri tomto procesu se vytvori Huffmanuv strom, ktery je
             reprezentovan dvema poli. Pole 'frekvence' obsahuje data
             stromu. Pole 'struktura' obsahuje informace o navaznosti
             jednotlivych uzlu na sve otce.}
  var pom: word;
      i: word;
      index, freq, dad: string; {pomocne retezce pro logovani}
  begin
    for i:=0 to 510 do struktura[i]:=0;
    if velikost_haldy=1 then struktura[halda[1]]:=256; {v pripade, ze cely vstupni soubor je slozen ze stejnych bytu}
    while velikost_haldy>1 do
      begin
        pom:=halda[1];
        halda[1]:=halda[velikost_haldy]; {odebrani nejmensiho prvku z haldy}
        dec(velikost_haldy);
        BublejDolu(1); {nalezeni noveho nejmensiho prvku}
        frekvence[255+velikost_haldy]:=frekvence[pom]+frekvence[halda[1]]; {tvorba otce dvou nejmensich prvku}
        struktura[pom]:=255+velikost_haldy; {index otce prvniho nejmensiho prvku bude kladny - je levym synem}
        struktura[halda[1]]:=-255-velikost_haldy; {index otce druheho nejmensiho prvku bude zaporny - je pravym synem}
        halda[1]:=255+velikost_haldy; {ulozeni otce do haldy}
        BublejDolu(1);
      end;
    struktura[255+velikost_haldy]:=0; {koren jiz nema otce}
    for i:=0 to 510 do {logovani}
      begin
        if frekvence[i]>0 then
          begin
            Str(i,index);
            Str(frekvence[i],freq);
            Str(struktura[i],dad);
            Zaznamenej('Frekvence['+index+'] = '+freq+' (otec = '+dad+')');
          end;
      end;
  end;
 
  procedure HuffmanCode;
            {Vytvori kodovaci pole pro snadnejsi kodovani vstupniho
             souboru a ulozeni nezbytnych informaci pro rekonstrukci
             Huffmanova stromu. Pro kazdy byte se projde zespodu stromem a
             zaznamena se jeho cesta ve forme binarniho cisla, kde jeho
             delka je delkou cesty, hodnota 0 znamena levy syn, hodnota
             1 znamena pravy syn. Binarni cislo je prevedeno na word a
             ulozeno do pole 'kod'. Jeho delka je ulozena do pole 'delka'.
             Nasledne jsou tyto pole prokladane ulozena do vystupniho souboru.}
  var i, delka_data: byte;
      kod_data, smerovnik: word;
      uzel: longint;
      index, code, lng: string; {pomocne retezce pro logovani}
  begin
    for i:=0 to 255 do
      begin
        if frekvence[i]=0 then {nulove frekvence maji nulovy kod i delku}
          begin
            kod[i]:=0;
            delka[i]:=0;
          end
        else
          begin
            delka_data:=0;
            kod_data:=0;
            smerovnik:=1; {postupne bude obsahovat 1,2,4,8... tedy binarne 1,10,100,1000...}
            uzel:=struktura[i]; {otec bytu i}
            while uzel<>0 do {dokud se nedojde ke koreni}
              begin
                if uzel<0 then {uzel je pravym synem, je nutne zakodovat 1}
                  begin
                    kod_data:=kod_data+smerovnik; {pravy smer je kodovan 1}
                    uzel:=-uzel;
                  end;
                uzel:=struktura[uzel]; {prechod na vyssi uroven stromu}
                smerovnik:=2*smerovnik; {v binarni reprezentaci se 1 posune doleva o jednu pozici}
                inc(delka_data);
              end;
            kod[i]:=kod_data;  {konecne prirazeni hodnot}
            delka[i]:=delka_data;
          end;
      end;
    for i:=0 to 255 do {logovani}
      if frekvence[i]>0 then
        begin
          Str(i,index);
          Str(kod[i],code);
          Str(delka[i],lng);
          Zaznamenej('Kod['+index+'] = '+code+' (delka = '+lng+')');
        end;
    for i:=0 to 255 do {ukladani dat do vystupniho souboru}
      begin
        UlozWord(kod[i]);
        UlozByte(delka[i]);
      end;
  end;
 
  procedure Encode;
            {Kazdy byte vstupniho souboru je preveden na svuj kod. Ten je
             nasledne rozlozen na jednotlive bity dle pole 'delka'. Temito
             bity je postupne plnen vystupni byte, ktery je po svem naplneni
             ulozen do vystupniho souboru. Specialni pozornost je venovana
             poslednimu bytu, ktery nemusi byt uplny. Informace o jeho
             neuplnosti je ulozena do posledniho bytu celeho souboru.}
  var i, vstup, vystup, pozice: byte;
      vstupni_word, vystupni_byte: bitove_pole;
  begin
    pozice:=7; {ukazatel do vystupniho bytu, nejvyssi rad ma ukazatel 7, nejnizsi 0}
    UkazNa(0); {vstupni soubor cist od zacatku}
    while NactiByte(vstup) do
      begin
        RozlozWord(vstupni_word,kod[vstup]);
        for i:=(delka[vstup]-1) downto 0  do
          begin
            vystupni_byte[pozice]:=vstupni_word[i];
            if pozice=0 then {vystupni byte byl naplnen, je treba jej ulozit}
              begin
                SlozByte(vystupni_byte,vystup);
                UlozByte(vystup);
                pozice:=7; {reset}
              end
            else dec(pozice);
          end;
      end;
    if pozice<7 then {zbyl neuplny byte? - hodnota 7 kvuli reset (viz vyse)}
      begin
        for i:=pozice downto 0 do vystupni_byte[pozice]:=false; {doplneni nulami}
        SlozByte(vystupni_byte,vystup); {ulozeni zbyleho bytu}
        UlozByte(vystup);
      end;
    if pozice<7 then UlozByte(pozice+1) else UlozByte(0);
    {na konec vystupniho souboru se ulozi pocet bitu, ktere je treba pri dekompresi ignorovat}
  end;
 
begin
  Zaznamenej('Zahajena komprese (Huffman).');
  SpocitejFrekvence;
  VytvorHaldu;
  HuffmanTree;
  HuffmanCode;
  Encode;
  Zaznamenej('Ukoncena komprese (Huffman).');
  Zaznamenej('Kompresni pomer = '+KompresniPomer);
end;
 
procedure HuffmanDecode;
type pprvek=^prvek;
     prvek=record  {uzel stromu}
             list: boolean; {je uzel listem nebo ne?}
             data: byte; {v listu ulozen dekodovaci byte, jinak nahodna hodnota}
             pravy: pprvek; {v listu bude nil}
             levy: pprvek; {v listu bude nil}
           end;
var kod: array[0..255] of word;
    delka: array[0..255] of byte;
    koren: pprvek;
    chyba: boolean; {kontrola spravnosti vstupniho souboru}
 
  procedure NactiPole;
            {Obnovi pole 'kod' a 'delka', ktere obsahuji nezbytne informace pro
             rekonstrukci stromu.}
  var i: byte;
      index, code, lng: string; {pomocne retezce pro logovani}
  begin
    for i:=0 to 255 do {nacitani dat ze vstupniho souboru}
      begin
        if NactiWord(kod[i])=false then chyba:=true;
        if NactiByte(delka[i])=false then chyba:=true;
        {chyba, pokud vstupni soubor neobsahuje ani nezbytne informace pro rekonstrukci stromu}
      end;
    for i:=0 to 255 do {logovani}
      if (delka[i]>0) and (chyba=false) then
        begin
          Str(i,index);
          Str(kod[i],code);
          Str(delka[i],lng);
          Zaznamenej('Kod['+index+'] = '+code+' (delka = '+lng+')');
        end;
  end;
 
  procedure VytvorStrom(var koren: pprvek);
            {Za pomoci informaci z poli 'kod' a 'delka' je rekonstruovan
             Huffmanuv strom. Je reprezentovan ukazately na zaznamy, ve kterych
             je ukazatel na praveho a leveho syna, identifikator listu a dale
             hodnota uzlu. Hodnota listu reprezentuje cilovy dekodovany byte.}
  var i, j: byte;
      vstupni_word: bitove_pole;
      uzel, novy: pprvek;
  begin
    new(koren); {inicializace korene}
    uzel:=koren;
    uzel^.pravy:=nil;
    uzel^.levy:=nil;
    uzel^.list:=false;
    for i:=0 to 255 do
      begin
        uzel:=koren;
        RozlozWord(vstupni_word,kod[i]);
        for j:=(delka[i]-1) downto 0 do {prochazeni 'neproslapanou' cestou}
          begin
            if vstupni_word[j]=true then {jdu doprava}
              begin
                if uzel^.pravy=nil then {pokud cesta neexistuje, tak vytvorit}
                  begin
                    new(novy);
                    uzel^.pravy:=novy;
                    uzel:=novy;
                    uzel^.pravy:=nil;
                    uzel^.levy:=nil;
                    uzel^.list:=false;
                  end
                else uzel:=uzel^.pravy; {cesta jiz existuje, pouze projit dale}
              end
            else                        {jdu doleva}
              begin
                if uzel^.levy=nil then {pokud cesta neexistuje, tak vytvorit}
                  begin
                    new(novy);
                    uzel^.levy:=novy;
                    uzel:=novy;
                    uzel^.pravy:=nil;
                    uzel^.levy:=nil;
                    uzel^.list:=false;
                  end
                else uzel:=uzel^.levy; {cesta jiz existuje, pouze projit dale}
              end;
            if j=0 then {konec cesty - je nutne ulozit cilovou hodnotu}
              begin
                uzel^.data:=i;
                uzel^.list:=true;
              end;
          end;
      end;
    Zaznamenej('Rekonstrukce Huffmanova stromu dokoncena.');
  end;
 
  procedure Decode;
            {Vstupni byty budou nacitany jako kontinualni cesta Huffmanovym
             stromem. Pokazde kdyz se dojde do listu je ulozen vystupni byte
             a ukazatel je vracen na koren stromu. Procedura take hlida posledni
             potencialne neuplny byte, ve kterem je mozna potreba ignorovat
             nekolik bitu.}
  var vstup, i, ignorovat: byte;
      velikost, pozice: longint;
      vstupni_byte: bitove_pole;
      uzel: pprvek;
  begin
    uzel:=koren;
    velikost:=VelikostSouboru;
    pozice:=PoziceSouboru;
    UkazNa(velikost-1);   {presun na konec}
    NactiByte(ignorovat); {kolik je potreba na konci ignorovat?}
    UkazNa(pozice);       {zpatky na puvodni misto}
    while (PoziceSouboru<(velikost-1)) and (NactiByte(vstup)) and (chyba=false) do
          {POZOR - NactiByte posunuje pozici, proto je v podmince PoziceSouboru napred}
          {posledni byte = EOF, predposledni byte = pocet ignorovanych bitu, oba byty se nesmi dekodovat}
      begin
        RozlozByte(vstupni_byte,vstup);
        pozice:=PoziceSouboru-1; {protoze NactiByte posune pozici na budouci byte, je nutne dekrementovat}
        for i:=7 downto 0 do
          begin
            if (pozice=(velikost-2)) and (ignorovat>i) then {v poslednim bytu jsou ignorovane bity}
              begin
                {nedelat nic, bity jsou ignorovany}
              end
            else
              begin
                if chyba=false then
                  if vstupni_byte[i]=false then {sestoupit ve strome doleva}
                    if uzel^.levy<>nil then uzel:=uzel^.levy else chyba:=true
                  else                          {sestoupit ve strome doprava}
                    if uzel^.pravy<>nil then uzel:=uzel^.pravy else chyba:=true;
                  {pokud je algoritmus navigovan neexistujici cestou, urcite
                   data neodpovidaji stromu - tzn. bud je soubor poskozen
                   anebo se uzivatel pokousi dekomprimovat cizi soubor}
                if (uzel^.list=true) and (chyba=false) then {nalezen list}
                  begin
                    UlozByte(uzel^.data);
                    uzel:=koren; {reset}
                  end;
              end;
          end;
      end;
  end;
 
begin
  Zaznamenej('Zahajena dekomprese (Huffman).');
  chyba:=false;
  NactiPole;
  if chyba=false then VytvorStrom(koren);
  if chyba=false then Decode;
  if chyba=false then Zaznamenej('Ukoncena dekomprese (Huffman).')
  else Zaznamenej('Vstupni soubor je poskozen nebo se nejedna o soubor vytvoreny timto programem.');
end;
 
procedure RLEEncode;
var frekvence: array[0..255] of longint;
    escape: byte; {escape character pro identifikaci zkomprimovane sekvence bytu}
 
  procedure SpocitejFrekvence;
            {Vypocita frekvencni vyskyt vsech bytu a ulozi je do pole.}
  var data: byte;
      i: word;
      index, freq: string; {pomocne retezce pro logovani}
  begin
    UkazNa(0);
    for i:=0 to 255 do frekvence[i]:=0; {nulovani pole}
    while NactiByte(data) do
      if frekvence[data]<MaxLongInt then inc(frekvence[data]);
      {jen pro jistotu - aby longint pretekl, musel by uzivatel komprimovat
       soubor o velikosti vice nez 2GB, coz je vzhledem k nizkemu vykonu programu
       velmi nepravdepodobne}
    for i:=0 to 255 do {logovani}
      begin
        if frekvence[i]>0 then
          begin
            Str(i,index);
            Str(frekvence[i],freq);
            Zaznamenej('Byte '+index+' ma frekvenci '+freq);
          end;
      end;
  end;
 
  procedure NajdiEscape;
            {Prvni znak s nejnizsi frekvenci bude escape characterem.}
  var i: byte;
      min: longint;
      esc: string;
  begin
    min:=frekvence[0];
    escape:=0;
    for i:=1 to 255 do
      begin
        if frekvence[i]<min then
          begin
            min:=frekvence[i];
            escape:=i;
          end;
      end;
    Str(escape,esc); {logovani}
    Zaznamenej('Escape character = '+esc);
  end;
 
  procedure Encode;
  var vstup, temp, opakovani, i: byte;
  begin
    UkazNa(0); {navrat na zacatek souboru}
    UlozByte(escape); {na zacatku souboru bude vzdy ulozen escape character}
    opakovani:=0;
    while NactiByte(vstup) do
      begin
        if vstup=escape then {escape character bude ukladan specialnim zpusobem}
          begin
            UlozByte(escape); {na jeho ulozeni se spotrebuji 2 byty misto jednoho}
            UlozByte(0);      {escape character samotny a dale nulovy byte}
            opakovani:=0;
          end
        else
          begin
            if opakovani=0 then temp:=vstup; {opakovani=0 pri inicializaci nebo po ulozeni escape characteru}
            if ((temp<>vstup) and (opakovani>=4)) or ((temp=vstup) and (opakovani=255)) then
               {ma smysl komprimovat... escape character + pocet opakovani (max 255) + komprimovany byte}
              begin
                UlozByte(escape);
                UlozByte(opakovani);
                UlozByte(temp);
                temp:=vstup;
                opakovani:=1;
              end
            else if (temp<>vstup) and (opakovani<=3) then
               {komprese by se nevyplatila - jsou na ni potreba 3 byty}
              begin
                for i:=1 to opakovani do UlozByte(temp);
                temp:=vstup;
                opakovani:=1;
              end
            else inc(opakovani); {zatim se o kompresi nerozhodlo}
          end;
      end;
    {ulozeni zbytku}
    if opakovani<=3 then
      begin
        for i:=1 to opakovani do UlozByte(temp);
      end
    else
      begin
        UlozByte(escape);
        UlozByte(opakovani);
        UlozByte(temp);
      end;
  end;
 
begin
  Zaznamenej('Zahajena komprese (RLE).');
  SpocitejFrekvence;
  NajdiEscape;
  Encode;
  Zaznamenej('Ukoncena komprese (RLE).');
  Zaznamenej('Kompresni pomer = '+KompresniPomer);
end;
 
procedure RLEDecode;
var chyba: boolean; {kontrola spravnosti vstupniho souboru}
 
  procedure Decode;
  var vstup, escape, opakovani, vystup, i: byte;
  begin
    NactiByte(escape); {nacteni referencniho escape characteru}
    while (NactiByte(vstup)) and (chyba=false) do
      begin
        if vstup=escape then {escape character oznacuje komprimovanou sekvenci bytu}
          if NactiByte(opakovani) then
            if opakovani=0 then UlozByte(escape) {rozpoznani znaku, ktery je identicky s escape characterem}
            else if NactiByte(vystup) then {pokud se nejednalo o escape character, je potreba dalsi byte}
                   begin
                     for i:=1 to opakovani do UlozByte(vystup); {expandovani komprimovane sekvence}
                   end
                 else chyba:=true {pokud neexistuje zadny dalsi byte, neco je spatne}
          else chyba:=true {pokud po escape characteru nenasleduje dalsi byte, neco je spatne}
        else UlozByte(vstup); {nekomprimovane byty ukladat primo}
      end;
  end;
 
begin
  Zaznamenej('Zahajena dekomprese (RLE).');
  chyba:=false;
  Decode;
  if chyba=false then Zaznamenej('Ukoncena dekomprese (RLE).')
  else Zaznamenej('Vstupni soubor je poskozen nebo se nejedna o soubor vytvoreny timto programem.');
end;
 
{<<< ENGINE}
 
{Rizeni cinnosti >>>}
procedure Komprimuj;
begin
  if paramstr(4)='-h' then HuffmanEncode;
  if paramstr(4)='-r' then RLEEncode;
end;
 
procedure Dekomprimuj;
begin
  if paramstr(4)='-h' then HuffmanDecode;
  if paramstr(4)='-r' then RLEDecode;
end;
{<<< Rizeni cinnosti}
 
{I/O procedury >>>}
procedure ZavriVstupni;
begin
  close(vstupni_soubor);
  Zaznamenej('Vstupni soubor uzavren.');
end;
 
procedure ZavriVystupni;
begin
  close(vystupni_soubor);
  Zaznamenej('Vystupni soubor uzavren.');
end;
 
procedure ZavriLog;
begin
  if vypis=true then close(log_soubor);
end;
 
function OtevriVstupni(jmeno: string): boolean;
begin
  assign(vstupni_soubor,jmeno);
  {$I-} reset(vstupni_soubor,1); {$I+}      {pokus o otevreni}
  if IOresult=0 then
    begin
      OtevriVstupni:=true;                  {soubor existuje}
      Zaznamenej('Vstupni soubor '+jmeno+' otevren pro cteni.');
    end
  else
    begin
      OtevriVstupni:=false;                 {soubor neexistuje}
      Zaznamenej('Vstupni soubor '+jmeno+' neexistuje.');
    end;
end;
 
function OtevriVystupni(jmeno: string): boolean;
var i: byte;
    prepis: boolean;
begin
  prepis:=true;
  assign(vystupni_soubor,jmeno);
  {$I-} reset(vystupni_soubor,1); {$I+}     {pokus o otevreni}
  if IOresult=0 then                        {soubor uz existuje}
    begin
      close(vystupni_soubor);
      prepis:=false;
      for i:=(povinne+1) to paramcount do   {lze jej prepsat?}
        if paramstr(i)='-w' then prepis:=true;
    end;
  if prepis=true then
    begin
      rewrite(vystupni_soubor,1);
      OtevriVystupni:=true;                 {soubor lze zapisovat}
      Zaznamenej('Vystupni soubor '+jmeno+' otevren pro zapis.');
    end
  else
    begin
      OtevriVystupni:=false;                {soubor nelze zapisovat}
      Zaznamenej('Vystupni soubor '+jmeno+' nelze zapisovat.');
      ZavriVstupni;                         {kvuli zkracenemu vyhodnoceni v hlavnim programu}
    end;
end;
 
procedure OtevriLog;
var i: byte;
begin
  vypis:=false;
  for i:=(povinne+1) to paramcount do       {jsou zapnute vypisy?}
    if paramstr(i)='-l' then vypis:=true;
  if vypis=true then
    begin
      assign(log_soubor,'log.txt');
      rewrite(log_soubor);
    end;
end;
{<<< I/O procedury}
 
begin
  if (paramcount>=povinne) and (paramcount<=celkem) then
    begin
      OtevriLog;
      if OtevriVstupni(paramstr(1)) and OtevriVystupni(paramstr(2)) then
        begin
          if paramstr(3)='-c' then Komprimuj;
          if paramstr(3)='-d' then Dekomprimuj;
          ZavriVstupni;
          ZavriVystupni;
        end;
      ZavriLog;
    end
  else
    begin  {help}
      writeln;
      writeln('Komprese textu, verze 1.0');
      writeln('Copyright (c) 2008 Petr Koupy');
      writeln;
      writeln('komprese.exe VSTUP VYSTUP [rezim] [algoritmus] ([prepis] [logovani])');
      writeln;
      writeln('Nazvy souboru uvadet bez cesty.');
      writeln('[rezim]        -c   komprese vstupniho souboru');
      writeln('               -d   dekomprese vstupniho souboru');
      writeln('[algoritmus]   -h   Huffmanovo kodovani');
      writeln('               -r   Run-Lenght Encoding');
      writeln('[prepis]       -w   povolit prepis existujiciho vystupniho souboru (nepovinne)');
      writeln('[logovani]     -l   povolit logovani udalosti do souboru log.txt (nepovinne)');
    end;
end.