Программа крестики-нолики

USES
  CRT,
  Graph;
TYPE
  Line=ARRAY[0..14] OF Integer;
CONST
  l1:Line=(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14);
  l2:Line=(15,16,17,18,19,20,21,22,23,24,25,26,27,28,29);
  l3:Line=(30,31,32,33,34,35,36,37,38,39,40,41,42,43,44);
  l4:Line=(45,46,47,48,49,50,51,52,53,54,55,56,57,58,59);
  l5:Line=(60,61,62,63,64,65,66,67,68,69,70,71,72,73,74);
  l6:Line=(75,76,77,78,79,80,81,82,83,84,85,86,87,88,89);
  l7:Line=(90,91,92,93,94,95,96,97,98,99,100,101,102,103,104);
  l8:Line=(105,106,107,108,109,110,111,112,113,114,115,116,117,118,119);
  l9:Line=(120,121,122,123,124,125,126,127,128,129,130,131,132,133,134);
  l10:Line=(135,136,137,138,139,140,141,142,143,144,145,146,147,148,149);
  l11:Line=(150,151,152,153,154,155,156,157,158,159,160,161,162,163,164);
  l12:Line=(165,166,167,168,169,170,171,172,173,174,175,176,177,178,179);
  l13:Line=(180,181,182,183,184,185,186,187,188,189,190,191,192,193,194);
  l14:Line=(195,196,197,198,199,200,201,202,203,204,205,206,207,208,209);
  l15:Line=(210,211,212,213,214,215,216,217,218,219,220,221,222,223,224);
  l16:Line=(0,15,30,45,60,75,90,105,120,135,150,165,180,195,210);
  l17:Line=(1,16,31,46,61,76,91,106,121,136,151,166,181,196,211);
  l18:Line=(2,17,32,47,62,77,92,107,122,137,152,167,182,197,212);
  l19:Line=(3,18,33,48,63,78,93,108,123,138,153,168,183,198,213);
  l20:Line=(4,19,34,49,64,79,94,109,124,139,154,169,184,199,214);
  l21:Line=(5,20,35,50,65,80,95,110,125,140,155,170,185,200,215);
  l22:Line=(6,21,36,51,66,81,96,111,126,141,156,171,186,201,216);
  l23:Line=(7,22,37,52,67,82,97,112,127,142,157,172,187,202,217);
  l24:Line=(8,23,38,53,68,83,98,113,128,143,158,173,188,203,218);
  l25:Line=(9,24,39,54,69,84,99,114,129,144,159,174,189,204,219);
  l26:Line=(10,25,40,55,70,85,100,115,130,145,160,175,190,205,220);
  l27:Line=(11,26,41,56,71,86,101,116,131,146,161,176,191,206,221);
  l28:Line=(12,27,42,57,72,87,102,117,132,147,162,177,192,207,222);
  l29:Line=(13,28,43,58,73,88,103,118,133,148,163,178,193,208,223);
  l30:Line=(14,29,44,59,74,89,104,119,134,149,164,179,194,209,224);
  l31:Line=(4,18,32,46,60,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1);
  l32:Line=(5,19,33,47,61,75,-1,-1,-1,-1,-1,-1,-1,-1,-1);
  l33:Line=(6,20,34,48,62,76,90,-1,-1,-1,-1,-1,-1,-1,-1);
  l34:Line=(7,21,35,49,63,77,91,105,-1,-1,-1,-1,-1,-1,-1);
  l35:Line=(8,22,36,50,64,78,92,106,120,-1,-1,-1,-1,-1,-1);
  l36:Line=(9,23,37,51,65,79,93,107,121,135,-1,-1,-1,-1,-1);
  l37:Line=(10,24,38,52,66,80,94,108,122,136,150,-1,-1,-1,-1);
  l38:Line=(11,25,39,53,67,81,95,109,123,137,151,165,-1,-1,-1);
  l39:Line=(12,26,40,54,68,82,96,110,124,138,152,166,180,-1,-1);
  l40:Line=(13,27,41,55,69,83,97,111,125,139,153,167,181,195,-1);
  l41:Line=(14,28,42,56,70,84,98,112,126,140,154,168,182,196,210);
  l42:Line=(29,43,57,71,85,99,113,127,141,155,169,183,197,211,-1);
  l43:Line=(44,58,72,86,100,114,128,142,156,170,184,198,212,-1,-1);
  l44:Line=(59,73,87,101,115,129,143,157,171,185,199,213,-1,-1,-1);
  l45:Line=(74,88,102,116,130,144,158,172,186,200,214,-1,-1,-1,-1);
  l46:Line=(89,103,117,131,145,159,173,187,201,215,-1,-1,-1,-1,-1);
  l47:Line=(104,118,132,146,160,174,188,202,216,-1,-1,-1,-1,-1,-1);
  l48:Line=(119,133,147,161,175,189,203,217,-1,-1,-1,-1,-1,-1,-1);
  l49:Line=(134,148,162,176,190,204,218,-1,-1,-1,-1,-1,-1,-1,-1);
  l50:Line=(149,163,177,191,205,219,-1,-1,-1,-1,-1,-1,-1,-1,-1);
  l51:Line=(164,178,192,206,220,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1);
  l52:Line=(0,16,32,48,64,80,96,112,128,144,160,176,192,208,224);
  l53:Line=(1,17,33,49,65,81,97,113,129,145,161,177,193,209,-1);
  l54:Line=(2,18,34,50,66,82,98,114,130,146,162,178,194,-1,-1);
  l55:Line=(3,19,35,51,67,83,99,115,131,147,163,179,-1,-1,-1);
  l56:Line=(4,20,36,52,68,84,100,116,132,148,164,-1,-1,-1,-1);
  l57:Line=(5,21,37,53,69,85,101,117,133,149,-1,-1,-1,-1,-1);
  l58:Line=(6,22,38,54,70,86,102,118,134,-1,-1,-1,-1,-1,-1);
  l59:Line=(7,23,39,55,71,87,103,119,-1,-1,-1,-1,-1,-1,-1);
  l60:Line=(8,24,40,56,72,88,104,-1,-1,-1,-1,-1,-1,-1,-1);
  l61:Line=(9,25,41,57,73,89,-1,-1,-1,-1,-1,-1,-1,-1,-1);
  l62:Line=(10,26,42,58,74,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1);
  l63:Line=(15,31,47,63,79,95,111,127,143,159,175,191,207,223,-1);
  l64:Line=(30,46,62,78,94,110,126,142,158,174,190,206,222,-1,-1);
  l65:Line=(45,61,77,93,109,125,141,157,173,189,205,221,-1,-1,-1);
  l66:Line=(60,76,92,108,124,140,156,172,188,204,220,-1,-1,-1,-1);
  l67:Line=(75,91,107,123,139,155,171,187,203,219,-1,-1,-1,-1,-1);
  l68:Line=(90,106,122,138,154,170,186,202,218,-1,-1,-1,-1,-1,-1);
  l69:Line=(105,121,137,153,169,185,201,217,-1,-1,-1,-1,-1,-1,-1);
  l70:Line=(120,136,152,168,184,200,216,-1,-1,-1,-1,-1,-1,-1,-1);
  l71:Line=(135,151,167,183,199,215,-1,-1,-1,-1,-1,-1,-1,-1,-1);
  l72:Line=(150,166,182,198,214,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1);
