Advertisement
THOMAS_SHELBY_18

FieldGenerator

Mar 31st, 2024 (edited)
95
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 5.83 KB | Source Code | 0 0
  1. program GameDeskGenerator;
  2.  
  3. {$APPTYPE CONSOLE}
  4.  
  5. {$R *.res}
  6.  
  7. uses
  8.   System.SysUtils;
  9.  
  10. type
  11.     TFieldCellState = (stImpossible = -1, stFree, stShortShip, stSmallShip, stMediumShip, stLongShip);
  12.     TField = array [0..7, 0..7] of TFieldCellState;
  13.     TFieldForGeneration = 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: TFieldForGeneration; I, J: ShortInt): TFieldCellState;
  19.     TPlaceShipProcedure = procedure (var ShipsField: TFieldForGeneration; Ship: TShip; X, Y: ShortInt);
  20. var
  21.     Field: TField;
  22.     TempField: TFieldForGeneration;
  23.     ShipsArray: TShipsArray;
  24.     Ship: TShip;
  25.     CommonShipsCount: Byte;
  26.  
  27. procedure CreateNewField(var Field: TFieldForGeneration);
  28. var
  29.     I, J: ShortInt;
  30. begin
  31.     for J := Low(Field) to High(Field) do
  32.         Field[-1, J] := stImpossible;
  33.  
  34.     for I := Low(Field)+1 to High(Field)-1 do
  35.     begin
  36.         for J := Low(Field)+1 to High(Field)-1 do
  37.             Field[I, J] := stFree;
  38.         Field[I, Low(Field)] := stImpossible;
  39.         Field[I, High(Field)] := stImpossible;
  40.     end;
  41.  
  42.     for J := Low(Field) to High(Field) do
  43.         Field[High(Field), J] := stImpossible;
  44. end;
  45.  
  46. procedure OutputField(Field: TFieldForGeneration);
  47. var
  48.     I, J: ShortInt;
  49. begin
  50.     for I := Low(Field) to High(Field) do
  51.     begin
  52.         for J := Low(Field) to High(Field) do
  53.             Write(StrToFloat(IntToStr(Ord(Field[J, I]))):4:0);
  54.         Writeln;
  55.     end;
  56. end;
  57.  
  58. procedure InitializeShips(var ShipsArray: TShipsArray);
  59. var
  60.     CurrShip: TShip;
  61.     I, J: Byte;
  62. begin
  63.     J := Low(ShipsArray);
  64.     for CurrShip := Low(TShip) to High(TShip) do
  65.         for I := 5 - Ord(CurrShip) DownTo 1 do
  66.         begin
  67.             ShipsArray[J] := CurrShip;
  68.             Inc(J);
  69.         end;
  70.  
  71.     CommonShipsCount := 10;
  72. end;
  73.  
  74. procedure OutputShips(ShipsArray: TShipsArray);
  75. var
  76.     I: Byte;
  77. begin
  78.     for I := Low(ShipsArray) to CommonShipsCount-1 do
  79.         Write(Ord(ShipsArray[I]), ' ');
  80. end;
  81.  
  82. function PullShip(var ShipsArray: TShipsArray): TShip;
  83. var
  84.     Ship: TShip;
  85. begin
  86.     Ship := ShipsArray[CommonShipsCount-1];
  87.     Dec(CommonShipsCount);
  88.  
  89.     PullShip := Ship;
  90. end;
  91.  
  92. function GetRandomDirection(): Boolean;
  93. var
  94.     IsHorizontal: Boolean;
  95. begin
  96.     if Random(2) = 0 then
  97.         IsHorizontal := True
  98.     else
  99.         IsHorizontal := False;
  100.  
  101.     GetRandomDirection := isHorizontal;
  102. end;
  103.  
  104. function ConvertShipToFieldState(Ship: TShip): TFieldCellState;
  105. const
  106.     TempArr: array [TShip] of TFieldCellState = (stShortShip, stSmallShip, stMediumShip, stLongShip);
  107. begin
  108.     ConvertShipToFieldState := TempArr[Ship];
  109. end;
  110.  
  111. function ReturnRowElemState(ShipField: TFieldForGeneration; I, J: ShortInt): TFieldCellState;
  112. begin
  113.     ReturnRowElemState := ShipField[J, I];
  114. end;
  115.  
  116. function ReturnColElemState(ShipField: TFieldForGeneration; I, J: ShortInt): TFieldCellState;
  117. begin
  118.     ReturnColElemState := ShipField[I, J];
  119. end;
  120.  
  121. procedure PlaceShipHorizontal (var ShipsField: TFieldForGeneration; Ship: TShip; Y, X: ShortInt);
  122. var
  123.     I: ShortInt;
  124. begin
  125.     for I := -1 to Ord(Ship) do
  126.     begin
  127.         ShipsField[X+I, Y-1] := stImpossible;
  128.         ShipsField[X+I, Y] := ConvertShipToFieldState(Ship);
  129.         ShipsField[X+I, Y+1] := stImpossible;
  130.     end;
  131.     ShipsField[X-1, Y] := stImpossible;
  132.     ShipsField[X+Ord(Ship), Y] := stImpossible;
  133. end;
  134.  
  135. procedure PlaceShipVertical (var ShipsField: TFieldForGeneration; Ship: TShip; X, Y: ShortInt);
  136. var
  137.     I: ShortInt;
  138. begin
  139.     for I := -1 to Ord(Ship) do
  140.     begin
  141.         ShipsField[X-1, Y+I] := stImpossible;
  142.         ShipsField[X, Y+I] := ConvertShipToFieldState(Ship);
  143.         ShipsField[X+1, Y+I] := stImpossible;
  144.     end;
  145.     ShipsField[X, Y-1] := stImpossible;
  146.     ShipsField[X, Y+Ord(Ship)] := stImpossible;
  147. end;
  148.  
  149. function IsPlacedShipInField(var ShipsField: TFieldForGeneration; Ship: TShip; Coord: ShortInt; IsHorizontal: Boolean): Boolean;
  150. var
  151.     I, SecondCoord, Counter: ShortInt;
  152.     HasFreePlace: Boolean;
  153.     ReturnCellState: TReturnCellStateFunction;
  154.     PlaceShip: TPlaceShipProcedure;
  155. begin
  156.     Counter := 0;
  157.     HasFreePlace := False;
  158.     I := Low(ShipsField)+1;
  159.  
  160.     if IsHorizontal then
  161.     begin
  162.         ReturnCellState := ReturnColElemState;
  163.         PlaceShip := PlaceShipHorizontal;
  164.     end
  165.     else
  166.     begin
  167.         ReturnCellState := ReturnRowElemState;
  168.         PlaceShip := PlaceShipVertical;
  169.     end;
  170.  
  171.     while ((I < High(ShipsField)) and not HasFreePlace) do
  172.     begin
  173.         if Ord(ReturnCellState(ShipsField, I, Coord)) = 0 then
  174.             Inc(Counter)
  175.         else
  176.             Counter := 0;
  177.  
  178.         if Counter = Ord(Ship) then
  179.         begin
  180.             HasFreePlace := True;
  181.             SecondCoord := I - Ord(Ship)+1;
  182.             PlaceShip(ShipsField, Ship, Coord, SecondCoord );
  183.         end;
  184.         Inc(I);
  185.     end;
  186.  
  187.     IsPlacedShipInField := HasFreePlace;
  188. end;
  189.  
  190. procedure PutShipToField(Ship: TShip; var ShipsField: TFieldForGeneration);
  191. var
  192.     Coord, I: ShortInt;
  193.     IsHorizontal: Boolean;
  194. begin
  195.     repeat
  196.         IsHorizontal := GetRandomDirection;
  197.         Coord := Random(11);
  198.     until IsPlacedShipInField(ShipsField, Ship, Coord, IsHorizontal);
  199. end;
  200.  
  201. procedure FillGameField(var Field: TFieldForGeneration; var ShipsArray: TShipsArray);
  202. var
  203.     Ship: TShip;
  204.     I: ShortInt;
  205. begin
  206.     for I := 1 to 10 do
  207.     begin
  208.         Ship := PullShip(ShipsArray);
  209.         PutShipToField(Ship, TempField);
  210.     end;
  211. end;
  212.  
  213. begin
  214.     Randomize;
  215.     CreateNewField(TempField);
  216.     OutputField(TempField);
  217.  
  218.     InitializeShips(ShipsArray);
  219.     OutputShips(ShipsArray);
  220.  
  221.     FillGameField(TempField, ShipsArray);
  222.     Writeln;
  223.     Writeln;
  224.  
  225.     OutputField(TempField);
  226.  
  227.  
  228.     Readln;
  229. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement