Changeset 125 for trunk

Timestamp:

Jun 17, 2017, 2:24:51 AM (7 years ago)

Author:

chronos

Message:

• Modified: Introduced TClient class for real user accessing particular player or spectator. TPlayer is now just player in the game.
• Fixed: Exception if no human player was selected.

Location:

trunk

Files:

• Forms/UFormMain.lfm (modified) (1 diff)
• Forms/UFormMain.pas (modified) (11 diffs)
• Forms/UFormNew.pas (modified) (1 diff)
• Languages/xtactics.cs.po (modified) (3 diffs)
• UCore.pas (modified) (12 diffs)
• UGame.pas (modified) (23 diffs)
• xtactics.lpi (modified) (1 diff)

trunk/Forms/UFormMain.lfm

@@ -14 +14 @@
   OnKeyUp = FormKeyUp
   OnShow = FormShow
-  LCLVersion = '1.6.0.4'
+  LCLVersion = '1.6.4.0'
   WindowState = wsMaximized
   object StatusBar1: TStatusBar

trunk/Forms/UFormMain.pas

@@ -131 +131 @@
 begin
   DrawStart := Now;
-  if Assigned(Core.Player) then
-  with Core.Player do begin
+  if Assigned(Core.CurrentClient) then
+  with Core.CurrentClient do begin
     View.DestRect := Bounds(0, 0, PaintBox1.Width, PaintBox1.Height);
     if csOpaque in PaintBox1.ControlStyle then begin
@@ -138 +138 @@
       TempBitmap.Canvas.Brush.Color := clBackground; //PaintBox1.GetColorResolvingParent;
       TempBitmap.Canvas.FillRect(0, 0, PaintBox1.Width, PaintBox1.Height);
-      Paint(TempBitmap.Canvas);
+      if Assigned(ControlPlayer) then ControlPlayer.Paint(TempBitmap.Canvas, View)
+        else Core.Game.Map.Paint(TempBitmap.Canvas, View);
       PaintBox1.Canvas.Draw(0, 0, TempBitmap);
     end else begin
@@ -145 +146 @@
       PaintBox1.Canvas.FillRect(0, 0, PaintBox1.Width, PaintBox1.Height);
       {$endif}
-      Paint(PaintBox1.Canvas);
+      if Assigned(ControlPlayer) then ControlPlayer.Paint(PaintBox1.Canvas, View)
+        else Core.Game.Map.Paint(PaintBox1.Canvas, View);
     end;
   end;
@@ -158 +160 @@
 procedure TFormMain.PaintBox1Resize(Sender: TObject);
 begin
-  if Assigned(Core.Player) then
-  with Core.Player do
+  if Assigned(Core.CurrentClient) then
+  with Core.CurrentClient do
     View.DestRect := Bounds(0, 0, PaintBox1.Width, PaintBox1.Height);
   Redraw;
@@ -251 +253 @@
   NewZoom: Single;
 begin
