examples/chin/chinczyk.log

   1 program chinczyk;\r
   2 (*****************************************************************************)\r
   3 (*                                                                           *)\r
   4 (*      Program autorstwa Tomasza Michalaka i Piotra Miekusa.                *)\r
   5 (*   Coroutiny biorace udzial w grze sa sparametryzowana coroutina jednego   *)\r
   6 (*   typu.Dokonano rowniez wielu zmian i poprawek w wspolprogramie arbitra   *)\r
   7 (*                                                           *)\r
   8 (*****************************************************************************)\r
   9 \r
  10   var kostka,i,ia:integer;\r
  11   var tab: arrayof arrayof integer;\r
  12   var gracz: arrayof coroutine;\r
  13   var f:file;\r
  14 (*          *               *                *                 *          *)\r
  15 \r
  16    unit player:iiuwgraph coroutine(g:integer);\r
  17      var x,y,i,j,k,l:integer;\r
  18      var b:boolean;\r
  19      begin\r
  20        return;\r
  21        do;\r
  22        b:=false;\r
  23        call move(280,240);\r
  24        call A.outhline("use curcors to point pawn");\r
  25        call move(300,250);\r
  26        call A.outhline("  and press END"); \r
  27        call move(360,230);\r
  28        call move(360,230);\r
  29        call track(360,230);\r
  30        x:=inxpos;\r
  31        y:=inypos;\r
  32        call move(280,240);\r
  33        call A.outhline("                         ");\r
  34        call move(300,250);\r
  35        call A.outhline("               "); \r
  36        for i:=1 to 4 do\r
  37          j:=tab(g,i);\r
  38        if j=0 then\r
  39          k:=x-A.pl(0,g,i).x;\r
  40          l:=y-A.pl(0,g,i).y;\r
  41        else\r
  42          if j<41 then\r
  43            k:=x-A.pl(j,1,1).x;\r
  44            l:=y-A.pl(j,1,1).y;\r
  45            else\r
  46            k,l:=0;\r
  47          fi;\r
  48        fi;\r
  49        if k>0 andif l>0 andif k<47 andif l<36 then b:=true; exit fi;\r
  50       od;\r
  51       if b then call A.przesunpion(i);\r
  52       else call A.przesunpion(0);\r
  53       fi;\r
  54       detach;\r
  55       od;\r
  56    end player;\r
  57    \r
  58      \r
  59 unit gracz1:coroutine(g,eh,spp:integer);\r
  60 \r
  61 var stran              :arrayof integer;\r
  62 var pp,j,i,nrkil,witch :integer;\r
  63 var home               :arrayof boolean;\r
  64 var polepos :boolean; \r
  65  \r
  66 unit man:class;               (* pawn *)\r
  67  var ple,saf,rsa     :integer;\r
  68  var kil,hun,fin,mov :boolean;\r
  69 end man;\r
  70 \r
  71 var pawn                :arrayof man;\r
  72 \r
  73 unit pawns:procedure;\r
  74   var h:integer;\r
  75   begin\r
  76   for i:=1 to 4 do\r
  77     pawn(i).ple:=tab(g,i);\r
  78   od;\r
  79   pp:=0;\r
  80   polepos:=true;\r
  81   for i:=1 to 4 do  home(i):=false; od;\r
  82   for i:=1 to 4 do\r
  83     h:=tab(g,i);  \r
  84     if h=0 then pp:=pp+1 fi;\r
  85     if h=spp then polepos:=false fi;\r
  86     if h>100 then home(h-100):=true fi;\r
  87   od;\r
  88   if pp=0 then polepos:=false fi;\r
  89 end pawns;    \r
  90  \r
  91 unit finish:function:boolean;\r
  92   unit inhome:function(a:integer):boolean;\r
  93    begin\r
  94      result:=false;\r
  95      if a>1 andif a<=eh andif a+kostka>eh then\r
  96        if a+kostka-eh<5 andif not home(a+kostka-eh) then\r
  97          result:=true;\r
  98          pawn(i).mov:=true;\r
  99        else\r
 100          pawn(i).mov:=false;  \r
 101        fi;\r
 102      else\r
 103        pawn(i).mov:=true;  \r
 104      fi;\r
 105   end inhome;        \r
 106   begin\r
 107      result:=false;\r
 108      for i:=1 to 4 do\r
 109        pawn(i).fin:=false;\r
 110        if pawn(i).ple>0 andif pawn(i).ple<99 then\r
 111          if inhome(pawn(i).ple) then\r
 112            result:=true;\r
 113            pawn(i).fin:=true;\r
 114          fi\r
 115        else\r
 116          pawn(i).mov:=false;\r
 117        fi;\r
 118      od;\r
 119 end finish;\r
 120 \r
 121 unit killer:function:integer;\r
 122   begin\r
 123     for i:=1 to 4 do\r
 124       pawn(i).kil:=false;\r
 125       pawn(i).hun:=false;\r
 126       j:=pawn(i).ple;\r
 127       if j>0 andif j<50 then\r
 128         j:=j+kostka;\r
 129         if j>40 then j:=j-40 fi;\r
 130         if stran(j)=/=0 then\r
 131           if stran(j)=/=g then\r
 132             pawn(i).hun:=true\r
 133           else\r
 134             pawn(i).kil:=true;\r
 135             pawn(i).mov:=false;\r
 136             result:=result+1;\r
 137           fi;\r
 138         fi;\r
 139       fi;  \r
 140     od;        \r
 141 end killer;\r
 142 \r
 143 unit strangers:procedure;\r
 144  begin\r
 145    for i:=1 to 40 do stran(i):=0;od;\r
 146    for i:=1 to 4 do  \r
 147       for j:=1 to 4 do\r
 148         if tab(i,j)>0 andif tab(i,j)<50 then\r
 149           stran(tab(i,j)):=i;\r
 150         fi;\r
 151       od;\r
 152    od;     \r
 153 end strangers;\r
 154 \r
 155 unit safety:procedure;\r
 156    unit rafset:function(a:integer):integer;\r
 157     var b,c,p:integer;\r
 158     var finplo :boolean;\r
 159     begin\r
 160      if a>40 then a:=a mod 40 fi;    \r
 161      result:=0;\r
 162      finplo:=false;\r
 163      if a mod 10=1 then\r
 164        if (a+9) div 10 =/=g then result:=1 fi;\r
 165      fi;\r
 166      for p:=1 to 6 do     \r
 167        if a = 1 then a:=40;\r
 168        else a:=a-1;\r
 169        fi;\r
 170        b:=stran(a);\r
 171        if a mod 10 =0 then finplo:=true fi;\r
 172        if b=/=0 andif b=/=g then\r
 173          if finplo then\r
 174            c:=(((a-1) div 10)+2) mod 4;\r
 175            if c=0 then c:=4 fi;\r
 176            if c=/=g then result:=result+1 fi;\r
 177          else  \r
 178            result:=result+1;\r
 179          fi;\r
 180        fi;\r
 181      od;    \r
 182    end rafset;\r
 183  begin\r
 184    for i:=1 to 4 do\r
 185      if pawn(i).ple>0 andif pawn(i).ple<99 then\r
 186        pawn(i).saf:=rafset(pawn(i).ple);\r
 187        pawn(i).rsa:=pawn(i).saf-rafset(pawn(i).ple+kostka);\r
 188      else\r
 189        pawn(i).saf:=6;\r
 190        pawn(i).rsa:=-12;  \r
 191      fi;\r
 192    od;\r
 193 end safety;    \r
 194                                             \r
 195 unit move:procedure;\r
 196  var speed:boolean;\r
 197  var moves:arrayof boolean;\r
 198   begin\r
 199   j:=-12;\r
 200  \r
 201   speed:=true;\r
 202   array moves dim(1:4);\r
 203   for i:=1 to 4 do\r
 204     moves(i):=false;\r
 205     if not pawn(i).kil andif pawn(i).hun then\r
 206       moves(i):=true;\r
 207       speed:=false;\r
 208     fi\r
 209   od;\r
 210   for i:=1 to 4 do\r
 211    if not pawn(i).kil andif pawn(i).ple>0 andif pawn(i).mov then\r
 212      if speed orif moves(i) then\r
 213        if pawn(i).rsa>j then    \r
 214          witch:=i;\r
 215          j:=pawn(i).rsa\r
 216        fi\r
 217      fi\r
 218    fi\r
 219   od;\r
 220   kill (moves);\r
 221   if witch>4 then witch:=0 fi;\r
 222 end move;\r
 223   \r
 224 begin\r
 225  array pawn dim(1:4);\r
 226  array home dim(1:4);\r
 227  array stran dim(1:40);\r
 228  for i:=1 to 4 do\r
 229    pawn(i):=new man;\r
 230  od;\r
 231  return;\r
 232  do\r
 233   call pawns;\r
 234   call strangers;\r
 235  if finish then\r
 236    for i:=1 to 4 do\r
 237      if pawn(i).fin then witch:=i fi;\r
 238    od;\r
 239  else\r
 240   if polepos and kostka=6 then\r
 241     i:=1;\r
 242     while tab(g,i)=/=0 do i:=i+1; od;\r
 243     if i>4 then i:=4 fi;\r
 244     witch:=i;\r
 245   else\r
 246     nrkil:=killer;\r
 247     witch:=0;\r
 248     if nrkil=/=4-pp then\r
 249       call safety;\r
 250       call move;\r
 251     fi;\r
 252   fi;\r
 253  fi; \r
 254   call A.przesunpion(witch);\r
 255   detach;\r
 256 od;\r
 257 end gracz1;\r
 258 (*           *                *               *                  *          *)\r
 259 \r
 260    \r
 261    unit gracz3:coroutine;\r
 262 \r
 263       unit possible_pool:function(gracz,pion,kostka:integer):integer;\r
 264          var beg,dom,i:integer,b:boolean;\r
 265          begin\r
 266          beg:=(gracz-1)*10+1;\r
 267          if tab(gracz)(pion)=0 then \r
 268             if kostka=6 then result:=beg;\r
 269             else result:=0;\r
 270             fi;\r
 271          else \r
 272             if tab(gracz)(pion)>=100 then result:=0;\r
 273             else\r
 274                if tab(gracz)(pion)<beg and tab(gracz)(pion)+kostka>=beg then\r
 275                   dom:=kostka+tab(gracz)(pion)+100;\r
 276                   for i:=1 to 4 do\r
 277                      b:=false;\r
 278                      if tab(gracz)(i)=dom then b:=true; fi;\r
 279                      if b then result:=0; else result:=100; fi;\r
 280                   od;\r
 281                else\r
 282                   b:=false;\r
 283                   for i:=1 to 4 do\r
 284                      if i<>pion andif tab(gracz)(pion)+kostka=tab(gracz)(i) then \r
 285                         b:=true; \r
 286                      fi;\r
 287                   od;\r
 288                   if b then result:=0;\r
 289                   else result:=tab(gracz)(pion)+kostka;\r
 290                   fi;\r
 291                fi;\r
 292             fi;\r
 293          fi;\r
 294       end possible_pool;\r
 295 \r
 296       unit inni_w_domu:function(gracz:integer):integer;\r
 297          var i:integer;\r
 298          begin\r
 299          result:=0;\r
 300          for i:=1 to 4 do \r
 301             if tab(gracz)(i)>=100 then result:=result+1; \r
 302             fi;\r
 303          od;\r
 304       end inni_w_domu;\r
 305 \r
 306       unit inni_jeszcze_w_domu:function(gracz:integer):integer;\r
 307          var i:integer;\r
 308          begin\r
 309          result:=0;\r
 310          for i:=1 to 4 do \r
 311             if tab(gracz)(i)=0 then result:=result+1;\r
 312             fi;\r
 313          od;\r
 314       end inni_jeszcze_w_domu;\r
 315 \r
 316       unit wyjscie_z_domu:function(pion:integer):integer;\r
 317          begin\r
 318          if tab(3)(pion)=0 and kostka=6 then result:=1; \r
 319          else result:=0;\r
 320          fi;\r
 321       end wyjscie_z_domu;\r
 322 \r
 323       unit state_of_player:function(player:integer):integer;\r
 324          var i:integer;\r
 325          begin\r
 326          result:=0;\r
 327          for i:=1 to 4 do\r
 328             if tab(player,i)=0 then result:=result-1;\r
 329             else \r
 330                if tab(player,i)>=100 then result:=result+2;\r
 331                fi;\r
 332             fi;\r
 333          od;\r
 334          if result<0 then result:=0;\r
 335          fi;\r
 336       end state_of_player;\r
 337       \r
 338       unit pod_biciem:function(pool:integer):integer;\r
 339          var i,j,k:integer;\r
 340          begin\r
 341          if pool=0 or pool>=100 then result:=0;\r
 342          else\r
 343             for i:=1 to 4 do\r
 344                if i<>3 then\r
 345                   for j:=1 to 4 do\r
 346                      for k:=1 to 6 do\r
 347                         if possible_pool(i,j,k)=pool then result:=result+1;\r
 348                         fi;\r
 349                      od;\r
 350                   od;\r
 351                fi;\r
 352             od;                         \r
 353          fi;\r
 354       end pod_biciem;\r
 355       \r
 356       unit wyjscie_spod_bicia:function(pion:integer):integer;\r
 357          var p,k:integer;\r
 358          begin\r
 359          p:=pod_biciem(tab(3)(pion));\r
 360          if p>0 then\r
 361             k:=pod_biciem(possible_pool(3,pion,kostka));\r
 362             if p-k>0 then result:=p-k;\r
 363             else\r
 364                if p=k then result:=spodmn*p;\r
 365                else result:=0;\r
 366                fi;\r
 367             fi;\r
 368          fi;\r
 369       end wyjscie_spod_bicia;\r
 370 \r
 371       unit wejscie_pod_bicie:function(pion:integer):integer;\r
 372          begin\r
 373          result:=pod_biciem(possible_pool(3,pion,kostka));\r
 374       end wejscie_pod_bicie;\r
 375 \r
 376       unit bicie:function(pion:integer):integer;\r
 377          var i,j,p:integer;\r
 378          begin\r
 379          result:=0;\r
 380          p:=possible_pool(3,pion,kostka);\r
 381          if p<100 then\r
 382             for i:=1 to 4 do\r
 383                if i<>3 then\r
 384                   for j:=1 to 4 do\r
 385                      if tab(i,j)=p then result:=state_of_player(i)*3;\r
 386                      fi;\r
 387                   od;\r
 388                fi;\r
 389             od;\r
 390          fi;\r
 391       end bicie;\r
 392 \r
 393       unit stoi_moj:function(pole:integer):boolean;\r
 394          var pion:integer;\r
 395          begin\r
 396          result:=false;\r
 397          for pion:=1 to 4 do \r
 398             if tab(3,pion)=pole then result:=true; fi;\r
 399          od;\r
 400       end stoi_moj;\r
 401 \r
 402       unit dom:function(pion:integer):integer;\r
 403          begin\r
 404          if tab(3)(pion)<100 and possible_pool(3,pion,kostka)>=100 then \r
 405             result:=1;\r
 406          else result:=0;\r
 407          fi;\r
 408       end dom;\r
 409 \r
 410       var turniej:arrayof integer;\r
 411       var ii,j:integer;\r
 412       var spodmn,inni,innij:integer;\r
 413 \r
 414       begin\r
 415       array turniej dim(1:4);\r
 416       spodmn:=2;\r
 417       return;\r
 418       do\r
 419 (*         call A.gdziepiony;         *)\r
 420          for ii:=1 to 4 do turniej(ii):=0; od;\r
 421          inni:=inni_w_domu(1);\r
 422          inni:=inni+inni_w_domu(2);\r
 423          inni:=inni+inni_w_domu(4);\r
 424          innij:=inni_jeszcze_w_domu(1);\r
 425          innij:=innij+inni_jeszcze_w_domu(2);\r
 426          innij:=innij+inni_jeszcze_w_domu(4);\r
 427          for ii:=1 to 4 do\r
 428             turniej(ii):=turniej(ii)+dom(ii)*inni*3;\r
 429             turniej(ii):=turniej(ii)+wyjscie_z_domu(ii)*(inni+innij);\r
 430             turniej(ii):=turniej(ii)+bicie(ii);\r
 431             turniej(ii):=turniej(ii)-wejscie_pod_bicie(ii);\r
 432             turniej(ii):=turniej(ii)+wyjscie_spod_bicia(ii);\r
 433          od;\r
 434          for ii:=1 to 4 do\r
 435             if possible_pool(3,ii,kostka)=0 \r
 436             orif stoi_moj(possible_pool(3,ii,kostka)) \r
 437             then turniej(ii):=-1; fi;\r
 438          od;\r
 439          j:=1;\r
 440          for ii:=2 to 4 do\r
 441             if turniej(ii)>turniej(j) then j:=ii;\r
 442             fi;\r
 443             if turniej(ii)=turniej(j) then \r
 444                if tab(3)(ii)>tab(3)(j) then j:=ii;\r
 445                fi;\r
 446             fi;\r
 447          od;\r
 448          if turniej(j)>=0 then\r
 449             call A.przesunpion(j);\r
 450          fi;\r
 451          detach;\r
 452       od;\r
 453    end gracz3;\r
 454 \r
 455 (***************************************************************)\r
 456 \r
 457 \r
 458 unit gracz4: coroutine;\r
 459 const g=4;\r
 460 const start=31;\r
 461 const endpos=30;\r
 462 \r
 463 var players : arrayof boy; \r
 464 \r
 465 unit boy:class;\r
 466   var pos,back : integer;\r
 467   var suicide,stab,finish,moveout : boolean;\r
 468 end boy;\r
 469 \r
 470 unit playerinit:procedure;\r
 471 var i:integer;\r
 472  begin\r
 473   for i:=1 to 4 do\r
 474     players(i).pos:=tab(g,i);\r
 475   od;\r
 476 end playerinit;\r
 477 \r
 478 unit finishing:function(nr:integer):boolean;\r
 479  var i,j:integer;\r
 480  begin\r
 481    result:=false;\r
 482    i:=players(nr).pos;\r
 483    if i<>0 \r
 484    then \r
 485      if i+kostka>endpos and i+kostka<endpos+5 and i<=endpos\r
 486      then \r
 487        result:=true;\r
 488        for j:=1 to 4\r
 489        do \r
 490          if j <> nr \r
 491          then\r
 492            if (players(j).pos-100+1)=i+kostka-endpos\r
 493            then result:=false;\r
 494            fi;\r
 495          fi;\r
 496        od;\r
 497      fi;\r
 498    fi;\r
 499 end finishing;\r
 500  \r
 501 unit suiciding:function(nr:integer):boolean;\r
 502  var i:integer;\r
 503  begin\r
 504   result:=false;\r
 505   if players(nr).pos<>0\r
 506   then \r
 507    for i:=1 to 4 \r
 508    do\r
 509      if nr<>i \r
 510      then\r
 511          if (players(nr).pos+kostka-1) mod 40 + 1 = players(i).pos \r
 512     andif players(i).pos<100\r
 513          then \r
 514            result:=true;\r
 515            exit;\r
 516     fi;\r
 517      fi;\r
 518    od\r
 519   else\r
 520    for i:= 1 to 4\r
 521    do\r
 522      if i<>nr andif players(i).pos=start\r
 523      then result:=true;\r
 524      exit;\r
 525      fi;\r
 526    od;\r
 527   fi;\r
 528 end suiciding;\r
 529  \r
 530 unit stabing:function(nr:integer):boolean;\r
 531  var i,j:integer;\r
 532  var b1,b2:boolean;\r
 533  begin\r
 534   result:=false;\r
 535    for i:=1 to 4\r
 536    do\r
 537      if i<>g \r
 538      then\r
 539        for j:= 1 to 4\r
 540        do\r
 541          if players(nr).pos > 0 and players(nr).pos <100\r
 542          then\r
 543            b1:=(players(nr).pos+kostka-1) mod 40 +1 =tab(i,j) ;\r
 544            b2:=players(nr).pos>=start and b1;\r
 545            if b1 and (players(nr).pos+kostka-1) mod 40 + 1<=endpos orif b2 \r
 546            then\r
 547              result:=true;\r
 548              exit exit;\r
 549            fi\r
 550          else\r
 551          result:=(kostka=6 and players(nr).pos=0 and tab(i,j)=start);\r
 552          exit exit;\r
 553          fi;\r
 554        od;\r
 555      fi;\r
 556    od;\r
 557 end stabing;  \r
 558 \r
 559 unit atback:function(nr:integer):integer;\r
 560  var i,j,np:integer;\r
 561  begin\r
 562   np:=players(nr).pos;\r
 563   result:=0;\r
 564   if np<>0\r
 565   then \r
 566    if np < 7 \r
 567    then\r
 568      for i:=1 to 4 \r
 569      do \r
 570        if i<>g \r
 571        then \r
 572          for j:=1 to 4\r
 573          do\r
 574            if (tab(i,j) < np)\r
 575            then\r
 576                if tab(i,j)>0\r
 577                then result:=result+1;\r
 578                fi\r
 579            else \r
 580              if tab(i,j) > 40-(6-np)\r
 581              then result:=result+1;\r
 582              fi;\r
 583            fi;\r
 584          od;\r
 585        fi;\r
 586      od;\r
 587    else\r
 588      for i:=1 to 4\r
 589      do\r
 590        if i<>g\r
 591        then\r
 592          for j:=1 to 4\r
 593     do\r
 594       if tab(i,j) < np\r
 595       andif tab(i,j) > np-7\r
 596       then result:=result +1;\r
 597       fi;\r
 598     od;\r
 599        fi;\r
 600      od;                \r
 601    fi;\r
 602   fi;\r
 603  end atback;\r
 604  \r
 605  unit begining : function(nr:integer):boolean;\r
 606   begin\r
 607     result:=players(nr).pos=0 and kostka=6;\r
 608   end begining;\r
 609   \r
 610  unit move:function:integer;\r
 611   var i,j,k : integer;\r
 612   var ok:boolean;\r
 613   begin\r
 614    for i:= 1 to 4\r
 615    do\r
 616      players(i).back:=atback(i);\r
 617      players(i).suicide:=suiciding(i);\r
 618      players(i).stab:=stabing(i);\r
 619      players(i).finish:=finishing(i);\r
 620      players(i).moveout:=begining(i);\r
 621    od;\r
 622    ok:=false;\r
 623    (********************* bije i wychodzi ************)\r
 624    for i:=1 to 4\r
 625    do \r
 626      if players(i).moveout \r
 627      then\r
 628        for j:=1 to 4\r
 629        do\r
 630          if g<>j \r
 631     then\r
 632            for k:=1 to 4 \r
 633            do\r
 634         if tab(j,k)=start\r
 635         then \r
 636           result:=i;\r
 637           ok:=true; exit exit exit;\r
 638         fi;\r
 639       od;\r
 640     fi;\r
 641        od;\r
 642      fi;\r
 643    od;\r
 644    (******************** gonia go i konczy **************)\r
 645   if not ok \r
 646   then \r
 647    for i:=1 to 4\r
 648    do\r
 649      if players(i).pos>0\r
 650      andif players(i).pos<100\r
 651      andif players(i).finish \r
 652      andif players(i).back > 0\r
 653      then\r
 654        result:=i;\r
 655        ok:=true; exit;\r
 656      fi;\r
 657    od;\r
 658   fi;\r
 659    (******************** gonia go i bije ******************)\r
 660   if not ok \r
 661   then\r
 662    for i:=1 to 4\r
 663    do\r
 664      if players(i).pos<100\r
 665      andif players(i).back>0\r
 666      andif players(i).stab\r
 667      then\r
 668        result:=i;\r
 669        ok:=true; exit;\r
 670      fi;\r
 671    od;\r
 672   fi;\r
 673    (******************* bije ********************************)\r
 674   if not ok \r
 675   then   \r
 676    for i:=1 to 4\r
 677    do\r
 678      if players(i).stab\r
 679      then\r
 680        result:=i;\r
 681        ok:=true; exit;\r
 682      fi;\r
 683    od;\r
 684   fi;\r
 685    (******************** goni go conajmniej dwoch **********)\r
 686   if not ok \r
 687   then\r
 688    for i:=1 to 4\r
 689    do\r
 690      if players(i).pos<100\r
 691      andif players(i).back>=2\r
 692      andif not players(i).suicide\r
 693      then\r
 694        result:=i;\r
 695        ok:=true; exit;\r
 696      fi;\r
 697    od;\r
 698   fi;\r
 699    (******************* wychodzi ****************************)\r
 700   if not ok \r
 701   then\r
 702    for i:=1 to 4\r
 703    do\r
 704      if players(i).moveout\r
 705      andif not players(i).suicide\r
 706      then\r
 707        result:=i;\r
 708        ok:=true; exit;\r
 709      fi;\r
 710    od;\r
 711   fi;\r
 712    \r
 713    (******************* konczy *******************************)\r
 714   if not ok \r
 715   then\r
 716    for i:=1 to 4\r
 717    do\r
 718      if players(i).finish\r
 719      then\r
 720        result:=i;\r
 721        ok:=true; exit;\r
 722      fi;\r
 723    od;\r
 724   fi;\r
 725 \r
 726    (******************** gonia go **********)\r
 727   if not ok \r
 728   then\r
 729    for i:=1 to 4\r
 730    do\r
 731      if players(i).pos<100\r
 732      andif players(i).pos>0\r
 733      andif players(i).back>0\r
 734      andif not players(i).suicide\r
 735      then\r
 736        result:=i;\r
 737        ok:=true; exit;\r
 738      fi;\r
 739    od;\r
 740   fi;   \r
 741    (******************* nie bije swojego *********************)\r
 742   if not ok \r
 743   then\r
 744    for i:=4 downto 1\r
 745    do\r
 746      if players(i).pos<100\r
 747      andif players(i).pos>0\r
 748      andif not players(i).suicide\r
 749      then\r
 750        result:=i;\r
 751        ok:=true; exit;\r
 752      fi;\r
 753    od;\r
 754   fi;\r
 755    (******************* bije swojego *********************)\r
 756   if not ok \r
 757   then\r
 758    for i:=1 to 4\r
 759    do\r
 760      if players(i).suicide\r
 761      then\r
 762        result := 0 ;\r
 763        ok:=true; exit;\r
 764      fi;\r
 765    od;\r
 766   fi;\r
 767   \r
 768   \r
 769   if not ok then result:=0 fi; \r
 770 \r
 771 \r
 772  end move;\r
 773   \r
 774 \r
 775  \r
 776  \r
 777  \r
 778  \r
 779  (****** MAIN *****)\r
 780  (*****************)\r
 781 var aa:char;\r
 782 \r
 783  var i,m:integer;\r
 784  begin\r
 785   array players dim(1:4);\r
 786   for i:=1 to 4 \r
 787   do\r
 788     players(i):=new boy;\r
 789   od;\r
 790   return;\r
 791   do\r
 792     call playerinit;\r
 793     m:=move;\r
 794     call A.przesunpion(m);\r
 795     \r
 796     detach;\r
 797   od;\r
 798 end gracz4;\r
 799  \r
 800  \r
 801  (********* * * * * * * * * * * * *************)\r
 802  \r
 803 \r
 804   unit arbiter:iiuwgraph coroutine;\r
 805  \r
 806    var x,y,zawod,i,j,ktory,sk      : integer;\r
 807    var polestartu,skon,zero,wejscie,plansza: arrayof integer;\r
 808    var dom,old,tabcub           : arrayof arrayof integer;\r
 809    var tabpi                       : arrayof arrayof arrayof integer; \r
 810    var dtab                        : arrayof arrayof string;  \r
 811    var ctabs                       : arrayof string;\r
 812  \r
 813    const c=1.3;\r
 814 (********** plan **************)\r
 815    \r
 816    unit line:class(x1,y1,x2,y2:integer);\r
 817    end line;\r
 818    \r
 819    unit inchar : function: integer;\r
 820       var i : integer;\r
 821       begin\r
 822          do\r
 823          i := inkey;\r
 824          if i <> 0 then exit fi;\r
 825          od;\r
 826          result := i;\r
 827    end inchar;\r
 828    \r
 829    unit OUTHLINE: procedure(b:string);\r
 830       var i,j:integer;\r
 831       var a  :arrayof char;\r
 832                 \r
 833       begin\r
 834          a:=unpack(b);\r
 835          i:=upper(a);\r
 836          for j:=1 to i do\r
 837             call hascii(0);\r
 838             call hascii(ord(a(j)));\r
 839          od;\r
 840          kill (a); \r
 841    end outhline;      \r
 842    unit sdrp:procedure(a,b,c,d:integer);\r
 843       begin\r
 844          call move(a,c);\r
 845          call draw(b,c);\r
 846          call draw(b,d);\r
 847          call draw(a,d);\r
 848          call draw(a,c);\r
 849       end sdrp   \r
 850 \r
 851    unit sdrp1:procedure;\r
 852       begin\r
 853          call sdrp(45,76,23,49);\r
 854          call move(76,23);\r
 855          call draw(80,26);\r
 856          call draw(80,52);\r
 857          call draw(49,52);\r
 858          call draw(45,49);\r
 859    end sdrp1;      \r
 860 \r
 861   unit sdrp2:procedure;\r
 862       begin\r
 863          call sdrp(48,82,23,49);     \r
 864          call move(82,49);\r
 865          call draw(78,52);\r
 866          call draw(44,52);\r
 867          call draw(44,26);\r
 868          call draw(48,23);\r
 869   end sdrp2;\r
 870   \r
 871   unit sdrp3:procedure;\r
 872      begin\r
 873          call sdrp(48,82,26,52);               \r
 874          call move(48,52);\r
 875          call draw(44,49);\r
 876          call draw(44,23);\r
 877          call draw(78,23);\r
 878          call draw(82,26);\r
 879    end sdrp3;\r
 880    \r
 881    unit sdrp4:procedure;\r
 882       begin\r
 883          call sdrp(45,76,26,52);   \r
 884          call move(45,26);\r
 885          call draw(49,23);\r
 886          call draw(80,23);\r
 887          call draw(80,49);\r
 888          call draw(76,52);\r
 889    end sdrp4;       \r
 890        \r
 891     \r
 892    unit drp1:procedure(a,b:integer,t:arrayof string);\r
 893      begin   \r
 894          call move(a,b);\r
 895          call outhline(t(1));       \r
 896          call move(a,b+8);\r
 897          call outhline(t(2));\r
 898          call move(a,b+16);\r
 899          call outhline(t(3));\r
 900     end drp1     \r
 901          \r
 902    unit drp11:procedure(d:integer);\r
 903       begin\r
 904          call sdrp1;\r
 905          call drp1(51,25,dtab(d));\r
 906       end;\r
 907          \r
 908    unit drp21:procedure(d:integer);\r
 909       begin\r
 910          call sdrp2;\r
 911          call drp1(53,25,dtab(d));\r
 912       end;\r
 913 \r
 914    unit drp31:procedure(d:integer);\r
 915       begin\r
 916          call sdrp3;\r
 917          call drp1(53,28,dtab(d));\r
 918       end;\r
 919 \r
 920    unit drp41:procedure(d:integer);\r
 921       begin\r
 922          call sdrp4;\r
 923          call drp1(51,28,dtab(d));\r
 924       end;\r
 925    \r
 926    unit mktab:procedure;\r
 927      var i,j:integer;\r
 928      begin\r
 929        array tabpi dim(1:4);\r
 930        for i:=1 to 4 do\r
 931           array tabpi(i) dim(1:4);\r
 932           for j:=1 to 4 do\r
 933             array tabpi(i,j) dim(1:200);\r
 934           od;\r
 935        od;\r
 936       for i:=1 to 4 do \r
 937          call cls;\r
 938          call drp11(i);\r
 939          call move(43,22);\r
 940          tabpi(i,1):=getmap(84,54);\r
 941       od;\r
 942       \r
 943       for i:=1 to 4 do \r
 944          call cls;\r
 945          call drp21(i);\r
 946          call move(43,22);\r
 947          tabpi(i,2):=getmap(84,54);\r
 948       od;\r
 949       \r
 950       for i:=1 to 4 do \r
 951          call cls;\r
 952          call drp31(i);\r
 953          call move(43,22);\r
 954          tabpi(i,3):=getmap(84,54);\r
 955       od;\r
 956       \r
 957       for i:=1 to 4 do \r
 958          call cls;\r
 959          call drp41(i);\r
 960          call move(43,22);\r
 961          tabpi(i,4):=getmap(84,54);\r
 962       od;\r
 963     end mktab; \r
 964 \r
 965       unit piszpion:coroutine(x,y,k:integer);\r
 966          var i,j:integer;\r
 967          begin\r
 968             return;\r
 969             do\r
 970                call move(x,y);\r
 971           for i:=1 to 2 do\r
 972                call putmap(tabpi(ktory,k));\r
 973           for j:=1 to 30 do od;\r
 974           call putmap(zero);\r
 975           for j:=1 to 30 do od;\r
 976           od;\r
 977           call putmap(tabpi(ktory,k));\r
 978                detach;\r
 979             od;\r
 980       end piszpion;      \r
 981 var  pl:arrayof arrayof arrayof piszpion;\r
 982 \r
 983     \r
 984       unit mkpl:procedure;\r
 985       var a,b,c,i,j:integer;   \r
 986       \r
 987       begin\r
 988          array pl dim(0:104);\r
 989          array pl(0) dim(1:4);\r
 990          for i:=1 to 4 do\r
 991             array pl(0,i) dim (1:4);\r
 992             array pl(100+i) dim (1:4);\r
 993             for j:=1 to 4 do\r
 994                array pl(100+i,j) dim (1:1);\r
 995             od;\r
 996          od;\r
 997          for i:=1 to 40 do\r
 998             array pl(i) dim(1:1);\r
 999             array pl(i,1) dim(1:1);\r
