Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 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: ShortInt;
- HasFreePlace: Boolean;
- ReturnCellState: TReturnCellStateFunction;
- PlaceShip: TPlaceShipProcedure;
- begin
- 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)) and not HasFreePlace) do
- begin
- if Ord(ReturnCellState(ShipsField, I, Coord)) = 0 then
- Inc(Counter)
- else
- Counter := 0;
- if Counter = Ord(Ship) then
- begin
- HasFreePlace := True;
- SecondCoord := I - Ord(Ship)+1;
- PlaceShip(ShipsField, Ship, Coord, SecondCoord );
- end;
- Inc(I);
- 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
- Writeln('В начале было: ', FreeCellsCount);
- 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;
- Writeln(Col, ' ', Row, ' ', FreeCellsCount);
- 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);
- Writeln('Осталось:', FreeCellsCount);
- OutputField(ShootField);
- end;
- Readln;
- end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement