backup battle units

unit BattleDescribeUnit;

interface
uses
    FieldGeneratorUnit;
type
    TCellsArray = array [0..99] of Byte;

var
    UserShipsCountArray: TShipsCountArray;
    IsBotPlaneActive: Boolean;

procedure InitializeBot(Field: TField);
procedure ChangeFieldAroundShootPlace(var ShootField: TField; var DisplayedField: TField; Col, Row: ShortInt);
procedure ChangeFieldForDestroyedShip(var ShootField: TField; var DisplayedShip: TField; Ship: TShip; Col, Row: ShortInt; IsHorizontal: Boolean);
function IsShipDestroyed(ShootField: TField; Ship: TShip; Col, Row: ShortInt; IsHorizontal: Boolean): Boolean;
procedure MakeShoot(var DisplayedUserField: TField; var WasHit: Boolean);
implementation
uses
    BattleUnit, ListUnit;
var
    FreeCellsCount: ShortInt;
    CellsIndex, FreeCells: TCellsArray;
    PriorityCellsListHeader: PListElem;
    ShootUserField, UserField: TField;
    WasPlaneUsed: Boolean;

function CellsArrayInitialize(): TCellsArray;
var
    I, J, Temp: Byte;
    FreeCells: TCellsArray;
begin
    for I := 0 to 9 do
        for J := 0 to 9 do
        begin
            Temp := I + 9 * I + J;
            FreeCells[Temp] := Temp;
        end;

    CellsArrayInitialize := FreeCells;
end;

procedure EditFreeCells(ShootField: TField; Col, Row: ShortInt);
var
    LastFreeCellsValue, Coord: Byte;
begin
    if (ShootField[Col, Row] <> stImpossible) then
    begin
        Coord := 10 * Col + Row;
        LastFreeCellsValue := FreeCells[FreeCellsCount-1];
        FreeCells[CellsIndex[Coord]] := LastFreeCellsValue;
        CellsIndex[LastFreeCellsValue] := CellsIndex[Coord];
        Dec(FreeCellsCount);
    end;
end;

procedure ChangeFieldAroundShootPlace(var ShootField: TField; var DisplayedField: TField; Col, Row: ShortInt);
var
    I, J: ShortInt;
begin
    I := -1;
    while I < 2 do
    begin
        J := -1;
        while J < 2 do
        begin
            ShootField[Col+I, Row+J] := stImpossible;
            DisplayedField[Col+I, Row+J] := stImpossible;
            Inc(J, 2);
        end;
        Inc(I, 2);
    end;
end;

procedure EditCellsAroundShootPlaceInArray(ShootField: TField; Col, Row: ShortInt);
var
    I, J: ShortInt;
begin
    I := -1;
    while I < 2 do
    begin
        J := -1;
        while J < 2 do
        begin
            EditFreeCells(ShootField, Col+I, Row+J);
            Inc(J, 2);
        end;
        Inc(I, 2);
    end;
end;

procedure ChangeFieldForDestroyedShip(var ShootField: TField; var DisplayedShip: TField; Ship: TShip; Col, Row: ShortInt; IsHorizontal: Boolean);
var
    FirstSideCol, FirstSideRow, SecondSideCol, SecondSideRow, I: ShortInt;
begin
    if Ship = tShortShip then
    begin
        I := -1;
        while I < 2 do
        begin
            ShootField[Col+I, Row] := stImpossible;
            ShootField[Col, Row+I] := stImpossible;
            DisplayedShip[Col+I, Row] := stImpossible;
            DisplayedShip[Col, Row+I] := stImpossible;
            Inc(I, 2);
        end;
    end
    else
    begin
        FindSideOfShip(ShootField, Ship, Col, Row, FirstSideCol, FirstSideRow, IsHorizontal, -1);
        FindSideOfShip(ShootField, Ship, Col, Row, SecondSideCol, SecondSideRow, IsHorizontal, 1);

        ShootField[FirstSideCol, FirstSideRow] := stImpossible;
        ShootField[SecondSideCol, SecondSideRow] := stImpossible;
        DisplayedShip[FirstSideCol, FirstSideRow] := stImpossible;
        DisplayedShip[SecondSideCol, SecondSideRow] := stImpossible;
    end;
end;

procedure EditCellsForDestroyedShipInArray(ShootField: TField; Ship: TShip; Col, Row: ShortInt; IsHorizontal: Boolean);
var
    FirstSideCol, FirstSideRow, SecondSideCol, SecondSideRow, I: ShortInt;
begin
    if Ship = tShortShip then
    begin
        I := -1;
        while I < 2 do
        begin
            EditFreeCells(ShootField, Col+I, Row);
            EditFreeCells(ShootField, Col, Row+I);
            Inc(I, 2);
        end;
    end
    else
    begin
        FindSideOfShip(ShootField, Ship, Col, Row, FirstSideCol, FirstSideRow, IsHorizontal, -1);
        FindSideOfShip(ShootField, Ship, Col, Row, SecondSideCol, SecondSideRow, IsHorizontal, 1);

        EditFreeCells(ShootField, FirstSideCol, FirstSideRow);
        EditFreeCells(ShootField, SecondSideCol, SecondSideRow);
    end;
end;

function IsShipDestroyed(ShootField: TField; Ship: TShip; Col, Row: ShortInt; IsHorizontal: Boolean): Boolean;
var
    I, DamagedDecksCount: ShortInt;
    IsDestroyed, HasPartOfShip: Boolean;
    CompareFieldCellAndShipsDeck: TCompareFunction;
begin
    if IsHorizontal then
        CompareFieldCellAndShipsDeck := CompareCellsHorizontally
    else
        CompareFieldCellAndShipsDeck := CompareCellsVertically;

    DamagedDecksCount := 0;
    I := 0;
    Repeat
        HasPartOfShip := CompareFieldCellAndShipsDeck(ShootField, Ship, Col, Row, -I);
        if HasPartOfShip then
           Inc(DamagedDecksCount);
        Inc(I);
    Until (I = Ord(Ship)) or not HasPartOfShip;
    IsDestroyed := DamagedDecksCount = Ord(Ship);

    if not IsDestroyed then
    begin
        I := 1;
        Repeat
            HasPartOfShip := CompareFieldCellAndShipsDeck(ShootField, Ship, Col, Row, I);
            if HasPartOfShip then
                Inc(DamagedDecksCount);
            Inc(I);
        Until (I = Ord(Ship)) or not HasPartOfShip;
        IsDestroyed := DamagedDecksCount = Ord(Ship);
    end;

    IsShipDestroyed := IsDestroyed;
end;

function IsFieldCellFree(ShootField: TField; Col, Row: ShortInt): Boolean;
begin
    IsFieldCellFree := ShootField [Col, Row] = stFree;
end;

procedure AddPriorityCellsToList (ListHeader: PListElem; ShootField: TField; Col, Row: ShortInt);
var
    I: ShortInt;
begin
    I := -1;
    while I < 2 do
    begin
        if IsFieldCellFree(ShootField, Col+I, Row) then
            AddListElem(ListHeader, 10 * (Col+I) + Row);
        if IsFieldCellFree(ShootField, Col, Row+I) then
            AddListElem(ListHeader, 10 * Col + (Row+I));

        Inc(I, 2);
    end;
end;

Function ReturnFreeCellCoord(): ShortInt;
Var
    Col, Row, Coord, I: ShortInt;
    ListElem: PListElem;
Begin
    //если в списке приоритетных ячеек ничего нет - выбираем случайную необстрелянную ячейку
    If (PriorityCellsListHeader^.Next = Nil) Then
    Begin
        //выбирается случайное число от 0 до количества необстрелянных ячеек
        I := Random(FreeCellsCount);

        //координатой будет I-тое значение из массива FreeCells
        Coord := FreeCells[I];

        //в массив FreeCells на место "обстрелянной" координаты помещаем значение последней из FreeCells
        FreeCells[I] := FreeCells[FreeCellsCount-1];

        //для перемещенной координаты меняем ее индекс на I
        CellsIndex[FreeCellsCount-1] := I;

        //уменьшаем количество необстрелянных ячеек
        Dec(FreeCellsCount);

        {когда придется удалять из массива свободных ячеек элемент с конкретной координатой (после попадания или вычеркивания ячеек в результате уничтожения корабля),
        вместо осуществления линейного поиска, найти этот элемент с помощью массива CellsIndex можно будет со сложностью O(1).
        }

    End
    Else
    Begin
        Repeat
            //из списка приоритетных ячеек извлекается одна координата
            ListElem := ExtractElem(PriorityCellsListHeader);
            Coord := ListElem^.Coord;
            Col := Coord div 10;
            Row := Coord mod 10;

            //если ячейка еще в массиве необстрелянных - она будет удалена из массива
            EditFreeCells(ShootUserField, Col, Row);

            //если список приоритетных ячеек закончился или данная ячейка еще не обстреляна
        Until(PriorityCellsListHeader^.Next = Nil) Or (ShootUserField[Col, Row] = stFree);
    End;

    ReturnFreeCellCoord := Coord;
