{ SORTIADA.PAS                                                      }
{ Program na demonstrovanie triediacich algoritmov.                 }
{ Naprogramovane su nasledovne algoritmy:                           }
{ - Insert-sort                                                     }
{ - Bubble-sort                                                     }
{ - Shaker-sort                                                     }
{ - sheLL-sort                                                      }
{ - Quick-sort                                                      }
{ - Dobosiewicz-sort                                                }
{ - Merge-sort                                                      }
{ - Tree-sort                                                       }
{ - Heap-sort                                                       }
{ - maX-sort                                                        }
{                                                                   }
{ Datum:11.11.2002                             http://www.trsek.com }

program shoW_okienko;
{
             T R I E D I A C E   A L G O R I T M Y
             =====================================

   ..........  jednoduch‚ demonstracne prostredie   ..........

ulohy : a) Vymysli a implementuj in£ tematiku
        b) Dopln dalsie algoritmy
        c) Nech viacero algoritmov be‘¡ na obrazovke s£‡asne
        d) V pr¡pade '  iba €as ' naprogramuj meranie ‡asu
        e) Dopl¤  syst‚m  help

..............................................................
}
uses   dos,crt,graph;

const
      cesta_bgi  ='';
      meno_dat_suboru : string = 'sort.dat';
      x0 = 50;
      y0 = 2;

      poc_max = 80;                      {.. po‡et textov  .}
                        {.. implicitn‚ t.j.
                                        default nastavenia .}

      zac_main      : integer = 21;   { hlavne menu  .}
      kon_main      : integer = 27;
      cislo_submenu : integer = 22;   { = vyber algoritmus .}

      zac_a         : integer = 1;    { submenu algoritmy  .}
      kon_a         : integer = 10;
      c_sortu       : integer = 2;    { = bubblesort .}

      zac_r         : integer = 39;      { submenu rozsah .}
      kon_r         : integer = 51;
      rozsah        : integer = 42;   { = n..30            .}
      n             : integer = 30;

      zac_char      : integer = 34;      { submenu char. dat .}
      kon_char      : integer = 38;
      typ_dat       : integer = 36;   { = n hodne ..       .}

      zac_p         : integer = 63;   { submenu palicka/bod .}
      kon_p         : integer = 64;
      palicky_body  : integer = 63;   { = palicky          .}
      palica        = 63;
      bodka         = 64;

      zac_t         : integer = 67;  { submenu tempo }
      kon_t         : integer = 72;
      tempo         : integer = 68;  { = ‡akanie }
      tempo_spomal  : integer = 68;
      cakanie       : integer = 100;
      c_tempa       : integer = 1;
      temp          : integer = 1;
      etapy_stop    : boolean = false;
      cyklus_stop   : boolean = false;
      cyklus_vnutri : boolean = false;
      krok_stop     : boolean = false;
      cakaj         : boolean = true;
      esc           : boolean = false;

      zac_d         : integer = 76; { submenu spomalenie }
      kon_d         : integer = 80;
      spomalenie    : integer = 78; { = delay kon¨t = 100ms }

      dole  = 'P';  hore = 'H';    {.. druh˜ byte pre ¨ipky .}
                                   {..   vtedy je prv˜ = #0 .}

    te : array[0..6] of string[11] =
         (' Nestoj    ',' Delay 100 '
         ,' Etapy     ',' Cyklus    '
         ,' Vnutri    ',' Krokom    '
         ,' Esc       ');
     vyska : integer = 10;    { pre Herc smallfont }
     sirka : integer = 8;

type  texty = array[1..poc_max] of string[21];
                              {..  texty pre menu a submenu .}

const t : texty = ('  Insert-sort       '{..... 1........... }
                  ,'  Bubble-sort       '
                  ,'  Shaker-sort       '{.. v˜ber algoritmu.}
                  ,'  sheLL-sort        '
                  ,'  Quick-sort        '
                  ,'  Dobosiewicz-sort  '        {6}
                  ,'  Merge-sort        '        {7}
                  ,'  Tree-sort         '
                  ,'  Heap-sort         '
                  ,'  maX-sort          '    {10}
                  ,'                    '
                  ,'                    '
                  ,'                    '
                  ,'                    '
                  ,'                    '
                  ,'                    '
                  ,'                    '
                  ,'                    '
                  ,'                    '
                  ,'                    '
                  ,' Tempo uk ‘ky       ' {...... 21........ }
                  ,' Algoritmus         ' {...... 22........ }
                  ,' nastav Rozsah pola '
                  ,' Charakter £dajov   ' {== hlavn‚ menu == }
                  ,' Pali‡ky/bodky/ni‡  '
                  ,' Vykonaj            '
                  ,' Quit               ' {...... 27........ }
                  ,'                    '
                  ,'                    '
                  ,'                    '
                  ,'                    '
                  ,'                    '
                  ,'                    '
                  ,'     Vzostupne      ' {...... 34........ }
                  ,'     Zostupne       '
                  ,'     N hodne        '    {=== typ dat ===}
                  ,'     Rovnak‚        '
                  ,'     S£bor          ' {...... 38 ........}
                  ,'     n = 10         ' {...... 39 ........}
                  ,'     n = 20         '
                  ,'     n = 30         '   {=== rozsah ===}
                  ,'     n = 40         '
                  ,'     n = 50         '
                  ,'     n = 70         '
                  ,'     n = 100        '
                  ,'     n = 200        '
                  ,'     n = 300        '
                  ,'     n = 400        '
                  ,'     n = 500        '
                  ,'     n = 700        '
                  ,'     n = 1000       '    { 51 }
                  ,'     n = 2000       '
                  ,'     n = 3000       '
                  ,'     n = 4000       '
                  ,'     n = 5000       '
                  ,'     n = 10000      ' {.... 56........ }
                  ,'                    '
                  ,'                    '
                  ,'                    '
                  ,'                    '
                  ,'                    '
                  ,'                    '
                  ,'     Palicky        ' {.... 63........ }
                  ,'     Bodky          ' {== tvar prvkov==}
                  ,'     iba Cas        ' {.... 65........ }
                  ,'                    '
                  ,'   Nezastavuje      ' {.... 67 .......}
                  ,'   Delay spomal¡    '
                  ,'   Etapy stop       '
                  ,'   Cyklus stop      '
                  ,'   Vn£torn˜ cyklus  ' {== tempo ukazky ==}
                  ,'   Krokovanie       '
                  ,'   Esc              ' {.... 73 ......}
                  ,'                    '
                  ,'                    '
                  ,'   cakaj = 0        ' {.... 76 ......}
                  ,'   cakaj = 50       '
                  ,'   cakaj = 100      ' {== delay ==}
                  ,'   cakaj = 200      '
                  ,'   cakaj = 500      ' {.... 80 .....}
                   );
var
     a         : array [-3335..10000] of integer;
     tx        : array [0..6] of integer;
     tl,ty     : integer;
     p1,p2     : integer;
     mx,my,y1  : integer;
     me        : real;
     bola_vymena : boolean;
     limit,limit1  : integer;
     r3           : string[3];

{...  p a r a m e t e r  ... na konci reŸazca de¨ifruje ‡¡slo }

function parameter(r:string) : integer;
var   i,j,kod : integer;
      ret     : string;
begin
  ret:=copy(r,2+pos('=',r),6);
  i:=pos(' ',ret)-1;
  val(copy(ret,1,i),j,kod);
  if kod>0 then parameter:=10
  else parameter:=j;
end;

{........  n a j d e    v   t e x t e   prv‚ velk‚ p¡smeno..}

function Prve_velke(i:integer; var kde:integer):char;
var  j : integer;
     r:string;
begin
  r:=t[i]+'@';
  j:=0;
  repeat j:=j+1 until r[j] in ['A'..'Z','@'];
  if r[j]<>'@' then begin prve_velke:=r[j]; kde:=j end
               else begin prve_velke:=' ' ; kde:=0 end;
end;

{--------  funkcia  v y b e r  -------------------------------

       parametre : izac    - indexy textov z ktor˜ch vyber me
                   ikon
                   x,y     - s£radnice Œav‚ho horn‚ho rohu okna

       hodnota funkcie = index vybran‚ho textu alebo 0
}

function vyber(izac,ikon:integer; var ivyber:integer):integer;
var
    znak              : char;
    poc_t,i,j,povodne : integer;
                            {.. = prv‚ velke p¡smena textov .}
    velke_pismena : set of char;


{.......     p i s - t e x t     - nap¡¨e i-ty text do okienka
                                  - norma lnou alebo inverznou
                                    farbou                   }


procedure pis_text(i:integer; normalne:boolean);
var z : char;
    j : integer;
begin            {.. z=t[i,j] je prv‚ velk‚ p¡smeno v texte.}
  z:=prve_velke(i,j);
  gotoxy(x0,y0+i-izac);                 {.. nastav¡ kursor .}
  if normalne then
    begin lowvideo; write(' ',t[i],' ');
          highvideo;            {.. zv˜razn¡ velk‚ p¡smeno .}
          gotoxy(x0+j,y0+i-izac);  write(z);
    end
  else begin                    {.. nastav¡ inverzn‚ farby .}
         textbackground(white); textcolor(black);
                                                                                     lowvideo;
         write(' ',t[i],' ');
         highvideo;             {.. zv˜razn¡ velk‚ p¡smeno .}
         gotoxy(x0+j,y0+i-izac);  write(z);
                                {.. nastav¡ norm lne farby .}
         textbackground(black); textcolor(white);
       end;
end;

{..........      z m e n      - zmen¡ vybran˜ text..........}

procedure zmen(i:integer);
begin                  {.. doteraz vybran˜ nap¡¨e norm lne .}
  pis_text(ivyber,true);
  ivyber:=i;
  pis_text(ivyber,false); {..teraz vybran˜ nap¡¨e inverzne .}
end;

{...........     r   m ‡ e k   o k n a      ................}

procedure ramcek (x,y,x1,y1:integer);
var i,j:integer;
const r : string[7] = 'ÉÍ»Èͼº';  {.. r[1]..Œav˜ horn˜ znak
                                      r[2]..horizont lny
                                      r[3]..prav˜ horn˜
                                      atƒ ...               }
begin
  gotoxy(x0-1,y0-1);  write(r[1]);         {.. prv˜ riadok .}
  for i:=x0 to x1 do write(r[2]); write(r[3]);
  for i:=y0 to y1 do
    begin                                         {.. boky .}
      gotoxy(x0-1,i);  write(r[7]);
      gotoxy(x1+1,i); write(r[7]);
    end;
  gotoxy(x0-1,y1+1);  write(r[4]);        {.. spodn˜ ridok .}
  for i:=x0 to x1 do write(r[5]); write(r[6]);
end;

{.....   t e l o   f u n k c i e   v ˜ b e r   .............}

begin
  textbackground(black); textcolor(white);
  clrscr;
  writeln('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»');
  writeln('º                                  º');
  writeln('º        T R I E D E N I E.        º');
  writeln('º                                  º');
  write('º   '); lowvideo; write('  demon¨tra‡n‚  prostredie  ');highvideo;
  writeln('   º');
  writeln('º                                  º');
  writeln('ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹');
  writeln('º                                  º');
  write('º '); lowvideo; write('Algoritmus  ');highvideo;
  writeln(t[c_sortu],' º');
  writeln('º                                  º');
  write('º '); lowvideo; write('Rozsah   ');highvideo;
  writeln(t[rozsah],'    º');
  writeln('º                                  º');
  write('º '); lowvideo; write('Charakter d t ');highvideo;
  writeln(copy(t[typ_dat],6,15),'    º');
  writeln('º                                  º');
  write('º '); lowvideo; write('Obraz d t');highvideo;
  writeln(t[palicky_body],'    º');
  writeln('º                                  º');
  write('º '); lowvideo; write('Tempo uk ‘ky  ');highvideo;
  writeln(copy(t[tempo],4,17),'  º');
  writeln('º                                  º');
  write('º '); lowvideo; write('Delay      ');highvideo;
  writeln(t[spomalenie],'  º');
  writeln('ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ');
  povodne:=ivyber;
  ramcek(x0,y0,x0+length(t[izac])+1,y0+ikon-izac);
                                           {.. p¡¨e texty .}
  velke_pismena:=[];
  for i:=izac to ikon do begin
    pis_text(i,true);                        {.. norm lne .}
                               {.. mno‘ina velk˜ch p¡smen .}
    velke_pismena:=velke_pismena+[prve_velke(i,j)];
  end;
  pis_text(ivyber,false);                     {.. inverzne .}

               {...  cyklus vyberania ...}
  repeat
    znak:=upcase(readkey);
         {.. ak pre‡¡tan˜ znak je prv‚ velk‚ p¡smeno textu .}
    if znak in velke_pismena then
      begin
        i:=izac;   {.. najdem i = index textu, ktor˜ to je .}
        while prve_velke(i,j)<>znak do i:=i+1;
        zmen(i);
        delay(300);
      end
    else if znak=#0 then                {.. ak je to ¨ipka .}
     case readkey of
      dole : if ivyber<ikon then zmen(ivyber+1)
                            else zmen(izac);
      hore : if ivyber>izac then zmen(ivyber-1)
                            else zmen(ikon);
     end;
           {.. vyberanie kon‡¡ ak Ÿuknem <CR> alebo <ESC>
                          alebo prv‚ p¡smeno textu            .}

  until (znak in velke_pismena) or (znak=#13) or (znak=#27);

    {.. nastav¡ hodnotu funkcie  = 0 ak som si nevybral <ESC>
                            inak = index vybran‚ho textu    .}
  if znak=#27 then vyber:=povodne
              else vyber:=ivyber;
  clrscr;
end;

{[[[[[[[[[[[[[[[[[[[[[[ end menu ]]]]]]]]]]]]]]]]]]]]]]]]]]]]}

