Changeset 20

Timestamp:

Oct 5, 2019, 2:00:50 PM (5 years ago)

Author:

chronos

Message:

• Added: Player can undo last move.
• Modified: Optimized code of TGame.CanMove method.

Location:

trunk

Files:

• Forms/UFormMain.lfm (modified) (1 diff)
• Forms/UFormMain.pas (modified) (2 diffs)
• Forms/UFormNew.lfm (modified) (1 diff)
• Forms/UFormNew.pas (modified) (1 diff)
• Languages/Game2048.cs.po (modified) (3 diffs)
• Languages/Game2048.po (modified) (2 diffs)
• UCore.lfm (modified) (2 diffs)
• UCore.lrj (modified) (1 diff)
• UCore.pas (modified) (6 diffs)
• UGame.pas (modified) (12 diffs)

trunk/Forms/UFormMain.lfm

@@ -20 +20 @@
       Caption = 'Game'
       object MenuItemNew: TMenuItem
-        Action = Core.AGameNew
+        Action = Core.ANew
+      end
+      object MenuItem2: TMenuItem
+        Action = Core.AUndo
       end
       object MenuItem1: TMenuItem

trunk/Forms/UFormMain.pas

@@ -16 +16 @@
     MainMenu1: TMainMenu;
     MenuItem1: TMenuItem;
+    MenuItem2: TMenuItem;
     MenuItemNew: TMenuItem;
     MenuItemExit: TMenuItem;
@@ -48 +49 @@
 
 procedure TFormMain.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
-var
-  MovedCount: Integer;
 begin
   if Core.Game.Running and not Core.Game.Moving then begin
-    MovedCount := 0;
     case Key of
-      37: MovedCount := Core.Game.MoveAll(drLeft);
-      38: MovedCount := Core.Game.MoveAll(drUp);
-      39: MovedCount := Core.Game.MoveAll(drRight);
-      40: MovedCount := Core.Game.MoveAll(drDown);
+      37: Core.Game.MoveAll(drLeft);
+      38: Core.Game.MoveAll(drUp);
+      39: Core.Game.MoveAll(drRight);
+      40: Core.Game.MoveAll(drDown);
     end;
-    if MovedCount > 0 then Core.Game.FillRandomTile;
-    if not Core.Game.CanMove and (Core.Game.Board.GetEmptyTilesCount = 0) then
-      Core.Game.GameOver;
-    if (not Core.Game.Won) and (Core.Game.Board.GetHighestTileValue >= 2048) then
-      Core.Game.Win;
   end;
 end;

trunk/Forms/UFormNew.lfm

