program TheSeaBattle;
 USES Crt,Graph,dos;
 
  type TPole = array[1..10,1..10] of Integer;{определяем тип - поле}
{поле компа и поле игрока}
var comp_pole,player_pole: TPole;
                                             {поле боя, где -1 -нет корабля,}
                                             {0-есть корабль,}
                                             {1-корабль поражен,}
{Координаты всех кораблей}                   {2-промах}

koor_4 :array[1..4,1..3]  of integer; {Пример, 4-х палубный}
koor_31:array[1..3,1..3] of integer;    {1,1,1} {x,y,1-палуба не поражена}
koor_32:array[1..3,1..3] of integer;    {1,2,2} {x,y,2-палуба поражена}
koor_21:array[1..2,1..3] of integer;    {1,3,1}  {...}
koor_22:array[1..2,1..3] of integer;    {1,4,1}  {...}
koor_23:array[1..2,1..3] of integer;
koor_11:array[1..1,1..3] of integer;
koor_12:array[1..1,1..3] of integer;
koor_13:array[1..1,1..3] of integer;
koor_14:array[1..1,1..3] of integer;

game_Amount,          {Количество не подбитых кораблей}
game_Accuracy_level,            {уровень "ТОЧНОСТИ" компа }
game_Accuracy_Flag,          {флаг отвечающий за "точность" выстрелов компа }
game_Exit,          {флаг выхода}
game_Comp,           {Сколько палуб потопил компьютер}
game_Player,          {Сколько палуб потопил игрок}
game_x, game_y,game_i,game_j, {координаты}
 grDriver: Integer; {переменные для инициализации графики}
 start,time:longint;
 st:string;
 grMode: Integer;
 i,j:integer;

{процедура инициализации полей}
procedure Init (var Pole: TPole);
 var X, Y: Integer;
  begin
   Randomize;
    for X := 1 to 10 do
     for Y := 1 to 10 do
      Pole[X,Y] := -1;
end; {proc Init}

{ф-ция, определяющая, можно ли поставить однопалубный корабль в указанную}
{ячейку или нет}
function Freedom (x, y: Integer; Pole: TPole): Boolean;
const d: array[1..8,1..2] of Integer =
      ((0,1),(1,0),(0,-1),(-1,0),(1,1),(-1,1),(1,-1),(-1,-1));
var i: Integer;
    dx, dy: Integer;
begin
  if (x > 0) and (x < 11) and (y > 0) and (y < 11) and (Pole[x,y] = -1) then
  begin
    for i := 1 to 8 do
    begin
      dx := x + d[i,1];
      dy := y + d[i,2];
      if (dx > 0) and (dx < 11) and (dy > 0) and (dy < 11) and (Pole[dx,dy] > -1) then
      begin
        Freedom := False;
        Exit;
      end; {if}
    end; {for}
    Freedom := True;
  end else Freedom := False;
end; {func Freedom}

{процедура, расставляющая корабли на поле}
procedure Ships (var Pole: TPole);
var N, M, i: Integer;
    x, y, kx, ky: Integer;
    B: Boolean;
begin
  Init (Pole);
  for N := 3 downto 0 do
    for M := 0 to 3 - N do
    repeat
      Randomize;
      x := Random (10) + 1;
      y := Random (10) + 1;
      kx := Random (2);
      if kx = 0 then ky := 1
                else ky := 0;
      B := True;
      for i := 0 to N do
        if not Freedom (x + kx * i, y + ky * i, Pole) then B := False;
      if B then
        for i := 0 to N do
          begin
            case N of
             0:  case M of
                 0: begin  {запоминаем координаты первого однапалубника}
                      koor_11[i+1,1]:=x+kx*i;
                      koor_11[i+1,2]:=y+ky*i;
                      koor_11[i+1,3]:=1;
                    end;
                 1: begin  {запоминаем координаты второго однапалубника}
                      koor_12[i+1,1]:=x+kx*i;
                      koor_12[i+1,2]:=y+ky*i;
                      koor_12[i+1,3]:=1;
                    end;
                 2: begin  {запоминаем координаты третьего однапалубника}
                      koor_13[i+1,1]:=x+kx*i;
                      koor_13[i+1,2]:=y+ky*i;
                      koor_13[i+1,3]:=1;
                    end;
                 3: begin  {запоминаем координаты четвертого однапалубника}
                      koor_14[i+1,1]:=x+kx*i;
                      koor_14[i+1,2]:=y+ky*i;
                      koor_14[i+1,3]:=1;
                    end;
                end;{end case}
             1: case M of
                 0: begin  {запоминаем координаты первого двухпалубника}
                      koor_21[i+1,1]:=x+kx*i;
                      koor_21[i+1,2]:=y+ky*i;
                      koor_21[i+1,3]:=1;
                    end;
                 1: begin  {запоминаем координаты второго двухпалубника}
                      koor_22[i+1,1]:=x+kx*i;
                      koor_22[i+1,2]:=y+ky*i;
                      koor_22[i+1,3]:=1;
                    end;
                 2: begin  {запоминаем координаты третьего двухпалубника}
                      koor_23[i+1,1]:=x+kx*i;
                      koor_23[i+1,2]:=y+ky*i;
                      koor_23[i+1,3]:=1;
                    end;
                end;{end case}

             2: case M of
                 0: begin  {запоминаем координаты первого трехпалубника}
                      koor_31[i+1,1]:=x+kx*i;
                      koor_31[i+1,2]:=y+ky*i;
                      koor_31[i+1,3]:=1;
                    end;
                 1: begin {запоминаем координаты второго трехпалубника}
                      koor_32[i+1,1]:=x+kx*i;
                      koor_32[i+1,2]:=y+ky*i;
                      koor_32[i+1,3]:=1;
                    end;
                end;{end case}
             3: begin {запоминаем координаты четырехпалубника}
                  koor_4[i+1,1]:=x+kx*i;
                  koor_4[i+1,2]:=y+ky*i;
                  koor_4[i+1,3]:=1;
                end;
            end;{end case}
            Pole[x+kx*i,y+ky*i] := 0;
          end;
    until B;
