Changeset 32 for trunk


Ignore:
Timestamp:
Oct 12, 2019, 11:01:10 PM (5 years ago)
Author:
chronos
Message:
  • Modified: In computer form allow to stop AI play.
  • Modified: Optimized moves history computation using MoveAll without animation.
Location:
trunk
Files:
7 edited

Legend:

Unmodified
Added
Removed
  • trunk/Forms/UFormComputer.lfm

    r29 r32  
    1313  OnShow = FormShow
    1414  LCLVersion = '2.0.2.0'
    15   object ButtonSolve: TButton
    16     Left = 159
     15  object ButtonStart: TButton
     16    Left = 40
    1717    Height = 38
    18     Top = 281
     18    Top = 24
    1919    Width = 113
    20     Caption = 'Solve'
    21     OnClick = ButtonSolveClick
     20    Caption = 'Start'
     21    OnClick = ButtonStartClick
    2222    TabOrder = 0
    2323  end
     24  object ButtonStop: TButton
     25    Left = 208
     26    Height = 38
     27    Top = 24
     28    Width = 113
     29    Caption = 'Stop'
     30    Enabled = False
     31    OnClick = ButtonStopClick
     32    TabOrder = 1
     33  end
    2434end
  • trunk/Forms/UFormComputer.lrj

    r29 r32  
    11{"version":1,"strings":[
    22{"hash":1113,"name":"tformcomputer.caption","sourcebytes":[65,73],"value":"AI"},
    3 {"hash":5923781,"name":"tformcomputer.buttonsolve.caption","sourcebytes":[83,111,108,118,101],"value":"Solve"}
     3{"hash":5941396,"name":"tformcomputer.buttonstart.caption","sourcebytes":[83,116,97,114,116],"value":"Start"},
     4{"hash":371552,"name":"tformcomputer.buttonstop.caption","sourcebytes":[83,116,111,112],"value":"Stop"}
    45]}
  • trunk/Forms/UFormComputer.pas

    r31 r32  
    2828
    2929  TFormComputer = class(TForm)
    30     ButtonSolve: TButton;
    31     procedure ButtonSolveClick(Sender: TObject);
     30    ButtonStart: TButton;
     31    ButtonStop: TButton;
     32    procedure ButtonStartClick(Sender: TObject);
     33    procedure ButtonStopClick(Sender: TObject);
    3234    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    3335    procedure FormCreate(Sender: TObject);
     
    3537    procedure FormShow(Sender: TObject);
    3638  private
     39    Stop: Boolean;
    3740    GameTries1: TGameTries;
    3841    GameTries2: TGameTries;
     
    147150end;
    148151
    149 procedure TFormComputer.ButtonSolveClick(Sender: TObject);
     152procedure TFormComputer.ButtonStartClick(Sender: TObject);
    150153var
    151154  NewTry: TGameTry;
     
    155158  GameTries: TGameTries;
    156159begin
     160  ButtonStart.Enabled := False;
     161  ButtonStop.Enabled := True;
     162  Stop := False;
    157163  with Core.Game do begin
    158     while CanMove do begin
     164    while CanMove and not Stop do begin
    159165      NewTry := TGameTry.Create;
    160166      NewTry.Game.Assign(Core.Game);
     
    182188      end;
    183189      MoveAllAndUpdate(GameTries[0].Moves[0]);
    184 {      if CanMergeDirection(drDown) then MoveAll(drDown)
    185       else if CanMergeDirection(drRight) then MoveAll(drRight)
    186       else if CanMergeDirection(drLeft) then MoveAll(drLeft)
    187       else if CanMoveDirection(drDown) then MoveAll(drDown)
    188       else if CanMoveDirection(drRight) then MoveAll(drRight)
    189       else if CanMoveDirection(drLeft) then MoveAll(drLeft)
    190       else if CanMoveDirection(drUp) then MoveAll(drUp)
     190{      if CanMergeDirection(drDown) then MoveAllAnimate(drDown)
     191      else if CanMergeDirection(drRight) then MoveAllAnimate(drRight)
     192      else if CanMergeDirection(drLeft) then MoveAllAnimate(drLeft)
     193      else if CanMoveDirection(drDown) then MoveAllAnimate(drDown)
     194      else if CanMoveDirection(drRight) then MoveAllAnimate(drRight)
     195      else if CanMoveDirection(drLeft) then MoveAllAnimate(drLeft)
     196      else if CanMoveDirection(drUp) then MoveAllAnimate(drUp)
    191197      else Break;
    192198      }
     
    195201    end;
    196202  end;
     203  ButtonStart.Enabled := True;
     204  ButtonStop.Enabled := False;
     205end;
     206
     207procedure TFormComputer.ButtonStopClick(Sender: TObject);
     208begin
     209  Stop := True;
    197210end;
    198211
     
    224237  NewTry: TGameTry;
    225238begin
    226   for Direction := Low(TMoveDirection) to High(TMoveDirection) do begin
     239  for Direction := drLeft to drDown do begin
    227240    if GameTry.Game.CanMoveDirection(Direction) then begin
    228241      NewTry := TGameTry.Create;
     
    230243      NewTry.Game.UndoEnabled := False;
    231244      NewTry.Game.AnimationDuration := 0;
    232       NewTry.Game.MoveAll(Direction);
     245      NewTry.Game.MoveAllAnimate(Direction);
    233246      SetLength(NewTry.Moves, Length(NewTry.Moves) + 1);
    234247      NewTry.Moves[Length(NewTry.Moves) - 1] := Direction;
  • trunk/Languages/Game2048.cs.po

    r31 r32  
    7272msgstr "   "
    7373
    74 #: tformcomputer.buttonsolve.caption
    75 msgid "Solve"
    76 msgstr "Vyřešit"
     74#: tformcomputer.buttonstart.caption
     75msgid "Start"
     76msgstr "Spustit"
     77
     78#: tformcomputer.buttonstop.caption
     79msgid "Stop"
     80msgstr "Zastavit"
    7781
    7882#: tformcomputer.caption
  • trunk/Languages/Game2048.po

    r31 r32  
    6262msgstr ""
    6363
    64 #: tformcomputer.buttonsolve.caption
    65 msgid "Solve"
     64#: tformcomputer.buttonstart.caption
     65msgid "Start"
     66msgstr ""
     67
     68#: tformcomputer.buttonstop.caption
     69msgid "Stop"
    6670msgstr ""
    6771
  • trunk/UGame.pas

    r31 r32  
    124124    procedure Render(Canvas: TCanvas; CanvasSize: TPoint);
    125125    procedure MoveAll(Direction: TMoveDirection);
     126    procedure MoveAllAnimate(Direction: TMoveDirection);
    126127    procedure MoveAllAndUpdate(Direction: TMoveDirection);
    127128    procedure MoveTile(SourceTile, TargetTile: TTile);
     
    505506begin
    506507  case Direction of
    507     drLeft: begin
    508       Result := TArea.Create(1, 0, Board.Size.X - 1, Board.Size.Y - 1);
    509     end;
    510     drUp: begin
    511       Result := TArea.Create(0, 1, Board.Size.X - 1, Board.Size.Y - 1);
    512     end;
    513     drRight: begin
    514       Result := TArea.Create(Board.Size.X - 2, 0, 0, Board.Size.Y - 1);
    515     end;
    516     drDown: begin
    517       Result := TArea.Create(0, Board.Size.Y - 2, Board.Size.X - 1, 0);
    518     end;
     508    drNone: Result := TArea.Create(0, 0, 0, 0);
     509    drLeft: Result := TArea.Create(1, 0, Board.Size.X - 1, Board.Size.Y - 1);
     510    drUp: Result := TArea.Create(0, 1, Board.Size.X - 1, Board.Size.Y - 1);
     511    drRight: Result := TArea.Create(Board.Size.X - 2, 0, 0, Board.Size.Y - 1);
     512    drDown: Result := TArea.Create(0, Board.Size.Y - 2, Board.Size.X - 1, 0);
    519513  end;
    520514end;
     
    629623      RenderTile(Canvas, Board.Tiles[Y, X], TileRect);
    630624    end;
     625end;
     626
     627procedure TGame.MoveAll(Direction: TMoveDirection);
     628var
     629  P: TPoint;
     630  PNew: TPoint;
     631  I: Integer;
     632  Area: TArea;
     633begin
     634  if Direction = drNone then Exit;
     635  if not CanMoveDirection(Direction) then Exit;
     636  FMoving := True;
     637  FBoardUndo.Assign(Board);
     638  FCanUndo := True;
     639  Area := GetMoveArea(Direction);
     640  Board.ClearMerged;
     641  for I := 0 to Max(Board.Size.X, Board.Size.Y) - 1 do begin
     642    P := Area.P1;
     643    while P.Y <> Area.P2.Y + Area.Increment.Y do begin
     644      P.X := Area.P1.X;
     645      while P.X <> Area.P2.X + Area.Increment.X do begin
     646        PNew := P + DirectionDiff[Direction];
     647        if IsValidPos(PNew) then begin
     648          if (Board.Tiles[P.Y, P.X].Value <> 0) then begin
     649            if (Board.Tiles[PNew.Y, PNew.X].Value = 0) then begin
     650              Board.Tiles[P.Y, P.X].Moving := True;
     651              Board.Tiles[PNew.Y, PNew.X].Value := Board.Tiles[P.Y, P.X].Value;
     652              Board.Tiles[PNew.Y, PNew.X].Merged := Board.Tiles[P.Y, P.X].Merged;
     653              Board.Tiles[P.Y, P.X].Value := 0;
     654              Board.Tiles[P.Y, P.X].Merged := False;
     655            end else
     656            if (not Board.Tiles[P.Y, P.X].Merged) and (not Board.Tiles[PNew.Y, PNew.X].Merged) and
     657            (Board.Tiles[PNew.Y, PNew.X].Value = Board.Tiles[P.Y, P.X].Value) then begin
     658              Board.Tiles[P.Y, P.X].Moving := True;
     659              Board.Tiles[PNew.Y, PNew.X].Value := Board.Tiles[PNew.Y, PNew.X].Value + Board.Tiles[P.Y, P.X].Value;
     660              Board.Tiles[PNew.Y, PNew.X].Merged := True;
     661              Board.Tiles[P.Y, P.X].Value := 0;
     662              Board.Tiles[P.Y, P.X].Merged := False;
     663              Score := Score + Board.Tiles[PNew.Y, PNew.X].Value;
     664            end;
     665          end;
     666        end;
     667        Inc(P.X, Area.Increment.X);
     668      end;
     669      Inc(P.Y, Area.Increment.Y);
     670    end;
     671    DoChange;
     672  end;
     673  FMoving := False;
    631674end;
    632675
     
    707750begin
    708751  Result := False;
     752  if Direction = drNone then Exit;
    709753  Area := GetMoveArea(Direction);
    710754  P := Area.P1;
     
    729773end;
    730774
    731 procedure TGame.MoveAll(Direction: TMoveDirection);
     775procedure TGame.MoveAllAnimate(Direction: TMoveDirection);
    732776var
    733777  P: TPoint;
     
    823867begin
    824868  HighestValue := Board.GetHighestTileValue;
    825   MoveAll(Direction);
     869  MoveAllAnimate(Direction);
    826870
    827871  NewTile := FillRandomTile;
Note: See TracChangeset for help on using the changeset viewer.