VAR
  gd,gm:Integer;
  i,j:Integer;
  a:ARRAY[0..224] OF Integer;
  k,q,r:Integer;
  ch:Char;
  l:ARRAY[0..71] OF Line;
  w:ARRAY[0..4] OF Integer;
  g:ARRAY[0..224] OF LongInt;
  game_over:Boolean;
PROCEDURE DrawField(i:Integer;j:Integer;s:Integer;h:Integer);
VAR
  x,y,c:Integer;
  ss:String;
BEGIN
  x:=(i*2+1)*15;
  y:=(j*2+1)*15;
  CASE h OF
    0:c:=(i+j) MOD 2+7;
    1:c:=4;
    2:c:=14;
  END;
  SetFillStyle(1,c);
  Bar(x,y,x+30,y+30);
  CASE s OF
    1:BEGIN
      SetFillStyle(1,1);
      Circle(x+15,y+15,10);
      Circle(x+15,y+15,5);
      FloodFill(x+10,y+10,15);
    END;
    2:BEGIN
      SetFillStyle(1,2);
      MoveTo(x+6,y+6);
      LineRel(3,0);
      LineRel(6,6);
      LineRel(6,-6);
      LineRel(3,0);
      LineRel(0,3);
      LineRel(-6,6);
      LineRel(6,6);
      LIneRel(0,3);
      LineRel(-3,0);
      LineRel(-6,-6);
      LineRel(-6,6);
      LineRel(-3,0);
      LineRel(0,-3);
      LIneRel(6,-6);
      LineRel(-6,-6);
      LIneRel(0,-3);
      FloodFill(x+10,y+10,15);
    END;
  END;
  {Str(g[i+j*15],ss);   Vyvod znachenii koefiicienta
  SetColor(0);          opasnosti v celyax otladki.
  IF g[i+j*15]<10000 THEN OutTextXY(x,y,ss) ELSE OutTextXY(x,y,'Inf');
  SetColor(15);}