{..........     p r ¡ p r a v a     - rozmery obrazovky     .}

procedure priprava;
var i, dr, mo    : integer;
begin
  detectgraph(dr, mo);
  initgraph(dr, mo, cesta_bgi);
  mx:=getmaxx;  my:=getmaxy;
  closegraph;
  textbackground(black);
  clrscr;
  tl:=(mx-3) div 7;
  for i:=0 to 6 do tx[i]:=tl*i+3;
  ty:=my-12;
end;

procedure napis(r:string; c:integer);
var s : string[5];
begin
  str(c,s);
  r:=r+s;
  setfillstyle(emptyfill,white);
  bar(0,my-49,sirka*(length(r)+1),my-39);
  setfillstyle(solidfill,white);
  outtextxy(0,my-49,r);
end;

procedure zobraz_tempo(i:integer; normal:boolean);
begin
  if normal then begin
    setcolor(white);
    outtextxy(tx[i],ty-3,te[i])
  end
  else begin
    bar(tx[i]-2,ty-3,tx[i]+tl,ty+vyska);
    setcolor(black);
    outtextxy(tx[i],ty-3,te[i]);
    setcolor(white);
  end;
end;

procedure zmaz_tempo(i:integer);
begin
  setfillstyle(emptyfill,white);
  bar(tx[i]-2,ty-3,tx[i]+tl,ty+vyska);
  setfillstyle(solidfill,white);
end;

procedure premaz_delay;
var r : string[3];
begin
  str(cakanie:3,r);
  te[1]:=copy(te[1],1,7)+r;
  zmaz_tempo(1);
  zobraz_tempo(1,false);
end;

procedure zmena(z:char);
var  delta,nc : integer;
begin
  z:=upcase(z);
  if z in ['E','D','C','V','K','N',#27,'+','-','='] then
    case z of
                        {.. stop pre vonkaj¨¡ cyklus ..}
      'C' : begin etapy_stop:=true;     cakaj:=false;
                  cyklus_stop:=true;    esc:=false;
                  cyklus_vnutri:=false; temp:=3;
                  krok_stop:=false;
            end;
                        {.. stop pre etapy ..}
      'E' : begin etapy_stop:=true;     cakaj:=false;
                  cyklus_stop:=false;   esc:=false;
                  cyklus_vnutri:=false; temp:=2;
                  krok_stop:=false;
            end;
                        {.. spomaluje Delay     ..}
      'D' : begin etapy_stop:=false;    cakaj:=true;
                  cyklus_stop:=false;   esc:=false;
                  cyklus_vnutri:=false; temp:=1;
                  krok_stop:=false;
            end;
                        {.. stop pre Vnutorn˜ cyklus ..}
      'V' : begin etapy_stop:=true;     cakaj:=false;
                  cyklus_stop:=true;    esc:=false;
                  cyklus_vnutri:=true;  temp:=4;
                  krok_stop:=false;
            end;
                        {.. stop po kroku ..}
      'K' : begin etapy_stop:=true;     cakaj:=false;
                  cyklus_stop:=true;    esc:=false;
                  cyklus_vnutri:=true;  temp:=5;
                  krok_stop:=true;
            end;
                        {.. Nezastavuje be‘¡  ..}
      'N' : begin etapy_stop:=false;    cakaj:=false;
                  cyklus_stop:=false;   esc:=false;
                  cyklus_vnutri:=false; temp:=0;
                  krok_stop:=false;
            end;
                        {.. Esc  ukon‡¡ uk ‘ku ..}
      #27 : begin etapy_stop:=false;    cakaj:=false;
                  cyklus_stop:=false;   esc:=true;
                  cyklus_vnutri:=false; temp:=6;
                  krok_stop:=false;
            end;
      '+','-','='
          : if cakaj then begin
               delta:=cakanie div 10+1;
               if z='-' then begin
                 nc:=cakanie-delta;
                 if nc<0 then nc:=0;
               end
               else begin
                 nc:=cakanie+delta;
                 if nc>500 then nc:=500;
               end;
               if nc<>cakanie then begin
                 cakanie:=nc;
                 premaz_delay;
               end;
            end;
    end;
  if c_tempa<>temp then begin
    zmaz_tempo(c_tempa);
    zmaz_tempo(temp);
    zobraz_tempo(c_tempa,true);
    zobraz_tempo(temp,false);
    c_tempa:=temp;
  end;
end;

{.........  g e n e r u j e   d a t a   p r e  S O R T  .....}

procedure generuj;
var
       vstup : text;
       i     : integer;
begin
  clrscr;
  me:=mx/n;
  if c_sortu=8 then me:=me/3;  {  treesort }
  limit:=my-50;
  if palicky_body=zac_p then
    case c_sortu of
      4,8,9 : begin limit:=limit div 2;
                    limit1:=limit;
              end;
      7 : begin limit:=limit div 3;
                limit1:=limit+20;
          end;
    end;
  case typ_dat-zac_char of                   {.. vzostupne .}
    0 : for i:=1 to n do a[i]:=10+round((limit-10)/n*i);
                                             {..  zostupne .}
    1 : for i:=1 to n do a[n+1-i]:=10+round((limit-10)/n*i);
                                             {..  n hodne  .}
    2 : for i:=1 to n do a[i]:=1+random(limit);
                                            {..  kon¨tanty .}
    3 : for i:=1 to n do a[i]:=limit div 2;
    4 : begin
           write('meno vstupn‚ho s£boru dat : ');
           readln(meno_dat_suboru);
           if meno_dat_suboru='' then
             meno_dat_suboru:='sort.dat';
           assign(vstup,meno_dat_suboru);
           reset(vstup);
           for i:=1 to n do read(vstup,a[i]);
           close(vstup);
         end;
  end;
end;

{.............   zobraz¡  p r v o k  .......................
          alebo aj vyma‘e, keƒ je farba ‡ierna              }

procedure prvok(i:integer; farba:integer);
var poz:integer;
begin
  poz:=round(i*me);
  case palicky_body of
    palica  : begin setcolor(farba);
                    line(poz,limit,poz,limit-a[i]);
              end;
    bodka   : putpixel(poz,limit-a[i],farba);
  end;
end;

procedure palicka(i,farba:integer;hore:boolean);
var is : integer;
begin
  is:=round(abs(i)*me);
  if palicky_body=palica then begin
    setcolor(farba);
    if hore then line(is,limit,is,limit-a[i])
            else line(is,limit1,is,limit1+a[i])
  end
  else putpixel(is,limit-a[i],farba);
end;

{.............    v ˜ m e n a  ..............................}

procedure vymena(i,j:integer);
var  pom : integer;
begin
  bola_vymena:=true;                            {.. vymazaŸ .}
  prvok(i,black); prvok(j,black);
  pom:=a[i]; a[i]:= a[j]; a[j]:=pom;
  if cakaj then delay(cakanie);
  if krok_stop or keypressed then zmena(readkey);
  prvok(i,white); prvok(j,white);       {.. znova nakresliŸ .}
  if cakaj then delay(cakanie);
end;


{===========    I N S E R T  S O R T    =====================}

procedure insertsort;
var  i,j,p : integer;
begin
  for i:=1 to n do prvok(i,white);
  for i:=2 to n do
    if not esc then begin
      if cyklus_stop then zmena(readkey);
      if a[i-1]>a[i] then
        begin
          j:=i; p:=a[i]; a[0]:=p;
          prvok(i,black);
          if krok_stop then zmena(readkey);
          repeat j:=j-1;        prvok(j,black);
                 a[j+1]:=a[j];  prvok(j+1,white);
                 if keypressed or krok_stop then zmena(readkey);
                 if cakaj then delay(cakanie);
          until (a[j-1]<=p) or esc;
          a[j]:=p;              prvok(j,white);
          if krok_stop then zmena(readkey);
    end end;
end;

{==============      B U B B L E S O R T    =================}

procedure bubblesort;
var i,j : integer;
begin
  for i:=1 to n do prvok(i,white);
  for i:= n downto 2 do
    if not esc then begin
      if cyklus_stop then zmena(readkey);
      for j:= 2 to i do
        if not esc then begin
          if a[j-1]>a[j] then vymena(j,j-1);
          if keypressed then zmena(readkey);
        end;
    end;
end;

{=========     S H A K E R S O R T     ======================}

procedure shakersort;
var  j,vmin,vmin_n,vmax,vmax_n : integer;
begin
  for j:=1 to n do prvok(j,white);
  vmax:=n;  vmin:=1;
  repeat
    if not esc then begin
      j:=vmin;
      repeat
        j:=j+1;
        if a[j-1]>a[j] then begin
          vymena(j,j-1);
          vmax_n:=j-1;
        end;
      until j>=vmax;
      vmax:=vmax_n;
      if cyklus_stop then zmena(readkey);
    end;
    if not esc then begin
      j:=vmax+1;
      repeat
        j:=j-1;
        if a[j-1]>a[j] then begin
          vymena(j,j-1);
          vmin_n:=j;
        end;
      until j-1<=vmin;
      vmin:=vmin_n;
    end;
    if etapy_stop or cyklus_stop then zmena(readkey);
  until (vmin>=vmax) or esc;
end;

{==========   S H E L L  S O R T    =========================}

procedure shellsort;
var   k,i : integer;

procedure insert(z,k:integer; hore:boolean);
var  i,j,p : integer;
begin
  i:=z;
  repeat
    i:=i+k;
    if a[i-k]>a[i] then
    if not esc then
      begin
        if cyklus_vnutri then zmena(readkey);
        j:=i; p:=a[i]; a[z-k]:=p;
        palicka(i,black,hore);
        if cakaj then delay(cakanie);
        if krok_stop then zmena(readkey);
        repeat j:=j-k;        palicka(j,black,hore);
               a[j+k]:=a[j];  palicka(j+k,white,hore);
               if cakaj then delay(cakanie);
               if krok_stop or keypressed then zmena(readkey);
        until a[j-k]<=p;
        if cakaj then delay(cakanie);
        if krok_stop then zmena(readkey);
        a[j]:=p;              palicka(j,white,hore);
      end;
  until (i>n-k) or esc;
end;

procedure otoc(i,k:integer; hore:boolean);
var   j : integer;
begin
  j:=i;
  repeat
    palicka(j,black,hore);
    palicka(j,white,not hore);
    j:=j+k;
  until j>n;
end;

{................... telo  S H E L L   ......................}

begin
  for i:=1 to n do palicka(i,white,true);
  k:=1; repeat k:=3*k+1 until k>n div 6;
  repeat
    napis('krok : ',k);
    for i:=1 to k do
      if not esc then begin
        if cyklus_stop then zmena(readkey);
        otoc(i,k,true);
        insert(i,k,false);
        otoc(i,k,false);
    end;
    k:=k div 3;
    if etapy_stop or cyklus_stop then zmena(readkey);
  until (k=1) or esc;
  if not esc then begin
    napis('normalny insertsort krok : ',k);
    insert(1,1,true);
  end
end;

{=====        Q U I C K   S O R T     =======================}

procedure quicksort(zac,kon:integer);
var   i,j,pivot : integer;
begin
  pivot:=(a[zac]+a[kon]) div 2;
  i:=zac-1;  j:=kon+1;
  repeat
    repeat i:=i+1 until a[i]>=pivot;
    repeat j:=j-1 until a[j]<=pivot;
    if cyklus_vnutri then zmena(readkey);
    if i<j then vymena(i,j);

  until (i>=j) or esc;
  if etapy_stop and (kon-zac>20) then zmena(readkey);
  if i=j then begin
    i:=i+1; j:=j-1;
  end;
  if (j>zac) and not esc then quicksort(zac,j);
  if (i<kon) and not esc then quicksort(i,kon);
end;

{=========    D O B O S I E W I C Z   ======================}

procedure dobosiewiczsort;
var j,k : integer;
begin
  for j:=1 to n do prvok(j,white);
  k:=n;
  repeat
    if k>1 then k:=k * 3 div 4; napis('krok : ',k);
    for j:= k+1 to n do
      if not esc then if a[j-k]>a[j] then vymena(j,j-k);
    if cyklus_stop then zmena(readkey);
    if k>1 then k:=k * 3 div 4; napis('krok : ',k);
    bola_vymena:=false;
    for j:= n downto k+1 do
      if not esc then if a[j-k]>a[j] then vymena(j,j-k);
    if etapy_stop or cyklus_stop then zmena(readkey);
  until (k=1) and not bola_vymena or esc;
end;

{============  M E R G E S O R T  - rekurz¡vny ==============}

procedure mergesort;
{---------------------------------------------------------------------------

     uloha : dane pole a[] striedit metodou zlucovania

---------------------------------------------------------------------------}
const hore = true;  dole = false;
      show : boolean = true;
      znak : char = ' ';
var {  p    : array[1..100] of integer;}
      u,i  : integer;


{----------------------vlastne triedenie zlucovanim ----------------------}

  procedure merge(z,k:integer);
  {  striedi dany usek  a[z].....a[k]  metodou rekurzivneho zlucovania :
               1.   rozdeli usek na dve casti
               2.   rozdelene casti zvlast striedi ( rekurzivne )
               3.   zlucenie (merge) utriedenych casti
  }

  var  stred : integer;

{----------------------zlucovanie dvoch casti------------------------------}

  procedure zluc(z1,k1,z2,k2:integer);
  {  zlucuje dve casti : z1..k1
                         z2..k2
     pomocou pomocneho pola p
  }
  var  i,j,k : integer;

{----------------------------------prenes----------------------------------}
    procedure prenes(var co:integer); { prenesie mensi prvok do pola p }
    begin
      a[-k]:=a[co]; palicka(co,black,hore); palicka(-k,white,dole);
      if keypressed or krok_stop then zmena(readkey);
      if cakaj then delay(cakanie);
      co:=co+1;    { zmeny indexov co.. vystupny parameter         }
      k:=k+1;      {               k... globalny v procedure zluc }
    end;
{----------------------------------kopiruj---------------------------------}
    procedure kopiruj(od,po:integer); { kopiruje zvysok do pola p }
    var  i : integer;
    begin
      for i:=od to po do
        begin  a[-k]:=a[i]; palicka(i,black,hore); palicka(-k,white,dole);
               if cakaj then delay(cakanie);
               if keypressed or krok_stop then zmena(readkey);
               k:=k+1;
        end;
    end;
{--------------------------zlucovanie------------------------------------}
  begin
    i:=z1;     { i.. index najmensieho prvku v prvej casti  }
    j:=z2;     { j.. index najmensieho prvku v druhej casti }
    k:=z1;     { k.. index v vysledku                       }
                  {....   cyklus zlucovania   ....}
    repeat
      if a[i]<a[j] then prenes(i)  {  mensi prvok prenesieme do vysledneho }
                   else prenes(j);
    until (i>k1) or (j>k2) or esc;        {  cyklus konci ak jedna z casti konci }
    if (i>k1) and not esc then kopiruj(j,k2)     {  zvysok zkopirujeme do vysledku      }
                          else kopiruj(i,k1);

                   {... zastavuje qoli vykladu ...}
    if etapy_stop and (k2-z1>20) or cyklus_stop then zmena(readkey);
                     {  vysledok z pomocneho pola p penesieme do a[] }
    if not esc then
    for i:=z1 to k2 do
      begin
        if keypressed then zmena(readkey);
        a[i]:=a[-i]; palicka(-i,black,dole); palicka(i,white,hore);
      end;
  end;

{----------------------------merge----------------------------------------}

  begin
    u:=u+1;     { u.. uroven rekurzie}
    if (z<k) and not esc then   {.. ak ma pole aspon dva prvky => rozdelime }
      begin
        setcolor(white);      { vodorovnou useckou znazornime uroven rekurzie }
        line(round(z*me),limit+5+u,round(k*me),limit+5+u);
        stred:=(z+k) div 2;            {.. stred pola  }
        if not esc then merge(z,stred);                {.. striedenie 1.casti  }
        if not esc then merge(stred+1,k);              {.. striedenie 2.casti  }
        if not esc then zluc(z,stred,stred+1,k);       {.. zlucenie dvoch casti   }
        setcolor(black);
        line(round(z*me),limit+5+u,round(k*me),limit+5+u);
                              { vymazeme usecku }
      end;
    u:=u-1;
  end;

{--------------- telo  m e r g r e s o r t   rekurz¡vne-------}

begin


  u:=0;  znak:=' ';
  for i:=1 to n do palicka(i,white,hore);
  merge(1,n);
end;

{================  T R E E  S O R T  ========================}

procedure treesort;
var i,p,zarazka : integer;

procedure obsad(i:integer);
var   s1 : integer;
begin
  s1:=2*i;
  if s1<2*n then
    if a[s1]>a[s1+1] then s1:=s1+1;
  a[i]:=a[s1];
  if a[i]<zarazka then palicka(i,white,false);
  if cakaj then delay(cakanie);
  if keypressed or krok_stop then zmena(readkey);
  palicka(s1,black,false);
  if (s1<n) and (a[i]<zarazka) then obsad(s1)
  else
    begin
      a[s1]:=zarazka;
    end;
end;

begin
  zarazka:=limit+1;
  for i:=2*n-1 downto n do  begin a[i]:=a[i+1-n];
                                  palicka(i,white,true);
                                  if keypressed then zmena(readkey);
                            end;
  for i:=n to 2*n-1 do
  if not esc then
      begin
        palicka(i,black,true);
        if keypressed then zmena(readkey);
        palicka(i,white,false);
      end;
  for i:=n-1 downto 1 do  if not esc then obsad(i);
  if etapy_stop then zmena(readkey);
  for i:=2*n to 3*n-1 do
   if not esc then
    begin
      a[i]:=a[1];
      palicka(1,black,false);
      palicka(i,white,true);
      obsad(1);
    end;
end;


{==================   H E A P  S O R T   ==================}

procedure heapsort;
var i,p : integer;

procedure vymena(i,j:integer;penzia:boolean);
var p : integer;
begin
  palicka(i,black,false);
  palicka(j,black,false);
  p:=a[i]; a[i]:=a[j]; a[j]:=p;
  if cakaj then delay(cakanie);
  if keypressed or krok_stop then zmena(readkey);
  palicka(i,white,false);
  if penzia then palicka(j,white,true)
            else palicka(j,white,false);
end;

procedure halda(i,dlzka:integer);
var o,s1 : integer;
begin
  o:=i;
  s1:=2*o;
  if s1<=dlzka then
    begin
      if s1<dlzka then
        if a[s1]<a[s1+1] then s1:=s1+1;
      if cakaj then delay(cakanie);
      if keypressed or krok_stop then zmena(readkey);
      if a[o]<a[s1] then
        begin
          vymena(o,s1,false); halda(s1,dlzka);
        end;
    end;
end;

begin
  for i:=1 to n do palicka(i,white,true);
  for i:=n downto n div 2+1 do
   if not esc then
      begin
        if cakaj then delay(cakanie);
        palicka(i,black,true);
        if keypressed then zmena(readkey);
        palicka(i,white,false);
      end;
  if etapy_stop then zmena(readkey);
  if not esc then
    for i:=n div 2 downto 1 do
     if not esc then
      begin
        palicka(i,black,true);
        palicka(i,white,false);
        if keypressed then zmena(readkey);
        halda(i,n);
      end;
  if etapy_stop then zmena(readkey);
  for i:=n downto 2 do
   if not esc then
    begin
      vymena(1,i,true);
      if keypressed then zmena(readkey);
      halda(1,i-1);
    end;
  palicka(1,black,false);
  palicka(1,white,true);
end;

{==============      M A X S O R T          =================}

procedure maxsort;
var i,j,max : integer;
begin
  for i:=1 to n do prvok(i,white);
  for i:= n downto 2 do
    if not esc then begin
      if cyklus_stop then zmena(readkey);
      max:=1;
      for j:= 2 to i do
        if not esc then begin
          if a[j]>a[max] then max:=j;
          if cakaj then delay(cakanie);
          if keypressed then zmena(readkey);
        end;
      if not esc then vymena(max,i);
    end;
end;



{======        v y v o l   v a n i e  S O R T O V      ======}
{======                                                ======}

procedure sortuj;
var  i                : integer;
     s,s1,sh,sm,ss    : string;
     hod,min,sek,s100 : word;
     stare_tempo      : char;
begin
  generuj;                                {...  zobrazenie ..}
  detectgraph(p1,p2);
  initgraph(p1,p2,cesta_bgi);
  s:=t[c_sortu];     sh:='';
  for i:=1 to length(s) do sh:=sh+upcase(s[i])+' ';
  str(n,s1);
  settextstyle(triplexfont,horizdir,1);
  outtextxy(0,my-40,'n : '+s1+'           '+sh);
  settextstyle(smallfont,horizdir,5);
  c_tempa:=tempo-zac_t;
  for i:=0 to 6 do zobraz_tempo(i,i<>c_tempa);
  zmena(t[tempo,4]);
  settextstyle(smallfont,horizdir,05);
  settime(0,0,0,0);
                                      {.. t r i e d e n i e .}
  case c_sortu of
    1 : insertsort;
    2 : Bubblesort;
    3 : Shakersort;
    4 : shellsort;
    5 : begin for i:=1 to n do prvok(i,white);
              Quicksort(1,n);
        end;
    6 : dobosiewiczsort;
    7 : mergesort;
    8 : treesort;
    9 : heapsort;
   10 : maxsort;
  end;
                                   {.. prij¡mame gratul cie .}
  gettime(hod,min,sek,s100);
  for i:=0 to 6 do zmaz_tempo(i);
  setcolor(white);
  str(hod,sh);   str(min,sm);
  str(sek+s100/100:1:2,ss);
  outtextxy(0,my-15,'cas :  '+sh+':'+sm+':'+ss+'                    press  <Esc>  ');

  repeat until readkey=#27;
  closegraph;
end;

{==========                                       ==========}
{==========        h l a v n ˜  p r o g r a m     ==========}
{==========                                       ==========}

begin

  priprava;

  repeat
                   { ====   h l a v n ‚   m e n u   ==== }

    cislo_submenu:=vyber(zac_main,kon_main,cislo_submenu);

    case cislo_submenu-zac_main+1 of
                               {.. tempo uk ‘ky ..}
       1 : begin tempo:=vyber(zac_t,kon_t,tempo);
                 if tempo=tempo_spomal then begin
                   spomalenie:=vyber(zac_d,kon_d,spomalenie);
                   cakanie:=parameter(t[spomalenie]);
                   str(cakanie:3,r3);
                   te[1]:=copy(te[1],1,7)+r3;
                 end;
           end;
                               {.. nastavujem algoritmus .}
       2 : c_sortu:=vyber(zac_a,kon_a,c_sortu);

       3 : begin               {.. nastavujem rozsah dat .}
             rozsah:=vyber(zac_r,kon_r,rozsah);
             n:=parameter(t[rozsah]);
           end;                     {.. charakter vstupu .}
       4 : typ_dat:=vyber(zac_char,kon_char,typ_dat);
                                   {.. sp“sob vykreslenia .}
       5 : palicky_body:=vyber(zac_p,kon_p,palicky_body);

       6 : sortuj;                          {.. triedenie .}

     0,7 : halt;                       { Quit = ukon‡enie .}

    end;

  until false;
end.