New Generator + Shooter + ListUnit

program Intellect;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils,
  ListUnit in 'ListUnit.pas';

type
    TFieldCellState = (stImpossible = -1, stFree, stShortShip, stSmallShip, stMiddleShip, stLongShip);
    TField = array [-1..10, -1..10] of TFieldCellState;

    TShip = (tShortShip = 1, tSmallShip, tMiddleShip, tLongShip);
    TShipsArray = array [0..9] of TShip;

    TReturnCellStateFunction = function (ShipField: TField; I, J: ShortInt): TFieldCellState;
    TPlaceShipProcedure = procedure (var ShipsField: TField; Ship: TShip; X, Y: ShortInt);
    TCompareFunction = function(ShootField: TField; Ship: TShip; Col, Row, I: ShortInt): Boolean;

    TCellsArray = array [0..99] of Byte;


var
    TempField, ShootField: TField;
    ShipsArray: TShipsArray;
    CommonShipsCount, I: Byte;
    FreeCellsCount: ShortInt;
    CellsIndex, FreeCells: TCellsArray;
    PriorityCellsListHeader: PListElem;

procedure CreateNewField(var Field: TField);
var
    I, J: ShortInt;
begin
    for J := Low(Field) to High(Field) do
        Field[-1, J] := stImpossible;

    for I := Low(Field)+1 to High(Field)-1 do
    begin
        for J := Low(Field)+1 to High(Field)-1 do
            Field[I, J] := stFree;
        Field[I, Low(Field)] := stImpossible;
        Field[I, High(Field)] := stImpossible;
    end;

    for J := Low(Field) to High(Field) do
        Field[High(Field), J] := stImpossible;
end;

procedure OutputField(Field: TField);
var
    I, J: ShortInt;
begin
    for I := Low(Field) to High(Field) do
    begin
        for J := Low(Field) to High(Field) do
            Write(StrToFloat(IntToStr(Ord(Field[J, I]))):4:0);
        Writeln;
    end;
end;

procedure InitializeShips(var ShipsArray: TShipsArray);
var
    CurrShip: TShip;
    I, J: Byte;
begin
    J := Low(ShipsArray);
    for CurrShip := Low(TShip) to High(TShip) do
        for I := 5 - Ord(CurrShip) DownTo 1 do
        begin
            ShipsArray[J] := CurrShip;
            Inc(J);
        end;

    CommonShipsCount := 10;
end;

procedure OutputShips(ShipsArray: TShipsArray);
var
    I: Byte;
begin
    for I := Low(ShipsArray) to CommonShipsCount-1 do
        Write(Ord(ShipsArray[I]), ' ');
end;

function PullShip(var ShipsArray: TShipsArray): TShip;
var
    Ship: TShip;
begin
    Ship := ShipsArray[CommonShipsCount-1];
    Dec(CommonShipsCount);

    PullShip := Ship;
end;

function GetRandomDirection(): Boolean;
var
    IsHorizontal: Boolean;
begin
    if Random(2) = 0 then
        IsHorizontal := True
    else
        IsHorizontal := False;

    GetRandomDirection := isHorizontal;
end;

function ConvertShipToFieldState(Ship: TShip): TFieldCellState;
const
    TempArr: array [TShip] of TFieldCellState = (stShortShip, stSmallShip, stMiddleShip, stLongShip);
begin
    ConvertShipToFieldState := TempArr[Ship];
end;

function ConvertFieldStateToShip(FieldState: TFieldCellState): TShip;
const
    TempArr: array [stShortShip..stLongShip] of TShip = (tShortShip, tSmallShip, tMiddleShip, tLongShip);
begin
    ConvertFieldStateToShip := TempArr[FieldState];
end;

function ReturnRowElemState(ShipField: TField; I, J: ShortInt): TFieldCellState;
begin
    ReturnRowElemState := ShipField[J, I];
end;

function ReturnColElemState(ShipField: TField; I, J: ShortInt): TFieldCellState;
begin
    ReturnColElemState := ShipField[I, J];
end;

procedure PlaceShipHorizontal (var ShipsField: TField; Ship: TShip; Y, X: ShortInt);
var
    I: ShortInt;
begin
    for I := -1 to Ord(Ship) do
    begin
        ShipsField[X+I, Y-1] := stImpossible;
        ShipsField[X+I, Y] := ConvertShipToFieldState(Ship);
        ShipsField[X+I, Y+1] := stImpossible;
    end;
    ShipsField[X-1, Y] := stImpossible;
    ShipsField[X+Ord(Ship), Y] := stImpossible;
end;

procedure PlaceShipVertical (var ShipsField: TField; Ship: TShip; X, Y: ShortInt);
var
    I: ShortInt;
begin
    for I := -1 to Ord(Ship) do
    begin
        ShipsField[X-1, Y+I] := stImpossible;
        ShipsField[X, Y+I] := ConvertShipToFieldState(Ship);
        ShipsField[X+1, Y+I] := stImpossible;
    end;
    ShipsField[X, Y-1] := stImpossible;
    ShipsField[X, Y+Ord(Ship)] := stImpossible;
end;

function IsShipPlacedInField(var ShipsField: TField; Ship: TShip; Coord: ShortInt; IsHorizontal: Boolean): Boolean;
var
    I, SecondCoord, Counter, StartCell, PossibleCellCount: ShortInt;
    HasFreePlace: Boolean;
    ReturnCellState: TReturnCellStateFunction;
    PlaceShip: TPlaceShipProcedure;
begin
    PossibleCellCount := 0;
    Counter := 0;
    HasFreePlace := False;
    I := Low(ShipsField)+1;

    if IsHorizontal then
    begin
        ReturnCellState := ReturnColElemState;
        PlaceShip := PlaceShipHorizontal;
    end
    else
    begin
        ReturnCellState := ReturnRowElemState;
        PlaceShip := PlaceShipVertical;
    end;

    while I < High(ShipsField) do
    begin
        if Ord(ReturnCellState(ShipsField, I, Coord)) = 0 then
            Inc(Counter)
        else
        begin
            Counter := 0;
            PossibleCellCount := 0;
        end;

        if Counter = Ord(Ship) then
        begin
            HasFreePlace := True;
            StartCell :=  I - Ord(Ship)+1;
        end;

        if (Counter - Ord(Ship)) > PossibleCellCount then
            PossibleCellCount := Counter - Ord(Ship);

        Inc(I);
    end;

    if HasFreePlace then
    begin
        SecondCoord := StartCell + Random(PossibleCellCount + 1);
        PlaceShip(ShipsField, Ship, Coord, SecondCoord );
    end;

    IsShipPlacedInField := HasFreePlace;
end;

procedure PutShipToField(Ship: TShip; var ShipsField: TField);
var
    Coord: ShortInt;
    IsHorizontal: Boolean;
begin
    repeat
        IsHorizontal := GetRandomDirection;
        Coord := Random(10);
    until IsShipPlacedInField(ShipsField, Ship, Coord, IsHorizontal);
end;

procedure FillGameField(var Field: TField; var ShipsArray: TShipsArray);
var
    Ship: TShip;
    I: ShortInt;
begin
    for I := 1 to 10 do
    begin
        Ship := PullShip(ShipsArray);
        PutShipToField(Ship, TempField);
    end;
end;

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

