program nim; uses crt;
Type Throm=array[1..10] of integer;
var Msir,MaxHrom,poc,a,b:integer;
 sez:Throm;
 konec:boolean;

procedure writeh(sez:Throm);
begin
  for a:= 1 to maxHrom do write (sez[a],',');
  writeln;
end;

function hrajP(sez:Throm):boolean;
var a,b:integer;
begin
   hrajP:=false;
   a:= 1;
   while (a<=maxHrom) do
   begin
     if (sez[a]-1)>0 then
     for b:= 1 to sez[a]-1 do
       begin
       sez[a]:=sez[a]-b;
       if not hrajP(sez) then
         begin
           hrajP:=true;      {kombinace je pro protihrace prohrana}
           a:=maxhrom+1;     {prerusit while}
           break;            {prerusit for  }
         end;
       sez[a]:=sez[a]+b;
       end;
     inc(a);
   end;
end;

function hrajPoc(sez:Throm; var sez1:Throm):boolean;
var psez:Throm;
    kolik,odkud,a,b:integer;
begin
 hrajPoc:=true;
 sez1:=sez;
 for a:=1 to maxHrom do
  if (sez[a] mod (Msir+1))= 0 then psez[a]:=MSir +1  {dle vety mohu pouzit MOD }
  else psez[a]:=sez[a] mod (Msir+1);
 writeln('ja princezna matfyzacka jsem na rade,na stole lezi tyto hromadky: ');
 writeh(Sez);
 a:=1;kolik:=0;
 while a<=maxHrom do
  begin
   if psez[a]>1 then         {vybira hromadky s alespon 2ma sirkami}
    for b:= 1 to psez[a]-1 do {zkousi odebrat vsechny mozne kombinace}
    begin
    psez[a]:=psez[a]-b;
    if not hrajP(psez) then begin   {co na to protihrac ???}
      odkud:=a;
      kolik:=b;
      sez1[a]:=sez1[a]-b;        {odebrani}
      a:=maxHrom+1;              {preruseni while}
      break;                     {prerus for}
    end;
    psez[a]:=psez[a]+b;
    end;
  a:=a+1;
  end;

  if kolik>0 then
    writeln('beru ',kolik,' sirek z hromadky cislo ',odkud)
  else begin
   b:=1;
   for a:=2 to maxHrom do if sez1[a]>sez1[b] then b:=a; {nejvetsi hromada}
   if sez1[b]=1 then begin
     konec:=true; writeln('prohral jsem... beru posledni sirku z 1. hromady');
     hrajPoc:=false;
   end
   else begin
     writeln('prohravam !!!!!!,beru jednu sirku z hromadky cislo ',b);
     sez1[b]:=sez1[b]-1;
   end;
  end;
end;

function HrajC(Sez:Throm; var Sez1:Throm):boolean;
var Hr,Vzal:integer;
begin
 writeh(Sez);
 writeln('Z jake hromadky budes brat ? ');
 read(Hr);
 writeln('kolik sirek vezmes ?');
 read(Vzal);
 if (Vzal<1) or (Vzal>Msir) or (Hr>maxHrom) or (Hr<1) or (vzal>sez[Hr]) then
    writeln('svindlujes... !!!!');
 sez1:=sez; sez1[Hr]:=sez1[Hr]- Vzal;
 if sez1[Hr]=0 then begin
   writeln('S radosti Ti princi oznamuji , ze jsi prohral.....');
   Konec:=true;
   hrajC:=false;
 end
 else hrajC:=true;
end;


procedure hraj;
var sez1,sez2:Throm;
begin
write('hra zacina: ');writeh(sez);

while not Konec do
 if hrajC(Sez,sez1) then
 if hrajPoc(Sez1,Sez2) then Sez:=Sez2;
end;

begin
     clrscr;
     writeln('pojd,zahrajeme si sirky... ');
     writeln(' Kdo odebere posledni sirku z nejake hromadky prohral ! ');
     writeln(' zadej pocet hromadek');
     read(maxHrom);
     writeln('zadej mi pocatecni pocet sirek na kazde hromadce :');
     read(Poc);
     writeln('To bychom meli, a ted zakladni pravidla.');
     writeln('Kolik sirek se smi nejvic odebrat z jedne hromadky ?');
     read(MSir);
     for a:=1 to maxHrom do Sez[a]:=Poc;
     hraj;
end.