program chinczyk;
 
  var ii,ij,kostka, ilugraczy: integer;
  var tab: arrayof arrayof integer;
  var gracz: arrayof coroutine;

unit gracz1:coroutine;
var i:integer;
    
begin
 return;
 do
  call A.gdziepiony; 
  i:=0;
  call A.przesunpion(0);
  detach;
od;
end gracz1;




  
unit gracz2:coroutine;
var witch:integer;    
begin
 return;
 do
  call A.gdziepiony; 
      witch:=0;
  call A.przesunpion(witch);
  detach;
od;
end gracz2;
  
unit gracz3:coroutine;
const g=3;                                    (* number of player *)
const eh=20;                                  (* finish *)
const spp=21;                                 (* start *)

var stran                         :arrayof integer;
var pp,i,leader,nrkil,nrhun,witch :integer;
var home                          :arrayof boolean;

unit man:class;               (* pawn *)
 var ple,saf,rsa     :integer;
 var kil,hun,fin,mov :boolean;
end man;

var pawn                         :arrayof man;
unit poleposition:function:boolean;
 var h,i:integer;
 begin
  pp:=0;
  result:=true;
  for i:=1 to 4 do
    home(i):=false;
  od;
  for i:=1 to 4 do
    h:=tab(g,i);  
    if h=0 then pp:=pp+1 fi;
    if h=spp then result:=false fi;
    if h>100 then home(h-100):=true fi;
  od;
  if pp=0 then result:=false fi;
end poleposition;      

unit pawns:procedure;
var i:integer;
 begin
  for i:=1 to 4 do
    pawn(i).ple:=tab(g,i);
  od;
end pawns;    
 
unit finish:function:integer;
 var i:integer;
  unit inhome:function(a:integer):boolean;
   begin
     result:=false;
     if a>1 andif a<=eh andif a+kostka>eh then
       if a+kostka-eh<5 andif not home(a+kostka-eh) then
         result:=true;
         pawn(i).mov:=true;
       else
         pawn(i).mov:=false;  
       fi;
     else
       pawn(i).mov:=true;  
     fi;
  end inhome;        
  begin
     result:=0;
     for i:=1 to 4 do
       pawn(i).fin:=false;
       if pawn(i).ple>0 andif pawn(i).ple<99 then
         if inhome(pawn(i).ple) then
           result:=result+1;
           pawn(i).fin:=true;
         fi
       else
         pawn(i).mov:=false;
       fi;
     od;
end finish;

unit killer:function:integer;
  var i,j,k:integer;
  begin
    for i:=1 to 4 do
      pawn(i).kil:=false;
      for j:=1 to 3 do
        k:=(i+j) mod 4;
        if k=0 then k:=4 fi;
        if pawn(i).ple+kostka=pawn(k).ple andif pawn(i).ple=/=0 then
          pawn(i).kil:=true;
        fi
      od
    od
end killer;

unit hunter:function:integer;
 var i,j:integer;
  begin
  for i:=1 to 4 do
   if pawn(i).ple=/=0 then
     j:=member(pawn(i).ple+kostka,stran);
     if pawn(i).ple+kostka=stran(j) then
        pawn(i).hun:=true;
        result:=result+1;
     else
        pawn(i).hun:=false;
     fi
   fi
 od
end hunter;

unit strangers:procedure;
var i,j,k:integer;
 begin
   k:=1; 
   for i:=1 to 4 do
     if i=/=g then
       for j:=1 to 4 do
         if i>ilugraczy then stran(k):=0;
         else  stran(k):=tab(i,j);
         fi;
         k:=k+1;
       od;
     fi
   od;
   stran(13):=200;
   j:=12;
   while j>1 do
     i:=1;
     while i<j do
       if stran(i)>stran(i+1) then
         k:=stran(i);
         stran(i):=stran(i+1);
         stran(i+1):=k;
       fi;
       i:=i+1;
     od;
     j:=j-1;
   od;
end strangers;   

