Changeset 211 for trunk

Timestamp:

May 23, 2018, 8:53:58 PM (7 years ago)

Author:

chronos

Message:

• Modified: Each client form is redrawn by itself, not by Core.

Location:

trunk

Files:

• Forms/UFormClient.lfm (modified) (4 diffs)
• Forms/UFormClient.pas (modified) (4 diffs)
• UCore.lfm (modified) (5 diffs)
• UCore.pas (modified) (8 diffs)
• UGame.pas (modified) (1 diff)
• UGameClient.pas (modified) (5 diffs)
• UGameServer.pas (modified) (4 diffs)

trunk/Forms/UFormClient.lfm

@@ -7 +7 @@
   ClientHeight = 621
   ClientWidth = 775
-  DesignTimePPI = 120
+  DesignTimePPI = 144
   OnClose = FormClose
   OnCreate = FormCreate
@@ -17 +17 @@
   object StatusBar1: TStatusBar
     Left = 0
-    Height = 28
-    Top = 593
+    Height = 30
+    Top = 591
     Width = 775
     Panels = <    
@@ -34 +34 @@
   object ToolBar1: TToolBar
     Left = 0
-    Height = 593
+    Height = 591
     Top = 0
     Width = 32
@@ -75 +75 @@
   object PaintBox1: TPaintBox
     Left = 32
-    Height = 593
+    Height = 591
     Top = 0
     Width = 743

trunk/Forms/UFormClient.pas

@@ -79 +79 @@
     procedure SetClient(AValue: TClient);
     procedure DoClientChange(Sender: TObject);
