program chinczyk;
(*****************************************************************************)
(*                                                                           *)
(*      Program autorstwa Tomasza Michalaka i Piotra Miekusa.                *)
(*   Coroutiny biorace udzial w grze sa sparametryzowana coroutina jednego   *)
(*   typu.Dokonano rowniez wielu zmian i poprawek w wspolprogramie arbitra   *)
(*                                                           *)
(*****************************************************************************)

  var kostka,i,ia:integer;
  var tab: arrayof arrayof integer;
  var gracz: arrayof coroutine;
  var f:file;
(*          *               *                *                 *          *)

   unit player:iiuwgraph coroutine(g:integer);
     var x,y,i,j,k,l:integer;
     var b:boolean;
     begin
       return;
       do;
       b:=false;
       call move(280,240);
       call A.outhline("use curcors to point pawn");
       call move(300,250);
       call A.outhline("  and press END"); 
       call move(360,230);
       call move(360,230);
       call track(360,230);
       x:=inxpos;
       y:=inypos;
       call move(280,240);
       call A.outhline("                         ");
       call move(300,250);
       call A.outhline("               "); 
       for i:=1 to 4 do
         j:=tab(g,i);
       if j=0 then
         k:=x-A.pl(0,g,i).x;
         l:=y-A.pl(0,g,i).y;
       else
         if j<41 then
           k:=x-A.pl(j,1,1).x;
           l:=y-A.pl(j,1,1).y;
           else
           k,l:=0;
         fi;
       fi;
       if k>0 andif l>0 andif k<47 andif l<36 then b:=true; exit fi;
      od;
      if b then call A.przesunpion(i);
      else call A.przesunpion(0);
      fi;
      detach;
      od;
   end player;
   
     
unit gracz1:coroutine(g,eh,spp:integer);

var stran              :arrayof integer;
var pp,j,i,nrkil,witch :integer;
var home               :arrayof boolean;
var polepos :boolean; 
 
unit man:class;               (* pawn *)
 var ple,saf,rsa     :integer;
 var kil,hun,fin,mov :boolean;
end man;

var pawn                :arrayof man;

unit pawns:procedure;
  var h:integer;
  begin
  for i:=1 to 4 do
    pawn(i).ple:=tab(g,i);
  od;
  pp:=0;
  polepos:=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 polepos:=false fi;
    if h>100 then home(h-100):=true fi;
  od;
  if pp=0 then polepos:=false fi;
end pawns;    
 
unit finish:function:boolean;
  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:=false;
     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:=true;
           pawn(i).fin:=true;
         fi
       else
         pawn(i).mov:=false;
       fi;
     od;
end finish;

unit killer:function:integer;
  begin
    for i:=1 to 4 do
      pawn(i).kil:=false;
      pawn(i).hun:=false;
      j:=pawn(i).ple;
      if j>0 andif j<50 then
        j:=j+kostka;
        if j>40 then j:=j-40 fi;
        if stran(j)=/=0 then
          if stran(j)=/=g then
            pawn(i).hun:=true
          else
            pawn(i).kil:=true;
            pawn(i).mov:=false;
            result:=result+1;
          fi;
        fi;
      fi;  
    od;        
end killer;

unit strangers:procedure;
 begin
   for i:=1 to 40 do stran(i):=0;od;
   for i:=1 to 4 do  
      for j:=1 to 4 do
        if tab(i,j)>0 andif tab(i,j)<50 then
          stran(tab(i,j)):=i;
        fi;
      od;
   od;     
end strangers;

unit safety:procedure;
   unit rafset:function(a:integer):integer;
    var b,c,p:integer;
    var finplo :boolean;
    begin
     if a>40 then a:=a mod 40 fi;    
     result:=0;
     finplo:=false;
     if a mod 10=1 then
       if (a+9) div 10 =/=g then result:=1 fi;
     fi;
     for p:=1 to 6 do     
       if a = 1 then a:=40;
       else a:=a-1;
       fi;
       b:=stran(a);
       if a mod 10 =0 then finplo:=true fi;
       if b=/=0 andif b=/=g then
         if finplo then
           c:=(((a-1) div 10)+2) mod 4;
           if c=0 then c:=4 fi;
           if c=/=g then result:=result+1 fi;
         else  
           result:=result+1;
         fi;
       fi;
     od;    
   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 speed:boolean;
 var moves:arrayof boolean;
  begin
  j:=-12;
 
  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);
  if witch>4 then witch:=0 fi;
end move;
  
begin
 array pawn dim(1:4);
 array home dim(1:4);
 array stran dim(1:40);
 for i:=1 to 4 do
   pawn(i):=new man;
 od;
 return;
 do
  call pawns;
  call strangers;
 if finish then
   for i:=1 to 4 do
     if pawn(i).fin then witch:=i fi;
   od;
 else
  if polepos and kostka=6 then
    i:=1;
    while tab(g,i)=/=0 do i:=i+1; od;
    if i>4 then i:=4 fi;
    witch:=i;
  else
    nrkil:=killer;
    witch:=0;
    if nrkil=/=4-pp then
      call safety;
      call move;
    fi;
  fi;
 fi; 
  call A.przesunpion(witch);
  detach;
od;
end gracz1;
(*           *                *               *                  *          *)

   
   unit gracz3:coroutine;

      unit possible_pool:function(gracz,pion,kostka:integer):integer;
         var beg,dom,i:integer,b:boolean;
         begin
         beg:=(gracz-1)*10+1;
         if tab(gracz)(pion)=0 then 
            if kostka=6 then result:=beg;
            else result:=0;
            fi;
         else 
            if tab(gracz)(pion)>=100 then result:=0;
            else
               if tab(gracz)(pion)<beg and tab(gracz)(pion)+kostka>=beg then
                  dom:=kostka+tab(gracz)(pion)+100;
                  for i:=1 to 4 do
                     b:=false;
                     if tab(gracz)(i)=dom then b:=true; fi;
                     if b then result:=0; else result:=100; fi;
                  od;
               else
                  b:=false;
                  for i:=1 to 4 do
                     if i<>pion andif tab(gracz)(pion)+kostka=tab(gracz)(i) then 
                        b:=true; 
                     fi;
                  od;
                  if b then result:=0;
                  else result:=tab(gracz)(pion)+kostka;
                  fi;
               fi;
            fi;
         fi;
      end possible_pool;

      unit inni_w_domu:function(gracz:integer):integer;
         var i:integer;
         begin
         result:=0;
         for i:=1 to 4 do 
            if tab(gracz)(i)>=100 then result:=result+1; 
            fi;
         od;
      end inni_w_domu;

      unit inni_jeszcze_w_domu:function(gracz:integer):integer;
         var i:integer;
         begin
         result:=0;
         for i:=1 to 4 do 
            if tab(gracz)(i)=0 then result:=result+1;
            fi;
         od;
      end inni_jeszcze_w_domu;

      unit wyjscie_z_domu:function(pion:integer):integer;
         begin
         if tab(3)(pion)=0 and kostka=6 then result:=1; 
         else result:=0;
         fi;
      end wyjscie_z_domu;

      unit state_of_player:function(player:integer):integer;
         var i:integer;
         begin
         result:=0;
         for i:=1 to 4 do
            if tab(player,i)=0 then result:=result-1;
            else 
               if tab(player,i)>=100 then result:=result+2;
               fi;
            fi;
         od;
         if result<0 then result:=0;
         fi;
      end state_of_player;
      
      unit pod_biciem:function(pool:integer):integer;
         var i,j,k:integer;
         begin
         if pool=0 or pool>=100 then result:=0;
         else
            for i:=1 to 4 do
               if i<>3 then
                  for j:=1 to 4 do
                     for k:=1 to 6 do
                        if possible_pool(i,j,k)=pool then result:=result+1;
                        fi;
                     od;
                  od;
               fi;
            od;                         
         fi;
      end pod_biciem;
      
      unit wyjscie_spod_bicia:function(pion:integer):integer;
         var p,k:integer;
         begin
         p:=pod_biciem(tab(3)(pion));
         if p>0 then
            k:=pod_biciem(possible_pool(3,pion,kostka));
            if p-k>0 then result:=p-k;
            else
               if p=k then result:=spodmn*p;
               else result:=0;
               fi;
            fi;
         fi;
      end wyjscie_spod_bicia;

      unit wejscie_pod_bicie:function(pion:integer):integer;
         begin
         result:=pod_biciem(possible_pool(3,pion,kostka));
      end wejscie_pod_bicie;

      unit bicie:function(pion:integer):integer;
         var i,j,p:integer;
         begin
         result:=0;
         p:=possible_pool(3,pion,kostka);
         if p<100 then
            for i:=1 to 4 do
               if i<>3 then
                  for j:=1 to 4 do
                     if tab(i,j)=p then result:=state_of_player(i)*3;
                     fi;
                  od;
               fi;
            od;
         fi;
      end bicie;

      unit stoi_moj:function(pole:integer):boolean;
         var pion:integer;
         begin
         result:=false;
         for pion:=1 to 4 do 
            if tab(3,pion)=pole then result:=true; fi;
         od;
      end stoi_moj;

      unit dom:function(pion:integer):integer;
         begin
         if tab(3)(pion)<100 and possible_pool(3,pion,kostka)>=100 then 
            result:=1;
         else result:=0;
         fi;
      end dom;

      var turniej:arrayof integer;
      var ii,j:integer;
      var spodmn,inni,innij:integer;

      begin
      array turniej dim(1:4);
      spodmn:=2;
      return;
      do
(*         call A.gdziepiony;         *)
         for ii:=1 to 4 do turniej(ii):=0; od;
         inni:=inni_w_domu(1);
         inni:=inni+inni_w_domu(2);
         inni:=inni+inni_w_domu(4);
         innij:=inni_jeszcze_w_domu(1);
         innij:=innij+inni_jeszcze_w_domu(2);
         innij:=innij+inni_jeszcze_w_domu(4);
         for ii:=1 to 4 do
            turniej(ii):=turniej(ii)+dom(ii)*inni*3;
            turniej(ii):=turniej(ii)+wyjscie_z_domu(ii)*(inni+innij);
            turniej(ii):=turniej(ii)+bicie(ii);
            turniej(ii):=turniej(ii)-wejscie_pod_bicie(ii);
            turniej(ii):=turniej(ii)+wyjscie_spod_bicia(ii);
         od;
         for ii:=1 to 4 do
            if possible_pool(3,ii,kostka)=0 
            orif stoi_moj(possible_pool(3,ii,kostka)) 
            then turniej(ii):=-1; fi;
         od;
         j:=1;
         for ii:=2 to 4 do
            if turniej(ii)>turniej(j) then j:=ii;
            fi;
            if turniej(ii)=turniej(j) then 
               if tab(3)(ii)>tab(3)(j) then j:=ii;
               fi;
            fi;
         od;
         if turniej(j)>=0 then
            call A.przesunpion(j);
         fi;
         detach;
      od;
   end gracz3;

(***************************************************************)


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;

 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);
    
    detach;
  od;
end gracz4;
 
 
 (********* * * * * * * * * * * * *************)
 

  unit arbiter:iiuwgraph coroutine;
 
   var x,y,zawod,i,j,ktory,sk      : integer;
   var polestartu,skon,zero,wejscie,plansza: arrayof integer;
   var dom,old,tabcub           : arrayof arrayof integer;
   var tabpi                       : arrayof arrayof arrayof integer; 
   var dtab                        : arrayof arrayof string;  
   var ctabs                       : arrayof string;
 
   const c=1.3;
(********** plan **************)
   
   unit line:class(x1,y1,x2,y2:integer);
   end line;
   
   unit inchar : function: integer;
      var i : integer;
      begin
         do
         i := inkey;
         if i <> 0 then exit fi;
         od;
         result := i;
   end inchar;
   
   unit OUTHLINE: procedure(b:string);
      var i,j:integer;
      var a  :arrayof char;
                
      begin
         a:=unpack(b);
         i:=upper(a);
         for j:=1 to i do
            call hascii(0);
            call hascii(ord(a(j)));
         od;
         kill (a); 
   end outhline;      
   unit sdrp:procedure(a,b,c,d:integer);
      begin
         call move(a,c);
         call draw(b,c);
         call draw(b,d);
         call draw(a,d);
         call draw(a,c);
      end sdrp   

   unit sdrp1:procedure;
      begin
         call sdrp(45,76,23,49);
         call move(76,23);
         call draw(80,26);
         call draw(80,52);
         call draw(49,52);
         call draw(45,49);
   end sdrp1;      

  unit sdrp2:procedure;
      begin
         call sdrp(48,82,23,49);     
         call move(82,49);
         call draw(78,52);
         call draw(44,52);
         call draw(44,26);
         call draw(48,23);
  end sdrp2;
  
  unit sdrp3:procedure;
     begin
         call sdrp(48,82,26,52);               
         call move(48,52);
         call draw(44,49);
         call draw(44,23);
         call draw(78,23);
         call draw(82,26);
   end sdrp3;
   
   unit sdrp4:procedure;
      begin
         call sdrp(45,76,26,52);   
         call move(45,26);
         call draw(49,23);
         call draw(80,23);
         call draw(80,49);
         call draw(76,52);
   end sdrp4;       
       
    
   unit drp1:procedure(a,b:integer,t:arrayof string);
     begin   
         call move(a,b);
         call outhline(t(1));       
         call move(a,b+8);
         call outhline(t(2));
         call move(a,b+16);
         call outhline(t(3));
    end drp1     
         
   unit drp11:procedure(d:integer);
      begin
         call sdrp1;
         call drp1(51,25,dtab(d));
      end;
         
   unit drp21:procedure(d:integer);
      begin
         call sdrp2;
         call drp1(53,25,dtab(d));
      end;

   unit drp31:procedure(d:integer);
      begin
         call sdrp3;
         call drp1(53,28,dtab(d));
      end;

   unit drp41:procedure(d:integer);
      begin
         call sdrp4;
         call drp1(51,28,dtab(d));
      end;
   
   unit mktab:procedure;
     var i,j:integer;
     begin
       array tabpi dim(1:4);
       for i:=1 to 4 do
          array tabpi(i) dim(1:4);
          for j:=1 to 4 do
            array tabpi(i,j) dim(1:200);
          od;
       od;
      for i:=1 to 4 do 
         call cls;
         call drp11(i);
         call move(43,22);
         tabpi(i,1):=getmap(84,54);
      od;
      
      for i:=1 to 4 do 
         call cls;
         call drp21(i);
         call move(43,22);
         tabpi(i,2):=getmap(84,54);
      od;
      
      for i:=1 to 4 do 
         call cls;
         call drp31(i);
         call move(43,22);
         tabpi(i,3):=getmap(84,54);
      od;
      
      for i:=1 to 4 do 
         call cls;
         call drp41(i);
         call move(43,22);
         tabpi(i,4):=getmap(84,54);
      od;
    end mktab; 

      unit piszpion:coroutine(x,y,k:integer);
         var i,j:integer;
         begin
            return;
            do
               call move(x,y);
          for i:=1 to 2 do
               call putmap(tabpi(ktory,k));
          for j:=1 to 30 do od;
          call putmap(zero);
          for j:=1 to 30 do od;
          od;
          call putmap(tabpi(ktory,k));
               detach;
            od;
      end piszpion;      
var  pl:arrayof arrayof arrayof piszpion;

    
      unit mkpl:procedure;
      var a,b,c,i,j:integer;   
      
      begin
         array pl dim(0:104);
         array pl(0) dim(1:4);
         for i:=1 to 4 do
            array pl(0,i) dim (1:4);
            array pl(100+i) dim (1:4);
            for j:=1 to 4 do
               array pl(100+i,j) dim (1:1);
            od;
         od;
         for i:=1 to 40 do
            array pl(i) dim(1:1);
            array pl(i,1) dim(1:1);
         od;

open(f,integer,unpack("pola"));
call reset(f);

for i:=1 to 40 do
get(f,a);
get(f,b);
get(f,c);
pl(i,1,1):=new piszpion(a,b,c);
od;

for i:=1 to 4 do
for j:=1 to 4 do
get(f,a);
get(f,b);
get(f,c);
pl(0,i,j):=new piszpion(a,b,c);
od;
od;

for i:=1 to 4 do
for j:=101 to 104 do
get(f,a);
get(f,b);
get(f,c);
pl(j,i,1):=new piszpion(a,b,c);
od;
od;