unit member:function(a:integer,arra:arrayof integer):integer;
var i:integer;
 begin
  if a<99 then a:=(a+40)mod 40 fi;
  if a=0 then a:=40 fi;
  if a>arra(1) andif a<arra(13) then
   i:=1;
   while a>arra(i) do
     i:=i+1;
   od;
   result:=i;
  else if a<arra(1) then result:=1;
       else result:=12 fi
  fi;        
end member;


unit safety:procedure;
 var i:integer;
   unit rafset:function(k:integer):integer;
    var p,q:integer;
    begin
      p:=member(k,stran);
      q:=member(k-6,stran);
      result:=0;
      if p>q then result:=p-q
      else
        if p=q then result:=0
        else
          while stran(q)<99 do
            q:=q+1;
            result:=result+1;
            if q=13 then exit fi;
          od;
          q:=1;
          while stran(q)=0 do
            q:=q+1;
          od;
          result:=result+p-q;
        fi;  
      fi;
   end rafset;
 begin
   for i:=1 to 4 do
     if pawn(i).ple>0 andif pawn(i).ple<99 then
       pawn(i).saf:=rafset(pawn(i).ple);
       pawn(i).rsa:=pawn(i).saf-rafset(pawn(i).ple+kostka);
     else
       pawn(i).saf:=6;
       pawn(i).rsa:=-12;  
     fi;
   od;
end safety;    
                                            
unit move:procedure;
 var i,j:integer;
 var speed:boolean;
 var moves:arrayof boolean;
  begin
  j:=-12;
  if leader>0 then
    for i:=1 to 4 do
      if pawn(i).fin then
        if pawn(i).rsa>j then    
          witch:=i;
          j:=pawn(i).rsa
        fi
      fi
    od;
  else 
    speed:=true;
    array moves dim(1:4);
    for i:=1 to 4 do
      moves(i):=false;
      if not pawn(i).kil andif pawn(i).hun then
        moves(i):=true;
        speed:=false;
      fi
    od;
    for i:=1 to 4 do
     if not pawn(i).kil andif pawn(i).ple>0 andif pawn(i).mov then
       if speed orif moves(i) then
         if pawn(i).rsa>j then    
           witch:=i;
           j:=pawn(i).rsa
         fi
       fi
     fi
    od;
    kill (moves);
  fi;  
end move;
    
begin
 array pawn dim(1:4);
 array home dim(1:4);
 array stran dim(1:13);
 for i:=1 to 4 do
   pawn(i):=new man;
 od;
 return;
 do
  call A.gdziepiony; 
  call pawns;
  call strangers;
  if poleposition and kostka=6 then
    i:=1;
    while tab(g,i)=/=0 do
      i:=i+1;
    od;
    witch:=i;
  else
    leader:=finish;
    nrkil:=killer;
    if nrkil=4-pp then
      witch:=0;
    else
      nrhun:=hunter;
      call safety;
      call move;
    fi;
  fi;
  call A.przesunpion(witch);
  detach;
od;
end gracz3;
(*44444**************** gracz 4 **********)


unit gracz4: coroutine;
const g=4;
const start=31;
const endpos=30;

var players : arrayof boy; 

unit boy:class;
  var pos,back : integer;
  var suicide,stab,finish,moveout : boolean;
end boy;

unit playerinit:procedure;
var i:integer;
 begin
  for i:=1 to 4 do
    players(i).pos:=tab(g,i);
  od;
end playerinit;

unit finishing:function(nr:integer):boolean;
 var i,j:integer;
 begin
   result:=false;
   i:=players(nr).pos;
   if i<>0 
   then 
     if i+kostka>endpos and i+kostka<endpos+5 and i<=endpos
     then 
       result:=true;
       for j:=1 to 4
       do 
         if j <> nr 
         then
           if (players(j).pos-100+1)=i+kostka-endpos
           then result:=false;
           fi;
         fi;
       od;
     fi;
   fi;
end finishing;
 
unit suiciding:function(nr:integer):boolean;
 var i:integer;
 begin
  result:=false;
  if players(nr).pos<>0
  then 
   for i:=1 to 4 
   do
     if nr<>i 
     then
         if (players(nr).pos+kostka-1) mod 40 + 1 = players(i).pos 
    andif players(i).pos<100
         then 
           result:=true;
           exit;
    fi;
     fi;
   od
  else
   for i:= 1 to 4
   do
     if i<>nr andif players(i).pos=start
     then result:=true;
     exit;
     fi;
   od;
  fi;
end suiciding;
 
unit stabing:function(nr:integer):boolean;
 var i,j:integer;
 var b1,b2:boolean;
 begin
  result:=false;
   for i:=1 to 4
   do
     if i<>g 
     then
       for j:= 1 to 4
       do
         if players(nr).pos > 0 and players(nr).pos <100
         then
           b1:=(players(nr).pos+kostka-1) mod 40 +1 =tab(i,j) ;
           b2:=players(nr).pos>=start and b1;
           if b1 and (players(nr).pos+kostka-1) mod 40 + 1<=endpos orif b2 
           then
             result:=true;
             exit exit;
           fi
         else
         result:=(kostka=6 and players(nr).pos=0 and tab(i,j)=start);
         exit exit;
         fi;
       od;
     fi;
   od;
end stabing;  

unit atback:function(nr:integer):integer;
 var i,j,np:integer;
 begin
  np:=players(nr).pos;
  result:=0;
  if np<>0
  then 
   if np < 7 
   then
     for i:=1 to 4 
     do 
       if i<>g 
       then 
         for j:=1 to 4
         do
           if (tab(i,j) < np)
           then
               if tab(i,j)>0
               then result:=result+1;
               fi
           else 
             if tab(i,j) > 40-(6-np)
             then result:=result+1;
             fi;
           fi;
         od;
       fi;
     od;
   else
     for i:=1 to 4
     do
       if i<>g
       then
         for j:=1 to 4
    do
      if tab(i,j) < np
      andif tab(i,j) > np-7
      then result:=result +1;
      fi;
    od;
       fi;
     od;                
   fi;
  fi;
 end atback;
 
 unit begining : function(nr:integer):boolean;
  begin
    result:=players(nr).pos=0 and kostka=6;
  end begining;
  
 unit move:function:integer;
  var i,j,k : integer;
  var ok:boolean;
  begin
   for i:= 1 to 4
   do
     players(i).back:=atback(i);
     players(i).suicide:=suiciding(i);
     players(i).stab:=stabing(i);
     players(i).finish:=finishing(i);
     players(i).moveout:=begining(i);
   od;
   ok:=false;
   (********************* bije i wychodzi ************)
   for i:=1 to 4
   do 
     if players(i).moveout 
     then
       for j:=1 to 4
       do
         if g<>j 
    then
           for k:=1 to 4 
           do
        if tab(j,k)=start
        then 
          result:=i;
          ok:=true; exit exit exit;
        fi;
      od;
    fi;
       od;
     fi;
   od;
   (******************** gonia go i konczy **************)
  if not ok 
  then 
   for i:=1 to 4
   do
     if players(i).pos>0
     andif players(i).pos<100
     andif players(i).finish 
     andif players(i).back > 0
     then
       result:=i;
       ok:=true; exit;
     fi;
   od;
  fi;
   (******************** gonia go i bije ******************)
  if not ok 
  then
   for i:=1 to 4
   do
     if players(i).pos<100
     andif players(i).back>0
     andif players(i).stab
     then
       result:=i;
       ok:=true; exit;
     fi;
   od;
  fi;
   (******************* bije ********************************)
  if not ok 
  then   
   for i:=1 to 4
   do
     if players(i).stab
     then
       result:=i;
       ok:=true; exit;
     fi;
   od;
  fi;
   (******************** goni go conajmniej dwoch **********)
  if not ok 
  then
   for i:=1 to 4
   do
     if players(i).pos<100
     andif players(i).back>=2
     andif not players(i).suicide
     then
       result:=i;
       ok:=true; exit;
     fi;
   od;
  fi;
   (******************* wychodzi ****************************)
  if not ok 
  then
   for i:=1 to 4
   do
     if players(i).moveout
     andif not players(i).suicide
     then
       result:=i;
       ok:=true; exit;
     fi;
   od;
  fi;
   
   (******************* konczy *******************************)
  if not ok 
  then
   for i:=1 to 4
   do
     if players(i).finish
     then
       result:=i;
       ok:=true; exit;
     fi;
   od;
  fi;

   (******************** gonia go **********)
  if not ok 
  then
   for i:=1 to 4
   do
     if players(i).pos<100
     andif players(i).pos>0
     andif players(i).back>0
     andif not players(i).suicide
     then
       result:=i;
       ok:=true; exit;
     fi;
   od;
  fi;   
   (******************* nie bije swojego *********************)
  if not ok 
  then
   for i:=4 downto 1
   do
     if players(i).pos<100
     andif players(i).pos>0
     andif not players(i).suicide
     then
       result:=i;
       ok:=true; exit;
     fi;
   od;
  fi;
   (******************* bije swojego *********************)
  if not ok 
  then
   for i:=1 to 4
   do
     if players(i).suicide
     then
       result := 0 ;
       ok:=true; exit;
     fi;
   od;
  fi;
  
  
  if not ok then result:=0 fi; 


 end move;
  

 
 
 
 
 (****** MAIN *****)
 (*****************)
var aa:char;

  unit inchar : IIuwgraph function : integer;
    (*podaj nr znaku przeslanego z klawiatury *)
    var i : integer;
  begin
    do
      i := inkey;
      if i <> 0 then exit fi;
    od;
    result := i;
  end inchar;
 
 var i,m:integer;
 begin
  array players dim(1:4);
  for i:=1 to 4 
  do
    players(i):=new boy;
  od;
  return;
  do
    call playerinit;
    m:=move;
    call A.przesunpion(m);
    
   writeln("back,suic,stab,fin,out:");
   for i:= 1 to 4
   do

    write(players(i).back," ");
    if  players(i).suicide then write("1") else write("0") fi;
    write(" ");
    if     players(i).stab then write("1") else write("0") fi;
        write(" ");
    if     players(i).finish then write("1") else write("0") fi;
        write(" ");
    if     players(i).moveout then write("1") else write("0") fi;
        write(",");
   od;
   writeln("  ->",m);
   pref iiuwgraph block 

     var i:integer;
     begin
     i:=inchar;
     end;
   
    detach;
  od;
end gracz4;

  
  unit arbiter: coroutine;

  hidden plansza, ilegr, i, j, oczka, ktory, sk, polozenie, dom, gracze;
  hidden wejscie, polestartu, skonczyli, sem, zakonczenie;
  var plansza: arrayof pion;
  var ilegr, i, j, oczka, ktory, sk: integer;
  var polozenie, dom: arrayof arrayof integer;
  var gracze: arrayof coroutine;
  var wejscie: arrayof integer;
  var polestartu, skonczyli: arrayof integer;
  var sem: boolean;
  var zakonczenie: char;
  
  
  unit rzut: function: integer;
    
    var pom: real;
    
  begin
    pom:=random;
    pom:=6*pom;
    result:= entier(pom)+1
  end rzut;
  
  
  unit pion: class (czyj, jaki: integer);
  end pion;
  unit gdziepiony: procedure;
    var i, j: integer;
  begin
    for i:=1 to ilegr
    do
      for j:=1 to 4
      do
        tab(i,j):=polozenie(i,j)
      od
    od 
  end gdziepiony;
  
  
  unit przesunpion: procedure (co: integer);
  
    var s, g, t: integer;
    
    unit start: procedure;
    begin
      if oczka=/=6 then return fi;
      g:=polestartu (ktory);
      polozenie (ktory, co):=g;
      if plansza (g) =/= none
      then call bicie
      fi;
      plansza (g):=new pion (ktory, co)
    end start;
    
    unit bicie: procedure;
    begin
      polozenie (plansza(g).czyj, plansza(g).jaki):=0;
      kill (plansza(g))
    end bicie;
    
  begin     (*  przesunpion  *)
    if not sem 
    then
      return
    else
      sem:=false
    fi;
    if co=0 then return fi;
    s:=polozenie (ktory, co);
    if s > 100
    then     (*  pion w domu  *)
      return
    fi;
    if s=0 
    then
      call start;
      return
    fi;
    g:=s+oczka;
    if ( s <= wejscie(ktory)  and  g > wejscie(ktory) )
    then     (*  wejscie do domu  *)
      t:= oczka-(wejscie(ktory)-s);
      if t>4 then return fi;
      if dom (ktory,t) = 0
      then
        dom (ktory,t) := co;
        polozenie (ktory,co) :=100+t;
        kill (plansza(s))
      else
        return
      fi
    else
      if g>40 then g:=g-40 fi;
      if plansza(g)=/=none
      then call bicie
      fi;
      plansza(g):=plansza(s);
      plansza(s):=none;
      polozenie (ktory,co):=g
    fi
  end przesunpion;
  
  unit skonczyl: function: boolean;
    var i: integer;
  begin  
    for i:=1 to sk
    do
      if  skonczyli(i)=ktory
      then
        result:=true;
        exit
      fi
    od
  end skonczyl;
      
  
  unit koniec: function: boolean;
    var i: integer;
    var doszedl: boolean;
  begin
    doszedl:=true;
    for i:=1 to 4
    do
      if dom(ktory,i)=0
      then
        doszedl:=false;
      exit
      fi
    od;
    if doszedl
    then
      sk:=sk+1;
      skonczyli(sk):=ktory
    fi;
    result:= sk=ilegr
  end koniec;     
  
  unit komunikat: procedure;
    var i: integer;
  begin
    writeln;
    for i:=1 to ilegr
    do
      writeln (i:1," miejsce zajal gracz ",skonczyli(i):1)
    od
  end komunikat;

  
