program SystemPavouk;
uses crt;

const zavodniku_max = 100;

type dat = record
     stc : integer;
     jmeno: string;
     souperi : array [1..27] of integer;
     pavouk : array [1..9] of integer;
     nahoda : real;
end;

var data : array [1..100] of dat;
    poradi: array [1..100] of integer;
    start: array [1..100] of integer;

    zavodniku,
    pavouku,
    nejvetsi_kolo,
    max_shoda : integer;

procedure init_data;
{##################}
var I, J: integer;

begin
  for I:=1 to zavodniku_max do
    with data[I] do
      begin
        for J:=1 to 27 do
          souperi[J]:=0;
        for J:=1 to 9 do
          pavouk[J]:=0;
        stc:=I;
        jmeno:='Jmeno';
        nahoda:=RANDOM(1);
     end;
end; {procedure init_data}

function losovani_kola(kolo:integer):integer;
{############################################}
var prvni, pozice, zarazka, i, j : integer;
    konec : boolean;
    s, kontrola_od,kontrola_do,shoda : integer;

    function nejblizsi_volny:integer;
    {********************************}
    var p: integer;
    begin
      p:=pozice;
      repeat
        inc(p);
        if p>zavodniku then p:=1;
        if p=zarazka then konec:=true;
      until (start[p]=0) or (p=pozice) or konec;
      nejblizsi_volny:=p;
    end; {function nejblizsi_volny}

    function kontrola_shody(kdo,skym:integer):integer;
    {************************************************}
    var i,st: integer;
    begin
      st:=0;
      if kolo>1 then
        for i:=1 to 1+(kolo-2)*1 do
          if data[kdo].souperi[i]=skym then
            inc(st);
      kontrola_shody:=st;
    end; {function kontrola_shody}

    procedure zarad_soupere(odk,dok:integer);
    {***************************************}
    var i,j,k:integer;
    begin
      for i:=odk to dok do
        begin
          k:=1+(kolo-1)*1;
          for j:=odk to dok do
            if i<>j then
              begin
                data[poradi[i]].souperi[k]:=poradi[j];
                inc(k);
              end;
        end;
    end; {procedure zarad_soupere}

begin {function losovani_kola}
  if kolo>nejvetsi_kolo then
    max_shoda:=1;
  losovani_kola:=1; {losovani probehlo uspesne}
  for I:=1 to zavodniku_max do
  begin
    start[I]:=0;
    poradi[i]:=0;
  end;
  prvni:=(1+(kolo-1)*2);
  while prvni>zavodniku do
    prvni:=prvni-zavodniku;
  pozice:=prvni;
  zarazka:=prvni;
  i:=1;
  poradi[i]:=prvni;
  start[pozice]:=1;
  inc(i);
  while (i<zavodniku+1) and (i>1) do
    begin
      konec:=false;
      kontrola_od:=i-((i-1) mod 2);
      kontrola_do:=i;
      repeat
        s:=nejblizsi_volny; {nejblizsi v danem kole nezarazeny
                            hrac pocinaje za hodnotou pozice}
        shoda:=0;
        for j:=kontrola_od to kontrola_do-1 do
          shoda:=shoda+kontrola_shody(s,poradi[j]);
          {hrac S hral s hracem cislo pozice[j]? ano=1, ne=0}
        pozice:=s;
      until (shoda<=max_shoda) or konec;
      if konec then {nelze najit vhodny na teto urovni}
        begin
          dec(i);
          if i>0 then begin
            pozice:=poradi[i]; {vytazeni ukazovatka}
            if i=1 then
              zarazka:=prvni
            else
              zarazka:=poradi[i-1];
            poradi[i]:=0; {vyrazeni z poradi}
            for j:=1+(kolo-1)*1 to kolo*1 do {zruseni souperu}
              data[pozice].souperi[j]:=0;
            start[pozice]:=0; {zruseno zarazeni}
          end;
        end
      else
        begin
          poradi[i]:=s; {hrac do poradi}
          start[s]:=1; {hrac zarazen}
          if i mod 2 = 0 then {ukoncena ctverice}
            zarad_soupere(i-1,i); {zarazeni souperu}
          inc(i); {dalsi pozice}
          pozice:=s;
          zarazka:=s;
        end;
    end;
    if i<2 then {nepodarilo se vytvorit kolo}
      begin
        writeln;
        writeln('nelze seradit kolo:',kolo:3);
        losovani_kola:=0;
      end
    else
      begin {kolo serazeno spravne}
        j:=1;
        for i:=1 to zavodniku do
          begin
            data[poradi[i]].pavouk[kolo]:=j;
            inc(j);
          end;
      end;
end; {procedure_losovani kola}


var f:text;
    u,kl:integer;

begin {program pavouk}
  textmode(C80 + Font8x8);
  init_data;
  zavodniku:=16; {pocet zavodniku}
  nejvetsi_kolo:=9; {max. pocet pavouku}
  pavouku:=4;
  if pavouku>9 then pavouku:=9;
  max_shoda:=0;
  writeln('System PAVOUK pro ',zavodniku,' zavodniku, boju : ',pavouku);
  for kl:=1 to pavouku do
    if losovani_kola(kl)=1 then
      begin
        writeln('rozlosovani boje ',kl:2);
        for u:=1 to zavodniku do
          write(poradi[u]:3);
        writeln('');
      end
    else
      begin
        writeln('nelze rozlosovat kolo ',kl:2);
        kl:=pavouku;
      end;
  writeln('');
  writeln('Informace o zavodnicich a jejich souperich');
  writeln('');
  writeln('Zavod  kola:');
  write(' nik   ');
  for u:=1 to pavouku do
    write(u:3);
  writeln; writeln;
  for u:=1 to zavodniku do
    with data[u] do
      begin
        write(u:3,' -> ');
        for kl:=1 to pavouku*3 do
          if (souperi[kl]<>0) then write(souperi[kl]:3);
        write(' souboj c. :');
        for kl:=1 to pavouku do
          write(pavouk[kl]:3);
        writeln('');
      end;
  writeln('');
end. {program pavouk}