@@ -25 +25 @@
     ItemHeight = 0
     Items.Strings = (
+      '2 x 2'
       '3 x 3'
       '4 x 4'

trunk/Forms/UFormNew.pas

@@ -45 +45 @@
 procedure TFormNew.Load(Game: TGame);
 begin
-  ComboBoxSize.ItemIndex := Game.Board.Size.X - 3;
+  ComboBoxSize.ItemIndex := Game.Board.Size.X - 2;
 end;
 
 procedure TFormNew.Save(Game: TGame);
 begin
-  Game.Board.Size := Point(3 + ComboBoxSize.ItemIndex, 3 + ComboBoxSize.ItemIndex);
+  Game.Board.Size := Point(2 + ComboBoxSize.ItemIndex, 2 + ComboBoxSize.ItemIndex);
 end;
 

trunk/Languages/Game2048.cs.po

@@ -22 +22 @@
 msgstr "Ukončít"
 
-#: tcore.agamenew.caption
-msgctxt "tcore.agamenew.caption"
+#: tcore.anew.caption
+#, fuzzy
+msgctxt "tcore.anew.caption"
 msgid "New..."
 msgstr "Nová..."
@@ -31 +32 @@
 msgid "Settings"
 msgstr "Nastavení"
+
+#: tcore.aundo.caption
+msgid "Undo"
+msgstr ""
 
 #: tformabout.buttonclose.caption
@@ -149 +154 @@
 msgid "You won! Do you want to continue to play?"
 msgstr "Vyhrál jsi! Chceš pokračovat ve hře?"
+

trunk/Languages/Game2048.po

@@ -12 +12 @@
 msgstr ""
 
-#: tcore.agamenew.caption
-msgctxt "tcore.agamenew.caption"
+#: tcore.anew.caption
+msgctxt "tcore.anew.caption"
 msgid "New..."
 msgstr ""
@@ -20 +20 @@
 msgctxt "tcore.asettings.caption"
 msgid "Settings"
+msgstr ""
+
+#: tcore.aundo.caption
+msgid "Undo"
 msgstr ""
 

trunk/UCore.lfm

@@ -43 +43 @@
     left = 420
     top = 184
-    object AGameNew: TAction
+    object ANew: TAction
       Caption = 'New...'
-      OnExecute = AGameNewExecute
+      OnExecute = ANewExecute
+      ShortCut = 113
     end
     object AExit: TAction
@@ -58 +59 @@
       Caption = 'Settings'
       OnExecute = ASettingsExecute
+      ShortCut = 120
+    end
+    object AUndo: TAction
+      Caption = 'Undo'
+      OnExecute = AUndoExecute
+      ShortCut = 114
     end
   end

trunk/UCore.lrj

@@ -1 +1 @@
 {"version":1,"strings":[
-{"hash":88908046,"name":"tcore.agamenew.caption","sourcebytes":[78,101,119,46,46,46],"value":"New..."},
+{"hash":88908046,"name":"tcore.anew.caption","sourcebytes":[78,101,119,46,46,46],"value":"New..."},
 {"hash":315140,"name":"tcore.aexit.caption","sourcebytes":[69,120,105,116],"value":"Exit"},
 {"hash":4691652,"name":"tcore.aabout.caption","sourcebytes":[65,98,111,117,116],"value":"About"},
-{"hash":213582195,"name":"tcore.asettings.caption","sourcebytes":[83,101,116,116,105,110,103,115],"value":"Settings"}
+{"hash":213582195,"name":"tcore.asettings.caption","sourcebytes":[83,101,116,116,105,110,103,115],"value":"Settings"},
+{"hash":378031,"name":"tcore.aundo.caption","sourcebytes":[85,110,100,111],"value":"Undo"}
 ]}

trunk/UCore.pas

@@ -15 +15 @@
   TCore = class(TDataModule)
     AAbout: TAction;
+    AUndo: TAction;
     ASettings: TAction;
     ActionList1: TActionList;
     AExit: TAction;
-    AGameNew: TAction;
+    ANew: TAction;
     ApplicationInfo1: TApplicationInfo;
     PersistentForm1: TPersistentForm;
@@ -25 +26 @@
     procedure AAboutExecute(Sender: TObject);
     procedure AExitExecute(Sender: TObject);
-    procedure AGameNewExecute(Sender: TObject);
+    procedure ANewExecute(Sender: TObject);
     procedure ASettingsExecute(Sender: TObject);
+    procedure AUndoExecute(Sender: TObject);
     procedure DataModuleCreate(Sender: TObject);
     procedure DataModuleDestroy(Sender: TObject);
@@ -33 +35 @@
   public
     Game: TGame;
+    procedure UpdateInterface;
     procedure LoadConfig;
     procedure SaveConfig;
@@ -68 +71 @@
 end;
 
+procedure TCore.AUndoExecute(Sender: TObject);
+begin
+  Game.Undo;
+end;
+
 procedure TCore.AAboutExecute(Sender: TObject);
 begin
@@ -84 +92 @@
 end;
 
-procedure TCore.AGameNewExecute(Sender: TObject);
+procedure TCore.ANewExecute(Sender: TObject);
 begin
   FormNew := TFormNew.Create(nil);
@@ -107 +115 @@
 begin
   FormMain.Redraw;
+  UpdateInterface;
+end;
+
+procedure TCore.UpdateInterface;
+begin
+  AUndo.Enabled := Game.CanUndo;;
 end;
 

trunk/UGame.pas

@@ -55 +55 @@
     FRunning: Boolean;
     FScore: Integer;
+    FCanUndo: Boolean;
+    FBoardUndo: TBoard;
+    function CanMoveDirection(Direction: TDirection): Boolean;
     function GetTileColor(Value: Integer): TColor;
     procedure SetScore(AValue: Integer);
     procedure DoChange;
     procedure RenderTile(Canvas: TCanvas; Tile: TTile; TileRect: TRect);
+    procedure GameOver;
+    procedure Win;
+    function FillRandomTile: Integer;
   public
     Board: TBoard;
     TopScore: Integer;
     AnimationDuration: Integer;
-    Won: Boolean;
-    procedure GameOver;
-    procedure Win;
-    function FillRandomTile: Integer;
+    WinScore: Integer;
+    function CanUndo: Boolean;
+    procedure Undo;
     function CanMove: Boolean;
     procedure Assign(Source: TGame);
@@ -146 +151 @@
     CurrentContext := RegContext;
 
+    WriteInteger('SizeX', Size.X);
+    WriteInteger('SizeY', Size.Y);
     Value := '';
     for Y := 0 to Size.Y - 1 do begin
@@ -171 +178 @@
     CurrentContext := RegContext;
 
+    Size := Point(ReadIntegerWithDefault('SizeX', 4), ReadIntegerWithDefault('SizeY', 4));
     Items := TStringList.Create;
     Items.Delimiter := ',';
@@ -257 +265 @@
 procedure TGame.Win;
 begin
-  if not Won then begin
-    Won := True;
-    if MessageDlg(SWinCaption, SWinMessage, mtConfirmation,
-    mbYesNo, 0) = mrNo then begin
-      Running := False;
-    end;
+  if MessageDlg(SWinCaption, SWinMessage, mtConfirmation,
+  mbYesNo, 0) = mrNo then begin
+    Running := False;
   end;
 end;
@@ -281 +286 @@
 
 function TGame.CanMove: Boolean;
-var
-  TempGame: TGame;
-begin
-  Result := False;
-  TempGame := TGame.Create;
-  try
-    TempGame.Assign(Self);
-    TempGame.AnimationDuration := 0;
-    Result := TempGame.MoveAll(drDown) > 0;
-    if Result then Exit;
-    Result := TempGame.MoveAll(drUp) > 0;
-    if Result then Exit;
-    Result := TempGame.MoveAll(drRight) > 0;
-    if Result then Exit;
-    Result := TempGame.MoveAll(drLeft) > 0;
-  finally
-    TempGame.Free;
-  end;
+begin
+  Result := CanMoveDirection(drLeft) or CanMoveDirection(drRight) or
+    CanMoveDirection(drUp) or CanMoveDirection(drDown);
 end;
 
 procedure TGame.Assign(Source: TGame);
-var
-  X, Y: Integer;
 begin
   FScore := Source.FScore;
   TopScore := Source.TopScore;
   AnimationDuration := Source.AnimationDuration;
-  Won := Source.Won;
   Board.Assign(Source.Board);
 end;
@@ -316 +303 @@
   I: Integer;
 begin
+  FCanUndo := False;
   Board.Clear;
   Score := 0;
-  Won := False;
   Running := True;
   for I := 0 to 1 do FillRandomTile;
@@ -413 +400 @@
 end;
 
+function TGame.CanUndo: Boolean;
+begin
+  Result := FCanUndo;
+end;
+
+procedure TGame.Undo;
+begin
+  if CanUndo then begin
+    Board.Assign(FBoardUndo);
+    FCanUndo := False;
+    FRunning := CanMove;
+    DoChange;
+  end;
+end;
+
+function TGame.CanMoveDirection(Direction: TDirection): Boolean;
+var
+  StartPoint: TPoint;
+  AreaSize: TPoint;
+  Increment: TPoint;
+  P: TPoint;
+  PNew: TPoint;
+  PI: TPoint;
+begin
+  Result := False;
+  case Direction of
+    drLeft: begin
+      StartPoint := Point(1, 0);
+      AreaSize := Point(Board.Size.X - 2, Board.Size.Y - 1);
+      Increment := Point(1, 1);
+    end;
+    drUp: begin
+      StartPoint := Point(0, 1);
+      AreaSize := Point(Board.Size.X - 1, Board.Size.Y - 2);
+      Increment := Point(1, 1);
+    end;
+    drRight: begin
+      StartPoint := Point(Board.Size.X - 2, 0);
+      AreaSize := Point(Board.Size.X - 2, Board.Size.Y - 1);
+      Increment := Point(-1, 1);
+    end;
+    drDown: begin
+      StartPoint := Point(0, Board.Size.Y - 2);
+      AreaSize := Point(Board.Size.X - 1, Board.Size.Y - 2);
+      Increment := Point(1, -1);
+    end;
+  end;
+
+  PI.Y := 0;
+  while PI.Y <= AreaSize.Y do begin
+    PI.X := 0;
+    while PI.X <= AreaSize.X do begin
+      P := Point(StartPoint.X + PI.X * Increment.X, StartPoint.Y + PI.Y * Increment.Y);
+      PNew.X := P.X + DirectionDiff[Direction].X;
+      PNew.Y := P.Y + DirectionDiff[Direction].Y;
+      if IsValidPos(PNew) then begin
+        if (Board.Tiles[P.Y, P.X].Value <> 0) then begin
+          if (Board.Tiles[PNew.Y, PNew.X].Value = 0) or
+          (Board.Tiles[PNew.Y, PNew.X].Value = Board.Tiles[P.Y, P.X].Value) then begin
+            Result := True;
+            Break;
+          end;
+        end;
+        P.X := PNew.X;
+        P.Y := PNew.Y;
+        PNew.X := P.X + DirectionDiff[Direction].X;
+        PNew.Y := P.Y + DirectionDiff[Direction].Y;
+      end;
+      Inc(PI.X);
+    end;
+    if Result then Break;
+    Inc(PI.Y);
+  end;
+end;
 
 function TGame.MoveAll(Direction: TDirection): Integer;
@@ -430 +491 @@
   Time: TDateTime;
   Part: Double;
+  HighestValue: Integer;
 begin
   FMoving := True;
+  HighestValue := Board.GetHighestTileValue;
+  FBoardUndo.Assign(Board);
+  FCanUndo := True;
   //Diff := DirectionDiff[Direction];
   case Direction of
@@ -535 +600 @@
   end;
   Result := MovedCount;
+
+  // Update state after move
+  if MovedCount > 0 then FillRandomTile;
+  if not CanMove and (Board.GetEmptyTilesCount = 0) then
+    GameOver;
+  if (HighestValue < WinScore) and
+  (Board.GetHighestTileValue >= WinScore) then Win;
+
   FMoving := False;
 end;
@@ -560 +633 @@
     WriteInteger('TopScore', TopScore);
     WriteInteger('AnimationDuration', AnimationDuration);
-    WriteInteger('SizeX', Board.Size.X);
-    WriteInteger('SizeY', Board.Size.Y);
     WriteInteger('Score', Score);
     WriteBool('GameRunning', FRunning);
-    WriteBool('Won', Won);
+    WriteBool('CanUndo', FCanUndo);
   finally
     Free;
   end;
-  Board.SaveToRegistry(RegContext);
+  FBoardUndo.SaveToRegistry(TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\BoardUndo'));
+  Board.SaveToRegistry(TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\Board'));
 end;
 
@@ -576 +648 @@
   try
     CurrentContext := RegContext;
-    Board.Size := Point(ReadIntegerWithDefault('SizeX', 4), ReadIntegerWithDefault('SizeY', 4));
     AnimationDuration := ReadIntegerWithDefault('AnimationDuration', 30);
     TopScore := ReadIntegerWithDefault('TopScore', 0);
     Score := ReadIntegerWithDefault('Score', 0);
     FRunning := ReadBoolWithDefault('GameRunning', False);
-    Won := ReadBoolWithDefault('Won', False);
+    FCanUndo := ReadBoolWithDefault('CanUndo', False);
   finally
     Free;
   end;
-  Board.LoadFromRegistry(RegContext);
+  FBoardUndo.LoadFromRegistry(TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\BoardUndo'));
+  Board.LoadFromRegistry(TRegistryContext.Create(RegContext.RootKey, RegContext.Key + '\Board'));
 end;
 
@@ -591 +663 @@
 begin
   AnimationDuration := 30;
+  WinScore := 2048;
   Board := TBoard.Create;
+  FBoardUndo := TBoard.Create;
 end;
 
 destructor TGame.Destroy;
 begin
+  FreeAndNil(FBoardUndo);
   FreeAndNil(Board);
   inherited;