Changeset 414

Timestamp:

Jan 10, 2025, 4:24:19 PM (3 hours ago)

Author:

chronos

Message:

• Modified: Lowered idle CPU consumption.

Location:

trunk

Files:

• Core.pas (modified) (1 diff)
• Forms/FormClient.pas (modified) (3 diffs)
• Forms/FormMain.lfm (modified) (6 diffs)
• Forms/FormMain.pas (modified) (5 diffs)
• Game.pas (modified) (6 diffs)
• Packages/PinConnection/CommThread.pas (modified) (8 diffs)

trunk/Core.pas

@@ -213 +213 @@
   ThemeManager1.Theme := ThemeManager1.Themes.FindByName(String(XmlConfig1.GetValue('Theme', 'System')));
   LastOpenedList1.LoadFromXMLConfig(XMLConfig1, 'RecentFiles');
-  DevelMode := XMLConfig1.GetValue('DevelMode', false);
+  DevelMode := XMLConfig1.GetValue('DevelMode', False);
   AnimationSpeed := XMLConfig1.GetValue('AnimationSpeed', 50);
   Translator1.Language := Translator1.Languages.SearchByCode(String(XMLConfig1.GetValue('Language', '')));

trunk/Forms/FormClient.pas

@@ -320 +320 @@
   if RedrawPending and not Drawing then begin
     Drawing := True;
-    if not Core.Core.DevelMode then RedrawPending := False;
+    RedrawPending := False;
+    Timer1.Enabled := False;
     TimerPeriod := (9 * TimerPeriod + (Now - LastTimerTime)) / 10;
     LastTimerTime := Now;
@@ -358 +359 @@
 begin
   Redraw;
+  Core.Core.FormMain.UpdateInterface;
 end;
 
@@ -421 +423 @@
 begin
   RedrawPending := True;
+  Timer1.Enabled := True;
 end;
 

trunk/Forms/FormMain.lfm

@@ -1 +1 @@
 object FormMain: TFormMain
   Left = 534
-  Height = 959
+  Height = 925
   Top = 223
   Width = 1491
   Caption = 'xTactics'
-  ClientHeight = 959
+  ClientHeight = 925
   ClientWidth = 1491
   DesignTimePPI = 144
@@ -97 +97 @@
   object PanelMain: TPanel
     Left = 0
-    Height = 919
+    Height = 885
     Top = 40
     Width = 1491
@@ -107 +107 @@
   object MainMenu1: TMainMenu
     Images = Core.ImageListSmall
-    Left = 224
-    Top = 48
+    Left = 88
+    Top = 112
     object MenuItem1: TMenuItem
       Caption = 'Game'
@@ -233 +233 @@
     end
   end
-  object Timer1: TTimer
-    Interval = 20
-    OnTimer = Timer1Timer
-    Left = 128
-    Top = 263
-  end
   object ActionList1: TActionList
     Images = Core.ImageListSmall
-    Left = 280
-    Top = 152
+    Left = 88
+    Top = 184
     object AToolBarBigIcons: TAction
       Caption = 'Toolbar big icons'
@@ -265 +259 @@
   end
   object PopupMenuToolbar: TPopupMenu
-    Left = 452
-    Top = 98
+    Left = 432
+    Top = 112
     object MenuItem18: TMenuItem
       Action = AToolBarBigIcons
@@ -272 +266 @@
   end
   object PopupMenuOpenRecent: TPopupMenu
-    Left = 448
-    Top = 251
+    Left = 432
+    Top = 184
   end
 end

trunk/Forms/FormMain.pas

@@ -67 +67 @@
     PopupMenuToolbar: TPopupMenu;
     Separator1: TMenuItem;
-    Timer1: TTimer;
     ToolBar1: TToolBar;
     ToolButton1: TToolButton;
@@ -94 +93 @@
     procedure FormDestroy(Sender: TObject);
     procedure EraseBackground(DC: HDC); override;
-    procedure Timer1Timer(Sender: TObject);
   private
     FormActivated: Boolean;
@@ -106 +104 @@
     FormUnitMoves: TFormUnitMoves;
     FormCharts: TFormCharts;
+    procedure UpdateInterface;
     procedure LoadConfig(Config: TXmlConfig; Path: string);
     procedure SaveConfig(Config: TXmlConfig; Path: string);
@@ -128 +127 @@
 begin
   // Do nothing, all background space covered by controls
-end;
-
-procedure TFormMain.Timer1Timer(Sender: TObject);
-var
-  NewCaption: string;
-begin
-  NewCaption := 'xTactics';
-  if Assigned(Core.Core.Game.CurrentPlayer) then
-    NewCaption := Core.Core.Game.CurrentPlayer.Name + ' - ' + STurn + ' ' +
-    IntToStr(Core.Core.Game.TurnCounter) + ' - ' + NewCaption;
-  Caption := NewCaption;
 end;
 
@@ -311 +299 @@
 end;
 
+procedure TFormMain.UpdateInterface;
+var
+  NewCaption: string;
+begin
+  NewCaption := 'xTactics';
+  if Assigned(Core.Core.Game.CurrentPlayer) then
+    NewCaption := Core.Core.Game.CurrentPlayer.Name + ' - ' + STurn + ' ' +
+    IntToStr(Core.Core.Game.TurnCounter) + ' - ' + NewCaption;
+  Caption := NewCaption;
+end;
+
 procedure TFormMain.FormShow(Sender: TObject);
 begin

trunk/Game.pas

@@ -59 +59 @@
     procedure WinObjectiveMapPrepare;
     procedure BuildCity(Cell: TCell);
+    procedure DoChange;
   public
     GameSystem: TGameSystem;