end mkpl;      
      unit sq:procedure(x,y:integer);
         begin
            call move(c*(x+1)+40,20+y+1);
            call draw(c*(x+35)+40,20+y+1);
            call draw(c*(x+35)+40,20+y+35);
            call draw(c*(x+1)+40,20+y+35);
            call draw(c*(x+1)+40,20+y+1);
      end sq;
      
      unit cube:procedure;
      begin
      call move(0,8);
      call draw(32,8);
      call draw(32,34);
      call draw(0,34);
      call draw(0,8);
      call draw(10,0);
      call draw(41,0);
      call draw(32,8);
      call move(41,0);
      call draw(41,26);
      call draw(32,34);
      end;
      
      unit cubes:procedure(i,a,b,c:integer);
        begin
        call cube;
        call move(4,9);
        call outhline(ctabs(a));
        call move(4,17);
        call outhline(ctabs(b));
        call move(4,25);
        call outhline(ctabs(c));
        call move(0,0);
        tabcub(i):=getmap(41,34);
        call cls;
      end cubes;      
      
      unit cu:procedure(i,j:integer);
         begin
         call move(310,70);
         call outhline("PLAYER : ");
         case j        
          when 1: call outhline("1");
          when 2: call outhline("2");
          when 3: call outhline("3");
          when 4: call outhline("4");
         esac; 
    call move(360,80);        
    call putmap(tabcub(i));
      end cu;
      
      unit hjm:procedure(nw:arrayof arrayof integer);
         var i,j,x:integer;
         var z:string;
         unit drp:procedure(i,j:integer);
         var b1,b2:boolean;
            begin
          b1:=old(i,j)=0;
          if not b1 then b2:=plansza(old(i,j))=0 fi;
            if b2 or  b1 then
            if b1 then
              attach(pl(0,i,j));
              else          
               attach(pl(old(i,j),1,1));
            fi; 
          call putmap(zero); fi;
             if nw(i,j)=0 then x:=ktory;
                          ktory:=i;
                attach(pl(0,i,j));
                ktory:=x;
             else
               if nw(i,j)>100 then attach(pl(nw(i,j),i,1));
             else attach(pl(nw(i,j),1,1));
             fi;
               fi;
         end drp;               
         begin
            i:=ktory;
       do
               for j:=1 to 4 do
                  if old(i,j)<>nw(i,j) then  call drp(i,j); fi;
                  old(i,j):=nw(i,j);
               od;
          i:=i mod 4 +1;
          if i=ktory then exit fi;
            od;
         end;
      
   unit drpl:procedure;
      var i,x,y,x1,x2,y1,y2:integer;
   begin
            call gron(1); 
      open(f,integer,unpack("plan"));
      call reset(f);
      for i:=1 to 47 do

         get(f,x1);
         get(f,y1);
         call move(x1,y1);
         get(f,x2);
         get(f,y2);
         call draw(x2,y2);

      
         x:=735-x1;
         y:=y1;
         call move(x,y);
         x:=735-x2;
         y:=y2;
         call draw(x,y);
         
         x:=735-x1;
         y:=328-y1;
         call move(x,y);
         x:=735-x2;
         y:=328-y2;
         call draw(x,y);
         
         x:=x1;
         y:=328-y1;
         call move(x,y);
         x:=x2;
         y:=328-y2;
         call draw(x,y);
         
      od;
      
 end drpl;
         
   unit starter:procedure;
   var i,j:integer;
   begin
      array zero dim(1:1300);
      call gron(1);
      call move(0,0);
      zero:=getmap(42,32);
      call cubes(1,1,2,1);
      call cubes(2,3,1,4);
      call cubes(3,3,2,4);
      call cubes(4,5,1,5);
      call cubes(5,5,2,5);
      call cubes(6,5,5,5);
      call mktab;
      call mkpl;
      call drpl;
      call sq(72,0);
      call sq(395,36);
      call sq(395,252);
      call sq(72,216);
      for i:=1 to 4 do
       for j:=1 to 4 do
        ktory:=i;
        attach(pl(0,i,j));
       od;
      od;
      i:=inchar;
      
   end starter;
      
(************** end plan ***********)

  
  unit przesunpion:procedure(co:integer);
    var g,s,t:integer;
  
    unit start:procedure;
      begin
        g:=polestartu(ktory);
        tab(ktory,co):=g;
        if plansza(g)=/=0 then
          tab((plansza(g)/10),(plansza(g) mod 10)):=0;
        fi;
        plansza(g):=ktory*10+co;
    end start;
    begin
      if co<1 orif co>4 then return fi;
      if ktory<1 orif ktory>4 then return fi;
      s:=tab(ktory,co);
      g:=s+kostka;
      if s>100 then return fi;
      if s=0 then 
        if kostka=6 then call start fi;
        return; 
      fi;
      t:=wejscie(ktory);
      if s<=t  andif g>t then
        t:=g-t;
        if t<5 andif dom(ktory,t)=0 then
          dom(ktory,t):=co;
          tab(ktory,co):=100+t;
          plansza(s):=0;
        fi;
        return;
      else
        if g>40 then g:=g-40 fi;
        if plansza(g)=/=0 then
          tab((plansza(g)/10),(plansza(g) mod 10)):=0;
        fi;
        tab(ktory,co):=g;
        plansza(g):=plansza(s);
        plansza(s):=0;
      fi;
  end przesunpion;
                
  unit koniec: function: boolean;
    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;
      skon(ktory):=sk;
    fi;
    result:= sk=4
  end koniec;     
  
  unit komunikat: procedure;
    var m: arrayof integer;
  begin
    array m dim (1:4);
    for i:=1 to 4 do
      m(skon(i)):=i;
    od;  
    call groff;
    writeln;
    for i:=1 to 4 do
      writeln (i:1," miejsce zajal gracz ",m(i):1)
    od
  end komunikat;

begin     (*  arbiter  *)
  array tab dim (1:4);
  array old dim (1:4);
  array dom dim (1:4);
  array ctabs dim (1:5);
  array tabcub dim (1:6);
  array plansza dim (1:40);
  array skon dim (1:4);
  array wejscie dim (1:4);
  array polestartu dim (1:4);
  array dtab dim(1:4);
  for i:=1 to 4
  do
    skon(i):=0;
    array tabcub(i) dim(1:200);
    array dtab(i) dim (1:3);
    array tab(i) dim (1:4);
    array old(i) dim (1:4);
    array dom(i) dim (1:4);
    polestartu(i):=10*(i-1)+1;
    wejscie(i):=polestartu(i)-1;
  od;
  wejscie(1):=40;
  for i:=5 to 6 do
    array tabcub(i) dim(1:200);
  od;
  ctabs(1):="   ";  
  ctabs(2):=" * ";
  ctabs(3):="*  ";
  ctabs(4):="  *";
  ctabs(5):="* *";
  dtab(1,1):=" 1 ";       
  dtab(1,2):=" 1 ";
  dtab(1,3):=" 1 ";
  dtab(2,1):="2  ";       
  dtab(2,2):=" 2 ";
  dtab(2,3):="  2";
  dtab(3,1):="  3";
  dtab(3,2):=" 3 ";
  dtab(3,3):="3  ";
  dtab(4,1):="   ";       
  dtab(4,2):="444";
  dtab(4,3):="   ";

  return;
  call starter;
  ktory:=0;
  do
    ktory:= (ktory mod 4) + 1;
    if skon(ktory)=/=0 then repeat fi;
    do
      kostka:=entier(random*6)+1;
      call cu(kostka,ktory);
      attach (gracz(ktory));
      call hjm(tab);
      if koniec then exit exit fi;
      if kostka=/=6 or skon(ktory)=/=0 then exit fi
    od
  od;
  call komunikat;
  read (i);
  call endrun
end arbiter;

  var A: arbiter;    
(*          *           *            *                *             *)         
begin     (*  program glowny  *)
array gracz dim (1:4);
writeln ("Type how many PLAYERS want to enjoy game");
read(ia);
for i:=1 to ia do
gracz(i) := new player(i);
od;
if ia=0 then ia:=1;gracz(1):=new gracz1(1,40,1); fi;
for i:=ia+1 to 2 do
gracz(i) := new gracz1(i,(i-1)*10,i*10-9);
od;
gracz(3):=new gracz3;
gracz(4):=new gracz4;
A := new arbiter;
attach (A)
end chinczyk