Changeset 31 for trunk

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.

Location:

trunk

Files:

• Forms/UFormComputer.pas (modified) (3 diffs)
• Forms/UFormMain.lfm (modified) (1 diff)
• Forms/UFormMain.pas (modified) (1 diff)
• Forms/UFormNew.lfm (modified) (1 diff)
• Forms/UFormNew.pas (modified) (2 diffs)
• Game2048.lpi (modified) (2 diffs)
• Game2048.lpr (modified) (1 diff)
• Languages/Game2048.cs.po (modified) (2 diffs)
• Languages/Game2048.po (modified) (2 diffs)
• UCore.lfm (modified) (1 diff)
• UCore.lrj (modified) (1 diff)
• UCore.pas (modified) (4 diffs)
• UGame.pas (modified) (21 diffs)

trunk/Forms/UFormComputer.pas

@@ -13 +13 @@
   TGameTry = class
     Game: TGame;
-    Moves: array of TDirection;
+    Moves: array of TMoveDirection;
     constructor Create;
     destructor Destroy; override;
@@ -58 +58 @@
 function TGameTry.GetFitness: Double;
 const
-  DirWeight: array[TDirection] of Double = (0.25, -10000, 0.5, 0.75);
+  DirWeight: array[TMoveDirection] of Double = (0, 0.25, -10000, 0.5, 0.75);
 var
   I: Integer;
@@ -221 +221 @@
 procedure TFormComputer.TryAllDirections(GameTries: TGameTries; GameTry: TGameTry);
 var
-  Direction: TDirection;
+  Direction: TMoveDirection;
   NewTry: TGameTry;
 begin
-  for Direction := Low(TDirection) to High(TDirection) do begin
+  for Direction := Low(TMoveDirection) to High(TMoveDirection) do begin
     if GameTry.Game.CanMoveDirection(Direction) then begin
       NewTry := TGameTry.Create;

trunk/Forms/UFormMain.lfm

@@ -37 +37 @@
         Action = Core.AComputer
       end
+      object MenuItem5: TMenuItem
+        Action = Core.AHistory
+      end
     end
     object MenuItemHelp: TMenuItem

trunk/Forms/UFormMain.pas

@@ -19 +19 @@
     MenuItem3: TMenuItem;
     MenuItem4: TMenuItem;
+    MenuItem5: TMenuItem;
     MenuItemTools: TMenuItem;
     MenuItemNew: TMenuItem;

trunk/Forms/UFormNew.lfm

@@ -8 +8 @@
   ClientWidth = 487
   DesignTimePPI = 144
+  OnClose = FormClose
   OnCreate = FormCreate
+  OnShow = FormShow
   LCLVersion = '2.0.2.0'
   object Label1: TLabel

trunk/Forms/UFormNew.pas

@@ -19 +19 @@
     ComboBoxSize: TComboBox;
     Label1: TLabel;
+    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
     procedure FormCreate(Sender: TObject);
+    procedure FormShow(Sender: TObject);
   private
 
@@ -44 +46 @@
 end;
 
+procedure TFormNew.FormShow(Sender: TObject);
+begin
+  Core.PersistentForm1.Load(Self);
+end;
+
+procedure TFormNew.FormClose(Sender: TObject; var CloseAction: TCloseAction);
+begin
+  Core.PersistentForm1.Save(Self);
+end;
+
 procedure TFormNew.Load(Game: TGame);
 begin

trunk/Game2048.lpi

@@ -82 +82 @@
       </Item2>
     </RequiredPackages>
-    <Units Count="9">
+    <Units Count="10">
       <Unit0>
         <Filename Value="Game2048.lpr"/>
@@ -140 +140 @@
         <ResourceBaseClass Value="Form"/>
       </Unit8>
+      <Unit9>
+        <Filename Value="Forms/UFormHistory.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="FormHistory"/>
+        <HasResources Value="True"/>
+        <ResourceBaseClass Value="Form"/>
+      </Unit9>
     </Units>
   </ProjectOptions>

trunk/Game2048.lpr

@@ -9 +9 @@
   Interfaces, SysUtils,// this includes the LCL widgetset
   Forms, UGame, Common, UFormSettings, UFormMain, UCore, UFormHelp,
-  UFormComputer
+  UFormComputer, UFormHistory
   { you can add units after this };
 

trunk/Languages/Game2048.cs.po

@@ -32 +32 @@
 msgstr "Nápověda"
 
+#: tcore.ahistory.caption
+msgctxt "tcore.ahistory.caption"
+msgid "Moves history"
+msgstr "Historie pohybů"
+
 #: tcore.anew.caption
 msgctxt "tcore.anew.caption"
@@ -81 +86 @@
 msgstr "Nápověda"
 
+#: tformhistory.caption
+msgctxt "tformhistory.caption"
+msgid "Moves history"
+msgstr "Historie pohybů"
+
 #: tformmain.caption
 msgid "2048"

trunk/Languages/Game2048.po

@@ -22 +22 @@
 msgstr ""
 
+#: tcore.ahistory.caption
+msgctxt "tcore.ahistory.caption"
+msgid "Moves history"
+msgstr ""
+
 #: tcore.anew.caption
 msgctxt "tcore.anew.caption"
@@ -71 +76 @@
 msgstr ""
 
+#: tformhistory.caption
+msgctxt "tformhistory.caption"
+msgid "Moves history"
+msgstr ""
+
 #: tformmain.caption
 msgid "2048"

trunk/UCore.lfm

@@ -76 +76 @@
       ShortCut = 115
     end
+    object AHistory: TAction
+      Caption = 'Moves history'
+      OnExecute = AHistoryExecute
+    end
   end
 end

trunk/UCore.lrj

@@ -6 +6 @@
 {"hash":378031,"name":"tcore.aundo.caption","sourcebytes":[85,110,100,111],"value":"Undo"},
 {"hash":322608,"name":"tcore.ahelp.caption","sourcebytes":[72,101,108,112],"value":"Help"},
-{"hash":1113,"name":"tcore.acomputer.caption","sourcebytes":[65,73],"value":"AI"}
+{"hash":1113,"name":"tcore.acomputer.caption","sourcebytes":[65,73],"value":"AI"},
+{"hash":191263657,"name":"tcore.ahistory.caption","sourcebytes":[77,111,118,101,115,32,104,105,115,116,111,114,121],"value":"Moves history"}
 ]}

trunk/UCore.pas

@@ -16 +16 @@
     AAbout: TAction;
     AComputer: TAction;
+    AHistory: TAction;
     AHelp: TAction;
     AUndo: TAction;
@@ -30 +31 @@
     procedure AExitExecute(Sender: TObject);
     procedure AHelpExecute(Sender: TObject);
+    procedure AHistoryExecute(Sender: TObject);
     procedure ANewExecute(Sender: TObject);
     procedure ASettingsExecute(Sender: TObject);
@@ -54 +56 @@
 
 uses
-  UFormMain, UFormSettings, UFormAbout, UFormNew, UFormHelp, UFormComputer;
+  UFormMain, UFormSettings, UFormAbout, UFormNew, UFormHelp, UFormComputer,
+  UFormHistory;
 
 resourcestring
@@ -131 +134 @@
 end;
 
+procedure TCore.AHistoryExecute(Sender: TObject);
+begin
+  FormHistory := TFormHistory.Create(nil);
+  try
+    FormHistory.ShowModal;
+  finally
+    FreeAndNil(FormHistory);
+  end;
+end;
+
 procedure TCore.ANewExecute(Sender: TObject);
 begin

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);