Changeset 125


Ignore:
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:
7 edited

Legend:

Unmodified
Added
Removed
  • trunk/Forms/UFormMain.lfm

    r111 r125  
    1414  OnKeyUp = FormKeyUp
    1515  OnShow = FormShow
    16   LCLVersion = '1.6.0.4'
     16  LCLVersion = '1.6.4.0'
    1717  WindowState = wsMaximized
    1818  object StatusBar1: TStatusBar
  • trunk/Forms/UFormMain.pas

    r111 r125  
    131131begin
    132132  DrawStart := Now;
    133   if Assigned(Core.Player) then
    134   with Core.Player do begin
     133  if Assigned(Core.CurrentClient) then
     134  with Core.CurrentClient do begin
    135135    View.DestRect := Bounds(0, 0, PaintBox1.Width, PaintBox1.Height);
    136136    if csOpaque in PaintBox1.ControlStyle then begin
     
    138138      TempBitmap.Canvas.Brush.Color := clBackground; //PaintBox1.GetColorResolvingParent;
    139139      TempBitmap.Canvas.FillRect(0, 0, PaintBox1.Width, PaintBox1.Height);
    140       Paint(TempBitmap.Canvas);
     140      if Assigned(ControlPlayer) then ControlPlayer.Paint(TempBitmap.Canvas, View)
     141        else Core.Game.Map.Paint(TempBitmap.Canvas, View);
    141142      PaintBox1.Canvas.Draw(0, 0, TempBitmap);
    142143    end else begin
     
    145146      PaintBox1.Canvas.FillRect(0, 0, PaintBox1.Width, PaintBox1.Height);
    146147      {$endif}
    147       Paint(PaintBox1.Canvas);
     148      if Assigned(ControlPlayer) then ControlPlayer.Paint(PaintBox1.Canvas, View)
     149        else Core.Game.Map.Paint(PaintBox1.Canvas, View);
    148150    end;
    149151  end;
     
    158160procedure TFormMain.PaintBox1Resize(Sender: TObject);
    159161begin
    160   if Assigned(Core.Player) then
    161   with Core.Player do
     162  if Assigned(Core.CurrentClient) then
     163  with Core.CurrentClient do
    162164    View.DestRect := Bounds(0, 0, PaintBox1.Width, PaintBox1.Height);
    163165  Redraw;
     
    251253  NewZoom: Single;
    252254begin
    253   with Core, Game, Player, View do begin
     255  with Core, Game, CurrentClient, View do begin
    254256    MapRect := Map.GetPixelRect;
    255257    Factor := FloatPoint((DestRect.Right - DestRect.Left) / (MapRect.Right - MapRect.Left),
     
    284286procedure TFormMain.AZoomInExecute(Sender: TObject);
    285287begin
    286   with Core.Player do begin
     288  with Core.CurrentClient do begin
    287289    View.Zoom := View.Zoom * ZoomFactor;
    288290  end;
     
    294296  D: TPoint;
    295297begin
    296   with Core.Player do begin
     298  with Core.CurrentClient do begin
    297299    //D := Point(Trunc(MousePos.X - View.Left / ViewZoom),
    298300    //  Trunc(MousePos.Y - View.Top / ViewZoom));
     
    323325  if (Key = 27) or (Key = 17) then
    324326  if Assigned(Core.Game.CurrentPlayer) then begin
    325     Core.Game.CurrentPlayer.View.SelectedCell := nil;
     327    Core.CurrentClient.View.SelectedCell := nil;
    326328    Redraw;
    327329  end;
     
    341343begin
    342344  if Button = mbLeft then begin
    343     if Core.Game.CurrentPlayer.Mode = pmHuman then begin
     345    if Assigned(Core.CurrentClient) then begin
    344346      StartMousePoint := Point(X, Y);
    345       StartViewPoint := Core.Game.CurrentPlayer.View.SourceRect.TopLeft;
     347      StartViewPoint := Core.CurrentClient.View.SourceRect.TopLeft;
    346348      MoveActive := True;
    347349    end;
     
    361363  CellPos: TPoint;
    362364begin
    363   if Assigned(Core.Game.CurrentPlayer) then begin
     365  if Assigned(Core.CurrentClient) then begin
    364366    if MoveActive then
    365367    if (Abs(StartMousePoint.X - X) > Trunc(Screen.PixelsPerInch * MouseMinDiff)) or
    366368    (Abs(StartMousePoint.Y - Y) > Trunc(Screen.PixelsPerInch * MouseMinDiff)) then
    367     with Core.Game.CurrentPlayer do begin
    368       if Mode = pmHuman then begin
    369         View.SourceRect := Bounds(Trunc(StartViewPoint.X + (StartMousePoint.X - X) / View.Zoom),
    370           Trunc(StartViewPoint.Y + (StartMousePoint.Y - Y) / View.Zoom),
    371           View.SourceRect.Right - View.SourceRect.Left,
    372           View.SourceRect.Bottom - View.SourceRect.Top);
    373         Redraw;
    374       end;
     369    with Core.Game.CurrentPlayer, Core.CurrentClient do begin
     370      View.SourceRect := Bounds(Trunc(StartViewPoint.X + (StartMousePoint.X - X) / View.Zoom),
     371        Trunc(StartViewPoint.Y + (StartMousePoint.Y - Y) / View.Zoom),
     372        View.SourceRect.Right - View.SourceRect.Left,
     373        View.SourceRect.Bottom - View.SourceRect.Top);
     374      Redraw;
    375375    end;
    376376    Cell := nil;
    377     OldCell := Core.Game.CurrentPlayer.View.FocusedCell;
     377    OldCell := Core.CurrentClient.View.FocusedCell;
    378378    with Core.Game do
    379       Cell := Map.PosToCell(CurrentPlayer.View.CanvasToCellPos(Point(X, Y)), CurrentPlayer.View );
     379      Cell := Map.PosToCell(Core.CurrentClient.View.CanvasToCellPos(Point(X, Y)), Core.CurrentClient.View );
    380380    if Assigned(Cell) then begin
    381       Core.Game.CurrentPlayer.View.FocusedCell := Cell;
     381      Core.CurrentClient.View.FocusedCell := Cell;
    382382      StatusBar1.Panels[0].Text := '[' + IntToStr(Cell.PosPx.X) + ', ' + IntToStr(Cell.PosPx.Y) +
    383383        '] (' + IntToStr(Cell.MovesFrom.Count) + ', ' + IntToStr(Cell.MovesTo.Count) + ')';
    384384    end else begin
    385       Core.Game.CurrentPlayer.View.FocusedCell := nil;
     385      Core.CurrentClient.View.FocusedCell := nil;
    386386      StatusBar1.Panels[0].Text := '';
    387387    end;
    388     CellPos := Core.Game.CurrentPlayer.View.CanvasToCellPos(Point(X, Y));
     388    CellPos := Core.CurrentClient.View.CanvasToCellPos(Point(X, Y));
    389389    StatusBar1.Panels[2].Text := 'CellPos: ' + IntToStr(CellPos.X) + ', ' + IntToStr(CellPos.Y);
    390390    if Cell <> OldCell then Redraw;
     
    398398  (Abs(StartMousePoint.Y - Y) < Trunc(Screen.PixelsPerInch * MouseMinDiff)) then begin
    399399    if Core.Game.Running and (Core.Game.CurrentPlayer.Mode = pmHuman) then begin
    400       Core.Game.CurrentPlayer.View.SelectCell(Point(X, Y), Core.Game.CurrentPlayer, Shift);
     400      Core.CurrentClient.View.SelectCell(Point(X, Y), Core.Game.CurrentPlayer, Shift);
    401401      Redraw;
    402402    end;
  • trunk/Forms/UFormNew.pas

    r102 r125  
    241241  ReloadView;
    242242  //Height := Trunc(1.5 * Height);
     243  PageControl1.TabIndex := 0;
    243244end;
    244245
  • trunk/Languages/xtactics.cs.po

    r115 r125  
    104104
    105105#: tformabout.labelcontent.caption
    106 #, fuzzy
    107106msgctxt "tformabout.labelcontent.caption"
    108107msgid "   "
     
    480479#: uformabout.slicense
    481480msgid "License"
    482 msgstr ""
     481msgstr "Licence"
    483482
    484483#: uformabout.sreleasedate
     
    618617msgid "Zero zoom not allowed"
    619618msgstr "Nulové přiblížení není povoleno"
    620 
  • trunk/UCore.pas

    r122 r125  
    5252    StoredDimension: TControlDimension;
    5353    RegistryContext: TRegistryContext;
     54    procedure DoPlayerChange(Sender: TObject);
    5455    procedure DoOnMove(CellFrom, CellTo: TCell; var CountOnce,
    5556      CountRepeat: Integer; Update: Boolean; var Confirm: Boolean);
     
    5859    procedure GameNewTurnExecute(Sender: TObject);
    5960    procedure AutoSave;
     61    function GetPlayer: TPlayer;
    6062    procedure LoadConfig;
    6163    procedure SaveConfig;
    6264    procedure CommandLineParams;
    6365    procedure ScaleDPI;
     66    procedure SelectClient;
    6467  public
    6568    Game: TGame;
    66     Player: TPlayer;
    6769    UseSingleView: Boolean;
    6870    DevelMode: Boolean;
     
    7072    AnimationSpeed: Integer;
    7173    AutoSaveEnabled: Boolean;
     74    CurrentClient: TClient;
    7275    procedure UpdateActions;
    7376    procedure Init;
     
    160163end;
    161164
     165function TCore.GetPlayer: TPlayer;
     166begin
     167  Result := Game.CurrentPlayer;
     168end;
     169
    162170procedure TCore.LoadConfig;
    163171begin
     
    196204    if FileExists(FileName) then begin
    197205      Game.LoadFromFile(FileName);
    198       Player := Game.Players.GetFirstHuman;
     206      SelectClient;
    199207      LastMapFileName := OpenDialog1.FileName;
    200       with Core.Game.CurrentPlayer do
     208      with Core.CurrentClient do
    201209        View.DestRect := Bounds(0, 0, FormMain.PaintBox1.Width, FormMain.PaintBox1.Height);
    202210      FormMain.AZoomAll.Execute;
     
    226234  end;
    227235  {$endif}
     236end;
     237
     238procedure TCore.SelectClient;
     239var
     240  FirstHuman: TPlayer;
     241begin
     242  FirstHuman := Game.Players.GetFirstHuman;
     243  if Assigned(FirstHuman) then CurrentClient := FirstHuman.Client
     244    else CurrentClient := TClient(Game.Clients.First);
    228245end;
    229246
     
    289306  if OpenDialog1.Execute then begin
    290307    Game.LoadFromFile(OpenDialog1.FileName);
    291     Player := Game.Players.GetFirstHuman;
     308    SelectClient;
    292309    LastMapFileName := OpenDialog1.FileName;
    293     with Core.Game.CurrentPlayer do
     310    with Core.CurrentClient do
    294311      View.DestRect := Bounds(0, 0, FormMain.PaintBox1.Width, FormMain.PaintBox1.Height);
    295312    FormMain.AZoomAll.Execute;
     
    304321    FormNew.Save(Game);
    305322    Game.New;
    306     Player := Game.Players.GetFirstHuman;
     323    SelectClient;
    307324    Game.Running := True;
    308325    FormMain.AZoomAll.Execute;
     
    365382  Game.OnWin := DoOnWin;
    366383  Game.OnNewTurn := GameNewTurnExecute;
     384  Game.OnPlayerChange := DoPlayerChange;
    367385  StoredDimension := TControlDimension.Create;
    368386  XMLConfig1.Filename := GetAppConfigDir(False) + 'Config.xml';
     
    376394  SaveConfig;
    377395  FreeAndNil(Game);
     396end;
     397
     398procedure TCore.DoPlayerChange(Sender: TObject);
     399begin
     400  if Assigned(Game.CurrentPlayer) and Assigned(Game.CurrentPlayer.Client) then
     401    CurrentClient := Game.CurrentPlayer.Client;
    378402end;
    379403
     
    389413  FInitialized := True;
    390414  LoadConfig;
    391   for I := 0 to Game.Players.Count - 1 do
    392     TPlayer(Game.Players[I]).View.DestRect := Rect(0, 0, FormMain.PaintBox1.Width,
     415  for I := 0 to Game.Clients.Count - 1 do
     416    TClient(Game.Clients[I]).View.DestRect := Rect(0, 0, FormMain.PaintBox1.Width,
    393417      FormMain.PaintBox1.Height);
    394418  Game.LoadConfig(XMLConfig1, 'Game');
     
    399423  if Game.FileName = '' then begin
    400424    Game.New;
    401     Player := Game.Players.GetFirstHuman;
     425    SelectClient;
    402426    Game.Running := True;
    403427    FormMain.AZoomAll.Execute;
  • trunk/UGame.pas

    r115 r125  
    2828  TCellLinks = class;
    2929  TMapArea = class;
     30  TClient = class;
    3031
    3132  TFloatPoint = record
     
    248249  TPlayer = class
    249250  private
     251    FClient: TClient;
    250252    FGame: TGame;
     253    procedure SetClient(AValue: TClient);
    251254    procedure SetGame(AValue: TGame);
    252255  public
     
    254257    Name: string;
    255258    Color: TColor;
    256     View: TView;
    257259    Mode: TPlayerMode;
    258260    TotalUnits: Integer;
     
    266268    procedure LoadFromNode(Node: TDOMNode);
    267269    procedure SaveToNode(Node: TDOMNode);
    268     procedure Paint(Canvas: TCanvas);
     270    procedure Paint(Canvas: TCanvas; View: TView);
    269271    constructor Create;
    270272    destructor Destroy; override;
    271273    procedure Assign(Source: TPlayer);
    272274    property Game: TGame read FGame write SetGame;
     275    property Client: TClient read FClient write SetClient;
    273276  end;
    274277
     
    333336  end;
    334337
     338  { TClient }
     339
     340  TClient = class
     341  private
     342    FGame: TGame;
     343    FControlPlayer: TPlayer;
     344    procedure SetControlPlayer(AValue: TPlayer);
     345    procedure SetGame(AValue: TGame);
     346  public
     347    Name: string;
     348    View: TView;
     349    constructor Create;
     350    destructor Destroy; override;
     351    property ControlPlayer: TPlayer read FControlPlayer write SetControlPlayer;
     352    property Game: TGame read FGame write SetGame;
     353  end;
     354
     355  { TClients }
     356
     357  TClients = class(TObjectList)
     358    Game: TGame;
     359    procedure New(Name: string);
     360  end;
     361
    335362  { TGame }
    336363
     
    349376    FOnMove: TMoveEvent;
    350377    FOnNewTurn: TNotifyEvent;
     378    FOnPlayerChange: TNotifyEvent;
    351379    FOnWin: TWinEvent;
    352380    FRunning: Boolean;
     
    367395  public
    368396    Players: TPlayers;
     397    Clients: TClients;
    369398    Map: TMap;
    370399    MapImageFileName: string;
     
    406435    property OnWin: TWinEvent read FOnWin write FOnWin;
    407436    property OnNewTurn: TNotifyEvent read FOnNewTurn write FOnNewTurn;
     437    property OnPlayerChange: TNotifyEvent read FOnPlayerChange write FOnPlayerChange;
    408438  end;
    409439
     
    509539    ((((Color shr 16) and $ff) shr 1) shl 16) or
    510540    ((((Color shr 24) and $ff) shr 0) shl 24);
     541end;
     542
     543{ TClients }
     544
     545procedure TClients.New(Name: string);
     546var
     547  NewClient: TClient;
     548begin
     549  NewClient := TClient.Create;
     550  NewClient.Game := Game;
     551  NewClient.Name := Name;
     552  Add(NewClient);
     553end;
     554
     555{ TClient }
     556
     557procedure TClient.SetGame(AValue: TGame);
     558begin
     559  if FGame = AValue then Exit;
     560  FGame := AValue;
     561  View.Game := AValue;
     562end;
     563
     564procedure TClient.SetControlPlayer(AValue: TPlayer);
     565begin
     566  if FControlPlayer = AValue then Exit;
     567  if Assigned(FControlPlayer) then
     568    FControlPlayer.FClient := nil;
     569  FControlPlayer := AValue;
     570  if Assigned(FControlPlayer) then
     571     FControlPlayer.FClient := Self;
     572end;
     573
     574constructor TClient.Create;
     575begin
     576  View := TView.Create;
     577end;
     578
     579destructor TClient.Destroy;
     580begin
     581  ControlPlayer := nil;
     582  FreeAndNil(View);
     583  inherited Destroy;
    511584end;
    512585
     
    17401813  if FGame = AValue then Exit;
    17411814  FGame := AValue;
    1742   View.Game := Game;
     1815end;
     1816
     1817procedure TPlayer.SetClient(AValue: TClient);
     1818begin
     1819  if FClient=AValue then Exit;
     1820  if Assigned(FClient) then FClient.FControlPlayer := nil;
     1821  FClient := AValue;
     1822  if Assigned(FClient) then FClient.FControlPlayer := Self;
    17431823end;
    17441824
     
    21462226end;
    21472227
    2148 procedure TPlayer.Paint(Canvas: TCanvas);
     2228procedure TPlayer.Paint(Canvas: TCanvas; View: TView);
    21492229begin
    21502230  PlayerMap.Paint(Canvas, View);
     
    21532233constructor TPlayer.Create;
    21542234begin
    2155   View := TView.Create;
    21562235  StartUnits := DefaultPlayerStartUnits;
    21572236  StartCell := nil;
     
    21632242begin
    21642243  FreeAndNil(PlayerMap);
    2165   FreeAndNil(View);
    21662244  inherited Destroy;
    21672245end;
     
    21802258  Agressivity := Source.Agressivity;
    21812259  Defensive := Source.Defensive;
    2182   View.Assign(Source.View);
    21832260end;
    21842261
     
    24322509  end else begin
    24332510    FRunning := AValue;
    2434     for I := 0 to Players.Count - 1 do
    2435     with TPlayer(Players[I]) do begin
     2511    for I := 0 to Clients.Count - 1 do
     2512    with TClient(Clients[I]) do begin
    24362513      View.Clear;
    24372514    end;
     
    28112888  PrevPlayer: TPlayer;
    28122889begin
    2813   CurrentPlayer.View.SelectedCell := nil;
     2890  //TODO CurrentPlayer.View.SelectedCell := nil;
    28142891  MoveAll(CurrentPlayer);
    28152892  Map.Grow(CurrentPlayer);
     
    28202897  repeat
    28212898    CurrentPlayer := TPlayer(Players[(Players.IndexOf(CurrentPlayer) + 1) mod Players.Count]);
     2899    if Assigned(FOnPlayerChange) then
     2900      FOnPlayerChange(Self);
    28222901  until CurrentPlayer.TotalCells > 0;
    28232902  if Players.IndexOf(CurrentPlayer) < Players.IndexOf(PrevPlayer) then begin
     
    28702949  Players := TPlayers.Create;
    28712950  Players.Game := Self;
     2951  Clients := TClients.Create;
     2952  Clients.Game := Self;
    28722953
    28732954  MapImageFileName := 'Images/Maps/WorldMap.png';
     
    28872968destructor TGame.Destroy;
    28882969begin
     2970  FreeAndNil(Clients);
    28892971  FreeAndNil(Moves);
    28902972  FreeAndNil(Players);
     
    29183000  end;
    29193001
    2920 
    29213002  if SymetricMap then begin
    29223003    for C := 0 to (Map.Cells.Count div 2) - 1 do begin
     
    29313012  with TPlayer(Players[I]) do begin
    29323013    PlayerMap.Update;
    2933     View.Clear;
    29343014    if (Map.Size.X > 0) and (Map.Size.Y > 0) then begin
    29353015      // Try to obtain start cell for each player
     
    29503030      StartCell.Power := TPlayer(Players[I]).StartUnits;
    29513031    end;
     3032    PlayerMap.CheckVisibility;
     3033  end;
     3034  if Players.Count > 0 then CurrentPlayer := TPlayer(Players[0])
     3035    else CurrentPlayer := nil;
     3036
     3037  Clients.Clear;
     3038  Clients.New('Spectator');
     3039  for I := 0 to Players.Count - 1 do
     3040  with TPlayer(Players[I]) do
     3041  if Mode = pmHuman then begin
     3042    Clients.New(TPlayer(Players[I]).Name);
     3043    TPlayer(Players[I]).Client := TClient(Clients.Last);
     3044  end;
     3045
     3046  for I := 0 to Clients.Count - 1 do
     3047  with TClient(Clients[I]) do begin
     3048    View.Clear;
    29523049    View.Zoom := 1;
    29533050    View.CenterMap;
    2954     PlayerMap.CheckVisibility;
    2955   end;
    2956   if Players.Count > 0 then CurrentPlayer := TPlayer(Players[0])
    2957     else CurrentPlayer := nil;
     3051  end;
    29583052end;
    29593053
     
    29853079    with TCellLink(CellLinks[C]) do begin
    29863080      if Length(Points) >= 2 then begin
    2987         MoveTo(Points[0]);
     3081        MoveTo(View.CellToCanvasPos(Points[0]));
    29883082        for I := 1 to Length(Points) - 1 do
    2989           LineTo(Points[I]);
     3083          LineTo(View.CellToCanvasPos(Points[I]));
    29903084      end;
    29913085    end;
  • trunk/xtactics.lpi

    r113 r125  
    22<CONFIG>
    33  <ProjectOptions>
    4     <Version Value="9"/>
     4    <Version Value="10"/>
    55    <General>
    66      <SessionStorage Value="InProjectDir"/>
Note: See TracChangeset for help on using the changeset viewer.