END;
FUNCTION CheckVictory:Integer;
VAR
  i,j,q,v:Integer;
  w1,w2:Boolean;
BEGIN
  v:=0;
  FOR i:=0 TO 71 DO BEGIN
    FOR j:=0 TO 10 DO BEGIN
      w1:=TRUE;
      w2:=TRUE;
      FOR q:=0 TO 4 DO BEGIN
        w[q]:=l[i][j+q];
        IF w[q]=-1 THEN BEGIN
          w1:=FALSE;
          w2:=FALSE;
        END
        ELSE BEGIN
          IF a[w[q]]<>1 THEN w1:=FALSE;
          IF a[w[q]]<>2 THEN w2:=FALSE;
        END;
      END;
      IF w1 THEN v:=1;
      IF w2 THEN v:=2;
      IF v<>0 THEN break;
    END;
    IF v<>0 THEN break;
  END;
  CheckVictory:=v;
END;
FUNCTION GetResponse:Integer;
VAR
  i,j,k,q,z,r,ii,jj:Integer;
  gmax:LongInt;
  f:Boolean;
BEGIN
  r:=-1;
  FOR k:=0 TO 224 DO BEGIN
    IF a[k]=0 THEN BEGIN
      r:=k;
      break;
    END;
  END;
  IF r<>-1 THEN BEGIN
    k:=0;
    FOR i:=0 TO 14 DO BEGIN
      FOR j:=0 TO 14 DO BEGIN
        IF a[k]=0 THEN g[k]:=100-(i-7)*(i-7)-(j-7)*(j-7) ELSE g[k]:=0;
        k:=k+1;
      END;
    END;
    FOR k:=0 TO 224 DO BEGIN
      IF a[k]=2 THEN BEGIN
        IF k MOD 15>0 THEN BEGIN
          IF a[k-1]=0 THEN g[k-1]:=g[k-1]+1000;
          IF k>14 THEN IF a[k-16]=0 THEN g[k-16]:=g[k-16]+1000;
          IF k<210 THEN IF a[k+14]=0 THEN g[k+14]:=g[k+14]+1000;
        END;
        IF k MOD 15<14 THEN BEGIN
          IF a[k+1]=0 THEN g[k+1]:=g[k+1]+1000;
          IF k>14 THEN IF a[k-14]=0 THEN g[k-14]:=g[k-14]+1000;
          IF k<210 THEN IF a[k+16]=0 THEN g[k+16]:=g[k+16]+1000;
        END;
        IF k>14 THEN IF a[k-15]=0 THEN g[k-15]:=g[k-15]+1000;
        IF k<210 THEN IF a[k+15]=0 THEN g[k+15]:=g[k+15]+1000;
      END;
    END;
    f:=FALSE;
    FOR i:=0 TO 71 DO BEGIN
      FOR j:=0 TO 13 DO BEGIN
        FOR k:=j+1 TO 14 DO BEGIN
          IF (a[l[i][j]]=0) AND (a[l[i][k]]=0) THEN BEGIN
            a[l[i][j]]:=2;
            a[l[i][k]]:=2;
            f:=FALSE;
            FOR q:=0 TO 10 DO BEGIN
              IF (a[l[i][q]]=2) THEN BEGIN
                IF (a[l[i][q+1]]=2) THEN BEGIN
                  IF (a[l[i][q+2]]=2) THEN BEGIN
                    IF (a[l[i][q+3]]=2) THEN BEGIN
                      IF (a[l[i][q+4]]=2) THEN BEGIN
                        f:=TRUE;
                        break;
                      END;
                    END;
                  END;
                END;
              END;
            END;
            a[l[i][j]]:=0;
            a[l[i][k]]:=0;
            IF f THEN BEGIN
              g[l[i][j]]:=g[l[i][j]]+1000000;
              g[l[i][k]]:=g[l[i][k]]+1000000;
              break;
            END;
          END;
          IF f THEN break;
        END;
        If f THEN break;
      END;
    END;
    FOR i:=0 TO 71 DO BEGIN
      FOR j:=0 TO 14 DO BEGIN
        IF a[l[i][j]]=0 THEN BEGIN
          a[l[i][j]]:=2;
          FOR q:=0 TO 10 DO BEGIN
            f:=TRUE;
            FOR z:=0 TO 4 DO BEGIN
              IF a[l[i][q+z]]<>2 THEN BEGIN
                f:=FALSE;
                break;
              END;
            END;
            IF f THEN break;
          END;
          IF f THEN g[l[i][j]]:=1000000000;
          a[l[i][j]]:=0;
        END;
      END;
    END;
    r:=0;
    gmax:=g[0];
    FOR k:=1 TO 224 DO BEGIN
      IF g[k]>gmax THEN BEGIN
        r:=k;
        gmax:=g[k];
      END;
    END;
  END;
  GetResponse:=r;