begin     (*  arbiter  *)
  ilegr:=ilugraczy;
  if ilegr=0 then call endrun fi;
  array polozenie dim (1:ilegr);
  array tab dim (1:ilegr);
  array dom dim (1:ilegr);
  array plansza dim (1:40);
  array skonczyli dim (1:ilegr);
  array gracze dim (1:ilegr);
  gracze:=copy(gracz);  
  for i:=1 to ilegr
  do
    array dom(i) dim (1:4);  
    array polozenie(i) dim (1:4);
    array tab(i) dim (1:4)
  od;
  array wejscie dim (1:ilegr);
  array polestartu dim (1:ilegr);
  for i:=1 to ilegr
  do
    polestartu(i):=10*(i-1)+1;
    wejscie(i):=polestartu(i)-1
  od;
  wejscie(1):=40;
  
  return;
for ii:=1 to 4 do
 for ij:=1 to 4 do 
  write(tab(ii,ij):4) 
 od;
 writeln;
od;
  ktory:=4;
  do
    if ktory=3 then ktory:=4
    else ktory:=3;
    fi;
    if skonczyl
    then repeat
    fi;
    do
      kostka, oczka:=rzut;
      sem:=true;

writeln ("            kostka   :" ,oczka,"   ktory    :",ktory);     
for ii:=3 to 4 do
 for ij:=1 to 4 do 
  write(tab(ii,ij):4) 
 od;
 writeln;
od;
      attach (gracze(ktory));
      if koniec then exit exit fi;
      if oczka=/=6 or skonczyl then exit fi;
    od;
  od;
  call komunikat;
  read (zakonczenie);
  call endrun
end arbiter;

  var A: arbiter;    
  
  
(*          *           *            *                *             *)         
 
 
   
  
begin     (*  program glowny  *)
ilugraczy :=4; 
array gracz dim (1:ilugraczy);
gracz(1) := new gracz1;
gracz(2) := new gracz2;
gracz(3) := new gracz3;
gracz(4) := new gracz4;
A := new arbiter;
attach (A)

end chinczyk