Changeset 29 for trunk/UGame.pas

Timestamp:

Oct 6, 2019, 9:53:39 PM (5 years ago)

Author:

chronos

Message:

• Added: Computer player accessible from Tools menu in Debug mode. It is not able to win game yet.

File:

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

trunk/UGame.pas

@@ -36 +36 @@
     procedure Clear;
     procedure ClearMerged;
+    function GetValueSum: Integer;
     function GetHighestTileValue: Integer;
     function GetEmptyTilesCount: Integer;
@@ -53 +54 @@
     FMoving: Boolean;
     FOnChange: TNotifyEvent;
+    FOnGameOver: TNotifyEvent;
+    FOnWin: TNotifyEvent;
     FRunning: Boolean;
     FScore: Integer;
     FCanUndo: Boolean;
     FBoardUndo: TBoard;
-    function CanMoveDirection(Direction: TDirection): Boolean;
     function GetTileColor(Value: Integer): TColor;
     procedure SetScore(AValue: Integer);
@@ -73 +75 @@
     function CanUndo: Boolean;
     procedure Undo;
+    function CanMergeDirection(Direction: TDirection): Boolean;
+    function CanMoveDirection(Direction: TDirection): Boolean;
     function CanMove: Boolean;
     procedure Assign(Source: TGame);
@@ -78 +82 @@
     procedure Render(Canvas: TCanvas; CanvasSize: TPoint);
     procedure MoveAll(Direction: TDirection);
+    procedure MoveAllAndUpdate(Direction: TDirection);
     procedure MoveTile(SourceTile, TargetTile: TTile);
     function IsValidPos(Pos: TPoint): Boolean;
@@ -87 +92 @@
     property Running: Boolean read FRunning write FRunning;
     property OnChange: TNotifyEvent read FOnChange write FOnChange;
+    property OnWin: TNotifyEvent read FOnWin write FOnWin;
+    property OnGameOver: TNotifyEvent read FOnGameOver write FOnGameOver;
     property Moving: Boolean read FMoving;
+  end;
+
+  TGames = class(TFPGObjectList<TGame>)
   end;
 
@@ -94 +104 @@
     (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');
 
 resourcestring
-  SGameOverCaption = 'Lost';
-  SGameOverMessage = 'Game over!';
-  SWinCaption = 'Win';
-  SWinMessage = 'You reached %d and won! You can continue to play to get higher score.';
   SScore = 'Score';
   STopScore = 'Top score';
@@ -212 +219 @@
 end;
 
+function TBoard.GetValueSum: Integer;
+var
+  X, Y: Integer;
+begin
+  Result := 0;
+  for Y := 0 to Size.Y - 1 do
+    for X := 0 to Size.X - 1 do
+      Inc(Result, Tiles[Y, X].Value);
+end;
+
 function TBoard.GetEmptyTilesCount: Integer;
 var
@@ -260 +277 @@
 procedure TGame.GameOver;
 begin
-  if Running then MessageDlg(SGameOverCaption, SGameOverMessage, mtInformation, [mbOK], 0);
+  if Running and Assigned(FOnGameOver) then FOnGameOver(Self);
   Running := False;
 end;
@@ -266 +283 @@
 procedure TGame.Win;
 begin
-  MessageDlg(SWinCaption, Format(SWinMessage, [WinScore]), mtInformation, [mbOk], 0);
+  if Assigned(FOnWin) then FOnWin(Self);
 end;
 
@@ -293 +310 @@
 procedure TGame.Assign(Source: TGame);
 begin
-  FScore := Source.FScore;
+  Board.Assign(Source.Board);
+  FBoardUndo.Assign(Source.FBoardUndo);
+  FCanUndo := Source.FCanUndo;
   TopScore := Source.TopScore;
   AnimationDuration := Source.AnimationDuration;
-  Board.Assign(Source.Board);
+  WinScore := Source.WinScore;
+  UndoEnabled := Source.UndoEnabled;
+  FScore := Source.FScore;
+  FRunning := Source.FRunning;
 end;
 
@@ -412 +434 @@
     FRunning := CanMove;
     DoChange;
+  end;
+end;
+
+function TGame.CanMergeDirection(Direction: TDirection): Boolean;
+var
+  StartPoint: TPoint;
+  AreaSize: TPoint;
+  Increment: TPoint;
+  P: TPoint;
+  PNew: TPoint;
+  PI: TPoint;
+  I: Integer;
+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;
+
+  for I := 0 to Max(Board.Size.X, Board.Size.Y) - 1 do begin
+    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[PNew.Y, PNew.X].Value = 0) then begin
+            Board.Tiles[PNew.Y, PNew.X].Value := Board.Tiles[P.Y, P.X].Value;
+            Board.Tiles[P.Y, P.X].Value := 0;
+          end else
+          if (Board.Tiles[P.Y, P.X].Value <> 0) then begin
+            if 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;
 end;
@@ -490 +578 @@
   Time: TDateTime;
   Part: Double;
-  HighestValue: Integer;
 begin
   if not CanMoveDirection(Direction) then Exit;
   FMoving := True;
-  HighestValue := Board.GetHighestTileValue;
   FBoardUndo.Assign(Board);
   FCanUndo := True;
@@ -596 +682 @@
     DoChange;
   end;
-
-  // Update state after move
+  FMoving := False;
+end;
+
+procedure TGame.MoveAllAndUpdate(Direction: TDirection);
+var
+  HighestValue: Integer;
+begin
+  HighestValue := Board.GetHighestTileValue;
+  MoveAll(Direction);
   FillRandomTile;
   if not CanMove and (Board.GetEmptyTilesCount = 0) then
@@ -603 +696 @@
   if (HighestValue < WinScore) and
   (Board.GetHighestTileValue >= WinScore) then Win;
-
-  FMoving := False;
 end;