END;
BEGIN
  l[0]:=l1;
  l[1]:=l2;
  l[2]:=l3;
  l[3]:=l4;
  l[4]:=l5;
  l[5]:=l6;
  l[6]:=l7;
  l[7]:=l8;
  l[8]:=l9;
  l[9]:=l10;
  l[10]:=l11;
  l[11]:=l12;
  l[12]:=l13;
  l[13]:=l14;
  l[14]:=l15;
  l[15]:=l16;
  l[16]:=l17;
  l[17]:=l18;
  l[18]:=l19;
  l[19]:=l20;
  l[20]:=l21;
  l[21]:=l22;
  l[22]:=l23;
  l[23]:=l24;
  l[24]:=l25;
  l[25]:=l26;
  l[26]:=l27;
  l[27]:=l28;
  l[28]:=l29;
  l[29]:=l30;
  l[30]:=l31;
  l[31]:=l32;
  l[32]:=l33;
  l[33]:=l34;
  l[34]:=l35;
  l[35]:=l36;
  l[36]:=l37;
  l[37]:=l38;
  l[38]:=l39;
  l[39]:=l40;
  l[40]:=l41;
  l[41]:=l42;
  l[42]:=l43;
  l[43]:=l44;
  l[44]:=l45;
  l[45]:=l46;
  l[46]:=l47;
  l[47]:=l48;
  l[48]:=l49;
  l[49]:=l50;
  l[50]:=l51;
  l[51]:=l52;
  l[52]:=l53;
  l[53]:=l54;
  l[54]:=l55;
  l[55]:=l56;
  l[56]:=l57;
  l[57]:=l58;
  l[58]:=l59;
  l[59]:=l60;
  l[60]:=l61;
  l[61]:=l62;
  l[62]:=l63;
  l[63]:=l64;
  l[64]:=l65;
  l[65]:=l66;
  l[66]:=l67;
  l[67]:=l68;
  l[68]:=l69;
  l[69]:=l70;
  l[70]:=l71;
  l[71]:=l72;
  game_over:=FALSE;
  gd:=0;
  gm:=0;
  InitGraph(gd,gm,'../BGI/');
  IF GraphResult<>0 THEN BEGIN
     ClrScr;
     WriteLn('Y vas ne klassicheskii Turpo Pascal.');
     WriteLn('Nastroite put k papke graphiki v procedure InitGraph.');
     ReadKey;
  END;
  FOR i:=0 TO 14 DO BEGIN
    FOR j:=0 TO 14 DO BEGIN
      DrawField(i,j,0,0);
    END;
  END;
  DrawField(0,0,0,1);
  FOR i:=0 TO 224 DO a[i]:=0;
  i:=0;
  j:=0;
  k:=0;
  REPEAT
    ch:=ReadKey;
    IF NOT game_over THEN BEGIN
      CASE ch OF
        #32:BEGIN
          IF a[k]=0 THEN BEGIN
            a[k]:=2;
            IF CheckVictory=2 THEN BEGIN
              game_over:=TRUE;
              FOR q:=0 TO 4 DO BEGIN
                k:=w[q];
                i:=k MOD 15;
                j:=k DIV 15;
                DrawField(i,j,a[k],2);
                SetFillStyle(1,1);
                SetTextStyle(1,0,5);
                Bar(30,50,570,105);
                OutTextXY(50,50,'Pozdravlyaem s pobedoi!');
              END;
            END
            ELSE BEGIN
              r:=GetResponse;
              IF r<>-1 THEN BEGIN
                a[r]:=1;
                IF CheckVictory=1 THEN BEGIN
                  game_over:=TRUE;
                  DrawField(i,j,a[k],0);
                  FOR q:=0 TO 4 DO BEGIN
                    k:=w[q];
                    i:=k MOD 15;
                    j:=k DIV 15;
                    DrawField(i,j,a[k],2);
                  END;
                  SetFillStyle(1,1);
                  SetTextStyle(1,0,5);
                  Bar(30,50,590,105);
                  OutTextXY(50,50,'Komp okazalsya umnee :)');
                END
                ELSE BEGIN
                  DrawField(i,j,a[k],1);
                  DrawField(r MOD 15,r DIV 15,a[r],0);
                END;
              END
              ELSE BEGIN
                game_over:=TRUE;
                DrawField(i,j,a[k],0);
              END;
            END;
          END;
        END;
        #72:BEGIN
          IF j>0 THEN BEGIN
            DrawField(i,j,a[k],0);
            j:=j-1;
            k:=k-15;
            DrawField(i,j,a[k],1);
          END;
        END;
        #75:BEGIN
          IF i>0 THEN BEGIN
            DrawField(i,j,a[k],0);
            i:=i-1;
            k:=k-1;
            DrawField(i,j,a[k],1);
          END;
        END;
        #77:BEGIN
          IF i<14 THEN BEGIN
            DrawField(i,j,a[k],0);
            i:=i+1;
            k:=k+1;
            DrawField(i,j,a[k],1);
          END;
        END;
        #80:BEGIN
          IF j<14 THEN BEGIN
            DrawField(i,j,a[k],0);
            j:=j+1;
            k:=k+15;
            DrawField(i,j,a[k],1);
          END;
        END;
      END;
    END;
  UNTIL ch=#27;
  CloseGraph;
END.

  l: array [0..71] of Line = (
    (...),
    ...
    (...));

            f:=FALSE;
            FOR q:=0 TO 10 DO BEGIN
              IF    (a[l[i][q  ]]=2)
                and (a[l[i][q+1]]=2)
                and (a[l[i][q+2]]=2)
                and (a[l[i][q+3]]=2)
                and (a[l[i][q+4]]=2)
              THEN BEGIN
                f:=FALSE;
                Break;
              END;
            END;

Program krestikinoliki;
uses
  CRT,
  Graph;
var
  gd,gm: Integer;
  i,j: Integer;
  a:array[0..224] of Integer;
  k,q,r:Integer;
  ch:Char;
  Li:array[0..71,0..14] of integer =
  ((0,1,2,3,4,5,6,7,8,9,10,11,12,13,14),
  (15,16,17,18,19,20,21,22,23,24,25,26,27,28,29),
  (30,31,32,33,34,35,36,37,38,39,40,41,42,43,44),
  (45,46,47,48,49,50,51,52,53,54,55,56,57,58,59),
  (60,61,62,63,64,65,66,67,68,69,70,71,72,73,74),
  (75,76,77,78,79,80,81,82,83,84,85,86,87,88,89),
  (90,91,92,93,94,95,96,97,98,99,100,101,102,103,104),
  (105,106,107,108,109,110,111,112,113,114,115,116,117,118,119),
  (120,121,122,123,124,125,126,127,128,129,130,131,132,133,134),
  (135,136,137,138,139,140,141,142,143,144,145,146,147,148,149),
  (150,151,152,153,154,155,156,157,158,159,160,161,162,163,164),
  (165,166,167,168,169,170,171,172,173,174,175,176,177,178,179),
  (180,181,182,183,184,185,186,187,188,189,190,191,192,193,194),
  (195,196,197,198,199,200,201,202,203,204,205,206,207,208,209),
  (210,211,212,213,214,215,216,217,218,219,220,221,222,223,224),
  (0,15,30,45,60,75,90,105,120,135,150,165,180,195,210),
  (1,16,31,46,61,76,91,106,121,136,151,166,181,196,211),
  (2,17,32,47,62,77,92,107,122,137,152,167,182,197,212),
  (3,18,33,48,63,78,93,108,123,138,153,168,183,198,213),
  (4,19,34,49,64,79,94,109,124,139,154,169,184,199,214),
  (5,20,35,50,65,80,95,110,125,140,155,170,185,200,215),
  (6,21,36,51,66,81,96,111,126,141,156,171,186,201,216),
  (7,22,37,52,67,82,97,112,127,142,157,172,187,202,217),
  (8,23,38,53,68,83,98,113,128,143,158,173,188,203,218),
  (9,24,39,54,69,84,99,114,129,144,159,174,189,204,219),
  (10,25,40,55,70,85,100,115,130,145,160,175,190,205,220),
  (11,26,41,56,71,86,101,116,131,146,161,176,191,206,221),
  (12,27,42,57,72,87,102,117,132,147,162,177,192,207,222),
  (13,28,43,58,73,88,103,118,133,148,163,178,193,208,223),
  (14,29,44,59,74,89,104,119,134,149,164,179,194,209,224),
  (4,18,32,46,60,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1),
  (5,19,33,47,61,75,-1,-1,-1,-1,-1,-1,-1,-1,-1),
  (6,20,34,48,62,76,90,-1,-1,-1,-1,-1,-1,-1,-1),
  (7,21,35,49,63,77,91,105,-1,-1,-1,-1,-1,-1,-1),
  (8,22,36,50,64,78,92,106,120,-1,-1,-1,-1,-1,-1),
  (9,23,37,51,65,79,93,107,121,135,-1,-1,-1,-1,-1),
  (10,24,38,52,66,80,94,108,122,136,150,-1,-1,-1,-1),
  (11,25,39,53,67,81,95,109,123,137,151,165,-1,-1,-1),
  (12,26,40,54,68,82,96,110,124,138,152,166,180,-1,-1),
  (13,27,41,55,69,83,97,111,125,139,153,167,181,195,-1),
  (14,28,42,56,70,84,98,112,126,140,154,168,182,196,210),
  (29,43,57,71,85,99,113,127,141,155,169,183,197,211,-1),
  (44,58,72,86,100,114,128,142,156,170,184,198,212,-1,-1),
  (59,73,87,101,115,129,143,157,171,185,199,213,-1,-1,-1),
  (74,88,102,116,130,144,158,172,186,200,214,-1,-1,-1,-1),
  (89,103,117,131,145,159,173,187,201,215,-1,-1,-1,-1,-1),
  (104,118,132,146,160,174,188,202,216,-1,-1,-1,-1,-1,-1),
  (119,133,147,161,175,189,203,217,-1,-1,-1,-1,-1,-1,-1),
  (134,148,162,176,190,204,218,-1,-1,-1,-1,-1,-1,-1,-1),
  (149,163,177,191,205,219,-1,-1,-1,-1,-1,-1,-1,-1,-1),
  (164,178,192,206,220,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1),
  (0,16,32,48,64,80,96,112,128,144,160,176,192,208,224),
  (1,17,33,49,65,81,97,113,129,145,161,177,193,209,-1),
  (2,18,34,50,66,82,98,114,130,146,162,178,194,-1,-1),
  (3,19,35,51,67,83,99,115,131,147,163,179,-1,-1,-1),
  (4,20,36,52,68,84,100,116,132,148,164,-1,-1,-1,-1),
  (5,21,37,53,69,85,101,117,133,149,-1,-1,-1,-1,-1),
  (6,22,38,54,70,86,102,118,134,-1,-1,-1,-1,-1,-1),
  (7,23,39,55,71,87,103,119,-1,-1,-1,-1,-1,-1,-1),
  (8,24,40,56,72,88,104,-1,-1,-1,-1,-1,-1,-1,-1),
  (9,25,41,57,73,89,-1,-1,-1,-1,-1,-1,-1,-1,-1),
  (10,26,42,58,74,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1),
  (15,31,47,63,79,95,111,127,143,159,175,191,207,223,-1),
  (30,46,62,78,94,110,126,142,158,174,190,206,222,-1,-1),
  (45,61,77,93,109,125,141,157,173,189,205,221,-1,-1,-1),
  (60,76,92,108,124,140,156,172,188,204,220,-1,-1,-1,-1),
  (75,91,107,123,139,155,171,187,203,219,-1,-1,-1,-1,-1),
  (90,106,122,138,154,170,186,202,218,-1,-1,-1,-1,-1,-1),
  (105,121,137,153,169,185,201,217,-1,-1,-1,-1,-1,-1,-1),
  (120,136,152,168,184,200,216,-1,-1,-1,-1,-1,-1,-1,-1),
  (135,151,167,183,199,215,-1,-1,-1,-1,-1,-1,-1,-1,-1),
  (150,166,182,198,214,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1));
  w:array[0..4] of Integer;
  g:array[0..224] of LongInt;
  game_over:Boolean;
 
 
procedure DrawField(i,j,s,h: integer);
var
  x,y,c:Integer;
  ss:String;
begin
  x:=(i*2+1)*15;
  y:=(j*2+1)*15;
  case h of
    0: c:=(i+j) mod 2+7;
    1: c:= 4;
    2: c:= 14;
  end;
  SetFillStyle(1,c);
  Bar(x,y,x+30,y+30);
  case s of
    1: begin
         SetFillStyle(1,1);
         Circle(x+15,y+15,10);
         Circle(x+15,y+15,5);
         FloodFill(x+10,y+10,15);
       end;
    2: begin
         SetFillStyle(1,2);
         Moveto(x+6,y+6);
         LineRel(3,0);
         LineRel(6,6);
         LineRel(6,-6);
         LineRel(3,0);
         LineRel(0,3);
         LineRel(-6,6);
         LineRel(6,6);
         LIneRel(0,3);
         LineRel(-3,0);
         LineRel(-6,-6);
         LineRel(-6,6);
         LineRel(-3,0);
         LineRel(0,-3);
         LineRel(6,-6);
         LineRel(-6,-6);
         LineRel(0,-3);
         FloodFill(x+10,y+10,15);
       end;
  end;
  {Str(g[i+j*15],ss);  // Vyvod znachenii koefiicienta
  SetColor(0);         // opasnosti v celyax otladki.
  if g[i+j*15]<10000 then
    OutTextXY(x,y,ss)
  else
    OutTextXY(x,y,'Inf');
  SetColor(15);}
end;
 
function CheckVictory:Integer;
var
  i,j,q,v:Integer;
  w1,w2:Boolean;
begin
  v:= 0;
  for i:= 0 to 71 do
    begin
      for j:= 0 to 10 do
        begin
          w1:= TRUE;
          w2:= TRUE;
          for q:= 0 to 4 do
            begin
              w[q]:= Li[i,j+q];
              if w[q] = -1 then
                begin
                  w1:= FALSE;
                  w2:= FALSE;
                end
               else
                 begin
                   if a[w[q]] <> 1 then
                     w1:= FALSE;
                   if a[w[q]] <> 2 then
                     w2:= FALSE;
        end;
      end;
      if w1 then
        v:= 1;
      if w2 then
        v:= 2;
      if v <> 0 then
        break;
    end;
    if v <> 0 then
      break;
  end;
  CheckVictory:= v;
end;
 
 
function GetResponse:Integer;
var
  i,j,k,q,z,r: Integer;
  gmax: LongInt;
  f: Boolean;
begin
  r:= -1;
  for k:= 0 to 224 do
    begin
      if a[k] = 0 then
        begin
          r:= k;
          break;
        end;
     end;
  if r <> -1 then
    begin
    k:= 0;
    for i:= 0 to 14 do
      begin
      for j:= 0 to 14 do
        begin
        if a[k] = 0 then
          g[k]:= 100-(i-7)*(i-7)-(j-7)*(j-7)
        else
          g[k]:= 0;
        k:= k+1;
      end;
    end;
    for k:= 0 to 224 do
      begin
      if a[k] = 2 then
        begin
          if k mod 15 > 0 then
            begin
              if a[k-1] = 0 then
                g[k-1]:= g[k-1]+1000;
              if k > 14 then
                if a[k-16 ]= 0 then
                  g[k-16]:= g[k-16]+1000;
              if k < 210 then
                if a[k+14] = 0 then
                  g[k+14]:= g[k+14]+1000;
        end;
        if k mod 15 < 14 then
          begin
            if a[k+1] = 0 then
              g[k+1]:= g[k+1]+1000;
            if k>14 then
              if a[k-14] = 0 then
                g[k-14]:= g[k-14]+1000;
            if k<210 then
              if a[k+16] = 0 then
                g[k+16]:= g[k+16]+1000;
        end;
        if k > 14 then
          if a[k-15] = 0 then
            g[k-15]:= g[k-15]+1000;
        if k<210 then
          if a[k+15] = 0 then
            g[k+15]:= g[k+15]+1000;
      end;
    end;
    f:= FALSE;
    for i:= 0 to 71 do
      begin
        for j:= 0 to 13 do
          begin
            for k:= j+1 to 14 do
              begin
                if (a[Li[i,j]] = 0) and (a[Li[i,k]] = 0) then
                  begin
                    a[Li[i,j]]:= 2;
                    a[Li[i,k]]:= 2;
                    f:= FALSE;
                    for q:= 0 to 10 do
                      begin
                        if (a[Li[i,q]] = 2) then
                          begin
                            if (a[Li[i,q+1]] = 2) then
                              begin
                                if (a[Li[i,q+2]] = 2) then
                                  begin
                                    if (a[Li[i,q+3]] = 2) then
                                      begin
                                        if (a[Li[i,q+4]] = 2) then
                                          begin
                                            f:= TRUE;
                                            break;
                                          end;
                                       end;
                                   end;
                                end;
                           end;
                      end;
            a[Li[i,j]]:= 0;
            a[Li[i,k]]:= 0;
            if f then
              begin
                g[Li[i,j]]:= g[Li[i,j]]+1000000;
                g[Li[i,k]]:= g[Li[i,k]]+1000000;
                break;
              end;
          end;
          if f then
            break;
        end;
        if f then
          break;
      end;
    end;
    for i:= 0 to 71 do
      begin
        for j:= 0 to 14 do
          begin
            if a[Li[i,j]] = 0 then
              begin
                a[Li[i,j]]:= 2;
                for q:= 0 to 10 do
                  begin
                    f:= TRUE;
                    for z:= 0 to 4 do
                      begin
                        if a[Li[i,q+z]] <> 2 then
                          begin
                            f:= FALSE;
                            break;
              end;
            end;
            if f then
              break;
          end;
          if f then
            g[Li[i,j]]:= 1000000000;
          a[Li[i,j]]:= 0;
        end;
      end;
    end;
    r:= 0;
    gmax:= g[0];
    for k:= 1 to 224 do
      begin
        if g[k] > gmax then
          begin
            r:= k;
            gmax:= g[k];
          end;
    end;
  end;
  GetResponse:= r;