-  with Core, Game, Player, View do begin
+  with Core, Game, CurrentClient, View do begin
     MapRect := Map.GetPixelRect;
     Factor := FloatPoint((DestRect.Right - DestRect.Left) / (MapRect.Right - MapRect.Left),
@@ -284 +286 @@
 procedure TFormMain.AZoomInExecute(Sender: TObject);
 begin
-  with Core.Player do begin
+  with Core.CurrentClient do begin
     View.Zoom := View.Zoom * ZoomFactor;
   end;
@@ -294 +296 @@
   D: TPoint;
 begin
-  with Core.Player do begin
+  with Core.CurrentClient do begin
     //D := Point(Trunc(MousePos.X - View.Left / ViewZoom),
     //  Trunc(MousePos.Y - View.Top / ViewZoom));
@@ -323 +325 @@
   if (Key = 27) or (Key = 17) then
   if Assigned(Core.Game.CurrentPlayer) then begin
-    Core.Game.CurrentPlayer.View.SelectedCell := nil;
+    Core.CurrentClient.View.SelectedCell := nil;
     Redraw;
   end;
@@ -341 +343 @@
 begin
   if Button = mbLeft then begin
-    if Core.Game.CurrentPlayer.Mode = pmHuman then begin
+    if Assigned(Core.CurrentClient) then begin
       StartMousePoint := Point(X, Y);
-      StartViewPoint := Core.Game.CurrentPlayer.View.SourceRect.TopLeft;
+      StartViewPoint := Core.CurrentClient.View.SourceRect.TopLeft;
       MoveActive := True;
     end;
@@ -361 +363 @@
   CellPos: TPoint;
 begin
-  if Assigned(Core.Game.CurrentPlayer) then begin
+  if Assigned(Core.CurrentClient) then begin
     if MoveActive then
     if (Abs(StartMousePoint.X - X) > Trunc(Screen.PixelsPerInch * MouseMinDiff)) or
     (Abs(StartMousePoint.Y - Y) > Trunc(Screen.PixelsPerInch * MouseMinDiff)) then
-    with Core.Game.CurrentPlayer do begin
-      if Mode = pmHuman then begin
-        View.SourceRect := Bounds(Trunc(StartViewPoint.X + (StartMousePoint.X - X) / View.Zoom),
-          Trunc(StartViewPoint.Y + (StartMousePoint.Y - Y) / View.Zoom),
-          View.SourceRect.Right - View.SourceRect.Left,
-          View.SourceRect.Bottom - View.SourceRect.Top);
-        Redraw;
-      end;
+    with Core.Game.CurrentPlayer, Core.CurrentClient do begin
+      View.SourceRect := Bounds(Trunc(StartViewPoint.X + (StartMousePoint.X - X) / View.Zoom),
+        Trunc(StartViewPoint.Y + (StartMousePoint.Y - Y) / View.Zoom),
+        View.SourceRect.Right - View.SourceRect.Left,
+        View.SourceRect.Bottom - View.SourceRect.Top);
+      Redraw;
     end;
     Cell := nil;
-    OldCell := Core.Game.CurrentPlayer.View.FocusedCell;
+    OldCell := Core.CurrentClient.View.FocusedCell;
     with Core.Game do
-      Cell := Map.PosToCell(CurrentPlayer.View.CanvasToCellPos(Point(X, Y)), CurrentPlayer.View );
+      Cell := Map.PosToCell(Core.CurrentClient.View.CanvasToCellPos(Point(X, Y)), Core.CurrentClient.View );
     if Assigned(Cell) then begin
-      Core.Game.CurrentPlayer.View.FocusedCell := Cell;
+      Core.CurrentClient.View.FocusedCell := Cell;
       StatusBar1.Panels[0].Text := '[' + IntToStr(Cell.PosPx.X) + ', ' + IntToStr(Cell.PosPx.Y) +
         '] (' + IntToStr(Cell.MovesFrom.Count) + ', ' + IntToStr(Cell.MovesTo.Count) + ')';
     end else begin
-      Core.Game.CurrentPlayer.View.FocusedCell := nil;
+      Core.CurrentClient.View.FocusedCell := nil;
       StatusBar1.Panels[0].Text := '';
     end;
-    CellPos := Core.Game.CurrentPlayer.View.CanvasToCellPos(Point(X, Y));
+    CellPos := Core.CurrentClient.View.CanvasToCellPos(Point(X, Y));
     StatusBar1.Panels[2].Text := 'CellPos: ' + IntToStr(CellPos.X) + ', ' + IntToStr(CellPos.Y);
     if Cell <> OldCell then Redraw;
@@ -398 +398 @@
   (Abs(StartMousePoint.Y - Y) < Trunc(Screen.PixelsPerInch * MouseMinDiff)) then begin
     if Core.Game.Running and (Core.Game.CurrentPlayer.Mode = pmHuman) then begin
-      Core.Game.CurrentPlayer.View.SelectCell(Point(X, Y), Core.Game.CurrentPlayer, Shift);
+      Core.CurrentClient.View.SelectCell(Point(X, Y), Core.Game.CurrentPlayer, Shift);
       Redraw;
     end;

trunk/Forms/UFormNew.pas

@@ -241 +241 @@
   ReloadView;
   //Height := Trunc(1.5 * Height);
+  PageControl1.TabIndex := 0;
 end;
 

trunk/Languages/xtactics.cs.po

@@ -104 +104 @@
 
 #: tformabout.labelcontent.caption
-#, fuzzy
 msgctxt "tformabout.labelcontent.caption"
 msgid "   "
@@ -480 +479 @@
 #: uformabout.slicense
 msgid "License"
-msgstr ""
+msgstr "Licence"
 
 #: uformabout.sreleasedate
@@ -618 +617 @@
 msgid "Zero zoom not allowed"
 msgstr "Nulové přiblížení není povoleno"
-

trunk/UCore.pas

@@ -52 +52 @@
     StoredDimension: TControlDimension;
     RegistryContext: TRegistryContext;
+    procedure DoPlayerChange(Sender: TObject);
     procedure DoOnMove(CellFrom, CellTo: TCell; var CountOnce,
       CountRepeat: Integer; Update: Boolean; var Confirm: Boolean);
@@ -58 +59 @@
     procedure GameNewTurnExecute(Sender: TObject);
     procedure AutoSave;
+    function GetPlayer: TPlayer;
     procedure LoadConfig;
     procedure SaveConfig;
     procedure CommandLineParams;
     procedure ScaleDPI;
+    procedure SelectClient;
   public
     Game: TGame;
-    Player: TPlayer;
     UseSingleView: Boolean;
     DevelMode: Boolean;
@@ -70 +72 @@
     AnimationSpeed: Integer;
     AutoSaveEnabled: Boolean;
+    CurrentClient: TClient;
     procedure UpdateActions;
     procedure Init;
@@ -160 +163 @@
 end;
 
+function TCore.GetPlayer: TPlayer;
+begin
+  Result := Game.CurrentPlayer;
+end;
+
 procedure TCore.LoadConfig;
 begin
@@ -196 +204 @@
     if FileExists(FileName) then begin
       Game.LoadFromFile(FileName);
-      Player := Game.Players.GetFirstHuman;
+      SelectClient;
       LastMapFileName := OpenDialog1.FileName;
-      with Core.Game.CurrentPlayer do
+      with Core.CurrentClient do
         View.DestRect := Bounds(0, 0, FormMain.PaintBox1.Width, FormMain.PaintBox1.Height);
       FormMain.AZoomAll.Execute;
@@ -226 +234 @@
   end;
   {$endif}
+end;
+
+procedure TCore.SelectClient;
+var
+  FirstHuman: TPlayer;
+begin
+  FirstHuman := Game.Players.GetFirstHuman;
+  if Assigned(FirstHuman) then CurrentClient := FirstHuman.Client
+    else CurrentClient := TClient(Game.Clients.First);
 end;
 
@@ -289 +306 @@
   if OpenDialog1.Execute then begin
     Game.LoadFromFile(OpenDialog1.FileName);
-    Player := Game.Players.GetFirstHuman;
+    SelectClient;
     LastMapFileName := OpenDialog1.FileName;
-    with Core.Game.CurrentPlayer do
+    with Core.CurrentClient do
       View.DestRect := Bounds(0, 0, FormMain.PaintBox1.Width, FormMain.PaintBox1.Height);
     FormMain.AZoomAll.Execute;
@@ -304 +321 @@
     FormNew.Save(Game);
     Game.New;
-    Player := Game.Players.GetFirstHuman;
+    SelectClient;
     Game.Running := True;
     FormMain.AZoomAll.Execute;
@@ -365 +382 @@
   Game.OnWin := DoOnWin;
   Game.OnNewTurn := GameNewTurnExecute;
+  Game.OnPlayerChange := DoPlayerChange;
   StoredDimension := TControlDimension.Create;
   XMLConfig1.Filename := GetAppConfigDir(False) + 'Config.xml';
@@ -376 +394 @@
   SaveConfig;
   FreeAndNil(Game);
+end;
+
+procedure TCore.DoPlayerChange(Sender: TObject);
+begin
+  if Assigned(Game.CurrentPlayer) and Assigned(Game.CurrentPlayer.Client) then
+    CurrentClient := Game.CurrentPlayer.Client;
 end;
 
@@ -389 +413 @@
   FInitialized := True;
   LoadConfig;
-  for I := 0 to Game.Players.Count - 1 do
-    TPlayer(Game.Players[I]).View.DestRect := Rect(0, 0, FormMain.PaintBox1.Width,
+  for I := 0 to Game.Clients.Count - 1 do
+    TClient(Game.Clients[I]).View.DestRect := Rect(0, 0, FormMain.PaintBox1.Width,
       FormMain.PaintBox1.Height);
   Game.LoadConfig(XMLConfig1, 'Game');
@@ -399 +423 @@
   if Game.FileName = '' then begin
     Game.New;
-    Player := Game.Players.GetFirstHuman;
+    SelectClient;
     Game.Running := True;
     FormMain.AZoomAll.Execute;

trunk/UGame.pas

@@ -28 +28 @@
   TCellLinks = class;
   TMapArea = class;
+  TClient = class;
 
   TFloatPoint = record
@@ -248 +249 @@
   TPlayer = class
   private
+    FClient: TClient;
     FGame: TGame;
+    procedure SetClient(AValue: TClient);
     procedure SetGame(AValue: TGame);
   public
@@ -254 +257 @@
     Name: string;
     Color: TColor;
-    View: TView;
     Mode: TPlayerMode;
     TotalUnits: Integer;
@@ -266 +268 @@
     procedure LoadFromNode(Node: TDOMNode);
     procedure SaveToNode(Node: TDOMNode);
-    procedure Paint(Canvas: TCanvas);
+    procedure Paint(Canvas: TCanvas; View: TView);
     constructor Create;
     destructor Destroy; override;
     procedure Assign(Source: TPlayer);
     property Game: TGame read FGame write SetGame;
+    property Client: TClient read FClient write SetClient;
   end;
 
@@ -333 +336 @@
   end;
 
+  { TClient }
+
+  TClient = class
+  private
+    FGame: TGame;
+    FControlPlayer: TPlayer;
+    procedure SetControlPlayer(AValue: TPlayer);
+    procedure SetGame(AValue: TGame);
+  public
+    Name: string;
+    View: TView;
+    constructor Create;
+    destructor Destroy; override;
+    property ControlPlayer: TPlayer read FControlPlayer write SetControlPlayer;
+    property Game: TGame read FGame write SetGame;
+  end;
+
+  { TClients }
+
+  TClients = class(TObjectList)
+    Game: TGame;
+    procedure New(Name: string);
+  end;
+
   { TGame }
 
@@ -349 +376 @@
     FOnMove: TMoveEvent;
     FOnNewTurn: TNotifyEvent;
+    FOnPlayerChange: TNotifyEvent;
     FOnWin: TWinEvent;
     FRunning: Boolean;
@@ -367 +395 @@
   public
     Players: TPlayers;
+    Clients: TClients;
     Map: TMap;
     MapImageFileName: string;
@@ -406 +435 @@
     property OnWin: TWinEvent read FOnWin write FOnWin;
     property OnNewTurn: TNotifyEvent read FOnNewTurn write FOnNewTurn;
+    property OnPlayerChange: TNotifyEvent read FOnPlayerChange write FOnPlayerChange;
   end;
 
@@ -509 +539 @@
     ((((Color shr 16) and $ff) shr 1) shl 16) or
     ((((Color shr 24) and $ff) shr 0) shl 24);
+end;
+
+{ TClients }
+
+procedure TClients.New(Name: string);
+var
+  NewClient: TClient;
+begin
+  NewClient := TClient.Create;
+  NewClient.Game := Game;
+  NewClient.Name := Name;
+  Add(NewClient);
+end;
+
+{ TClient }
+
+procedure TClient.SetGame(AValue: TGame);
+begin
+  if FGame = AValue then Exit;
+  FGame := AValue;
+  View.Game := AValue;
+end;
+
+procedure TClient.SetControlPlayer(AValue: TPlayer);
+begin
+  if FControlPlayer = AValue then Exit;
+  if Assigned(FControlPlayer) then
+    FControlPlayer.FClient := nil;
+  FControlPlayer := AValue;
+  if Assigned(FControlPlayer) then
+     FControlPlayer.FClient := Self;
+end;
+
+constructor TClient.Create;
+begin
+  View := TView.Create;
+end;
+
+destructor TClient.Destroy;
+begin
+  ControlPlayer := nil;
+  FreeAndNil(View);
+  inherited Destroy;
 end;
 
@@ -1740 +1813 @@
   if FGame = AValue then Exit;
   FGame := AValue;
-  View.Game := Game;
+end;
+
+procedure TPlayer.SetClient(AValue: TClient);
+begin
+  if FClient=AValue then Exit;
+  if Assigned(FClient) then FClient.FControlPlayer := nil;
+  FClient := AValue;
+  if Assigned(FClient) then FClient.FControlPlayer := Self;
 end;
 
@@ -2146 +2226 @@
 end;
 
-procedure TPlayer.Paint(Canvas: TCanvas);
+procedure TPlayer.Paint(Canvas: TCanvas; View: TView);
 begin
   PlayerMap.Paint(Canvas, View);
@@ -2153 +2233 @@
 constructor TPlayer.Create;
 begin
-  View := TView.Create;
   StartUnits := DefaultPlayerStartUnits;
   StartCell := nil;
@@ -2163 +2242 @@
 begin
   FreeAndNil(PlayerMap);
-  FreeAndNil(View);
   inherited Destroy;
 end;
@@ -2180 +2258 @@
   Agressivity := Source.Agressivity;
   Defensive := Source.Defensive;
-  View.Assign(Source.View);
 end;
 
@@ -2432 +2509 @@
   end else begin
     FRunning := AValue;
-    for I := 0 to Players.Count - 1 do
-    with TPlayer(Players[I]) do begin
+    for I := 0 to Clients.Count - 1 do
+    with TClient(Clients[I]) do begin
       View.Clear;
     end;
@@ -2811 +2888 @@
   PrevPlayer: TPlayer;
 begin
-  CurrentPlayer.View.SelectedCell := nil;
+  //TODO CurrentPlayer.View.SelectedCell := nil;
   MoveAll(CurrentPlayer);
   Map.Grow(CurrentPlayer);
@@ -2820 +2897 @@
   repeat
     CurrentPlayer := TPlayer(Players[(Players.IndexOf(CurrentPlayer) + 1) mod Players.Count]);
+    if Assigned(FOnPlayerChange) then
+      FOnPlayerChange(Self);
   until CurrentPlayer.TotalCells > 0;
   if Players.IndexOf(CurrentPlayer) < Players.IndexOf(PrevPlayer) then begin
@@ -2870 +2949 @@
   Players := TPlayers.Create;
   Players.Game := Self;
+  Clients := TClients.Create;
+  Clients.Game := Self;
 
   MapImageFileName := 'Images/Maps/WorldMap.png';
@@ -2887 +2968 @@
 destructor TGame.Destroy;
 begin
+  FreeAndNil(Clients);
   FreeAndNil(Moves);
   FreeAndNil(Players);
@@ -2918 +3000 @@
   end;
 
-
   if SymetricMap then begin
     for C := 0 to (Map.Cells.Count div 2) - 1 do begin
@@ -2931 +3012 @@
   with TPlayer(Players[I]) do begin
     PlayerMap.Update;
-    View.Clear;
     if (Map.Size.X > 0) and (Map.Size.Y > 0) then begin
       // Try to obtain start cell for each player
@@ -2950 +3030 @@
       StartCell.Power := TPlayer(Players[I]).StartUnits;
     end;
+    PlayerMap.CheckVisibility;
+  end;
+  if Players.Count > 0 then CurrentPlayer := TPlayer(Players[0])
+    else CurrentPlayer := nil;
+
+  Clients.Clear;
+  Clients.New('Spectator');
+  for I := 0 to Players.Count - 1 do
+  with TPlayer(Players[I]) do
+  if Mode = pmHuman then begin
+    Clients.New(TPlayer(Players[I]).Name);
+    TPlayer(Players[I]).Client := TClient(Clients.Last);
+  end;
+
+  for I := 0 to Clients.Count - 1 do
+  with TClient(Clients[I]) do begin
+    View.Clear;
     View.Zoom := 1;
     View.CenterMap;
-    PlayerMap.CheckVisibility;
-  end;
-  if Players.Count > 0 then CurrentPlayer := TPlayer(Players[0])
-    else CurrentPlayer := nil;
+  end;
 end;
 
@@ -2985 +3079 @@
     with TCellLink(CellLinks[C]) do begin
       if Length(Points) >= 2 then begin
-        MoveTo(Points[0]);
+        MoveTo(View.CellToCanvasPos(Points[0]));
         for I := 1 to Length(Points) - 1 do
-          LineTo(Points[I]);
+          LineTo(View.CellToCanvasPos(Points[I]));
       end;
     end;

trunk/xtactics.lpi

@@ -2 +2 @@
 <CONFIG>
   <ProjectOptions>
-    <Version Value="9"/>
+    <Version Value="10"/>
     <General>
       <SessionStorage Value="InProjectDir"/>