API tools faq
paste
Advertisement
MadCortez

Untitled

MadCortez
May 21st, 2021
822
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 15.01 KB | None | 0 0
raw download clone embed print report
  1. unit UnitBot;
  2.  
  3. interface
  4.  
  5. Type
  6.    TMatrix = array of array of Integer;
  7.  
  8. procedure StopBot;
  9. procedure ClearBot;
  10. procedure GameOverBot;
  11. procedure EatAppleBot;
  12. procedure CheckForLoseBot;
  13. procedure GamePlayBot;
  14. procedure RetWay(b: TMatrix);
  15. function FillField(): TMatrix;
  16. procedure CalcDir(x, y, Step: Integer; b: TMatrix; LocDir, LastLocDir: String);
  17. procedure CheckNext(LocDir: String);
  18. procedure CheckWay(LocDir: String);
  19. procedure CheckNextWay(LocDir: String);
  20. function RetDir(): String;
  21. function Check180(NextDir: String): String;
  22. procedure CheckNextWayField(x, y, Num: Integer);
  23. function CheckDown: String;
  24. function CheckUp: String;
  25. function CheckLeft: String;
  26. function CheckRight: String;
  27. procedure CheckDownAndUp;
  28. procedure CheckLeftAndRight;
  29. procedure MoveSnakeBot;
  30. procedure SpawnHeadBot;
  31.  
  32. implementation
  33.  
  34. Uses
  35.    SysUtils, UnitGame, UnitMain, UnitPlayer;
  36.  
  37. procedure StopBot;
  38. var
  39.    i: Integer;
  40. begin
  41.    AHeadBot.SetX(999);
  42.    for i := 1 to SnakeLenBot do
  43.       ATailsBot[i].SetX(999);
  44.    LoseFlag := True;
  45.    Form1.TimerBot.Enabled := False;
  46. end;
  47.  
  48. procedure ClearBot;
  49. var
  50.    i: Integer;
  51. begin
  52.    AHeadBot.Free;
  53.    for i := 1 to SnakeLen do
  54.       ATailsBot[i].Free;
  55. end;
  56.  
  57. procedure GameOverBot;
  58. var
  59.    i: Integer;
  60.    GameOverTxt: String;
  61. begin
  62.    Form1.TimerBot.Enabled := False;
  63.    StopBot;
  64. end;
  65.  
  66. procedure EatAppleBot;
  67. var
  68.    i: Integer;
  69. begin
  70.    Inc(ScoreBot);
  71.    Form1.LabelPointBot.Caption := IntToStr(ScoreBot);
  72.    for i := 1 to 30 do
  73.       s[i] := ' ';
  74.    S := 'Bot eat apple in ' + IntToStr(AHeadBot.GetX) + ' ' + IntToStr(AHeadBot.GetY) + #10#13;
  75.    Write(MyFile, S);
  76.    SpawnApple;
  77.    Inc(SnakeLenBot);
  78.    ATailsBot[SnakeLenBot] := TTail.Create(ATailsBot[SnakeLenBot - 1].GetX, ATailsBot[SnakeLenBot - 1].GetY, TailBotPic);
  79.    if Form1.TimerBot.Interval > 55 then
  80.       Form1.TimerBot.Interval := Form1.TimerBot.Interval - 5;
  81. end;
  82.  
  83. procedure CheckForLoseBot;
  84. var
  85.    i, j: Integer;
  86. begin
  87.    for i := 1 to SnakeLenBot do
  88.       if (AHeadBot.GetX = ATailsBot[i].GetX) and (AHeadBot.GetY = ATailsBot[i].GetY) then
  89.          GameOverBot;
  90.    for i := 1 to BoxNum do
  91.       if (AHeadBot.GetX = ABoxs[i].GetX) and (AHeadBot.GetY = ABoxs[i].GetY) then
  92.          GameOverBot;
  93.    for i := 1 to SnakeLen do
  94.       for j := 1 to SnakeLen do
  95.          if (AHeadBot.GetX = ATails[i].GetX) and (AHeadBot.GetY = ATails[i].GetY) then
  96.             GameOverBot;
  97. end;
  98.  
  99. procedure GamePlayBot;
  100. var
  101.    i, j: Integer;
  102.    Valid: Boolean;
  103. begin
  104.    if (AHeadBot.GetX = AApple.GetX) and (AHeadBot.GetY = AApple.GetY) then
  105.       EatAppleBot;
  106.  
  107.    if AHeadBot.GetX < 0 then
  108.       AHeadBot.SetX(19 * 24);
  109.    if AHeadBot.GetY < 0 then
  110.       AHeadBot.SetY(19 * 24);
  111.    if AHeadBot.GetX >= 20 * 24 then
  112.       AHeadBot.SetX(0);
  113.    if AHeadBot.GetY >= 20 * 24 then
  114.       AHeadBot.SetY(0);
  115.  
  116.    CheckForLoseBot;
  117. end;
  118.  
  119. procedure RetWay(b: TMatrix);
  120. var
  121.    x, y, Step: Integer;
  122. begin
  123.    x := AApple.GetX div 24;
  124.    y := AApple.GetY div 24;
  125.    Step := b[x, y];
  126.    SetLength(WayX, Step);
  127.    SetLength(WayY, Step);
  128.    Dec(Step);
  129.    WayX[Step] := x;
  130.    WayY[Step] := y;
  131.    while Step > 0 do
  132.    begin
  133.       Inc(x);
  134.       if (x >= 20) then
  135.          x := 0;
  136.       if b[x, y] = Step then
  137.       begin
  138.          Dec(Step);
  139.          WayX[Step] := x;
  140.          WayY[Step] := y;
  141.          continue;
  142.       end;
  143.       Dec(x);
  144.       if (x < 0) then
  145.          x := 19;
  146.       Dec(x);
  147.       if (x < 0) then
  148.          x := 19;
  149.       if b[x, y] = Step then
  150.       begin
  151.          Dec(Step);
  152.          WayX[Step] := x;
  153.          WayY[Step] := y;
  154.          continue;
  155.       end;
  156.       Inc(x);
  157.       if (x >= 20) then
  158.          x := 0;
  159.       Dec(y);
  160.       if (y < 0) then
  161.          y := 19;
  162.       if b[x, y] = Step then
  163.       begin
  164.          Dec(Step);
  165.          WayX[Step] := x;
  166.          WayY[Step] := y;
  167.          continue;
  168.       end;
  169.       Inc(y);
  170.       if (y >= 20) then
  171.          y := 0;
  172.       Inc(y);
  173.       if (y >= 20) then
  174.          y := 0;
  175.       if b[x, y] = Step then
  176.       begin
  177.          Dec(Step);
  178.          WayX[Step] := x;
  179.          WayY[Step] := y;
  180.          continue;
  181.       end;
  182.       Dec(y);
  183.       if (y < 0) then
  184.          y := 19;
  185.    end;
  186. end;
  187.  
  188. function FillField(): TMatrix;
  189. var
  190.    i: Integer;
  191.    a: TMatrix;
  192. begin
  193.    SetLength(a, 22, 22);
  194.    for i := 1 to BoxNum do
  195.       a[ABoxs[i].GetX div 24, ABoxs[i].GetY div 24] := -1;
  196.    for i := 1 to SnakeLen do
  197.       a[ATails[i].GetX div 24, ATails[i].GetY div 24] := -1;
  198.    for i := 1 to SnakeLenBot do
  199.       a[ATailsBot[i].GetX div 24, ATailsBot[i].GetY div 24] := -1;
  200.    a[AHead.GetX div 24, AHead.GetY div 24] := -1;
  201.    Result := a;
  202. end;
  203.  
  204. procedure CalcDir(x, y, Step: Integer; b: TMatrix; LocDir, LastLocDir: String);
  205. var
  206.    AppleX, AppleY, HeadX, HeadY, i: Integer;
  207.    a: TMatrix;
  208. begin
  209.    if Flag then
  210.       exit;
  211.  
  212.    if (x < 0) or (x > 20) or (y < 0) or (y > 20) then
  213.       exit;
  214.  
  215.  
  216.    if (LocDir = 'Right') and (LastLocDir = 'Left') then
  217.       exit;
  218.    if (LocDir = 'Left') and (LastLocDir = 'Right') then
  219.       exit;
  220.    if (LocDir = 'Down') and (LastLocDir = 'Up') then
  221.       exit;
  222.    if (LocDir = 'Up') and (LastLocDir = 'Down') then
  223.       exit;
  224.  
  225.    SetLength(a, 22, 22);
  226.    SetLength(b, 22, 22);
  227.    a := FillField;
  228.  
  229.    if b[x, y] <> 0 then exit;
  230.  
  231.    b[x, y] := Step;
  232.  
  233.    AppleX := AApple.GetX div 24;
  234.    AppleY := AApple.GetY div 24;
  235.    if (x = AppleX) and (y = AppleY) then
  236.    begin
  237.       if Step < min then
  238.       begin
  239.          RetWay(b);
  240.          Min := Step;
  241.          Flag := True;
  242.       end;
  243.       exit;
  244.    end;
  245.  
  246.    if (AppleX > x) and (LocDir <> 'Left') then
  247.       CalcDir(x + 1, y, Step + 1, b, 'Right', LocDir);
  248.    if (AppleX < x) and (LocDir <> 'Right') then
  249.       CalcDir(x - 1, y, Step + 1, b, 'Left', LocDir);
  250.    if (AppleY > y) and (LocDir <> 'Up') then
  251.       CalcDir(x, y + 1, Step + 1, b, 'Down', LocDir);
  252.    if (AppleY < y) and (LocDir <> 'Down') then
  253.       CalcDir(x, y - 1, Step + 1, b, 'Up', LocDir);
  254.  
  255. end;
  256.  
  257. procedure CheckNext(LocDir: String);
  258. var
  259.    i, AHeadX, AHeadY: Integer;
  260. begin
  261.    if CheckFlag then
  262.       exit;
  263.    AHeadX := AHeadBot.GetX;
  264.    AHeadY := AHeadBot.GetY;
  265.    if LocDir = 'Left' then
  266.       Dec(AHeadX, 24);
  267.    if LocDir = 'Right' then
  268.       Inc(AHeadX, 24);
  269.    if LocDir = 'Up' then
  270.       Dec(AHeadY, 24);
  271.    if LocDir = 'Down' then
  272.       Inc(AHeadY, 24);
  273.    for i := 1 to BoxNum do
  274.       if (AHeadX = ABoxs[i].GetX) and (AHeadY = ABoxs[i].GetY) then
  275.          exit;
  276.    for i := 1 to SnakeLenBot do
  277.       if (AHeadX = ATailsBot[i].GetX) and (AHeadY = ATailsBot[i].GetY) then
  278.          exit;
  279.    for i := 1 to SnakeLen do
  280.       if (AHeadX = ATails[i].GetX) and (AHeadY = ATails[i].GetY) then
  281.          exit;
  282.    CheckFlag := True;
  283.    NextDirCol := LocDir;
  284. end;
  285.  
  286. procedure CheckWay(LocDir: String);
  287. begin
  288.    CheckFlag := False;
  289.    if LocDir = 'Up' then
  290.    begin
  291.       CheckNext('Up');
  292.       CheckNext('Left');
  293.       CheckNext('Right');
  294.    end;
  295.    if LocDir = 'Down' then
  296.    begin
  297.       CheckNext('Down');
  298.       CheckNext('Left');
  299.       CheckNext('Right');
  300.    end;
  301.    if LocDir = 'Left' then
  302.    begin
  303.       CheckNext('Left');
  304.       CheckNext('Up');
  305.       CheckNext('Down');
  306.    end;
  307.    if LocDir = 'Right' then
  308.    begin
  309.       CheckNext('Right');
  310.       CheckNext('Up');
  311.       CheckNext('Down');
  312.    end;
  313. end;
  314.  
  315. procedure CheckNextWay(LocDir: String);
  316. var
  317.    i, AHeadX, AHeadY: Integer;
  318. begin
  319.    AHeadX := AHeadBot.GetX;
  320.    AHeadY := AHeadBot.GetY;
  321.    if LocDir = 'Left' then
  322.       Dec(AHeadX, 24);
  323.    if LocDir = 'Right' then
  324.       Inc(AHeadX, 24);
  325.    if LocDir = 'Up' then
  326.       Dec(AHeadY, 24);
  327.    if LocDir = 'Down' then
  328.       Inc(AHeadY, 24);
  329.    for i := 1 to BoxNum do
  330.       if (AHeadX = ABoxs[i].GetX) and (AHeadY = ABoxs[i].GetY) then
  331.          exit;
  332.    for i := 1 to SnakeLenBot do
  333.       if (AHeadX = ATailsBot[i].GetX) and (AHeadY = ATailsBot[i].GetY) then
  334.          exit;
  335.    for i := 1 to SnakeLen do
  336.       if (AHeadX = ATails[i].GetX) and (AHeadY = ATails[i].GetY) then
  337.          exit;
  338.    NextFlag := True;
  339. end;
  340.  
  341. function RetDir(): String;
  342. var
  343.    NextDir: String;
  344. begin
  345.    if (WayX[0] > AHeadBot.GetX div 24) and (DirBot <> 'Left') then
  346.       NextDir := 'Right';
  347.    if (WayX[0] < AHeadBot.GetX div 24) and (DirBot <> 'Right') then
  348.       NextDir := 'Left';
  349.    if (WayY[0] > AHeadBot.GetY div 24) and (DirBot <> 'Up') then
  350.       NextDir := 'Down';
  351.    if (WayY[0] < AHeadBot.GetY div 24) and (DirBot <> 'Down') then
  352.       NextDir := 'Up';
  353.    Result := NextDir;
  354. end;
  355.  
  356. function Check180(NextDir: String): String;
  357. begin
  358.    if (NextDir = 'Up') and (DirBot = 'Down') then
  359.       NextDir := 'Down';
  360.    if (NextDir = 'Down') and (DirBot = 'Up') then
  361.       NextDir := 'Up';
  362.    if (NextDir = 'Right') and (DirBot = 'Left') then
  363.       NextDir := 'Left';
  364.    if (NextDir = 'Left') and (DirBot = 'Right') then
  365.       NextDir := 'Right';
  366.    Result := NextDir;
  367. end;
  368.  
  369. procedure CheckNextWayField(x, y, Num: Integer);
  370. begin
  371.    if NextFlag then
  372.       exit;
  373.    if X < 0 then
  374.       X := 19;
  375.    if Y < 0 then
  376.       Y := 19;
  377.    if X >= 20 then
  378.       X := 0;
  379.    if Y >= 20 then
  380.       Y := 0;
  381.    if Field[x, y] = -1 then
  382.       exit;
  383.    Field[x, y] := -1;
  384.    Inc(Num);
  385.    if Num > SnakeLenBot then
  386.    begin
  387.       NextFlag := True;
  388.       exit;
  389.    end;
  390.    CheckNextWayField(x - 1, y, Num);
  391.    CheckNextWayField(x + 1, y, Num);
  392.    CheckNextWayField(x, y - 1, Num);
  393.    CheckNextWayField(x, y + 1, Num);
  394. end;
  395.  
  396. function CheckDown: String;
  397. var
  398.    NextDir: String;
  399. begin
  400.    Field := FillField;
  401.    CheckNextWayField(AHeadBot.GetX div 24, (AHeadBot.GetY + 24) div 24, 0);
  402.    if NextFlag then
  403.       NextDir := 'Down'
  404.    else
  405.    begin
  406.       Field := FillField;
  407.       CheckNextWayField((AHeadBot.GetX + 24) div 24, AHeadBot.GetY div 24, 0);
  408.       if NextFlag then
  409.          NextDir := 'Right';
  410.       if not(NextFlag) then
  411.       begin
  412.          Field := FillField;
  413.          CheckNextWayField((AHeadBot.GetX - 24) div 24, AHeadBot.GetY div 24, 0);
  414.          if NextFlag then
  415.             NextDir := 'Left';
  416.       end;
  417.    end;
  418.    Result := NextDir;
  419. end;
  420.  
  421. function CheckUp: String;
  422. var
  423.    NextDir: String;
  424. begin
  425.    Field := FillField;
  426.    CheckNextWayField(AHeadBot.GetX div 24, (AHeadBot.GetY - 24) div 24, 0);
  427.    if NextFlag then
  428.       NextDir := 'Up'
  429.    else
  430.    begin
  431.       Field := FillField;
  432.       CheckNextWayField((AHeadBot.GetX + 24) div 24, AHeadBot.GetY div 24, 0);
  433.       if NextFlag then
  434.          NextDir := 'Right';
  435.       if not(NextFlag) then
  436.       begin
  437.          Field := FillField;
  438.          CheckNextWayField((AHeadBot.GetX - 24) div 24, AHeadBot.GetY div 24, 0);
  439.          if NextFlag then
  440.             NextDir := 'Left';
  441.       end;
  442.    end;
  443.    Result := NextDir;
  444. end;
  445.  
  446. function CheckLeft: String;
  447. var
  448.    NextDir: String;
  449. begin
  450.    Field := FillField;
  451.    CheckNextWayField((AHeadBot.GetX - 24) div 24, AHeadBot.GetY div 24, 0);
  452.    if NextFlag then
  453.       NextDir := 'Left'
  454.    else
  455.    begin
  456.       Field := FillField;
  457.       CheckNextWayField(AHeadBot.GetX div 24, (AHeadBot.GetY - 24) div 24, 0);
  458.       if NextFlag then
  459.          NextDir := 'Up';
  460.       if not(NextFlag) then
  461.       begin
  462.          Field := FillField;
  463.          CheckNextWayField(AHeadBot.GetX div 24, (AHeadBot.GetY + 24) div 24, 0);
  464.          if NextFlag then
  465.             NextDir := 'Down';
  466.       end;
  467.    end;
  468.    Result := NextDir;
  469. end;
  470.  
  471. function CheckRight: String;
  472. var
  473.    NextDir: String;
  474. begin
  475.    Field := FillField;
  476.    CheckNextWayField((AHeadBot.GetX + 24) div 24, AHeadBot.GetY div 24, 0);
  477.    if NextFlag then
  478.       NextDir := 'Right'
  479.    else
  480.    begin
  481.       Field := FillField;
  482.       CheckNextWayField(AHeadBot.GetX div 24, (AHeadBot.GetY - 24) div 24, 0);
  483.       if NextFlag then
  484.          NextDir := 'Up';
  485.       if not(NextFlag) then
  486.       begin
  487.          Field := FillField;
  488.          CheckNextWayField(AHeadBot.GetX div 24, (AHeadBot.GetY + 24) div 24, 0);
  489.          if NextFlag then
  490.             NextDir := 'Down';
  491.       end;
  492.    end;
  493.    Result := NextDir;
  494. end;
  495.  
  496. procedure CheckDownAndUp;
  497. begin
  498.    Field := FillField;
  499.    CheckNextWayField((AHeadBot.GetX - 24) div 24, AHeadBot.GetY div 24, 0);
  500.    if NextFlag then
  501.       DirBot := 'Left'
  502.    else
  503.    begin
  504.       Field := FillField;
  505.       CheckNextWayField((AHeadBot.GetX + 24) div 24, AHeadBot.GetY div 24, 0);
  506.       if NextFlag then
  507.          DirBot := 'Right';
  508.    end;
  509. end;
  510.  
  511. procedure CheckLeftAndRight;
  512. begin
  513.    Field := FillField;
  514.    CheckNextWayField(AHeadBot.GetX div 24, (AHeadBot.GetY + 24) div 24, 0);
  515.    if NextFlag then
  516.       DirBot := 'Down'
  517.    else
  518.    begin
  519.       Field := FillField;
  520.       CheckNextWayField(AHeadBot.GetX div 24, (AHeadBot.GetY - 24) div 24, 0);
  521.       if NextFlag then
  522.          DirBot := 'Up';
  523.    end;
  524. end;
  525.  
  526. procedure MoveSnakeBot;
  527. var
  528.    i, HeadBotX, HeadBotY: Integer;
  529.    a: TMatrix;
  530.    NextDir: String;
  531.    Label l1;
  532. begin
  533.    for i := SnakeLenBot downto 2 do
  534.    begin
  535.       ATailsBot[i].SetX(ATailsBot[i - 1].GetX);
  536.       ATailsBot[i].SetY(ATailsBot[i - 1].GetY);
  537.    end;
  538.    ATailsBot[i].SetX(AHeadBot.GetX);
  539.    ATailsBot[i].SetY(AHeadBot.GetY);
  540.  
  541.    Min := 999999;
  542.    NextDir := DirBot;
  543.    CalcDir(AHeadBot.GetX div 24, AHeadBot.GetY div 24, 0, 0, DirBot, '');
  544.  
  545.    NextDir := RetDir;
  546.    NextDir := Check180(NextDir);
  547.  
  548.    if NextDir = DirBot then
  549.    begin
  550.       NextDirCol := NextDir;
  551.       CheckWay(DirBot);
  552.       NextDir := NextDirCol;
  553.    end;
  554.  
  555.    NextFlag := False;
  556.    if (NextDir = 'Down') then
  557.       NextDir := CheckDown
  558.    else
  559.       if (NextDir = 'Up') then
  560.          NextDir := CheckUp
  561.       else
  562.          if (NextDir = 'Left') then
  563.             NextDir := CheckLeft
  564.          else
  565.             if (NextDir = 'Right') then
  566.                NextDir := CheckRight;
  567.    if NextFlag then
  568.       DirBot := NextDir
  569.    else
  570.    begin
  571.       SetLength(a, 22, 22);
  572.       if (DirBot = 'Down') or (DirBot = 'Up') then
  573.          CheckDownAndUp;
  574.       if NextFlag then
  575.          goto l1;
  576.       if (DirBot = 'Left') or (DirBot = 'Right') then
  577.          CheckLeftAndRight;
  578.    end;
  579. l1:
  580.    for i := 0 to High(WayX) do
  581.    begin
  582.       WayX[i] := 0;
  583.       WayY[i] := 0;
  584.    end;
  585.    Flag := False;
  586.  
  587.    if DirBot = 'Down' then
  588.       AHeadBot.SetY(AHeadBot.GetY + 24);
  589.    if DirBot = 'Up' then
  590.       AHeadBot.SetY(AHeadBot.GetY - 24);
  591.    if DirBot = 'Left' then
  592.       AHeadBot.SetX(AHeadBot.GetX - 24);
  593.    if DirBot = 'Right' then
  594.       AHeadBot.SetX(AHeadBot.GetX + 24);
  595.    for i := 1 to 30 do
  596.       s[i] := ' ';
  597.    S := 'Move Bot to ' + IntToStr(AHeadBot.GetX) + ' ' + IntToStr(AHeadBot.GetY) + #10#13;
  598.    Write(MyFile, S);
  599. end;
  600.  
  601. procedure SpawnHeadBot;
  602. var
  603.    Valid: Boolean;
  604.    i: Integer;
  605. begin
  606.    AHeadBot := THead.Create(random(20) * 24, random(20) * 24, HeadBotPic);
  607.    repeat
  608.       Valid := True;
  609.       AHeadBot.SetX(random(20) * 24);
  610.       AHeadBot.SetY(random(20) * 24);
  611.       for i := 1 to BoxNum do
  612.          if (AHeadBot.GetX = ABoxs[i].GetX) and (AHeadBot.GetY = ABoxs[i].GetY) then
  613.             Valid := False;
  614.       if (AHeadBot.GetX = AHead.GetX) and (AHeadBot.GetY = AHead.GetY) then
  615.             Valid := False;
  616.    until Valid;
  617. end;
  618.  
  619. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!