procedure EditFreeCells(ShootField: TField; var FreeCells: TCellsArray; var CellsIndex: TCellsArray; Col, Row: ShortInt; var FreeCellsCount: 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 EditFieldAroundShootPlace(var ShootField: TField; var FreeCells: TCellsArray; var CellsIndex: TCellsArray; Col, Row: ShortInt; var FreeCellsCount: ShortInt);
var
    I, J: ShortInt;
begin
    I := -1;
    while I < 2 do
    begin
        J := -1;
        while J < 2 do
        begin
            EditFreeCells(ShootField, FreeCells, CellsIndex, Col+I, Row+J, FreeCellsCount);
            ShootField[Col+I, Row+J] := stImpossible;
            Inc(J, 2);
        end;
        Inc(I, 2);
    end;
end;

function CompareCellsVertically(ShootField: TField; Ship: TShip; Col,Row,I: ShortInt): Boolean;
begin
    CompareCellsVertically := ShootField[Col, Row+I] = ConvertShipToFieldState(Ship);
end;

function CompareCellsHorizontally(ShootField: TField; Ship: TShip; Col,Row,I: ShortInt): Boolean;
begin
    CompareCellsHorizontally := ShootField[Col+I, Row] = ConvertShipToFieldState(Ship);
end;

procedure FindSideOfShip(ShootField: TField; Ship: TShip; Col, Row: ShortInt; var FirstSideCol: ShortInt; var FirstSideRow: ShortInt; IsHorizontal: Boolean; DirectionCoef: ShortInt);
var
    I: ShortInt;
    HasPartOfShip: Boolean;
begin
    if IsHorizontal then
    begin
        I := 0;
        Repeat
            Inc(I);
            HasPartOfShip := CompareCellsHorizontally(ShootField, Ship, Col, Row, DirectionCoef*I);
        Until not HasPartOfShip;

        FirstSideRow := Row;
        FirstSideCol := Col + DirectionCoef * I;
    end
    else
    begin
        I := 0;
        Repeat
            Inc(I);
            HasPartOfShip := CompareCellsVertically(ShootField, Ship, Col, Row, DirectionCoef*I);
        Until not HasPartOfShip;
        FirstSideCol := Col;
        FirstSideRow := Row + DirectionCoef * I;
    end;
end;

procedure EditFieldForDestroyedShip(var ShootField: TField; Ship: TShip; var FreeCells: TCellsArray; var CellsIndex: TCellsArray; Col, Row: ShortInt; var FreeCellsCount: 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, FreeCells, CellsIndex, Col+I, Row, FreeCellsCount);
            EditFreeCells(ShootField, FreeCells, CellsIndex, Col, Row+I, FreeCellsCount);
            ShootField[Col+I, Row] := stImpossible;
            ShootField[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);

        EditFreeCells(ShootField, FreeCells, CellsIndex, FirstSideCol, FirstSideRow, FreeCellsCount);
        EditFreeCells(ShootField, FreeCells, CellsIndex, SecondSideCol, SecondSideRow, FreeCellsCount);
        ShootField[FirstSideCol, FirstSideRow] := stImpossible;
        ShootField[SecondSideCol, SecondSideRow] := stImpossible;
    end;
end;

function IsShipDestroyed(ShootField: TField; Ship: TShip; Col, Row: ShortInt; CompareFieldCellAndShipsDeck: TCompareFunction): Boolean;
var
    I, DamagedDecksCount: ShortInt;
    IsDestroyed, HasPartOfShip: Boolean;
begin
    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;

procedure MakeShoot(var ShootField: TField; UserField: TField; var FreeCells: TCellsArray; var CellsIndex: TCellsArray; var FreeCellsCount: ShortInt);
var
    ListElem: PListElem;
    Coord, I, Col, Row: ShortInt;
    State: TFieldCellState;
    Ship: TShip;
    IsDestroyedShipHorizontal, IsDestroyedShipVertical: Boolean;
begin
    if (PriorityCellsListHeader^.Next = nil) then
    begin
        I := Random(FreeCellsCount);
        Coord := FreeCells[I];
        FreeCells[I] := FreeCells[FreeCellsCount-1];
        CellsIndex[FreeCellsCount-1] := I;
        Dec(FreeCellsCount);

        Col := Coord div 10;
        Row := Coord mod 10;
    end
    else
    begin
        repeat
            ListElem := ExtractElem(PriorityCellsListHeader);
            Coord := ListElem^.Coord;
            Col := Coord div 10;
            Row := Coord mod 10;
            EditFreeCells(ShootField, FreeCells, CellsIndex, Col, Row, FreeCellsCount);
        until (PriorityCellsListHeader^.Next = nil) or (ShootField[Col, Row] = stFree);

    end;

    State := UserField[Col, Row];
    case State of
        stFree:
        begin
            ShootField[Col, Row] := stImpossible;
        end;
        stImpossible:
        begin
            ShootField[Col, Row] := stImpossible;
        end;
        stShortShip:
        begin
            Ship := tShortShip;
            ShootField[Col, Row] := State;
            EditFieldAroundShootPlace(ShootField, FreeCells, CellsIndex, Col, Row, FreeCellsCount);
            EditFieldForDestroyedShip(ShootField, Ship, FreeCells, CellsIndex, Col, Row, FreeCellsCount, True);
        end;
        else
        begin
            Ship := ConvertFieldStateToShip(State);
            ShootField[Col, Row] := State;
            EditFieldAroundShootPlace(ShootField, FreeCells, CellsIndex, Col, Row, FreeCellsCount);
            AddPriorityCellsToList(PriorityCellsListHeader, ShootField, Col, Row);

            IsDestroyedShipHorizontal := IsShipDestroyed(ShootField, Ship, Col, Row, CompareCellsHorizontally);
            IsDestroyedShipVertical := IsShipDestroyed(ShootField, Ship, Col, Row, CompareCellsVertically);
            if IsDestroyedShipHorizontal or IsDestroyedShipVertical then
            begin
                EditFieldForDestroyedShip(ShootField, Ship, FreeCells, CellsIndex, Col, Row, FreeCellsCount, IsDestroyedShipHorizontal);
                DisposeList(PriorityCellsListHeader);
            end;
        end;
    end;
end;

begin
    Randomize;
    CreateNewField(TempField);
    OutputField(TempField);

    InitializeShips(ShipsArray);
    OutputShips(ShipsArray);

    FillGameField(TempField, ShipsArray);
    Writeln;
    Writeln;

    OutputField(TempField);


    CellsArrayInitialize(FreeCells);
    CellsArrayInitialize(CellsIndex);
    CreateNewField(ShootField);


    InitializeList(PriorityCellsListHeader);

    //for I := 1 to 15 do

    while FreeCellsCount > 0 do
    begin
        MakeShoot(ShootField, TempField, FreeCells, CellsIndex, FreeCellsCount);
    end;
         Writeln;
    Writeln;
    OutputField(ShootField);
    Readln;
end.















unit ListUnit;

interface
type
    PListElem = ^TPriorityCellsList;
    TPriorityCellsList = record
        Coord: ShortInt;
        Next: PListElem;
    end;
    function CreateListElem(Coord: ShortInt): PListElem;
    procedure AddListElem(var Header: PListElem; Coord: ShortInt);
    function ExtractElem (var Header: PListElem): PListElem;
    procedure DisposeList(var Header: PListElem);
    procedure InitializeList(var PriorityCellsListHeader: PListElem);


implementation
function CreateListElem(Coord: ShortInt): PListElem;
var
    NewElem: PListElem;
begin
    New(NewElem);
    NewElem^.Coord := Coord;
    NewElem^.Next := nil;
    CreateListElem := NewElem;
end;

procedure AddListElem(var Header: PListElem; Coord: ShortInt);
var
    Temp: PListElem;
begin
    Temp := Header^.Next;
    Header^.Next := CreateListElem(Coord);
    Header^.Next^.Next := Temp;
end;

function ExtractElem (var Header: PListElem): PListElem;
var
    Temp: PListElem;
begin
    if Header^.Next <> nil then
    begin
        Temp := Header^.Next;
        Header^.Next := Temp^.Next;
        Temp^.Next := nil;
    end
    else
        Temp := nil;
    ExtractElem := Temp;
end;

procedure DisposeList(var Header: PListElem);
var
    Prev, Curr: PListElem;
begin
    Curr := Header^.Next;
    while Curr <> nil do
    begin
        Prev := Curr;
        Curr := Curr^.Next;
        Dispose(Prev);
    end;
    Header^.Next := nil;
end;

procedure InitializeList(var PriorityCellsListHeader: PListElem);
begin
    New(PriorityCellsListHeader);
    PriorityCellsListHeader^.Next := nil;
end;
end.