Advertisement
THOMAS_SHELBY_18

Shooter+Generator

Apr 3rd, 2024
105
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 14.46 KB | Source Code | 0 0
  1. program Intellect;
  2.  
  3. {$APPTYPE CONSOLE}
  4.  
  5. {$R *.res}
  6.  
  7. uses
  8.   System.SysUtils,
  9.   ListUnit in 'ListUnit.pas';
  10.  
  11. type
  12.     TFieldCellState = (stImpossible = -1, stFree, stShortShip, stSmallShip, stMiddleShip, stLongShip);
  13.     TField = array [-1..10, -1..10] of TFieldCellState;
  14.  
  15.     TShip = (tShortShip = 1, tSmallShip, tMiddleShip, tLongShip);
  16.     TShipsArray = array [0..9] of TShip;
  17.  
  18.     TReturnCellStateFunction = function (ShipField: TField; I, J: ShortInt): TFieldCellState;
  19.     TPlaceShipProcedure = procedure (var ShipsField: TField; Ship: TShip; X, Y: ShortInt);
  20.     TCompareFunction = function(ShootField: TField; Ship: TShip; Col, Row, I: ShortInt): Boolean;
  21.  
  22.     TCellsArray = array [0..99] of Byte;
  23.  
  24.  
  25. var
  26.     TempField, ShootField: TField;
  27.     ShipsArray: TShipsArray;
  28.     CommonShipsCount, I: Byte;
  29.     FreeCellsCount: ShortInt;
  30.     CellsIndex, FreeCells: TCellsArray;
  31.     PriorityCellsListHeader: PListElem;
  32.  
  33. procedure CreateNewField(var Field: TField);
  34. var
  35.     I, J: ShortInt;
  36. begin
  37.     for J := Low(Field) to High(Field) do
  38.         Field[-1, J] := stImpossible;
  39.  
  40.     for I := Low(Field)+1 to High(Field)-1 do
  41.     begin
  42.         for J := Low(Field)+1 to High(Field)-1 do
  43.             Field[I, J] := stFree;
  44.         Field[I, Low(Field)] := stImpossible;
  45.         Field[I, High(Field)] := stImpossible;
  46.     end;
  47.  
  48.     for J := Low(Field) to High(Field) do
  49.         Field[High(Field), J] := stImpossible;
  50. end;
  51.  
  52. procedure OutputField(Field: TField);
  53. var
  54.     I, J: ShortInt;
  55. begin
  56.     for I := Low(Field) to High(Field) do
  57.     begin
  58.         for J := Low(Field) to High(Field) do
  59.             Write(StrToFloat(IntToStr(Ord(Field[J, I]))):4:0);
  60.         Writeln;
  61.     end;
  62. end;
  63.  
  64. procedure InitializeShips(var ShipsArray: TShipsArray);
  65. var
  66.     CurrShip: TShip;
  67.     I, J: Byte;
  68. begin
  69.     J := Low(ShipsArray);
  70.     for CurrShip := Low(TShip) to High(TShip) do
  71.         for I := 5 - Ord(CurrShip) DownTo 1 do
  72.         begin
  73.             ShipsArray[J] := CurrShip;
  74.             Inc(J);
  75.         end;
  76.  
  77.     CommonShipsCount := 10;
  78. end;
  79.  
  80. procedure OutputShips(ShipsArray: TShipsArray);
  81. var
  82.     I: Byte;
  83. begin
  84.     for I := Low(ShipsArray) to CommonShipsCount-1 do
  85.         Write(Ord(ShipsArray[I]), ' ');
  86. end;
  87.  
  88. function PullShip(var ShipsArray: TShipsArray): TShip;
  89. var
  90.     Ship: TShip;
  91. begin
  92.     Ship := ShipsArray[CommonShipsCount-1];
  93.     Dec(CommonShipsCount);
  94.  
  95.     PullShip := Ship;
  96. end;
  97.  
  98. function GetRandomDirection(): Boolean;
  99. var
  100.     IsHorizontal: Boolean;
  101. begin
  102.     if Random(2) = 0 then
  103.         IsHorizontal := True
  104.     else
  105.         IsHorizontal := False;
  106.  
  107.     GetRandomDirection := isHorizontal;
  108. end;
  109.  
  110. function ConvertShipToFieldState(Ship: TShip): TFieldCellState;
  111. const
  112.     TempArr: array [TShip] of TFieldCellState = (stShortShip, stSmallShip, stMiddleShip, stLongShip);
  113. begin
  114.     ConvertShipToFieldState := TempArr[Ship];
  115. end;
  116.  
  117. function ConvertFieldStateToShip(FieldState: TFieldCellState): TShip;
  118. const
  119.     TempArr: array [stShortShip..stLongShip] of TShip = (tShortShip, tSmallShip, tMiddleShip, tLongShip);
  120. begin
  121.     ConvertFieldStateToShip := TempArr[FieldState];
  122. end;
  123.  
  124. function ReturnRowElemState(ShipField: TField; I, J: ShortInt): TFieldCellState;
  125. begin
  126.     ReturnRowElemState := ShipField[J, I];
  127. end;
  128.  
  129. function ReturnColElemState(ShipField: TField; I, J: ShortInt): TFieldCellState;
  130. begin
  131.     ReturnColElemState := ShipField[I, J];
  132. end;
  133.  
  134. procedure PlaceShipHorizontal (var ShipsField: TField; Ship: TShip; Y, X: ShortInt);
  135. var
  136.     I: ShortInt;
  137. begin
  138.     for I := -1 to Ord(Ship) do
  139.     begin
  140.         ShipsField[X+I, Y-1] := stImpossible;
  141.         ShipsField[X+I, Y] := ConvertShipToFieldState(Ship);
  142.         ShipsField[X+I, Y+1] := stImpossible;
  143.     end;
  144.     ShipsField[X-1, Y] := stImpossible;
  145.     ShipsField[X+Ord(Ship), Y] := stImpossible;
  146. end;
  147.  
  148. procedure PlaceShipVertical (var ShipsField: TField; Ship: TShip; X, Y: ShortInt);
  149. var
  150.     I: ShortInt;
  151. begin
  152.     for I := -1 to Ord(Ship) do
  153.     begin
  154.         ShipsField[X-1, Y+I] := stImpossible;
  155.         ShipsField[X, Y+I] := ConvertShipToFieldState(Ship);
  156.         ShipsField[X+1, Y+I] := stImpossible;
  157.     end;
  158.     ShipsField[X, Y-1] := stImpossible;
  159.     ShipsField[X, Y+Ord(Ship)] := stImpossible;
  160. end;
  161.  
  162. function IsShipPlacedInField(var ShipsField: TField; Ship: TShip; Coord: ShortInt; IsHorizontal: Boolean): Boolean;
  163. var
  164.     I, SecondCoord, Counter: ShortInt;
  165.     HasFreePlace: Boolean;
  166.     ReturnCellState: TReturnCellStateFunction;
  167.     PlaceShip: TPlaceShipProcedure;
  168. begin
  169.     Counter := 0;
  170.     HasFreePlace := False;
  171.     I := Low(ShipsField)+1;
  172.  
  173.     if IsHorizontal then
  174.     begin
  175.         ReturnCellState := ReturnColElemState;
  176.         PlaceShip := PlaceShipHorizontal;
  177.     end
  178.     else
  179.     begin
  180.         ReturnCellState := ReturnRowElemState;
  181.         PlaceShip := PlaceShipVertical;
  182.     end;
  183.  
  184.     while ((I < High(ShipsField)) and not HasFreePlace) do
  185.     begin
  186.         if Ord(ReturnCellState(ShipsField, I, Coord)) = 0 then
  187.             Inc(Counter)
  188.         else
  189.             Counter := 0;
  190.  
  191.         if Counter = Ord(Ship) then
  192.         begin
  193.             HasFreePlace := True;
  194.             SecondCoord := I - Ord(Ship)+1;
  195.             PlaceShip(ShipsField, Ship, Coord, SecondCoord );
  196.         end;
  197.         Inc(I);
  198.     end;
  199.  
  200.     IsShipPlacedInField := HasFreePlace;
  201. end;
  202.  
  203. procedure PutShipToField(Ship: TShip; var ShipsField: TField);
  204. var
  205.     Coord: ShortInt;
  206.     IsHorizontal: Boolean;
  207. begin
  208.     repeat
  209.         IsHorizontal := GetRandomDirection;
  210.         Coord := Random(10);
  211.     until IsShipPlacedInField(ShipsField, Ship, Coord, IsHorizontal);
  212. end;
  213.  
  214. procedure FillGameField(var Field: TField; var ShipsArray: TShipsArray);
  215. var
  216.     Ship: TShip;
  217.     I: ShortInt;
  218. begin
  219.     for I := 1 to 10 do
  220.     begin
  221.         Ship := PullShip(ShipsArray);
  222.         PutShipToField(Ship, TempField);
  223.     end;
  224. end;
  225.  
  226. procedure CellsArrayInitialize(var FreeCells: TCellsArray);
  227. var
  228.     I, J, Temp: Byte;
  229. begin
  230.     for I := 0 to 9 do
  231.         for J := 0 to 9 do
  232.         begin
  233.             Temp := I + 9 * I + J;
  234.             FreeCells[Temp] := Temp;
  235.         end;
  236.     FreeCellsCount := 100;
  237. end;
  238.  
  239. procedure EditFreeCells(ShootField: TField; var FreeCells: TCellsArray; var CellsIndex: TCellsArray; Col, Row: ShortInt; var FreeCellsCount: ShortInt);
  240. var
  241.     LastFreeCellsValue, Coord: Byte;
  242. begin
  243.     if ShootField[Col, Row] <> stImpossible then
  244.     begin
  245.         Coord := 10 * Col + Row;
  246.         LastFreeCellsValue := FreeCells[FreeCellsCount-1];
  247.         FreeCells[CellsIndex[Coord]] := LastFreeCellsValue;
  248.         CellsIndex[LastFreeCellsValue] := CellsIndex[Coord];
  249.         Dec(FreeCellsCount);
  250.     end;
  251. end;
  252.  
  253. procedure EditFieldAroundShootPlace(var ShootField: TField; var FreeCells: TCellsArray; var CellsIndex: TCellsArray; Col, Row: ShortInt; var FreeCellsCount: ShortInt);
  254. var
  255.     I, J: ShortInt;
  256. begin
  257.     I := -1;
  258.     while I < 2 do
  259.     begin
  260.         J := -1;
  261.         while J < 2 do
  262.         begin
  263.             EditFreeCells(ShootField, FreeCells, CellsIndex, Col+I, Row+J, FreeCellsCount);
  264.             ShootField[Col+I, Row+J] := stImpossible;
  265.             Inc(J, 2);
  266.         end;
  267.         Inc(I, 2);
  268.     end;
  269. end;
  270.  
  271. function CompareCellsVertically(ShootField: TField; Ship: TShip; Col,Row,I: ShortInt): Boolean;
  272. begin
  273.     CompareCellsVertically := ShootField[Col, Row+I] = ConvertShipToFieldState(Ship);
  274. end;
  275.  
  276. function CompareCellsHorizontally(ShootField: TField; Ship: TShip; Col,Row,I: ShortInt): Boolean;
  277. begin
  278.     CompareCellsHorizontally := ShootField[Col+I, Row] = ConvertShipToFieldState(Ship);
  279. end;
  280.  
  281. procedure FindSideOfShip(ShootField: TField; Ship: TShip; Col, Row: ShortInt; var FirstSideCol: ShortInt; var FirstSideRow: ShortInt; IsHorizontal: Boolean; DirectionCoef: ShortInt);
  282. var
  283.     I: ShortInt;
  284.     HasPartOfShip: Boolean;
  285. begin
  286.     if IsHorizontal then
  287.     begin
  288.         I := 0;
  289.         Repeat
  290.             Inc(I);
  291.             HasPartOfShip := CompareCellsHorizontally(ShootField, Ship, Col, Row, DirectionCoef*I);
  292.         Until not HasPartOfShip;
  293.  
  294.         FirstSideRow := Row;
  295.         FirstSideCol := Col + DirectionCoef * I;
  296.     end
  297.     else
  298.     begin
  299.         I := 0;
  300.         Repeat
  301.             Inc(I);
  302.             HasPartOfShip := CompareCellsVertically(ShootField, Ship, Col, Row, DirectionCoef*I);
  303.         Until not HasPartOfShip;
  304.         FirstSideCol := Col;
  305.         FirstSideRow := Row + DirectionCoef * I;
  306.     end;
  307. end;
  308.  
  309. procedure EditFieldForDestroyedShip(var ShootField: TField; Ship: TShip; var FreeCells: TCellsArray; var CellsIndex: TCellsArray; Col, Row: ShortInt; var FreeCellsCount: ShortInt; IsHorizontal: Boolean);
  310. var
  311.     FirstSideCol, FirstSideRow, SecondSideCol, SecondSideRow, I: ShortInt;
  312. begin
  313.     if Ship = tShortShip then
  314.     begin
  315.         I := -1;
  316.         while I < 2 do
  317.         begin
  318.             EditFreeCells(ShootField, FreeCells, CellsIndex, Col+I, Row, FreeCellsCount);
  319.             EditFreeCells(ShootField, FreeCells, CellsIndex, Col, Row+I, FreeCellsCount);
  320.             ShootField[Col+I, Row] := stImpossible;
  321.             ShootField[Col, Row+I] := stImpossible;
  322.             Inc(I, 2);
  323.         end;
  324.     end
  325.     else
  326.     begin
  327.         FindSideOfShip(ShootField, Ship, Col, Row, FirstSideCol, FirstSideRow, IsHorizontal, -1);
  328.         FindSideOfShip(ShootField, Ship, Col, Row, SecondSideCol, SecondSideRow, IsHorizontal, 1);
  329.  
  330.         EditFreeCells(ShootField, FreeCells, CellsIndex, FirstSideCol, FirstSideRow, FreeCellsCount);
  331.         EditFreeCells(ShootField, FreeCells, CellsIndex, SecondSideCol, SecondSideRow, FreeCellsCount);
  332.         ShootField[FirstSideCol, FirstSideRow] := stImpossible;
  333.         ShootField[SecondSideCol, SecondSideRow] := stImpossible;
  334.     end;
  335. end;
  336.  
  337. function IsShipDestroyed(ShootField: TField; Ship: TShip; Col, Row: ShortInt; CompareFieldCellAndShipsDeck: TCompareFunction): Boolean;
  338. var
  339.     I, DamagedDecksCount: ShortInt;
  340.     IsDestroyed, HasPartOfShip: Boolean;
  341. begin
  342.     DamagedDecksCount := 0;
  343.     I := 0;
  344.     Repeat
  345.         HasPartOfShip := CompareFieldCellAndShipsDeck(ShootField, Ship, Col, Row, -I);
  346.         if HasPartOfShip then
  347.            Inc(DamagedDecksCount);
  348.         Inc(I);
  349.     Until (I = Ord(Ship)) or not HasPartOfShip;
  350.     IsDestroyed := DamagedDecksCount = Ord(Ship);
  351.  
  352.     if not IsDestroyed then
  353.     begin
  354.         I := 1;
  355.         Repeat
  356.             HasPartOfShip := CompareFieldCellAndShipsDeck(ShootField, Ship, Col, Row, I);
  357.             if HasPartOfShip then
  358.                 Inc(DamagedDecksCount);
  359.             Inc(I);
  360.         Until (I = Ord(Ship)) or not HasPartOfShip;
  361.         IsDestroyed := DamagedDecksCount = Ord(Ship);
  362.     end;
  363.  
  364.     IsShipDestroyed := IsDestroyed;
  365. end;
  366.  
  367. function IsFieldCellFree(ShootField: TField; Col, Row: ShortInt): Boolean;
  368. begin
  369.     IsFieldCellFree := ShootField [Col, Row] = stFree;
  370. end;
  371.  
  372. procedure AddPriorityCellsToList (ListHeader: PListElem; ShootField: TField; Col, Row: ShortInt);
  373. var
  374.     I: ShortInt;
  375. begin
  376.     I := -1;
  377.     while I < 2 do
  378.     begin
  379.         if IsFieldCellFree(ShootField, Col+I, Row) then
  380.             AddListElem(ListHeader, 10 * (Col+I) + Row);
  381.         if IsFieldCellFree(ShootField, Col, Row+I) then
  382.             AddListElem(ListHeader, 10 * Col + (Row+I));
  383.  
  384.         Inc(I, 2);
  385.     end;
  386. end;
  387.  
  388. procedure MakeShoot(var ShootField: TField; UserField: TField; var FreeCells: TCellsArray; var CellsIndex: TCellsArray; var FreeCellsCount: ShortInt);
  389. var
  390.     ListElem: PListElem;
  391.     Coord, I, Col, Row: ShortInt;
  392.     State: TFieldCellState;
  393.     Ship: TShip;
  394.     IsDestroyedShipHorizontal, IsDestroyedShipVertical: Boolean;
  395. begin
  396.     Writeln('В начале было: ', FreeCellsCount);
  397.     if (PriorityCellsListHeader^.Next = nil) then
  398.     begin
  399.         I := Random(FreeCellsCount);
  400.         Coord := FreeCells[I];
  401.         FreeCells[I] := FreeCells[FreeCellsCount-1];
  402.         CellsIndex[FreeCellsCount-1] := I;
  403.         Dec(FreeCellsCount);
  404.  
  405.         Col := Coord div 10;
  406.         Row := Coord mod 10;
  407.     end
  408.     else
  409.     begin
  410.         repeat
  411.             ListElem := ExtractElem(PriorityCellsListHeader);
  412.             Coord := ListElem^.Coord;
  413.             Col := Coord div 10;
  414.             Row := Coord mod 10;
  415.             EditFreeCells(ShootField, FreeCells, CellsIndex, Col, Row, FreeCellsCount);
  416.         until (PriorityCellsListHeader^.Next = nil) or (ShootField[Col, Row] = stFree);
  417.  
  418.     end;
  419.  
  420.     Writeln(Col, ' ', Row, ' ', FreeCellsCount);
  421.  
  422.     State := UserField[Col, Row];
  423.     case State of
  424.         stFree:
  425.         begin
  426.             ShootField[Col, Row] := stImpossible;
  427.         end;
  428.         stImpossible:
  429.         begin
  430.             ShootField[Col, Row] := stImpossible;
  431.         end;
  432.         stShortShip:
  433.         begin
  434.             Ship := tShortShip;
  435.             ShootField[Col, Row] := State;
  436.             EditFieldAroundShootPlace(ShootField, FreeCells, CellsIndex, Col, Row, FreeCellsCount);
  437.             EditFieldForDestroyedShip(ShootField, Ship, FreeCells, CellsIndex, Col, Row, FreeCellsCount, True);
  438.         end;
  439.         else
  440.         begin
  441.             Ship := ConvertFieldStateToShip(State);
  442.             ShootField[Col, Row] := State;
  443.             EditFieldAroundShootPlace(ShootField, FreeCells, CellsIndex, Col, Row, FreeCellsCount);
  444.             AddPriorityCellsToList(PriorityCellsListHeader, ShootField, Col, Row);
  445.  
  446.             IsDestroyedShipHorizontal := IsShipDestroyed(ShootField, Ship, Col, Row, CompareCellsHorizontally);
  447.             IsDestroyedShipVertical := IsShipDestroyed(ShootField, Ship, Col, Row, CompareCellsVertically);
  448.             if IsDestroyedShipHorizontal or IsDestroyedShipVertical then
  449.             begin
  450.                 EditFieldForDestroyedShip(ShootField, Ship, FreeCells, CellsIndex, Col, Row, FreeCellsCount, IsDestroyedShipHorizontal);
  451.                 DisposeList(PriorityCellsListHeader);
  452.             end;
  453.         end;
  454.     end;
  455. end;
  456.  
  457. begin
  458.     Randomize;
  459.     CreateNewField(TempField);
  460.     OutputField(TempField);
  461.  
  462.     InitializeShips(ShipsArray);
  463.     OutputShips(ShipsArray);
  464.  
  465.     FillGameField(TempField, ShipsArray);
  466.     Writeln;
  467.     Writeln;
  468.  
  469.     OutputField(TempField);
  470.  
  471.  
  472.     CellsArrayInitialize(FreeCells);
  473.     CellsArrayInitialize(CellsIndex);
  474.     CreateNewField(ShootField);
  475.  
  476.  
  477.     InitializeList(PriorityCellsListHeader);
  478.  
  479.     //for I := 1 to 15 do
  480.  
  481.     while FreeCellsCount > 0 do
  482.     begin
  483.         MakeShoot(ShootField, TempField, FreeCells, CellsIndex, FreeCellsCount);
  484.         Writeln('Осталось:', FreeCellsCount);
  485.         OutputField(ShootField);
  486.     end;
  487.  
  488.  
  489.     Readln;
  490. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement