Changeset 31 for trunk/UGame.pas

Timestamp:

Oct 12, 2019, 10:47:02 PM (5 years ago)

Author:

chronos

Message:

• Added: New form accessible from menu Tools - Moves history with game moves history.

File:

• trunk/UGame.pas (modified) (21 diffs)

trunk/UGame.pas

@@ -10 +10 @@
 
 type
+  TGame = class;
+  TMoveDirection = (drNone, drLeft, drUp, drRight, drDown);
 
   { TTile }
 
   TTile = class
+    Index: TPoint;
     Value: Integer;
     NewValue: Integer;
@@ -32 +35 @@
     function Create(P1, P2: TPoint): TArea; overload;
     function Create(X1, Y1, X2, Y2: Integer): TArea; overload;
+  end;
+
+  { THistoryMove }
+
+  THistoryMove = class
+    Direction: TMoveDirection;
+    NewItemPos: TPoint;
+    NewItemValue: Integer;
+    procedure SaveToRegistry(RegContext: TRegistryContext);
+    procedure LoadFromRegistry(RegContext: TRegistryContext);
+  end;
+
+  { THistoryMoves }
+
+  THistoryMoves = class(TFPGObjectList<THistoryMove>)
+    procedure SaveToRegistry(RegContext: TRegistryContext);
+    procedure LoadFromRegistry(RegContext: TRegistryContext);
+  end;
+
+  { THistory }
+
+  THistory = class
+    Game: TGame;
+    Moves: THistoryMoves;
+    InitialTilesPos: array of TPoint;
+    procedure GetStep(GameStep: TGame; Step: Integer);
+    constructor Create;
+    destructor Destroy; override;
+    procedure SaveToRegistry(RegContext: TRegistryContext);
+    procedure LoadFromRegistry(RegContext: TRegistryContext);
   end;
 
@@ -55 +88 @@
   end;
 
-  TDirection = (drLeft, drUp, drRight, drDown);
-
   { TGame }
 
@@ -75 +106 @@
     procedure GameOver;
     procedure Win;
-    function FillRandomTile(Value4Change: Double = 0.1): Integer;
-    function GetMoveArea(Direction: TDirection): TArea;
+    function FillRandomTile(Value4Change: Double = 0.1): TTile;
+    function GetMoveArea(Direction: TMoveDirection): TArea;
   public
     Board: TBoard;
@@ -83 +114 @@
     WinScore: Integer;
     UndoEnabled: Boolean;
+    History: THistory;
     function CanUndo: Boolean;
     procedure Undo;
-    function CanMergeDirection(Direction: TDirection): Boolean;
-    function CanMoveDirection(Direction: TDirection): Boolean;
+    function CanMergeDirection(Direction: TMoveDirection): Boolean;
+    function CanMoveDirection(Direction: TMoveDirection): Boolean;
     function CanMove: Boolean;
     procedure Assign(Source: TGame);
     procedure New;
     procedure Render(Canvas: TCanvas; CanvasSize: TPoint);
-    procedure MoveAll(Direction: TDirection);
-    procedure MoveAllAndUpdate(Direction: TDirection);
+    procedure MoveAll(Direction: TMoveDirection);
+    procedure MoveAllAndUpdate(Direction: TMoveDirection);
     procedure MoveTile(SourceTile, TargetTile: TTile);
     function IsValidPos(Pos: TPoint): Boolean;
@@ -111 +143 @@
 
 const