1000          od;\r
1001 \r
1002 open(f,integer,unpack("pola"));\r
1003 call reset(f);\r
1004 \r
1005 for i:=1 to 40 do\r
1006 get(f,a);\r
1007 get(f,b);\r
1008 get(f,c);\r
1009 pl(i,1,1):=new piszpion(a,b,c);\r
1010 od;\r
1011 \r
1012 for i:=1 to 4 do\r
1013 for j:=1 to 4 do\r
1014 get(f,a);\r
1015 get(f,b);\r
1016 get(f,c);\r
1017 pl(0,i,j):=new piszpion(a,b,c);\r
1018 od;\r
1019 od;\r
1020 \r
1021 for i:=1 to 4 do\r
1022 for j:=101 to 104 do\r
1023 get(f,a);\r
1024 get(f,b);\r
1025 get(f,c);\r
1026 pl(j,i,1):=new piszpion(a,b,c);\r
1027 od;\r
1028 od;\r
1029 \r
1030 end mkpl;      \r
1031       unit sq:procedure(x,y:integer);\r
1032          begin\r
1033             call move(c*(x+1)+40,20+y+1);\r
1034             call draw(c*(x+35)+40,20+y+1);\r
1035             call draw(c*(x+35)+40,20+y+35);\r
1036             call draw(c*(x+1)+40,20+y+35);\r
1037             call draw(c*(x+1)+40,20+y+1);\r
1038       end sq;\r
1039       \r
1040       unit cube:procedure;\r
1041       begin\r
1042       call move(0,8);\r
1043       call draw(32,8);\r
1044       call draw(32,34);\r
1045       call draw(0,34);\r
1046       call draw(0,8);\r
1047       call draw(10,0);\r
1048       call draw(41,0);\r
1049       call draw(32,8);\r
1050       call move(41,0);\r
1051       call draw(41,26);\r
1052       call draw(32,34);\r
1053       end;\r
1054       \r
1055       unit cubes:procedure(i,a,b,c:integer);\r
1056         begin\r
1057         call cube;\r
1058         call move(4,9);\r
1059         call outhline(ctabs(a));\r
1060         call move(4,17);\r
1061         call outhline(ctabs(b));\r
1062         call move(4,25);\r
1063         call outhline(ctabs(c));\r
1064         call move(0,0);\r
1065         tabcub(i):=getmap(41,34);\r
1066         call cls;\r
1067       end cubes;      \r
1068       \r
1069       unit cu:procedure(i,j:integer);\r
1070          begin\r
1071          call move(310,70);\r
1072          call outhline("PLAYER : ");\r
1073          case j        \r
1074           when 1: call outhline("1");\r
1075           when 2: call outhline("2");\r
1076           when 3: call outhline("3");\r
1077           when 4: call outhline("4");\r
1078          esac; \r
1079     call move(360,80);        \r
1080     call putmap(tabcub(i));\r
1081       end cu;\r
1082       \r
1083       unit hjm:procedure(nw:arrayof arrayof integer);\r
1084          var i,j,x:integer;\r
1085          var z:string;\r
1086          unit drp:procedure(i,j:integer);\r
1087          var b1,b2:boolean;\r
1088             begin\r
1089           b1:=old(i,j)=0;\r
1090           if not b1 then b2:=plansza(old(i,j))=0 fi;\r
1091             if b2 or  b1 then\r
1092             if b1 then\r
1093               attach(pl(0,i,j));\r
1094               else          \r
1095                attach(pl(old(i,j),1,1));\r
1096             fi; \r
1097           call putmap(zero); fi;\r
1098              if nw(i,j)=0 then x:=ktory;\r
1099                           ktory:=i;\r
1100                 attach(pl(0,i,j));\r
1101                 ktory:=x;\r
1102              else\r
1103                if nw(i,j)>100 then attach(pl(nw(i,j),i,1));\r
1104              else attach(pl(nw(i,j),1,1));\r
1105              fi;\r
1106                fi;\r
1107          end drp;               \r
1108          begin\r
1109             i:=ktory;\r
1110        do\r
1111                for j:=1 to 4 do\r
1112                   if old(i,j)<>nw(i,j) then  call drp(i,j); fi;\r
1113                   old(i,j):=nw(i,j);\r
1114                od;\r
1115           i:=i mod 4 +1;\r
1116           if i=ktory then exit fi;\r
1117             od;\r
1118          end;\r
1119       \r
1120    unit drpl:procedure;\r
1121       var i,x,y,x1,x2,y1,y2:integer;\r
1122    begin\r
1123             call gron(1); \r
1124       open(f,integer,unpack("plan"));\r
1125       call reset(f);\r
1126       for i:=1 to 47 do\r
1127 \r
1128          get(f,x1);\r
1129          get(f,y1);\r
1130          call move(x1,y1);\r
1131          get(f,x2);\r
1132          get(f,y2);\r
1133          call draw(x2,y2);\r
1134 \r
1135       \r
1136          x:=735-x1;\r
1137          y:=y1;\r
1138          call move(x,y);\r
1139          x:=735-x2;\r
1140          y:=y2;\r
1141          call draw(x,y);\r
1142          \r
1143          x:=735-x1;\r
1144          y:=328-y1;\r
1145          call move(x,y);\r
1146          x:=735-x2;\r
1147          y:=328-y2;\r
1148          call draw(x,y);\r
1149          \r
1150          x:=x1;\r
1151          y:=328-y1;\r
1152          call move(x,y);\r
1153          x:=x2;\r
1154          y:=328-y2;\r
1155          call draw(x,y);\r
1156          \r
1157       od;\r
1158       \r
1159  end drpl;\r
1160          \r
1161    unit starter:procedure;\r
1162    var i,j:integer;\r
1163    begin\r
1164       array zero dim(1:1300);\r
1165       call gron(1);\r
1166       call move(0,0);\r
1167       zero:=getmap(42,32);\r
1168       call cubes(1,1,2,1);\r
1169       call cubes(2,3,1,4);\r
1170       call cubes(3,3,2,4);\r
1171       call cubes(4,5,1,5);\r
1172       call cubes(5,5,2,5);\r
1173       call cubes(6,5,5,5);\r
1174       call mktab;\r
1175       call mkpl;\r
1176       call drpl;\r
1177       call sq(72,0);\r
1178       call sq(395,36);\r
1179       call sq(395,252);\r
1180       call sq(72,216);\r
1181       for i:=1 to 4 do\r
1182        for j:=1 to 4 do\r
1183         ktory:=i;\r
1184         attach(pl(0,i,j));\r
1185        od;\r
1186       od;\r
1187       i:=inchar;\r
1188       \r
1189    end starter;\r
1190       \r
1191 (************** end plan ***********)\r
1192 \r
1193   \r
1194   unit przesunpion:procedure(co:integer);\r
1195     var g,s,t:integer;\r
1196   \r
1197     unit start:procedure;\r
1198       begin\r
1199         g:=polestartu(ktory);\r
1200         tab(ktory,co):=g;\r
1201         if plansza(g)=/=0 then\r
1202           tab((plansza(g)/10),(plansza(g) mod 10)):=0;\r
1203         fi;\r
1204         plansza(g):=ktory*10+co;\r
1205     end start;\r
1206     begin\r
1207       if co<1 orif co>4 then return fi;\r
1208       if ktory<1 orif ktory>4 then return fi;\r
1209       s:=tab(ktory,co);\r
1210       g:=s+kostka;\r
1211       if s>100 then return fi;\r
1212       if s=0 then \r
1213         if kostka=6 then call start fi;\r
1214         return; \r
1215       fi;\r
1216       t:=wejscie(ktory);\r
1217       if s<=t  andif g>t then\r
1218         t:=g-t;\r
1219         if t<5 andif dom(ktory,t)=0 then\r
1220           dom(ktory,t):=co;\r
1221           tab(ktory,co):=100+t;\r
1222           plansza(s):=0;\r
1223         fi;\r
1224         return;\r
1225       else\r
1226         if g>40 then g:=g-40 fi;\r
1227         if plansza(g)=/=0 then\r
1228           tab((plansza(g)/10),(plansza(g) mod 10)):=0;\r
1229         fi;\r
1230         tab(ktory,co):=g;\r
1231         plansza(g):=plansza(s);\r
1232         plansza(s):=0;\r
1233       fi;\r
1234   end przesunpion;\r
1235                 \r
1236   unit koniec: function: boolean;\r
1237     var doszedl: boolean;\r
1238   begin\r
1239     doszedl:=true;\r
1240     for i:=1 to 4\r
1241     do\r
1242       if dom(ktory,i)=0 then\r
1243         doszedl:=false;exit\r
1244       fi\r
1245     od;\r
1246     if doszedl then\r
1247       sk:=sk+1;\r
1248       skon(ktory):=sk;\r
1249     fi;\r
1250     result:= sk=4\r
1251   end koniec;     \r
1252   \r
1253   unit komunikat: procedure;\r
1254     var m: arrayof integer;\r
1255   begin\r
1256     array m dim (1:4);\r
1257     for i:=1 to 4 do\r
1258       m(skon(i)):=i;\r
1259     od;  \r
1260     call groff;\r
1261     writeln;\r
1262     for i:=1 to 4 do\r
1263       writeln (i:1," miejsce zajal gracz ",m(i):1)\r
1264     od\r
1265   end komunikat;\r
1266 \r
1267 begin     (*  arbiter  *)\r
1268   array tab dim (1:4);\r
1269   array old dim (1:4);\r
1270   array dom dim (1:4);\r
1271   array ctabs dim (1:5);\r
1272   array tabcub dim (1:6);\r
1273   array plansza dim (1:40);\r
1274   array skon dim (1:4);\r
1275   array wejscie dim (1:4);\r
1276   array polestartu dim (1:4);\r
1277   array dtab dim(1:4);\r
1278   for i:=1 to 4\r
1279   do\r
1280     skon(i):=0;\r
1281     array tabcub(i) dim(1:200);\r
1282     array dtab(i) dim (1:3);\r
1283     array tab(i) dim (1:4);\r
1284     array old(i) dim (1:4);\r
1285     array dom(i) dim (1:4);\r
1286     polestartu(i):=10*(i-1)+1;\r
1287     wejscie(i):=polestartu(i)-1;\r
1288   od;\r
1289   wejscie(1):=40;\r
1290   for i:=5 to 6 do\r
1291     array tabcub(i) dim(1:200);\r
1292   od;\r
1293   ctabs(1):="   ";  \r
1294   ctabs(2):=" * ";\r
1295   ctabs(3):="*  ";\r
1296   ctabs(4):="  *";\r
1297   ctabs(5):="* *";\r
1298   dtab(1,1):=" 1 ";       \r
1299   dtab(1,2):=" 1 ";\r
1300   dtab(1,3):=" 1 ";\r
1301   dtab(2,1):="2  ";       \r
1302   dtab(2,2):=" 2 ";\r
1303   dtab(2,3):="  2";\r
1304   dtab(3,1):="  3";\r
1305   dtab(3,2):=" 3 ";\r
1306   dtab(3,3):="3  ";\r
1307   dtab(4,1):="   ";       \r
1308   dtab(4,2):="444";\r
1309   dtab(4,3):="   ";\r
1310 \r
1311   return;\r
1312   call starter;\r
1313   ktory:=0;\r
1314   do\r
1315     ktory:= (ktory mod 4) + 1;\r
1316     if skon(ktory)=/=0 then repeat fi;\r
1317     do\r
1318       kostka:=entier(random*6)+1;\r
1319       call cu(kostka,ktory);\r
1320       attach (gracz(ktory));\r
1321       call hjm(tab);\r
1322       if koniec then exit exit fi;\r
1323       if kostka=/=6 or skon(ktory)=/=0 then exit fi\r
1324     od\r
1325   od;\r
1326   call komunikat;\r
1327   read (i);\r
1328   call endrun\r
1329 end arbiter;\r
1330 \r
1331   var A: arbiter;    \r
1332 (*          *           *            *                *             *)         \r
1333 begin     (*  program glowny  *)\r
1334 array gracz dim (1:4);\r
1335 writeln ("Type how many PLAYERS want to enjoy game");\r
1336 read(ia);\r
1337 for i:=1 to ia do\r
1338 gracz(i) := new player(i);\r
1339 od;\r
1340 if ia=0 then ia:=1;gracz(1):=new gracz1(1,40,1); fi;\r
1341 for i:=ia+1 to 2 do\r
1342 gracz(i) := new gracz1(i,(i-1)*10,i*10-9);\r
1343 od;\r
1344 gracz(3):=new gracz3;\r
1345 gracz(4):=new gracz4;\r
1346 A := new arbiter;\r
1347 attach (A)\r
1348 end chinczyk  \r
1349 \1a