end; {proc Ships}

{процедура очистки экрана}
procedure Clr;
begin
 SetFillStyle(0,0);
 Bar(0,0,GetMaxX,GetMaxY);
end; {proc Clr;}

function GetTime:longint;
  var h,m,s,ms:word;
   begin
    dos.GetTime(h,m,s,ms);
     GetTime:=ms+100*(s+60*(m+60*h));
   end;

function menu:integer;{процедура вывода меню}
var
cx1,cy1,cx2,k,s:          integer;
  ch:             char;
  XY:             word;
  p1:          pointer;
  key:         boolean;
  

BEGIN
begin
   {======================Zastavka i vibor rezima========================}
      SetBKColor(0);
      SetColor(9);
      SetLineStyle(0,0,1);
      SettextStyle(4,0,7);
      OutTextXY(150,60,'Sea');
      OutTextXY(280,60,'Battle');
      SetWriteMode(XorPut);
      SetColor(11);
      SetTextStyle(4,0,5);
      OutTextXY(120,250,'Play');
      OutTextXY(350,250,'List');
      OutTextXy(120,350,'Help');
      OutTextXY(350,350,'Exit');
      cx1:=120;
      cx2:=220;
      cy1:=300;
      SetColor(9);
      Line(cx1,cy1,cx2,cy1);
      ch:=#0;
      
      REPEAT
      
       begin
         if ch=#0 then
           repeat
             Ch:=Readkey;
           until ch in [#80,#72,#77,#75,#13];
         if ch=#72 then
           if cy1<>300 then
             begin
               s:=0;
               k:=-100;
      begin
    SetWriteMode(XorPut);
    SetLineStyle(0,0,1);
    Line(cx1,cy1,cx2,cy1);
    Line(cx1+s,cy1+k,cx2+s,cy1+k);
    Cy1:=Cy1+k;
    Cx1:=Cx1+s;
    Cx2:=Cx2+s;
    ch:=#0;
       end;
             end
           else
             repeat
               ch:=readkey;
             until ch in [#13,#80,#77,#75]
         else
         if ch=#80 then
           if cy1<>400 then
             begin
               s:=0;
               k:=100;
       begin
    SetWriteMode(XorPut);
    SetLineStyle(0,0,1);
    Line(cx1,cy1,cx2,cy1);
    Line(cx1+s,cy1+k,cx2+s,cy1+k);
    Cy1:=Cy1+k;
    Cx1:=Cx1+s;
    Cx2:=Cx2+s;
    ch:=#0;
       end;
             end
           else
             repeat
               ch:=readkey;
             until ch in [#13,#72,#77,#75]
         else
          if ch=#75 then
           if (cx1<>120) and (cx2<>220) then
            begin
             s:=-230;
             k:=0;
       begin
    SetWriteMode(XorPut);
    SetLineStyle(0,0,1);
    Line(cx1,cy1,cx2,cy1);
    Line(cx1+s,cy1+k,cx2+s,cy1+k);
    Cy1:=Cy1+k;
    Cx1:=Cx1+s;
    Cx2:=Cx2+s;
    ch:=#0;
       end;
             end
           else
             repeat
               ch:=readkey;
             until ch in [#13,#72,#77,#80]
         else
          if ch=#77 then
           if (cx1<>350) and (cx2<>450) then
            begin
             s:=230;
              k:=0;
       begin
    SetWriteMode(XorPut);
    SetLineStyle(0,0,1);
    Line(cx1,cy1,cx2,cy1);
    Line(cx1+s,cy1+k,cx2+s,cy1+k);
    Cy1:=Cy1+k;
    Cx1:=Cx1+s;
    Cx2:=Cx2+s;
    ch:=#0;
      end;
             end
           else
             repeat
               ch:=readkey;
             until ch in [#13,#72,#75,#80]
         else;

         if (ch=#13) then
         
           if (cx1=120) and (cx2=220) and (cy1=400)  then
             begin
               xy:=ImageSize(30,180,450,450);
               GetMem(p1,xy);
               GetImage(30,150,450,450,p1^);
               PutImage(30,150,p1^,XorPut);
               SetCOLOR(red);
               SetTextStyle(1,0,2);
               Setwritemode(copyput);
               OutTextXY(130,250,'Keys for operate:');
               OutTextXY(130,275,'*Space* - Fire');
               OutTextXY(130,300,'*Enter* - Choice');
               OutTextXY(130,325,'*Arrows*  - Moving of cursor');
               OutTextXY(130,350,'*Esc* - exit');
               ch:=#0;
               key:=false;

               repeat ch:=readkey;
               Until ch=#13;
               if ch=#13 then
               PutImage(30,150,p1^,NormalPut);
               Setwritemode(copyput);
               SetColor(9);
               cy1:=400; cx1:=120; cx2:=220;
               line(cx1,cy1,cx2,cy1);
               ch:=#0;
             end
             
           else
           
           if (cx1=350) and (cx2=450) and (cy1=300) then
            begin
               xy:=ImageSize(30,180,450,450);
               GetMem(p1,xy);
               GetImage(30,150,450,450,p1^);
               PutImage(30,150,p1^,XorPut);
               outtextxy(180,190,'HighList');
               ch:=#0;
               key:=false;
               repeat ch:=readkey;
               Until ch=#13;
               if ch=#13 then
               PutImage(30,150,p1^,NormalPut);
               SetWriteMode(CopyPut);
               cy1:=300; cx1:=350; cx2:=450;
               line(cx1,cy1,cx2,cy1);
               ch:=#0;
             end
             
           else
           
            if (cx1=350) and (cx2=450) and (cy1=400) then halt
            
            else
           else;
          end;
           
        until (ch=#13) and(cy1=300) and (cx1=120) and (cx2=220);
        end;
        
            begin
               clr;
               SetColor(9);
               SettextStyle(4,0,7);
               OutTextXY(150,60,'Sea');
               OutTextXY(280,60,'Battle');
               SetColor(11);
               SetTextStyle(4,0,5);
               OutTextXY(250,190,'Easy');
               OutTextXy(250,260,'Medium');
               OutTextXY(250,330,'Hard');
               cx1:=250;
               cx2:=380;
               cy1:=245;
               SetColor(9);
               Line(cx1,cy1,cx2,cy1);
               ch:=#0;
       {--2--} Repeat
                 begin
                  if ch=#0 then
                   repeat
                     Ch:=Readkey;
                   until ch in [#27,#80,#72,#13];
                   if ch=#72 then
                     if cy1<>245 then
                       begin
                         k:=-70;
                         s:=0;
                         
    begin
    SetWriteMode(XorPut);
    SetLineStyle(0,0,1);
    Line(cx1,cy1,cx2,cy1);
    Line(cx1+s,cy1+k,cx2+s,cy1+k);
    Cy1:=Cy1+k;
    Cx1:=Cx1+s;
    Cx2:=Cx2+s;
    ch:=#0;
      end;
                       end
                     else
                       repeat
                         ch:=readkey;
                       until ch in [#13,#80,#27]
                   else
                   if ch=#80 then
                     if cy1<>245+2*70 then
                       begin
                         k:=70;
                         s:=0;
                         begin
    SetWriteMode(XorPut);
    SetLineStyle(0,0,1);
    Line(cx1,cy1,cx2,cy1);
    Line(cx1+s,cy1+k,cx2+s,cy1+k);
    Cy1:=Cy1+k;
    Cx1:=Cx1+s;
    Cx2:=Cx2+s;
    ch:=#0;
      end;
                       end
                     else
                       repeat
                         ch:=readkey;
                       until ch in [#13,#72,#27]
                   else

                   if ch=#13 then
                      menu:=(cy1-245) div 70+1
                   else;
                 end;
           Until ch=#13;
           
         clr;
                      
end;
end;



          
{процедура рисования закрашенного круга}
procedure Krug(x,y,R:integer);
var i:integer;
begin
 for i:=0 to R do
  Circle(x,y,i);
end;{proc Krug}

{выводит сообщение, о том что корабль убит}
procedure Ubit;
begin
game_Amount:=game_Amount-1;
SetTextStyle(0,0,2);
SetColor(9);
OutTextXY(GetMaxX div 2-100,GetMaxY div 2-150,'***KILLED***');
Delay(20000);
SetColor(0);
OutTextXY(GetMaxX div 2-100,GetMaxY div 2-150,'***KILLED***');
end;

{выводит сообщение, о том что корабль ранен}
procedure Ranen;
begin
SetTextStyle(0,0,2);
SetColor(9);
OutTextXY(GetMaxX div 2-100,GetMaxY div 2-150,'*DAMAGED*');
Delay(20000);
SetColor(0);
OutTextXY(GetMaxX div 2-100,GetMaxY div 2-150,'*DAMAGED*');
end;

 {выводит сообщение, о том что Вы промазали}
procedure Mimo;
begin
 SetTextStyle(0,0,2);
 SetColor(9);
 OutTextXY(GetMaxX div 2-100,GetMaxY div 2-150,'*MISSED*');
 Delay(20000);
 SetColor(0);
 OutTextXY(GetMaxX div 2-100,GetMaxY div 2-150,'*MISSED*');
end;

{функция проверки - корабль:потоплен или только  подбит }
function Proverka(x,y:integer):boolean;
var flag,i:integer;
begin
 {сначала ищем координаты подбитого корабля в массивах координат кораблей}
 flag:=0;
 for i:=1 to 4 do
   if (koor_4[i,1]=x) and (koor_4[i,2]=y) then
     begin
      flag:=4;         {если нашли то}
      koor_4[i,3]:=0;  {устанавливаем, что один из бортов корабля подбит}
     end;
 for i:=1 to 3 do
   if (koor_31[i,1]=x) and (koor_31[i,2]=y) then
     begin
      flag:=31;         {если нашли то}
      koor_31[i,3]:=0;  {устанавливаем, что один из бортов корабля подбит}
     end;
 for i:=1 to 3 do
   if (koor_32[i,1]=x) and (koor_32[i,2]=y) then
     begin
      flag:=32;         {если нашли то}
      koor_32[i,3]:=0;  {устанавливаем, что один из бортов корабля подбит}
     end;
 for i:=1 to 2 do
   if (koor_21[i,1]=x) and (koor_21[i,2]=y) then
     begin
      flag:=21;         {если нашли то}
      koor_21[i,3]:=0;  {устанавливаем, что один из бортов корабля подбит}
     end;
 for i:=1 to 2 do
   if (koor_22[i,1]=x) and (koor_22[i,2]=y) then
     begin
      flag:=22;         {если нашли то}
      koor_22[i,3]:=0;  {устанавливаем, что один из бортов корабля подбит}
     end;
 for i:=1 to 2 do
   if (koor_23[i,1]=x) and (koor_23[i,2]=y) then
     begin
      flag:=23;         {если нашли то}
      koor_23[i,3]:=0;  {устанавливаем, что один из бортов корабля подбит}
     end;
  for i:=1 to 1 do
   if (koor_11[i,1]=x) and (koor_11[i,2]=y) then
     begin
      flag:=11;         {если нашли то}
      koor_11[i,3]:=0;  {устанавливаем, что один из бортов корабля подбит}
     end;
 for i:=1 to 1 do
   if (koor_12[i,1]=x) and (koor_12[i,2]=y) then
     begin
      flag:=12;         {если нашли то}
      koor_12[i,3]:=0;  {устанавливаем, что один из бортов корабля подбит}
     end;
 for i:=1 to 1 do
   if (koor_13[i,1]=x) and (koor_13[i,2]=y) then
     begin
      flag:=13;         {если нашли то}
      koor_13[i,3]:=0;  {устанавливаем, что один из бортов корабля подбит}
     end;
 for i:=1 to 1 do
   if (koor_14[i,1]=x) and (koor_14[i,2]=y) then
     begin
      flag:=14;         {если нашли то}
      koor_14[i,3]:=0;  {устанавливаем, что один из бортов корабля подбит}
     end;
{НАШЛИ КООРДИНАТЫ..............................................}
 case flag of
  4:    {если все палубы подбиты}
    if(koor_4[1,3]+koor_4[2,3]+koor_4[3,3]+koor_4[4,3] = 0) then
       begin
          Proverka:=True;
          Ubit;
       end
    else
       begin
          Proverka:=False;
          Ranen;
       end;
  31:    {если все палубы подбиты}
    if(koor_31[1,3]+koor_31[2,3]+koor_31[3,3] = 0) then
       begin
          Proverka:=True;
          Ubit;
       end
    else
       begin
          Proverka:=False;
          Ranen;
       end;
  32:    {если все палубы подбиты}
    if(koor_32[1,3]+koor_32[2,3]+koor_32[3,3] = 0) then
       begin
          Proverka:=True;
          Ubit;
       end
    else
       begin
          Proverka:=False;
          Ranen;
       end;
  21:    {если все палубы подбиты}
    if(koor_21[1,3]+koor_21[2,3] = 0) then
       begin
          Proverka:=True;
          Ubit;
       end
    else
       begin
          Proverka:=False;
          Ranen;
       end;
  22:    {если все палубы подбиты}
    if(koor_22[1,3]+koor_22[2,3] = 0) then
       begin
          Proverka:=True;
          Ubit;
       end
    else
       begin
          Proverka:=False;
          Ranen;
       end;
  23:    {если все палубы подбиты}
    if(koor_23[1,3]+koor_23[2,3] = 0) then
       begin
          Proverka:=True;
          Ubit;
       end
    else
       begin
          Proverka:=False;
          Ranen;
       end;
  11:    {если все палубы подбиты}
    if(koor_11[1,3] = 0) then
       begin
          Proverka:=True;
          Ubit;
       end;
  12:    {если все палубы подбиты}
    if(koor_12[1,3] = 0) then
       begin
          Proverka:=True;
          Ubit;
       end;
  13:    {если все палубы подбиты}
    if(koor_13[1,3] = 0) then
       begin
          Proverka:=True;
          Ubit;
       end;
  14:    {если все палубы подбиты}
    if(koor_14[1,3] = 0) then
       begin
          Proverka:=True;
          Ubit;
       end;
 end;{end case}
end;

{процедура прорисовки попаданий и промахов в поле компа в первом режиме игры}
procedure PolKomp1r(Pole: TPole);
var i,j,
    x,y:integer;
begin
 x:=GetMaxX div 2-290;
 y:=GetMaxY div 2-90;
 for i:=1 to 10 do
   begin
     for j:=1 to 10 do
       begin
         case Pole[i,j] of
          -1:begin
{              Setcolor(14);
              Krug(x,y,2);}
             end;
           0:begin
{              Setcolor(3);
              Krug(x,y,6);}
             end;
           1:begin
              Setcolor(4);
              Krug(x,y,4);
             end;
           2:begin
              Setcolor(14);
              Krug(x,y,2);
             end;
         end; {end case}
         x:=x+20;
       end; {end for j}
     x:=GetMaxX div 2-290;
     y:=y+20;
   end; {end for i}
end; {proc PolKomp1r}

{очерчивает подбитый корабль пустыми клетками}
procedure Ocherch(x,y:integer;var Pole:TPole);
const d: array[1..8,1..2] of Integer =
      ((0,1),(1,0),(0,-1),(-1,0),(1,1),(-1,1),(1,-1),(-1,-1));
var dx,dy,flag,i:integer;
begin
  {сначала ищем координаты подбитого корабля в массивах координат кораблей}
 flag:=0;
 for i:=1 to 4 do
   if (koor_4[i,1]=x) and (koor_4[i,2]=y) then
     begin
      flag:=4;         {если нашли то}
      koor_4[i,3]:=0;  {устанавливаем, что один из бортов корабля подбит}
     end;
 for i:=1 to 3 do
   if (koor_31[i,1]=x) and (koor_31[i,2]=y) then
     begin
      flag:=31;         {если нашли то}
      koor_31[i,3]:=0;  {устанавливаем, что один из бортов корабля подбит}
     end;
 for i:=1 to 3 do
   if (koor_32[i,1]=x) and (koor_32[i,2]=y) then
     begin
      flag:=32;         {если нашли то}
      koor_32[i,3]:=0;  {устанавливаем, что один из бортов корабля подбит}
     end;
 for i:=1 to 2 do
   if (koor_21[i,1]=x) and (koor_21[i,2]=y) then
     begin
      flag:=21;         {если нашли то}
      koor_21[i,3]:=0;  {устанавливаем, что один из бортов корабля подбит}
     end;
 for i:=1 to 2 do
   if (koor_22[i,1]=x) and (koor_22[i,2]=y) then
     begin
      flag:=22;         {если нашли то}
      koor_22[i,3]:=0;  {устанавливаем, что один из бортов корабля подбит}
     end;
 for i:=1 to 2 do
   if (koor_23[i,1]=x) and (koor_23[i,2]=y) then
     begin
      flag:=23;         {если нашли то}
      koor_23[i,3]:=0;  {устанавливаем, что один из бортов корабля подбит}
     end;
  for i:=1 to 1 do
   if (koor_11[i,1]=x) and (koor_11[i,2]=y) then
     begin
      flag:=11;         {если нашли то}
      koor_11[i,3]:=0;  {устанавливаем, что один из бортов корабля подбит}
     end;
 for i:=1 to 1 do
   if (koor_12[i,1]=x) and (koor_12[i,2]=y) then
     begin
      flag:=12;         {если нашли то}
      koor_12[i,3]:=0;  {устанавливаем, что один из бортов корабля подбит}
     end;
 for i:=1 to 1 do
   if (koor_13[i,1]=x) and (koor_13[i,2]=y) then
     begin
      flag:=13;         {если нашли то}
      koor_13[i,3]:=0;  {устанавливаем, что один из бортов корабля подбит}
     end;
 for i:=1 to 1 do
   if (koor_14[i,1]=x) and (koor_14[i,2]=y) then
     begin
      flag:=14;         {если нашли то}
      koor_14[i,3]:=0;  {устанавливаем, что один из бортов корабля подбит}
     end;
{НАШЛИ КООРДИНАТЫ..............................................}
 case flag of
  4: for i:=1 to 4 do
      for j:=1 to 8 do
       begin
         dx := koor_4[i,1] + d[j,1];
         dy := koor_4[i,2] + d[j,2];
         if (Pole[dx,dy] = -1) and (dx > 0) and (dx < 11) and (dy > 0) and (dy < 11) then
           begin
            Pole[dx,dy]:=2;
            Delay(10000);
            PolKomp1r(Pole);
           end;
       end;
  31: for i:=1 to 3 do
       for j:=1 to 8 do
       begin
         dx := koor_31[i,1] + d[j,1];
         dy := koor_31[i,2] + d[j,2];
         if (Pole[dx,dy] = -1) and (dx > 0) and (dx < 11) and (dy > 0) and (dy < 11)  then
           begin
            Pole[dx,dy]:=2;
            Delay(10000);
            PolKomp1r(Pole);
           end;
       end;
  32: for i:=1 to 3 do
       for j:=1 to 8 do
       begin
         dx := koor_32[i,1] + d[j,1];
         dy := koor_32[i,2] + d[j,2];
         if (Pole[dx,dy] = -1) and (dx > 0) and (dx < 11) and (dy > 0) and (dy < 11)  then
           begin
            Pole[dx,dy]:=2;
            Delay(10000);
            PolKomp1r(Pole);
           end;
       end;
  21: for i:=1 to 2 do
       for j:=1 to 8 do
       begin
         dx := koor_21[i,1] + d[j,1];
         dy := koor_21[i,2] + d[j,2];
         if (Pole[dx,dy] = -1) and (dx > 0) and (dx < 11) and (dy > 0) and (dy < 11)  then
           begin
            Pole[dx,dy]:=2;
            Delay(10000);
            PolKomp1r(Pole);
           end;
       end;
  22: for i:=1 to 2 do
       for j:=1 to 8 do
       begin
         dx := koor_22[i,1] + d[j,1];
         dy := koor_22[i,2] + d[j,2];
         if (Pole[dx,dy] = -1) and (dx > 0) and (dx < 11) and (dy > 0) and (dy < 11)  then
           begin
            Pole[dx,dy]:=2;
            Delay(10000);
            PolKomp1r(Pole);
           end;
       end;
  23: for i:=1 to 2 do
       for j:=1 to 8 do
       begin
         dx := koor_23[i,1] + d[j,1];
         dy := koor_23[i,2] + d[j,2];
         if (Pole[dx,dy] = -1) and (dx > 0) and (dx < 11) and (dy > 0) and (dy < 11)  then
           begin
            Pole[dx,dy]:=2;
            Delay(10000);
            PolKomp1r(Pole);
           end;
       end;
  11:
     for j:=1 to 8 do
       begin
         dx := koor_11[i,1] + d[j,1];
         dy := koor_11[i,2] + d[j,2];
         if (Pole[dx,dy] = -1) and (dx > 0) and (dx < 11) and (dy > 0) and (dy < 11)  then
           begin
            Pole[dx,dy]:=2;
            Delay(10000);
            PolKomp1r(Pole);
           end;
       end;
  12:
     for j:=1 to 8 do
       begin
         dx := koor_12[i,1] + d[j,1];
         dy := koor_12[i,2] + d[j,2];
         if (Pole[dx,dy] = -1) and (dx > 0) and (dx < 11) and (dy > 0) and (dy < 11)  then
           begin
            Pole[dx,dy]:=2;
            Delay(10000);
            PolKomp1r(Pole);
           end;
       end;
  13:
     for j:=1 to 8 do
       begin
         dx := koor_13[i,1] + d[j,1];
         dy := koor_13[i,2] + d[j,2];
         if (Pole[dx,dy] = -1) and (dx > 0) and (dx < 11) and (dy > 0) and (dy < 11)  then
           begin
            Pole[dx,dy]:=2;
            Delay(10000);
            PolKomp1r(Pole);
           end;
       end;
  14:
     for j:=1 to 8 do
       begin
         dx := koor_14[i,1] + d[j,1];
         dy := koor_14[i,2] + d[j,2];
         if (Pole[dx,dy] = -1) and (dx > 0) and (dx < 11) and (dy > 0) and (dy < 11)  then
           begin
            Pole[dx,dy]:=2;
            Delay(10000);
            PolKomp1r(Pole);
           end;
       end;
 end;{end case}
end;

{процедура, выводящая оставшиеся после проигрыша неподбитые корабли}
procedure Ostatok(dx:integer;Pole: TPole);
var i,j,
    x,y:integer;
begin
 x:=GetMaxX div 2-dx;
 y:=GetMaxY div 2-90;
 for i:=1 to 10 do
   begin
     for j:=1 to 10 do
       begin
        if Pole[i,j]=0 then
          begin
              Setcolor(6);
              Krug(x,y,5);
          end;
        x:=x+20;
       end; {end for j}
     x:=GetMaxX div 2-dx;
     y:=y+20;
   end; {end for i}
end;


{процедура прорисовки полей в первом режиме игры}
procedure Proris_pole1r;
var i,j:integer;
begin
 SetColor(1);
 {рисуем первое поле}
 j:=100;
 SetTextStyle(4,0,2);
 OutTextXY(15,GetMaxY div 2+110, 'Поле Компьютера');
 for i:=1 to 11 do
  begin
   Line(GetMaxX div 2-300,GetMaxY div 2-j,GetMaxX div 2-100,GetMaxY div 2-j);
   j:=j-20;
 end;
 j:=300;
 for i:=1 to 11 do
  begin
   Line(GetMaxX div 2-j,GetMaxY div 2-100,GetMaxX div 2-j,GetMaxY div 2+100);
   j:=j-20;
 end;
 OutTextXY(405,GetMaxY div 2+110, 'Ваше поле');

 j:=100;
 for i:=1 to 11 do
  begin
   Line(GetMaxX div 2+50,GetMaxY div 2-j,GetMaxX div 2+250,GetMaxY div 2-j);
   j:=j-20;
 end;
 j:=-50;
 for i:=1 to 11 do
  begin
   Line(GetMaxX div 2-j,GetMaxY div 2-100,GetMaxX div 2-j,GetMaxY div 2+100);
   j:=j-20;
 end;
{ readkey;}
end; {proc Proris_pole1r}

{процедура прорисовки попаданий и промахов в поле игрока}
procedure PolIgrok1r(Pole: TPole);
var i,j,
    x,y:integer;
begin
 x:=GetMaxX div 2+60;
 y:=GetMaxY div 2-90;
 for i:=1 to 10 do
   begin
     for j:=1 to 10 do
       begin
         case Pole[i,j] of
          -1:begin
{              Setcolor(14);
              Krug(x,y,2);}
             end;
           0:begin
              Setcolor(3);
              Krug(x,y,6);
             end;
           1:begin
              Setcolor(4);
              Krug(x,y,4);
             end;
           2:begin
              Setcolor(14);
              Krug(x,y,2);
             end;
         end; {end case}
         x:=x+20;
       end; {end for j}
     x:=GetMaxX div 2+60;
     y:=y+20;
   end; {end for i}
end; {proc PolеIgrok1r}

{функция проверяющая попал игрок или нет}
function Vistrel1r(x,y:integer;var Pole: TPole):boolean;
var temp:integer;
begin
  temp:=Pole[x,y];
  case temp of
   -1:begin
       Pole[x,y]:=2;
       Mimo;
       Vistrel1r:=false;
      end;
    0:begin
       Pole[x,y]:=1;
       If (Proverka(x,y)) then
        Ocherch(x,y,Pole);
       Vistrel1r:=true;
      end;
    1:Vistrel1r:=false;
    2:Vistrel1r:=false;
  end;
end;


{процедура прорисовки курсора в первом режиме игры}
procedure Kursor1r(var x,y,i,j:integer);
var
 c:char;
 flag:boolean;
begin
 game_Exit:=0;
 SetFillStyle(1,11);
 Bar(i,j,i+10,j+10);
 flag:=true;
 while(flag) do
  begin
    c:=readkey;
    case c of
     #72:         {вверх}
        if(y-1>0) then
            begin
             SetFillStyle(1,0);
             Bar(i,j,i+10,j+10);
             PolKomp1r(comp_pole);
             j:=j-20;
             y:=y-1;
             SetFillStyle(1,11);
             Bar(i,j,i+10,j+10);
            end;
     #80:         {вниз}
        if(y+1<11) then
          begin
           SetFillStyle(1,0);
           Bar(i,j,i+10,j+10);
           PolKomp1r(comp_pole);
           j:=j+20;
           y:=y+1;
           SetFillStyle(1,11);
           Bar(i,j,i+10,j+10);
          end;
     #75:         {влево}
        if(x-1>0) then
         begin
           SetFillStyle(1,0);
           Bar(i,j,i+10,j+10);
           PolKomp1r(comp_pole);
           i:=i-20;
           x:=x-1;
           SetFillStyle(1,11);
           Bar(i,j,i+10,j+10);
          end;
     #77:         {вправо}
        if(x+1<11) then
         begin
           SetFillStyle(1,0);
           Bar(i,j,i+10,j+10);
           PolKomp1r(comp_pole);
           i:=i+20;
           x:=x+1;
           SetFillStyle(1,11);
           Bar(i,j,i+10,j+10);
          end;
     #32:
        begin
           flag:=Vistrel1r(y,x,comp_pole);
           if flag then game_player:=game_player+1;
           SetFillStyle(1,11);
           Bar(i,j,i+10,j+10);
           PolKomp1r(comp_pole);
           SetFillStyle(1,11);
           Bar(i,j,i+10,j+10);
           If (game_player=20) then flag:=false;
        end;
     #27:begin
           game_Exit:=1;
           flag:=false;
         end;
    end; {end case}
  end;{end while}
end; {proc Kursor1r}


{процедура - ход компьютера}
function Comp_Hod(fl:integer; var Pole:TPole):boolean;
var temp,i,j:integer;
begin
 temp:=0;
 Randomize;
 if (fl=0) then
   while (temp<>1)and(game_Comp<20) do
    begin
      i:=Random(10)+1;
      j:=Random(10)+1;
      if Pole[i,j] = 0 then
        begin
          
          Pole[i,j]:=1;
          PolIgrok1r(Pole);
          
          If (proverka(i,j)) then ocherch(i,j,Pole);
          
          Delay(20000);
          game_Comp:=game_Comp+1;
          temp:=temp+1;
          Comp_Hod:=true;
        end;
     end
 else
   begin
    i:=Random(10)+1;
    j:=Random(10)+1;
    while (Pole[i,j]=1)or(Pole[i,j]=2) do
     begin
       i:=Random(10)+1;
       j:=Random(10)+1;
     end;
    if Pole[i,j] = 0 then
     begin
       Pole[i,j]:=1;
       PolIgrok1r(Pole);
       
       Delay(20000);
       game_Comp:=game_Comp+1;
       Comp_Hod:=true;
     end
    else
     begin
       Pole[i,j]:=2;
       PolIgrok1r(Pole);
       Delay(20000);
       Comp_Hod:=false;
     end;
   end;
end;

begin

ClrScr;
grDriver := Detect;
InitGraph(grDriver, grMode,'d:\bp\bgi\');
clr;
game_Accuracy_level:=menu;

 begin
  start:=GetTime;
  Ships(player_pole);
  Ships(comp_pole);

  Proris_pole1r;
  PolIgrok1r(player_pole);
  game_comp:=0;
  game_player:=0;
  game_x:=1; game_y:=1;
  game_i:=GetMaxX div 2-295;
  game_j:=GetMaxY div 2-95;
  game_accuracy_flag:=0;

  repeat

   Kursor1r(game_x,game_y,game_i,game_j);
   if (game_Exit<>1) and (game_player<20) then
      begin
         Randomize;
         if (game_Accuracy_level=1) then
           game_accuracy_flag:=random(10)
         else if (game_Accuracy_level=2) then
                  game_accuracy_flag:=random(5)
              else
                game_accuracy_flag:=random(3);
       while(Comp_Hod(game_accuracy_flag,player_pole)) do
         if (game_Accuracy_level=1) then
           game_accuracy_flag:=random(10)
         else if (game_Accuracy_level=2) then
                  game_accuracy_flag:=random(5)
              else
                game_accuracy_flag:=random(3);
      end;

  until (game_comp = 20) or (game_player = 20) or (game_Exit=1);
  
   SetTextStyle(4,0,0);
   SetColor(4);
   
  If (game_player = 20) then
      begin
      SetTextStyle(4,0,0);
      SetColor(4);
      OutTextXY(GetMaxX div 2-120,GetMaxY div 2+150,'Вы выиграли!');
      Time:=GetTime-start;
      str(time,st);
      outtextxy(100,100,st);
      readkey;
      end
  Else If (game_comp = 20) then
  Begin
   Ostatok(290,comp_pole);
   OutTextXY(GetMaxX div 2-120,GetMaxY div 2+150,'Вы Проиграли!');
  End;
   OutTextXY(GetMaxX div 2-120,GetMaxY div 2+130,'Игра Окончена!');


END;

readkey;
CloseGraph;
end.