End;

Procedure ShootUserFieldOnCoord(Var DisplayedUserField: TField; Var WasHit: Boolean; Col, Row: ShortInt);
Var
    State: TFieldCellState;
    Ship: TShip;
    IsHorizontal: Boolean;
begin
    // в переменной State сохраняется значение поля игрока в этой ячейке
    State := UserField[Col, Row];
    Case State Of
        stFree, stImpossible:
        Begin
            // попадания не было - на отображающемся поле игрока и на поле, которое обстреливает бот помечаем ячейку как stImpossible
            ShootUserField[Col, Row] := stImpossible;
            DisplayedUserField[Col, Row] := stImpossible;

            //попадания от бота не было
            WasHit := False;
        End;
    Else
        Begin
            //попадание было
            WasHit := True;

            //конвертируется состояние поля в этой ячейке в тип корабля
            Ship := ConvertFieldStateToShip(State);

            //выполняются соответствующие преобразования полей
            ShootUserField[Col, Row] := State;
            DisplayedUserField[Col, Row] := stDamaged;

            //4 клетки по диагоналям вокруг попадания удаляются из массива необстрелянных ячеек
            EditCellsAroundShootPlaceInArray(ShootUserField, Col, Row);

            //изменяется поле, обстреливаемое ботом, и отображаемое поле игрока
            ChangeFieldAroundShootPlace(ShootUserField, DisplayedUserField, Col, Row);

            //если попадание по кораблю, у которого больше 1 палубы, 4 ячейки, окружающие его, помещаются в список приоритетных
            If Ship <> tShortShip Then
                AddPriorityCellsToList(PriorityCellsListHeader, ShootUserField, Col, Row);

            IsHorizontal := IsShipInFieldHorizontal(UserField, Ship, Col, Row);

            //если корабль уничтожен полностью
            If IsShipDestroyed(ShootUserField, Ship, Col, Row, IsHorizontal) Then
            Begin
                //клетки поля, оставшиеся свободными вокруг корабля, удаляются из массива необстрелянных ячеек
                EditCellsForDestroyedShipInArray(ShootUserField, Ship, Col, Row, IsHorizontal);

                //клетки поля, оставшиеся свободными вокруг корабля, помечаются на полях обстрелянными
                ChangeFieldForDestroyedShip(ShootUserField, DisplayedUserField, Ship, Col, Row, IsHorizontal);

                //удаление всех приоритетных ячеек
                DisposeList(PriorityCellsListHeader);

                //считать корабль уничтоженным
                Dec(UserShipsCountArray[Ship]);
            End;
        End;
    End;
End;

procedure MakeShoot(var DisplayedUserField: TField; var WasHit: Boolean);
var
    Coord, Col, Row, I, J: ShortInt;

begin
    Coord := ReturnFreeCellCoord();
    Col := Coord div 10;
    Row := Coord mod 10;

    IsBotPlaneActive := False;
    if not WasPlaneUsed then
        IsBotPlaneActive := Random(15) = 1;

    if IsBotPlaneActive then
    begin
        for I := Col-1 to Col+1 do
            for J := Row-1 to Row+1 do
            begin
                //if (I <> Col) and (J <> Col)  then
                    //EditFreeCells(ShootUserField, I, J);
                ShootUserFieldOnCoord (DisplayedUserField, WasHit, I, J);
            end;
        WasPlaneUsed := True;
        WasHit := False;
    end
    else
        ShootUserFieldOnCoord(DisplayedUserField, WasHit, Col, Row);
end;

Procedure InitializeBot(Field: TField);
Begin
    //инициализация массива необстреляных ячеек
    FreeCells := CellsArrayInitialize();

    //инициализация массива индексов необстрелянных ячеек
    CellsIndex := CellsArrayInitialize();

    //полем пользователя в модуле считать преданное поле из BattleUnit
    UserField := Field;

    //количество необстреляных ячеек вначале игры
    FreeCellsCount := 100;

    //создаётся пустое поле пользователя для обстрела
    ShootUserField := CreateField();

    //инициализация списка приоритетных для обстрела ячеек
    PriorityCellsListHeader := InitializeList();

    //инициализация массива оставшихся кораблей пользователя
    UserShipsCountArray := IinializeShipsCountArray();

    //флаг, принимающий значение True, когда ботом был использован "авиаудар"
    WasPlaneUsed := False;
