Морской бой

Разработка Морского боя ещё с дней колледжа.

Классическая игра с довольно сообразительным ботом. Боту дана элементарная логика игры в морской бой и не более. Вы играете на равных, ведь бот, также как и вы не видит поле соперника, а лишь рисует его для себя.

Игра работает на простом Canvas на функциях, по этому требует от процессора довольно много.

В игре есть звук и анимация, а также бот может ответить вам на приветствие и выполнить некоторые команды, например, если вы захотите пропустить ход или сменить обращение к вам.

Архив с игрой без исходников т.к. я надеюсь, что когда-нибудь доведу его до ума.

Но вот некоторая часть. Например:

Генератор игрового поля (расстановка кораблей)

Если код по неизвестным причинам не работает или не хватает частей – пишите мне на почту в контактах сайта, отвечу в обязательном порядке.

Знак “& lt;” – это знак “меньше”

Знак “& gt;” – это знак “больше” (“сраный” html и его проблемы)


TArray = array[1..10, 1..10] of Byte;          //Массив кораблей
TDirection = (tdLeft, tdRight, tdUp, tdDown);  //Направления корабля относительно начала

function TGame.SetShips:TArray;
var SPos:TPoint;
    ShipSize, i:Byte;
    Direction:TDirection;
    OutExcept:Cardinal;
begin
 repeat                                              //Пускаем масштабный цикл расстановки
  ClearPoly(Result);                                 //Очищаем поле
  OutExcept:=0;                                      //Сброс критических попыток
  Randomize;                                         //"Збиваем" сиды
  for ShipSize:=4 downto 1 do                        //С максимального к минимальному кораблю
   begin
    for i:=1 to 5-ShipSize do                        //Кол-во кораблей текущего размера
     begin
      OutExcept:=0;                                  //Сброс критических попыток
      repeat                                         //Искать позицию, пока не найдем или исчерпаем попытки
       SPos.X:=Random(10)+1;                         //Случ. X координата
       SPos.Y:=Random(10)+1;                         //Случ. Y координата
       Inc(OutExcept);                               //Увелич. счетчик попыток
      until CheckPos(Result, SPos, Direction, ShipSize) or (OutExcept=3000000); //Если нашлось место или попытки исчерпаны, то прерываем
      if OutExcept = 3000000 then Break;             //Если исчерпаны попытки, то прерываем тек. итерацию
      InsertShip(Result, SPos, Direction, ShipSize); //Ставим корабль
     end;
    if OutExcept = 3000000 then Break;               //Если исчерпаны попытки, то прерываем тек. итерацию
   end;
 until OutExcept < 3000000;                          //Если попытки не исчерпаны, то все расставлено
end;

function TGame.GetPos(CPoly:TArray; SPos:TPoint):Byte;
begin
 Result:=CPoly[SPos.X, SPos.Y];
end;

function TGame.CheckCell(SPos:TPoint):Boolean;
begin
 Result:= (SPos.X >= 1) and (SPos.X <= 10) and (SPos.Y >= 1) and (SPos.Y <= 10);
end;

function TGame.InsertCheck(Poly:TArray; SPos:TPoint):Boolean;
begin
 Result:=CheckCell(SPos) and (Poly[SPos.X, SPos.Y]=aEmpty);
end;

procedure TGame.InsertShip(var CPoly:TArray; SPos:TPoint; Direction:TDirection; ShipSize:Byte);
var i:SmallInt;
begin
 case Direction of
  tdLeft:
   begin
    for i:= -1 to ShipSize do if InsertCheck(CPoly, Point(SPos.X-i, SPos.Y-1)) then CPoly[SPos.X-i, SPos.Y-1]:=aBusy;
    for i:= 0 to ShipSize-1 do CPoly[SPos.X-i, SPos.Y ]:=ShipSize;
    for i:= -1 to ShipSize do if InsertCheck(CPoly, Point(SPos.X-i, SPos.Y+1)) then CPoly[SPos.X-i, SPos.Y+1]:=aBusy;
    if InsertCheck(CPoly, Point(SPos.X+1, SPos.Y)) then CPoly[SPos.X+1, SPos.Y]:=aBusy;
    if InsertCheck(CPoly, Point(SPos.X-ShipSize, SPos.Y)) then CPoly[SPos.X-ShipSize, SPos.Y]:=aBusy;
    Exit;
   end;

 tdRight:
  begin
   for i:= -1 to ShipSize do if InsertCheck(CPoly, Point(SPos.X+i, SPos.Y-1)) then CPoly[SPos.X+i, SPos.Y-1]:=aBusy;
   for i:= 0 to ShipSize-1 do CPoly[SPos.X+i, SPos.Y ]:=ShipSize;
   for i:= -1 to ShipSize do if InsertCheck(CPoly, Point(SPos.X+i, SPos.Y+1)) then CPoly[SPos.X+i, SPos.Y+1]:=aBusy;
   if InsertCheck(CPoly, Point(SPos.X-1, SPos.Y)) then CPoly[SPos.X-1, SPos.Y]:=aBusy;
   if InsertCheck(CPoly, Point(SPos.X+ShipSize, SPos.Y)) then CPoly[SPos.X+ShipSize, SPos.Y]:=aBusy;
   Exit;
  end;

 tdUp:
  begin
   for i:= -1 to ShipSize do if InsertCheck(CPoly, Point(SPos.X-1, SPos.Y-i)) then CPoly[SPos.X-1, SPos.Y-i]:=aBusy;
   for i:= 0 to ShipSize-1 do CPoly[SPos.X , SPos.Y-i]:=ShipSize;
   for i:= -1 to ShipSize do if InsertCheck(CPoly, Point(SPos.X+1, SPos.Y-i)) then CPoly[SPos.X+1, SPos.Y-i]:=aBusy;
   if InsertCheck(CPoly, Point(SPos.X, SPos.Y+1)) then CPoly[SPos.X, SPos.Y+1]:=aBusy;
   if InsertCheck(CPoly, Point(SPos.X, SPos.Y-ShipSize)) then CPoly[SPos.X, SPos.Y-ShipSize]:=aBusy;
   Exit;
  end;

 tdDown:
  begin
   for i:= -1 to ShipSize do if InsertCheck(CPoly, Point(SPos.X-1, SPos.Y+i)) then CPoly[SPos.X-1, SPos.Y+i]:=aBusy;
   for i:= 0 to ShipSize-1 do CPoly[SPos.X , SPos.Y+i]:=ShipSize;
   for i:= -1 to ShipSize do if InsertCheck(CPoly, Point(SPos.X+1, SPos.Y+i)) then CPoly[SPos.X+1, SPos.Y+i]:=aBusy;
   if InsertCheck(CPoly, Point(SPos.X, SPos.Y-1)) then CPoly[SPos.X, SPos.Y-1]:=aBusy;
   if InsertCheck(CPoly, Point(SPos.X, SPos.Y+ShipSize)) then CPoly[SPos.X, SPos.Y+ShipSize]:=aBusy;
   Exit;
  end;
 end;
end;
function TGame.CheckPos(CPoly:TArray; SPos:TPoint; var Direction:TDirection; ShipSize:Byte):Boolean;
var FirstDir:Byte;
    i, j:Smallint;
    Used:set of TDirection;
    IsBreak:Boolean;
    DPos:TPoint;
begin
 Result:=False;
 if CPoly[SPos.X, SPos.Y] &lt;&gt; aEmpty then Exit;
 Used:=[];
 Randomize;
 repeat
  repeat
   FirstDir:=Random(4);
  until (not (TDirection(FirstDir) in Used)) or (Used = [tdLeft, tdRight, tdUp, tdDown]);
  IsBreak:=False;
  case TDirection(FirstDir) of
   tdLeft:
    begin
     if SPos.X < ShipSize then
      begin
       Include(Used, tdLeft);
       Continue;
      end;
     for j:=-1 to 1 do
      begin
       for i:=-1 to ShipSize do
        begin
         DPos:=Point(SPos.X-i, SPos.Y+j);
         if (CheckCell(DPos)) then
         if (not (GetPos(CPoly, DPos)=aEmpty)) then
         if (not (GetPos(CPoly, DPos)=aBusy)) then
          begin
           Include(Used, tdLeft);
           IsBreak:=True;
           Break;
          end;
        end;
       if IsBreak then Break;
      end;
     if IsBreak then Continue;
     Result:=True;
     Direction:=tdLeft;
     Exit;
    end;

   tdRight:
    begin
     if (10 - SPos.X) < ShipSize then
      begin
       Include(Used, tdRight);
       Continue;
      end;
     for j:=-1 to 1 do
      begin
       for i:=-1 to ShipSize do
        begin
         DPos:=Point(SPos.X+i, SPos.Y+j);
         if (CheckCell(DPos)) then
          if (not (GetPos(CPoly, DPos)=aEmpty)) then
           if (not (GetPos(CPoly, DPos)=aBusy)) then
            begin
             Include(Used, tdRight);
             IsBreak:=True;
             Break;
            end;
        end;
       if IsBreak then Break;
      end;
     if IsBreak then Continue;
     Result:=True;
     Direction:=tdRight;
     Exit;
    end;

   tdUp: 
    begin
     if SPos.Y < ShipSize then
      begin
       Include(Used, tdUp);
       Continue;
     end;
     for j:=-1 to 1 do
      begin
       for i:=-1 to ShipSize do
        begin
         DPos:=Point(SPos.X+j, SPos.Y-i);
         if (CheckCell(DPos)) then
          if (not (GetPos(CPoly, DPos)=aEmpty)) then
           if (not (GetPos(CPoly, DPos)=aBusy)) then
            begin
             Include(Used, tdUp);
             IsBreak:=True;
             Break;
            end;
        end;
       if IsBreak then Break;
      end;
     if IsBreak then Continue;;
     Result:=True;
     Direction:=tdUp;
     Exit;
    end;

   tdDown:
    begin
     if (10 - SPos.Y) < ShipSize then
      begin
       Include(Used, tdDown);
       Continue;
      end;
     for j:=-1 to 1 do
      begin
       for i:=-1 to ShipSize do
        begin
         DPos:=Point(SPos.X+j, SPos.Y+i);
         if (CheckCell(DPos)) then
          if (not (GetPos(CPoly, DPos)=aEmpty)) then
           if (not (GetPos(CPoly, DPos)=aBusy)) then
            begin
             Include(Used, tdDown);
             IsBreak:=True;
             Break;
            end;
        end;
       if IsBreak then Break;
      end;
     if IsBreak then Continue;
     Result:=True;
     Direction:=tdDown;
     Exit;
    end;
   end;
 until Used = [tdLeft, tdRight, tdUp, tdDown];
end;

1 2 3

Скачать Ships.rar
Share

You may also like...

Добавить комментарий