@@ -510 +511 @@
 end;
 
+procedure TGame.DoChange;
+begin
+  if Assigned(FOnChange) then
+    FOnChange(Self);
+end;
+
 procedure TGame.Assign(Source: TGame);
 begin
@@ -678 +685 @@
     FreeAndNil(Doc);
   end;
+  DoChange;
 end;
 
@@ -851 +859 @@
   CurrentPlayer.RemoveInvalidMoves;
   CurrentPlayer.InitUnitMoves;
-  if Assigned(FOnChange) then
-    FOnChange(Self);
+  DoChange;
 end;
 
@@ -1009 +1016 @@
 
   ComputePlayerStats;
+  DoChange;
 end;
 
@@ -1015 +1023 @@
   Running := False;
   if Assigned(OnWin) then OnWin(Winner);
+  DoChange;
 end;
 

trunk/Packages/PinConnection/CommThread.pas

@@ -12 +12 @@
   TReceiveDataEvent = procedure(Stream: TMemoryStream) of object;
 
-  { TCommThreadReceiveThread }
-
-  TCommThreadReceiveThread = class(TTermThread)
+  { TCommThreadReceiveDataThread }
+
+  TCommThreadReceiveDataThread = class(TTermThread)
   public
     Parent: TCommThread;
@@ -24 +24 @@
   end;
 
+  { TCommThreadReceiveStatusThread }
+
+  TCommThreadReceiveStatusThread = class(TTermThread)
+  public
+    Parent: TCommThread;
+    Stream: TBinarySerializer;
+    procedure Execute; override;
+    constructor Create(CreateSuspended: Boolean;
+      const StackSize: SizeUInt = DefaultStackSize);
+    destructor Destroy; override;
+  end;
+
   { TCommThread }
 
@@ -29 +41 @@
   private
     //FOnReceiveData: TReceiveDataEvent;
-    FReceiveThread: TCommThreadReceiveThread;
+    FReceiveDataThread: TCommThreadReceiveDataThread;
+    FReceiveStatusThread: TCommThreadReceiveStatusThread;
     FInputBuffer: TBinarySerializer;
     FInputBufferLock: TCriticalSection;
@@ -91 +104 @@
 
   if AValue then begin
-    FReceiveThread := TCommThreadReceiveThread.Create(True);
-    FReceiveThread.FreeOnTerminate := False;
-    FReceiveThread.Parent := Self;
-    FReceiveThread.Name := 'CommThread';
-    FReceiveThread.Start;
+    FReceiveDataThread := TCommThreadReceiveDataThread.Create(True);
+    FReceiveDataThread.FreeOnTerminate := False;
+    FReceiveDataThread.Parent := Self;
+    FReceiveDataThread.Name := 'CommThreadData';
+    FReceiveDataThread.Start;
+
+    FReceiveStatusThread := TCommThreadReceiveStatusThread.Create(True);
+    FReceiveStatusThread.FreeOnTerminate := False;
+    FReceiveStatusThread.Parent := Self;
+    FReceiveStatusThread.Name := 'CommThreadStatus';
+    FReceiveStatusThread.Start;
   end else begin
-    FreeAndNil(FReceiveThread);
+    FreeAndNil(FReceiveDataThread);
+    FreeAndNil(FReceiveStatusThread);
   end;
   inherited;
@@ -134 +154 @@
 end;
 
-{ TCommThreadReceiveThread }
-
-procedure TCommThreadReceiveThread.Execute;
-var
-  TempStatus: Integer;
-  DoSleep: Boolean;
+{ TCommThreadReceiveDataThread }
+
+procedure TCommThreadReceiveDataThread.Execute;
 begin
   with Parent do
   repeat
-    DoSleep := True;
     // Check if new data arrived
-    if FDataAvailable.WaitFor(0) = wrSignaled then begin
-      DoSleep := False;
+    if FDataAvailable.WaitFor(100) = wrSignaled then begin
       try
         FInputBufferLock.Acquire;
@@ -157 +172 @@
       Pin.Send(Stream.List);
     end;
-
+  until Terminated;
+end;
+
+constructor TCommThreadReceiveDataThread.Create(CreateSuspended: Boolean;
+  const StackSize: SizeUInt);
+begin
+  inherited;
+  Stream := TBinarySerializer.Create;
+  Stream.List := TListByte.Create;
+  Stream.OwnsList := True;
+end;
+
+destructor TCommThreadReceiveDataThread.Destroy;
+begin
+  FreeAndNil(Stream);
+  inherited;
+end;
+
+{ TCommThreadReceiveStatusThread }
+
+procedure TCommThreadReceiveStatusThread.Execute;
+var
+  TempStatus: Integer;
+begin
+  with Parent do
+  repeat
     // Check if state changed
-    if FStatusEvent.WaitFor(0) = wrSignaled then begin
-      DoSleep := False;
+    if FStatusEvent.WaitFor(100) = wrSignaled then begin
       try
         FInputBufferLock.Acquire;
@@ -170 +209 @@
       Pin.Status := TempStatus;
     end;
-    if not Terminated and DoSleep then begin
-      Sleep(1);
-    end;
   until Terminated;
 end;
 
-constructor TCommThreadReceiveThread.Create(CreateSuspended: Boolean;
+constructor TCommThreadReceiveStatusThread.Create(CreateSuspended: Boolean;
   const StackSize: SizeUInt);
 begin
@@ -185 +221 @@
 end;
 
-destructor TCommThreadReceiveThread.Destroy;
+destructor TCommThreadReceiveStatusThread.Destroy;
 begin
   FreeAndNil(Stream);