-  DirectionDiff: array[TDirection] of TPoint = (
-    (X: -1; Y: 0), (X: 0; Y: -1), (X: 1; Y: 0), (X: 0; Y: 1)
+  DirectionDiff: array[TMoveDirection] of TPoint = (
+    (X: 0; Y: 0), (X: -1; Y: 0), (X: 0; Y: -1), (X: 1; Y: 0), (X: 0; Y: 1)
   );
-  DirectionText: array[TDirection] of string = ('Left', 'Up', 'Right', 'Down');
+  DirectionText: array[TMoveDirection] of string = ('None', 'Left', 'Up', 'Right', 'Down');
 
 resourcestring
@@ -121 +153 @@
 
 implementation
+
+{ THistoryMoves }
+
+procedure THistoryMoves.SaveToRegistry(RegContext: TRegistryContext);
+var
+  I: Integer;
+begin
+  with TRegistryEx.Create do
+  try
+    CurrentContext := RegContext;
+    WriteInteger('Count', Count);
+    for I := 0 to Count - 1 do begin
+      Items[I].SaveToRegistry(TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '/' + IntToStr(I)));
+    end;
+  finally
+    Free;
+  end;
+end;
+
+procedure THistoryMoves.LoadFromRegistry(RegContext: TRegistryContext);
+var
+  I: Integer;
+  C: Integer;
+  HistoryMove: THistoryMove;
+begin
+  with TRegistryEx.Create do
+  try
+    CurrentContext := RegContext;
+    C := ReadIntegerWithDefault('Count', 0);
+    for I := 0 to C - 1 do begin
+      HistoryMove := THistoryMove.Create;
+      Add(HistoryMove);
+      HistoryMove.LoadFromRegistry(TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '/' + IntToStr(I)));
+    end;
+  finally
+    Free;
+  end;
+end;
+
+{ THistoryMove }
+
+procedure THistoryMove.SaveToRegistry(RegContext: TRegistryContext);
+begin
+  with TRegistryEx.Create do
+  try
+    CurrentContext := RegContext;
+    WriteInteger('Direction', Integer(Direction));
+    WriteInteger('NewItemPosX', NewItemPos.X);
+    WriteInteger('NewItemPosY', NewItemPos.Y);
+    WriteInteger('NewItemValue', NewItemValue);
+  finally
+    Free;
+  end;
+end;
+
+procedure THistoryMove.LoadFromRegistry(RegContext: TRegistryContext);
+begin
+  with TRegistryEx.Create do
+  try
+    CurrentContext := RegContext;
+    Direction := TMoveDirection(ReadIntegerWithDefault('Direction', Integer(drNone)));
+    NewItemPos := Point(ReadIntegerWithDefault('NewItemPosX', 0),
+      ReadIntegerWithDefault('NewItemPosY', 0));
+    NewItemValue := ReadIntegerWithDefault('NewItemValue', 0);
+  finally
+    Free;
+  end;
+end;
+
+{ THistory }
+
+procedure THistory.GetStep(GameStep: TGame; Step: Integer);
+var
+  I: Integer;
+begin
+  GameStep.Board.Size := Game.Board.Size;
+  GameStep.Board.Clear;
+  GameStep.Score := 0;
+  for I := 0 to Length(InitialTilesPos) - 1 do
+    GameStep.Board.Tiles[InitialTilesPos[I].Y, InitialTilesPos[I].X].Value := 2;
+  for I := 0 to Step - 1 do
+  with Moves[I] do begin
+    GameStep.MoveAll(Direction);
+    if GameStep.Board.Tiles[NewItemPos.Y, NewItemPos.X].Value = 0 then
+      GameStep.Board.Tiles[NewItemPos.Y, NewItemPos.X].Value := NewItemValue
+      else raise Exception.Create('Tile should be empty');
+  end;
+end;
+
+constructor THistory.Create;
+begin
+  Moves := THistoryMoves.Create;
+end;
+
+destructor THistory.Destroy;
+begin
+  FreeAndNil(Moves);
+  inherited Destroy;
+end;
+
+procedure THistory.SaveToRegistry(RegContext: TRegistryContext);
+var
+  I: Integer;
+begin
+  with TRegistryEx.Create do
+  try
+    CurrentContext := TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\InitialTilesPos');
+    WriteInteger('Count', Length(InitialTilesPos));
+    for I := 0 to Length(InitialTilesPos) - 1 do begin
+      WriteInteger('X' + IntToStr(I), InitialTilesPos[I].X);
+      WriteInteger('Y' + IntToStr(I), InitialTilesPos[I].Y);
+    end;
+  finally
+    Free;
+  end;
+  Moves.SaveToRegistry(RegContext);
+end;
+
+procedure THistory.LoadFromRegistry(RegContext: TRegistryContext);
+var
+  I: Integer;
+begin
+  with TRegistryEx.Create do
+  try
+    CurrentContext := TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\InitialTilesPos');
+    SetLength(InitialTilesPos, ReadIntegerWithDefault('Count', 0));
+    for I := 0 to Length(InitialTilesPos) - 1 do begin
+      InitialTilesPos[I] := Point(ReadIntegerWithDefault('X' + IntToStr(I), 0),
+        ReadIntegerWithDefault('Y' + IntToStr(I), 0));
+    end;
+  finally
+    Free;
+  end;
+  Moves.LoadFromRegistry(RegContext);
+end;
 
 { TArea }
@@ -154 +321 @@
   SetLength(Tiles, FSize.Y, FSize.X);
   for Y := 0 to FSize.Y - 1 do
-    for X := 0 to FSize.X - 1 do
+    for X := 0 to FSize.X - 1 do begin
       Tiles[Y, X] := TTile.Create;
+      Tiles[Y, X].Index := Point(X, Y);
+    end;
 end;
 
@@ -228 +397 @@
       end;
     end;
+    Lines.Free;
+    Items.Free;
   finally
     Free;
@@ -315 +486 @@
 end;
 
-function TGame.FillRandomTile(Value4Change: Double = 0.1): Integer;
+function TGame.FillRandomTile(Value4Change: Double = 0.1): TTile;
 var
   EmptyTiles: TTiles;
   NewValue: Integer;
 begin
-  Result := 0;
+  Result := nil;
   EmptyTiles := TTiles.Create(False);
   Board.GetEmptyTiles(EmptyTiles);
   if EmptyTiles.Count > 0 then begin
     if Random < Value4Change then NewValue := 4 else NewValue := 2;
-    EmptyTiles[Random(EmptyTiles.Count)].Value := NewValue;
-    Result := 1;
+    Result := EmptyTiles[Random(EmptyTiles.Count)];
+    Result.Value := NewValue;
   end;
   EmptyTiles.Free;
 end;
 
-function TGame.GetMoveArea(Direction: TDirection): TArea;
+function TGame.GetMoveArea(Direction: TMoveDirection): TArea;
 begin
   case Direction of
@@ -371 +542 @@
 var
   I: Integer;
+  NewTile: TTile;
 begin
   FCanUndo := False;
@@ -376 +548 @@
   Score := 0;
   Running := True;
-  for I := 0 to 1 do FillRandomTile(0);
+  with History do begin
+    Moves.Clear;
+
+    SetLength(InitialTilesPos, 0);
+    for I := 0 to 1 do begin
+      NewTile := FillRandomTile(0);
+      SetLength(InitialTilesPos, Length(InitialTilesPos) + 1);
+      InitialTilesPos[Length(InitialTilesPos) - 1] := NewTile.Index;
+    end;
+  end;
   DoChange;
 end;
@@ -484 +665 @@
 end;
 
-function TGame.CanMergeDirection(Direction: TDirection): Boolean;
+function TGame.CanMergeDirection(Direction: TMoveDirection): Boolean;
 var
   P: TPoint;
@@ -495 +676 @@
   for I := 0 to Max(Board.Size.X, Board.Size.Y) - 1 do begin
     P := Area.P1;
-    while P.Y <> Area.P2.Y do begin
+    while P.Y <> Area.P2.Y + Area.Increment.Y do begin
       P.X := Area.P1.X;
-      while P.X <> Area.P2.X do begin
+      while P.X <> Area.P2.X + Area.Increment.X do begin
         PNew := P + DirectionDiff[Direction];
         if IsValidPos(PNew) then begin
@@ -519 +700 @@
 end;
 
-function TGame.CanMoveDirection(Direction: TDirection): Boolean;
+function TGame.CanMoveDirection(Direction: TMoveDirection): Boolean;
 var
   P: TPoint;
@@ -548 +729 @@
 end;
 
-procedure TGame.MoveAll(Direction: TDirection);
+procedure TGame.MoveAll(Direction: TMoveDirection);
 var
   P: TPoint;
@@ -560 +741 @@
   Area: TArea;
 begin
+  if Direction = drNone then Exit;
   if not CanMoveDirection(Direction) then Exit;
   FMoving := True;
@@ -634 +816 @@
 end;
 
-procedure TGame.MoveAllAndUpdate(Direction: TDirection);
+procedure TGame.MoveAllAndUpdate(Direction: TMoveDirection);
 var
   HighestValue: Integer;
+  HistoryMove: THistoryMove;
+  NewTile: TTile;
 begin
   HighestValue := Board.GetHighestTileValue;
   MoveAll(Direction);
-  FillRandomTile;
+
+  NewTile := FillRandomTile;
+  HistoryMove := THistoryMove.Create;
+  HistoryMove.Direction := Direction;
+  HistoryMove.NewItemPos := NewTile.Index;
+  HistoryMove.NewItemValue := NewTile.Value;
+  History.Moves.Add(HistoryMove);
+
   if not CanMove and (Board.GetEmptyTilesCount = 0) then
     GameOver;
@@ -678 +869 @@
   FBoardUndo.SaveToRegistry(TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\BoardUndo'));
   Board.SaveToRegistry(TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\Board'));
+  History.SaveToRegistry(TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\History'));
 end;
 
@@ -696 +888 @@
   FBoardUndo.LoadFromRegistry(TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\BoardUndo'));
   Board.LoadFromRegistry(TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\Board'));
+  History.LoadFromRegistry(TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\History'));
   DoChange;
 end;
@@ -705 +898 @@
   Board := TBoard.Create;
   FBoardUndo := TBoard.Create;
+  History := THistory.Create;
+  History.Game := Self;
 end;
 
 destructor TGame.Destroy;
 begin
+  FreeAndNil(History);
   FreeAndNil(FBoardUndo);
   FreeAndNil(Board);