End;

end.









unit BattleUnit;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Menus, Vcl.ExtCtrls, BattleDescribeUnit;

type
  TBattleForm = class(TForm)
    ExitLabel: TLabel;
    MainMenu: TMainMenu;
    ManualMenuItem: TMenuItem;
    AboutDeveloperMenuItem: TMenuItem;
    UserFieldImage: TImage;
    BotFieldImage: TImage;
    PointerLabel: TLabel;
    YourFieldLabel: TLabel;
    BotFieldLabel: TLabel;
    BotTimer: TTimer;
    WinnerInfoLabel: TLabel;
    PlaneImage: TImage;
    ActiveTimer: TTimer;
    InformationLabel: TLabel;
    procedure ExitLabelMouseEnter(Sender: TObject);
    procedure ExitLabelMouseLeave(Sender: TObject);
    procedure ExitLabelClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure BotFieldImageMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure BotFieldImageMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure BotTimerTimer(Sender: TObject);
    procedure PlaneImageClick(Sender: TObject);
    procedure ActiveTimerTimer(Sender: TObject);
    procedure ManualMenuItemClick(Sender: TObject);
    procedure AboutDeveloperMenuItemClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  BattleForm: TBattleForm;

implementation
uses
    GridUnit, FieldGeneratorUnit, ConstructorUnit, ListUnit, AboutDeveloperUnit, ManualUnit;

const
    CELL_WIDTH = 30;

var
    UserField, DisplayedUserField, BotField, DisplayedBotField: TField;
    ImpossibleCellsMatrix: TImpossibleCellsMatrix;
    WasCorrectShoot, WasHit, IsUserPlaneActive: Boolean;
    BotShipsCountArray: TShipsCountArray;

{$R *.dfm}

procedure ShootBotField (Col, Row: ShortInt);
var
    Ship: TShip;
    IsHorizontal: Boolean;
begin
    case BotField[Col, Row] of
        stImpossible, stFree :
        begin
            DisplayedBotField[Col, Row] := stImpossible;
            WasHit := False;
        end
    else
        DisplayedBotField[Col, Row] := BotField[Col, Row];
        WasHit := True;
        ChangeFieldAroundShootPlace(BotField, DisplayedBotField, Col, Row);
        Ship := ConvertFieldStateToShip (BotField[Col, Row]);
        IsHorizontal := IsShipInFieldHorizontal(BotField, Ship, Col, Row);
        if IsShipDestroyed(DisplayedBotField, Ship, Col, Row, IsHorizontal) then
        begin
            ChangeFieldForDestroyedShip(BotField, DisplayedBotField, Ship, Col, Row, IsHorizontal);
            Dec(BotShipsCountArray[Ship]);
            if IsShipsCountArrayEmpty(BotShipsCountArray) then
            begin
                BattleForm.WinnerInfoLabel.Caption := 'Это победа!!!';
                BattleForm.WinnerInfoLabel.Visible := True;
                BattleForm.BotFieldImage.Enabled := False;
            end;
        end;
    end;
end;

procedure TBattleForm.AboutDeveloperMenuItemClick(Sender: TObject);
begin
    AboutDeveloperForm.ShowModal;
end;

procedure TBattleForm.ActiveTimerTimer(Sender: TObject);
begin
    if PlaneImage.Visible = True then
        PlaneImage.Visible := False
    else
        PlaneImage.Visible := True;
end;

procedure TBattleForm.BotFieldImageMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
    Col, Row: ShortInt;
    I, J: ShortInt;
begin
    Col := X div CELL_WIDTH;
    Row := Y div CELL_WIDTH;

    if IsBotPlaneActive or IsUserPlaneActive then
        InformationLabel.Visible := False;

    if DisplayedBotField[Col, Row] = stFree then
    begin
        if IsUserPlaneActive then
        begin
            for I := Col-1 to Col+1 do
                for J := Row-1 to Row+1 do
                    ShootBotField (I, J);

            DrawField(BotFieldImage, DisplayedBotField);
            IsUserPlaneActive := False;
            ActiveTimer.Enabled := False;
            PlaneImage.Visible := False;
            WasHit := False;
        end
        else
        begin
            ShootBotField (Col, Row);
            DrawField(BotFieldImage, DisplayedBotField);
        end;
        WasCorrectShoot := True;
    end;
end;

Procedure TBattleForm.BotTimerTimer(Sender: TObject);
Begin
    //процедура из модуля BattleDescribeUnit, изменяющая отображаемое поле пользователя и возвращающая информацию, было ли попадание
    MakeShoot(DisplayedUserField, WasHit);

    //если текущим ходом бот использовал "авиаудар" - вывести информацию
    If IsBotPlaneActive Then
    Begin
        InformationLabel.Caption := 'Авиаудар!!!';
        InformationLabel.Visible := True;
    End;

    DrawField(UserFieldImage, DisplayedUserField);

    //если попадания не было - передача хода игроку
    If Not WasHit Then
    Begin
        BotTimer.Enabled := False;
        BotFieldImage.Enabled := True;
        PointerLabel.Caption := '>>';
    End;

    //если кораблей пользователя не осталось - вывести информацию о поражении
    If IsShipsCountArrayEmpty(UserShipsCountArray) Then
    Begin
        WinnerInfoLabel.Caption := 'Поражение... :(';
        WinnerInfoLabel.Visible := True;
        BotFieldImage.Enabled := False;
        BotTimer.Enabled := False;
    End;
End;

procedure TBattleForm.BotFieldImageMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
    if WasCorrectShoot and not WasHit then
    begin
        BotFieldImage.Enabled := False;
        BotTimer.Enabled := True;
        PointerLabel.Caption := '<<';
        WasCorrectShoot := False;
    end;
end;

procedure TBattleForm.ExitLabelClick(Sender: TObject);
begin
    BattleForm.Close;
end;

procedure TBattleForm.ExitLabelMouseEnter(Sender: TObject);
begin
    with Sender as TLabel do
    begin
        Font.Color := clBlack;
    end;
end;

procedure TBattleForm.ExitLabelMouseLeave(Sender: TObject);
begin
    with Sender as TLabel do
    begin
        Font.Color := clGrayText;
    end;
end;

function CreateOnlyShipsField(Field: TField): TField;
var
    I, J: ShortInt;
    OnlyShipsField: TField;
begin
    for I := Low(Field) to High(Field) do
        for J := Low(Field) to High(Field) do
        begin
            if Field[J, I] = stImpossible then
                OnlyShipsField[J, I] := stFree
            else
                OnlyShipsField[J, I] := Field[J, I];
        end;
    CreateOnlyShipsField := OnlyShipsField;
end;

procedure TBattleForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
     CanClose := MessageBox(Handle, 'Вы действительно хотите выйти?', 'Вы уверены?', MB_YESNO Or MB_ICONQUESTION) = IDYES;
end;

Procedure TBattleForm.FormShow(Sender: TObject);
Begin
    //в данном модуле в качестве поля пользователя считать Field из модуля-конструктора
    UserField := ConstructorUnit.Field;

    //создается пустая характерная для поля матрица
    ImpossibleCellsMatrix := CreateImpossibleCellsMatrix();

    //генерируется поле бота
    BotField := GenerateField(ImpossibleCellsMatrix);

    //создается пустое "отображаемое" поле бота
    DisplayedBotField := CreateField();

    //создаётся "отображаемое" поле игрока, состоящее только из кораблей
    DisplayedUserField := CreateOnlyShipsField(UserField);

    //инициализируется массив с количеством неутопленных кораблей бота
    BotShipsCountArray := IinializeShipsCountArray();

    //инициализация бота в BattleDescribeUnit
    InitializeBot(UserField);

    //инициализация флагов и свойств компонентов формы
    IsUserPlaneActive := False;
    ActiveTimer.Enabled := False;
    InformationLabel.Visible := False;

    WinnerInfoLabel.Visible := False;
    BotFieldImage.Enabled := True;
    PlaneImage.Visible := True;

    DrawField(UserFieldImage, DisplayedUserField);
    DrawField(BotFieldImage, DisplayedBotField);
End;

procedure TBattleForm.ManualMenuItemClick(Sender: TObject);
begin
    ManualForm.ShowModal;
end;

procedure TBattleForm.PlaneImageClick(Sender: TObject);
begin
    IsUserPlaneActive := not IsUserPlaneActive;
    ActiveTimer.Enabled := not ActiveTimer.Enabled;
    InformationLabel.Caption := 'Приготовьтесь к авиаудару...';
    InformationLabel.Visible := not InformationLabel.Visible;
end;



end.