Changeset 65

Timestamp:

Jan 23, 2020, 12:21:53 AM (4 years ago)

Author:

chronos

Message:

• Added: Separated TGame paint and state change events.
• Modified: Animate tiles movements in background thread.
• Modified: Initialize TCore as first application form.

Location:

trunk

Files:

• Forms/UFormMain.lfm (modified) (1 diff)
• Forms/UFormMain.pas (modified) (10 diffs)
• Game2048.lpr (modified) (1 diff)
• UCore.pas (modified) (3 diffs)
• UGame.pas (modified) (14 diffs)

trunk/Forms/UFormMain.lfm

@@ -55 +55 @@
   end
   object TimerDraw: TTimer
-    Interval = 20
+    Interval = 10
     OnTimer = TimerDrawTimer
     left = 138

trunk/Forms/UFormMain.pas

@@ -7 +7 @@
 uses
   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus, Math,
-  ActnList, ExtCtrls, StdCtrls, UGame, UPersistentForm, UApplicationInfo;
+  ActnList, ExtCtrls, StdCtrls, UGame, UPersistentForm, UApplicationInfo,
+  LCLType, Syncobjs, DateUtils;
 
 type
+  TFormMain = class;
+
+  { TMoveThread }
+
+  TMoveThread = class(TThread)
+    FormMain: TFormMain;
+    procedure Execute; override;
+  end;
 
   { TFormMain }
@@ -39 +48 @@
     procedure FormShow(Sender: TObject);
     procedure TimerDrawTimer(Sender: TObject);
+    procedure EraseBackground(DC: HDC); override;
   private
+    DrawDuration: TDateTime;
     MouseStart: TPoint;
     MouseDown: Boolean;
     RedrawPending: Boolean;
     MoveBuffer: array of TMoveDirection;
+    MoveBufferLock: TCriticalSection;
+    MoveThread: TMoveThread;
     procedure AddToMoveBuffer(Direction: TMoveDirection);
     procedure ProcessMoveBuffer;
@@ -60 +73 @@
 uses
   UCore;
+
+{ TMoveThread }
+
+procedure TMoveThread.Execute;
+begin
+  while not Terminated do begin
+    FormMain.ProcessMoveBuffer;
+    Sleep(10);
+  end;
+end;
 
 { TFormMain }
@@ -72 +95 @@
       40: AddToMoveBuffer(drDown);
     end;
-    ProcessMoveBuffer;
+    //ProcessMoveBuffer;
   end;
 end;
@@ -111 +134 @@
       else if (Angle > 135) and (Angle <= 225) then AddToMoveBuffer(drLeft)
       else if (Angle > 225) and (Angle <= 315) then AddToMoveBuffer(drUp);
-      ProcessMoveBuffer;
+      //ProcessMoveBuffer;
     end;
   end;
@@ -123 +146 @@
 
 procedure TFormMain.FormPaint(Sender: TObject);
-begin
+var
+  TimeStart: TDateTime;
+begin
+  TimeStart := Now;
   Core.Game.Render(Canvas, Point(Width, Height - MainMenu1.Height));
+  DrawDuration := Now - TimeStart;
 end;
 
@@ -130 +157 @@
 begin
   Core.PersistentForm1.Save(Self);
+  ControlStyle := [csOpaque];
 end;
 
 procedure TFormMain.FormCreate(Sender: TObject);
 begin
+  MoveBufferLock := TCriticalSection.Create;
+  MoveThread := TMoveThread.Create(True);
+  MoveThread.FormMain := Self;
+  MoveThread.FreeOnTerminate := False;
+  MoveThread.Start;
 end;
 
 procedure TFormMain.FormDestroy(Sender: TObject);
 begin
+  FreeAndNil(MoveThread);
+  FreeAndNil(MoveBuffer);
 end;
 
@@ -156 +191 @@
     RedrawPending := False;
     Repaint;
-  end;
+    Caption := FloatToStr(Round(DrawDuration / OneMillisecond));
+  end;
+end;
+
+procedure TFormMain.EraseBackground(DC: HDC);
+begin
+  // Do nothing
 end;
 
 procedure TFormMain.AddToMoveBuffer(Direction: TMoveDirection);
 begin
-  SetLength(MoveBuffer, Length(MoveBuffer) + 1);
-  MoveBuffer[Length(MoveBuffer) - 1] := Direction;
+  MoveBufferLock.Acquire;
+  try
+    SetLength(MoveBuffer, Length(MoveBuffer) + 1);
+    MoveBuffer[Length(MoveBuffer) - 1] := Direction;
+  finally
+    MoveBufferLock.Release;
+  end;
 end;
 
@@ -168 +214 @@
 begin
   if not Core.Game.Moving then begin
+    MoveBufferLock.Acquire;
     while Length(MoveBuffer) > 0 do begin
+      MoveBufferLock.Release;
       Core.Game.MoveAllAndUpdate(MoveBuffer[0], True);
+      MoveBufferLock.Acquire;
       if Length(MoveBuffer) > 1 then
         Move(MoveBuffer[1], MoveBuffer[0], (Length(MoveBuffer) - 1) * SizeOf(TMoveDirection));
@@ -175 +224 @@
         SetLength(MoveBuffer, Length(MoveBuffer) - 1);
     end;
-  end else begin
+    MoveBufferLock.Release;
   end;
 end;

trunk/Game2048.lpr

@@ -29 +29 @@
   Application.Scaled := True;
   Application.Initialize;
+  Application.CreateForm(TCore, Core);
   Application.CreateForm(TFormMain, FormMain);
-  Application.CreateForm(TCore, Core);
   Application.Run;
 end.

trunk/UCore.pas

@@ -40 +40 @@
   private
     procedure GameChange(Sender: TObject);
+    procedure GamePaint(Sender: TObject);
     procedure GameWin(Sender: TObject);
     procedure GameOver(Sender: TObject);
@@ -80 +81 @@
   Game.Board.Size := Point(4, 4);
   Game.OnChange := GameChange;
+  Game.OnPaint := GamePaint;
   Game.OnWin := GameWin;
   Game.OnGameOver := GameOver;
@@ -179 +181 @@
 procedure TCore.GameChange(Sender: TObject);
 begin
-  FormMain.Redraw;
   UpdateInterface;
+end;
+
+procedure TCore.GamePaint(Sender: TObject);
+begin
+  if Assigned(FormMain) then FormMain.Redraw;
 end;
 

trunk/UGame.pas

@@ -104 +104 @@
     FOnChange: TNotifyEvent;
     FOnGameOver: TNotifyEvent;
+    FOnPaint: TNotifyEvent;
     FOnWin: TNotifyEvent;
     FRecordHistory: Boolean;
@@ -115 +116 @@
     procedure SetScore(AValue: Integer);
     procedure DoChange;
+    procedure DoPaint;
     procedure RenderTile(Canvas: TCanvas; Tile: TTile; TileRect: TRect; WithText: Boolean);
     procedure GameOver;
@@ -129 +131 @@
     TopScore: Integer;
     AnimationDuration: Integer;
+    AnimationTick: Integer;
     WinTileValue: Integer;
     UndoEnabled: Boolean;
@@ -155 +158 @@
     property Running: Boolean read FRunning write FRunning;
     property OnChange: TNotifyEvent read FOnChange write FOnChange;
+    property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
     property OnWin: TNotifyEvent read FOnWin write FOnWin;
     property OnGameOver: TNotifyEvent read FOnGameOver write FOnGameOver;
@@ -506 +510 @@
 end;
 
+procedure TGame.DoPaint;
+begin
+  if Assigned(FOnPaint) then FOnPaint(Self);
+end;
+
 procedure TGame.GameOver;
 begin
@@ -516 +525 @@
   if FSkin = AValue then Exit;
   FSkin := AValue;
-  DoChange;
+  DoPaint;
 end;
 
@@ -595 +604 @@
   AnimateTiles;
   DoChange;
+  DoPaint;
 end;
 
@@ -763 +773 @@
       Inc(P.Y, Area.Increment.Y);
     end;
-    DoChange;
+    DoPaint;
   end;
   FMoving := False;
@@ -945 +955 @@
               Trunc(Part * DirectionDiff[Direction].Y * 100));
         end;
-      DoChange;
-      Application.ProcessMessages;
-      Sleep(1);
+      DoPaint;
+      //Application.ProcessMessages;
+      Sleep(AnimationTick);
     until Time > EndTime;
 
@@ -968 +978 @@
       Board.Tiles[Y, X].Value := Board.Tiles[Y, X].NewValue;
     end;
-  DoChange;
+  DoPaint;
   FMoving := False;
 end;
@@ -1008 +1018 @@
           Board.Tiles[Y, X].Shift := Point(Trunc(Part * 100), Trunc(Part * 100));
       end;
-    DoChange;
-    Application.ProcessMessages;
-    Sleep(1);
+    DoPaint;
+    //Application.ProcessMessages;
+    Sleep(AnimationTick);
   until Time > EndTime;
 
@@ -1019 +1029 @@
         Board.Tiles[Y, X].Shift := Point(0, 0);
       end;
-  DoChange;
+  DoPaint;
   FMoving := False;
 end;
@@ -1155 +1165 @@
   end;
   DoChange;
+  DoPaint;
 end;
 
@@ -1160 +1171 @@
 begin
   AnimationDuration := 30;
+  AnimationTick := 10; // ms
   WinTileValue := 11; // 2^11 = 2048
   Board := TBoard.Create;