+    procedure DoGameEnd(Sender: TObject);
     procedure DoTurnStart(Sender: TObject);
     procedure DoMove(CellFrom, CellTo: TCell; var CountOnce,
@@ -231 +232 @@
     FClient.OnTurnStart := DoTurnStart;
     FClient.OnDestroy := DoClientDestroy;
+    FClient.OnGameEnd := DoGameEnd;
     FClient.View.DestRect := TRect.CreateBounds(TPoint.Create(0, 0), TPoint.Create(PaintBox1.Width, PaintBox1.Height));
   end;
@@ -237 +239 @@
 
 procedure TFormClient.DoClientChange(Sender: TObject);
+begin
+  Redraw;
+end;
+
+procedure TFormClient.DoGameEnd(Sender: TObject);
 begin
   Redraw;
@@ -245 +252 @@
   TurnActive := True;
   Synchronize(UpdateInterface);
+  Synchronize(Redraw);
 end;
 

trunk/UCore.lfm

@@ -3 +3 @@
   OnDestroy = DataModuleDestroy
   OldCreateOrder = False
-  Height = 676
-  HorizontalOffset = 262
-  VerticalOffset = 203
-  Width = 1048
-  PPI = 120
+  Height = 811
+  HorizontalOffset = 314
+  VerticalOffset = 244
+  Width = 1258
+  PPI = 144
   object ActionListMain: TActionList
     Images = ImageListSmall
-    left = 114
-    top = 50
+    left = 137
+    top = 60
     object AExit: TAction
       Caption = 'Exit'
@@ -101 +101 @@
   end
   object ImageListSmall: TImageList
-    left = 655
-    top = 350
+    left = 786
+    top = 420
     Bitmap = {
       4C690C00000010000000100000000000000000000000E3AA4BD6E5B35EFFE3B1
@@ -494 +494 @@
     POFilesFolder = 'Languages'
     OnTranslate = CoolTranslator1Translate
-    left = 114
-    top = 363
+    left = 137
+    top = 436
   end
   object ImageListLarge: TImageList
     Height = 32
     Width = 32
-    left = 655
-    top = 238
+    left = 786
+    top = 286
     Bitmap = {
       4C690C0000002000000020000000000000000000000000000000E2AA4B36E2A9
@@ -2046 +2046 @@
     RootName = 'CONFIG'
     ReadOnly = False
-    left = 114
-    top = 463
+    left = 137
+    top = 556
   end
   object OpenDialog1: TOpenDialog
     DefaultExt = '.xtmap'
-    left = 938
-    top = 243
+    left = 1126
+    top = 292
   end
   object SaveDialog1: TSaveDialog
     DefaultExt = '.xtmap'
-    left = 938
-    top = 138
+    left = 1126
+    top = 166
   end
   object ApplicationInfo: TApplicationInfo
@@ -2074 +2074 @@
     RegistryRoot = rrKeyCurrentUser
     License = 'CC0'
-    left = 114
-    top = 150
+    left = 137
+    top = 180
   end
   object PersistentForm: TPersistentForm
     MinVisiblePart = 50
     EntireVisible = False
-    left = 650
-    top = 500
+    left = 780
+    top = 600
   end
   object ScaleDPI1: TScaleDPI
     AutoDetect = False
-    left = 113
-    top = 563
+    left = 136
+    top = 676
   end
   object LastOpenedList1: TLastOpenedList
     MaxCount = 10
     OnChange = LastOpenedList1Change
-    left = 114
-    top = 250
+    left = 137
+    top = 300
   end
 end

trunk/UCore.pas

@@ -70 +70 @@
     procedure LoadRecentExecute(Sender: TObject);
     procedure StartNewGame;
+    procedure LoadGame(FileName: string);
     procedure DoPlayerChange(Sender: TObject);
     procedure DoMoveUpdated(UnitMove: TUnitMove);
@@ -78 +79 @@
     procedure CommandLineParams;
     procedure SelectClient;
-    procedure LoadGame(FileName: string);
-    procedure RedrawClients;
     procedure UpdateOtherForms;
     procedure FormClientActions;
@@ -139 +138 @@
   I: Integer;
 begin
-  RedrawClients;
+  Server.GameEnd;
   if Assigned(Player) then
     ShowMessage(Format(SPlayerWins, [Player.Name]))
@@ -276 +275 @@
   if MessageDlg(SEndGame, SEndGameQuestion, mtConfirmation, mbYesNo, 0) = mrYes then begin
     Game.Running := False;
-    RedrawClients;
+    Server.GameEnd;
     UpdateActions;
   end;
@@ -489 +488 @@
       TPoint.Create(FormClient.PaintBox1.Width, FormClient.PaintBox1.Height));
   FormClient.AZoomAll.Execute;
-  RedrawClients;
   UpdateOtherForms;
   UpdateActions;
@@ -495 +493 @@
   if Assigned(ServerClient) then ServerClient.TurnStart
     else raise Exception.Create(SMissingServerClientForPlayer);
-end;
-
-procedure TCore.RedrawClients;
-var
-  Form: TFormClient;
-begin
-  for Form in FormClients do
-    Form.Redraw;
-  FormClient.Redraw;
 end;
 
@@ -579 +568 @@
   if Game.Players.GetAliveCount = Game.Players.Count then Game.Running := True
     else ShowMessage(Format(SPlayersNotInitialized, [Game.Players.Count, Game.Players.GetAliveCount]));
-  FormClient.AZoomAll.Execute;
-  RedrawClients;
   UpdateOtherForms;
   UpdateActions;
@@ -594 +581 @@
 begin
   if Assigned(Game.CurrentPlayer) then begin
-    PlayerClient := LocalClients.SearchPlayer(Game.CurrentPlayer);
-    if Assigned(PlayerClient) then FormClient.Client := PlayerClient;
+    if Game.CurrentPlayer.Mode = pmHuman then begin
+      PlayerClient := LocalClients.SearchPlayer(Game.CurrentPlayer);
+      if Assigned(PlayerClient) then FormClient.Client := PlayerClient;
+    end;
 
     ServerClient := Server.Clients.SearchByPlayer(Game.CurrentPlayer);

trunk/UGame.pas

@@ -3176 +3176 @@
   // Select new player from alive players
   AlivePlayers := TPlayers.Create(False);
-  Players.GetAlivePlayers(AlivePlayers);
-  NewPlayerIndex := AlivePlayers.IndexOf(CurrentPlayer) + 1;
-  if NewPlayerIndex >= AlivePlayers.Count then begin
-    // Start of turn
-    Inc(TurnCounter);
-    RecordTurnStats;
-    if Assigned(FOnNewTurn) then
-      FOnNewTurn(Self);
-    NewPlayerIndex := NewPlayerIndex mod AlivePlayers.Count;
-  end;
-  CurrentPlayer := AlivePlayers[NewPlayerIndex];
+  try
+    Players.GetAlivePlayers(AlivePlayers);
+    NewPlayerIndex := AlivePlayers.IndexOf(CurrentPlayer) + 1;
+    if NewPlayerIndex >= AlivePlayers.Count then begin
+      // Start of turn
+      Inc(TurnCounter);
+      RecordTurnStats;
+      if Assigned(FOnNewTurn) then
+        FOnNewTurn(Self);
+      NewPlayerIndex := NewPlayerIndex mod AlivePlayers.Count;
+    end;
+    CurrentPlayer := AlivePlayers[NewPlayerIndex];
+  finally
+    AlivePlayers.Free;
+  end;
 
   if Assigned(FOnPlayerChange) then

trunk/UGameClient.pas

@@ -21 +21 @@
     FOnChange: TNotifyEvent;
     FOnDestroy: TNotifyEvent;
+    FOnGameEnd: TNotifyEvent;
     FOnReceive: TCommandEvent;
     FOnMove: TMoveEvent;
@@ -35 +36 @@
     procedure ReceiveCmd(Command: TCommand; DataOut, DataIn: TStream); virtual;
     procedure DoTurnStart(Sender: TObject); virtual;
+    procedure DoGameEnd(Sender: TObject);
   public
     Name: string;
@@ -54 +56 @@
     property OnChange: TNotifyEvent read FOnChange write FOnChange;
     property OnTurnStart: TNotifyEvent read FOnTurnStart write FOnTurnStart;
+    property OnGameEnd: TNotifyEvent read FOnGameEnd write FOnGameEnd;
     property Active: Boolean read FActive write SetActive;
   end;
@@ -134 +137 @@
   if Assigned(FOnTurnStart) then
     FOnTurnStart(Self);
+end;
+
+procedure TClient.DoGameEnd(Sender: TObject);
+begin
+  if Assigned(FOnGameEnd) then
+    FOnGameEnd(Self);
 end;
 
@@ -191 +200 @@
   Protocol := TGameProtocolClient.Create;
   Protocol.OnTurnStart := DoTurnStart;
+  Protocol.OnGameEnd := DoGameEnd;
 end;
 

trunk/UGameServer.pas

@@ -25 +25 @@
     procedure SendCmd(Command: TCommand; DataOut, DataIn: TStream);
     procedure TurnStart;
+    procedure GameEnd;
     property OnReceiveCmd: TCommandEvent read FOnReceiveCmd write
       FOnReceiveCmd;
@@ -60 +61 @@
     procedure SaveConfig(Config: TXmlConfig; Path: string);
     procedure InitClients;
+    procedure GameEnd;
     procedure Clear;
     constructor Create;
@@ -100 +102 @@
 begin
   Protocol.TurnStart;
+end;
+
+procedure TServerClient.GameEnd;
+begin
+  Protocol.GameEnd;
 end;
 
@@ -234 +241 @@
 end;
 
+procedure TServer.GameEnd;
+var
+  I: Integer;
+begin
+  for I := 0 to Clients.Count - 1 do
+    Clients[I].GameEnd;
+end;
+
 procedure TServer.Clear;
 begin