end;
 
 
begin
 
  game_over:= FALSE;
  gd:= 0;
  gm:= 0;
  InitGraph(gd,gm,'../BGI/');
  if GraphResult <> 0 then
    begin
     ClrScr;
     WriteLn('Y vas ne klassicheskii Turpo Pascal.');
     WriteLn('Nastroite put k papke graphiki v procedure InitGraph.');
     ReadKey;
    end;
  for i:= 0 to 14 do
    begin
      for j:= 0 to 14 do
        begin
          DrawField(i,j,0,0);
        end;
  end;
  DrawField(0,0,0,1);
  for i:= 0 to 224 do
    a[i]:= 0;
  i:= 0;
  j:= 0;
  k:= 0;
  repeat
    ch:= ReadKey;
    if not game_over then
      begin
      case ch of
        #32:begin
              if a[k] = 0 then
                begin
                  a[k]:= 2;
                  if CheckVictory = 2 then
                    begin
                      game_over:= TRUE;
                      for q:= 0 to 4 do
                        begin
                          k:= w[q];
                          i:= k mod 15;
                          j:= k div 15;
                          DrawField(i,j,a[k],2);
                          SetFillStyle(1,1);
                          SetTextStyle(1,0,5);
                          Bar(30,50,570,105);
                          OutTextXY(50,50,'Pozdravlyaem s pobedoi!');
                        end;
                 end
                else
                  begin
                    r:= GetResponse;
                    if r <> -1 then
                      begin
                        a[r]:= 1;
                        if CheckVictory = 1 then
                          begin
                            game_over:= TRUE;
                            DrawField(i,j,a[k],0);
                            for q:= 0 to 4 do
                              begin
                                k:= w[q];
                                i:= k mod 15;
                                j:= k div 15;
                                DrawField(i,j,a[k],2);
                              end;
                             SetFillStyle(1,1);
                             SetTextStyle(1,0,5);
                             Bar(30,50,590,105);
                             OutTextXY(50,50,'Komp okazalsya umnee :)');
                           end
                          else
                            begin
                              DrawField(i,j,a[k],1);
                              DrawField(r mod 15,r div 15,a[r],0);
                            end;
                       end
                     else
                       begin
                         game_over:= TRUE;
                         DrawField(i,j,a[k],0);
                       end;
            end;
          end;
        end;
        #72: begin
               if j > 0 then
                 begin
                   DrawField(i,j,a[k],0);
                   j:= j-1;
                   k:= k-15;
                   DrawField(i,j,a[k],1);
                 end;
             end;
        #75: begin
               if i > 0 then
                 begin
                   DrawField(i,j,a[k],0);
                   i:= i-1;
                   k:= k-1;
                   DrawField(i,j,a[k],1);
                 end;
             end;
        #77: begin
               if i < 14 then
                 begin
                   DrawField(i,j,a[k],0);
                   i:= i+1;
                   k:= k+1;
                   DrawField(i,j,a[k],1);
                 end;
             end;
        #80: begin
               if j < 14 then
                 begin
                   DrawField(i,j,a[k],0);
                   j:= j+1;
                   k:= k+15;
                   DrawField(i,j,a[k],1);
                 end;
             end;
      end;
    end;
  until ch = #27;
  CloseGraph;
end.