Changeset 185


Ignore:
Timestamp:
Feb 12, 2018, 3:08:27 PM (7 years ago)
Author:
chronos
Message:
Location:
trunk
Files:
35 added
10 edited

Legend:

Unmodified
Added
Removed

  • trunk/Forms/UFormChat.pas

    r184 r185  
    77uses
    88  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
    9   UGame, UGameClient;
     9  UGame, UGameClient, SpecializedList;
    1010
    1111type
    … …  
    4141
    4242procedure TFormChat.ButtonMessageSendClick(Sender: TObject);
    43 var
    44   TextMessage: TCommandTextMessage;
    4543begin
    4644  if Assigned(Client) then
    4745  with Client do begin
    48     TextMessage.Text := EditMessage.Text;
    49     Client.Send(cmdTextMessage, @TextMessage, nil);
     46    Protocol.SendMessage(EditMessage.Text);
    5047    MemoChat.Lines.Add(Client.Name + ': ' + EditMessage.Text);
    5148    EditMessage.Text := '';

  • trunk/Forms/UFormClient.pas

    r184 r185  
    7979      CountRepeat: Integer; Update: Boolean; var Confirm: Boolean);
    8080  public
    81     property Client: TClient read FClient write SetClient;
    8281    procedure LoadConfig(Config: TXmlConfig; Path: string);
    8382    procedure SaveConfig(Config: TXmlConfig; Path: string);
    8483    procedure ReloadView;
    8584    procedure Redraw;
     85    property Client: TClient read FClient write SetClient;
    8686  end;
    8787

  • trunk/Languages/xtactics.cs.po

    r183 r185  
    868868msgstr "Nulové přiblížení není povoleno"
    869869
     870#: uvarblockserializer.serrorgetvarsize
     871msgid "Error reading variable block size"
     872msgstr ""
     873
     874#: uvarblockserializer.smaskedvaluereaderror
     875msgid "Error reading masked variable length block."
     876msgstr ""
     877
     878#: uvarblockserializer.sreaderror
     879msgid "Stream read error. Expected length %d, read %d. Source stream size %d."
     880msgstr ""
     881
     882#: uvarblockserializer.suint64overflow
     883msgid "64-bit UInt read overflow."
     884msgstr ""
     885

  • trunk/Languages/xtactics.po

    r183 r185  
    847847msgstr ""
    848848
     849#: uvarblockserializer.serrorgetvarsize
     850msgid "Error reading variable block size"
     851msgstr ""
     852
     853#: uvarblockserializer.smaskedvaluereaderror
     854msgid "Error reading masked variable length block."
     855msgstr ""
     856
     857#: uvarblockserializer.sreaderror
     858msgid "Stream read error. Expected length %d, read %d. Source stream size %d."
     859msgstr ""
     860
     861#: uvarblockserializer.suint64overflow
     862msgid "64-bit UInt read overflow."
     863msgstr ""
     864

  • trunk/UCore.pas

    r184 r185  
    88  Classes, SysUtils, XMLConf, FileUtil, ActnList, Controls, Dialogs, Forms,
    99  UGame, UApplicationInfo, UPersistentForm, UScaleDPI, UCoolTranslator,
    10   URegistry, ULastOpenedList, Registry, Menus, UGeometry, Contnrs, UFormClient,
    11   UGameServer, UGameClient;
     10  URegistry, ULastOpenedList, Registry, Menus, UGeometry, UFormClient,
     11  UGameServer, UGameClient, fgl;
    1212
    1313type
    … …  
    8787    AnimationSpeed: Integer;
    8888    AutoSaveEnabled: Boolean;
    89     FormClients: TObjectList; // TFormClient
    90     //CurrentClient: TClient;
    91     LocalClients: TObjectList; // TClient
     89    FormClients: TFPGObjectList<TFormClient>;
     90    Clients: TClients;
    9291    procedure Spectate(Player: TPlayer);
    9392    procedure UpdateActions;
    … …  
    219218begin
    220219  FirstHuman := Game.Players.GetFirstHuman;
    221   if Assigned(FirstHuman) then FormClient.Client := Server.Clients.SearchPlayer(FirstHuman)
    222     else FormClient.Client := TClient(Server.Clients.First);
     220  if Assigned(FirstHuman) then FormClient.Client := Clients.SearchPlayer(FirstHuman)
     221    else FormClient.Client := TClient(Clients.First);
    223222end;
    224223
    … …  
    376375begin
    377376  Server := TServer.Create;
     377  Clients := TClients.Create;
    378378  Game := TGame.Create;
    379379  Game.OnMoveUpdated := DoMoveUpdated;
    … …  
    382382  Game.OnPlayerChange := DoPlayerChange;
    383383  Server.Game := Game;
     384  Clients.Game := Game;
    384385  StoredDimension := TControlDimension.Create;
    385386  XMLConfig1.Filename := GetAppConfigDir(False) + 'Config.xml';
    386387  ForceDirectories(GetAppConfigDir(False));
    387   FormClients := TObjectList.Create;
     388  FormClients := TFPGObjectList<TFormClient>.Create;
    388389end;
    389390
    … …  
    400401  FreeAndNil(Server);
    401402  FreeAndNil(Game);
     403  FreeAndNil(Clients);
    402404end;
    403405
    … …  
    447449begin
    448450  Form := TFormClient.Create(nil);
    449   Form.Client := Server.Clients.New(SSpectator);
     451  Form.Client := Clients.New(SSpectator);
    450452  //Form.Client.Form := Form;
    451453  //Form.Client.ControlPlayer := Player;
    … …  
    456458
    457459procedure TCore.StartNewGame;
     460var
     461  NewClient: TClient;
     462  Player: TPlayer;
    458463begin
    459464  Game.New;
    460465  Server.InitClients;
     466
     467  // Create local clients for human players
     468  for Player in Game.Players do
     469  with Player do
     470  if Mode = pmHuman then begin
     471    NewClient := Clients.New(Name);
     472    NewClient.ControlPlayer := Player;
     473    NewClient.View.Clear;
     474    NewClient.View.Zoom := 1;
     475    if Assigned(NewClient.ControlPlayer.StartCell) then
     476      NewClient.View.CenterPlayerCity(NewClient.ControlPlayer)
     477      else NewClient.View.CenterMap;
     478  end;
     479
    461480  Game.DevelMode := DevelMode;
    462481  SelectClient;
    … …  
    474493begin
    475494  if Assigned(Game.CurrentPlayer) then begin
    476     PlayerClient := Server.Clients.SearchPlayer(Game.CurrentPlayer);
     495    PlayerClient := Clients.SearchPlayer(Game.CurrentPlayer);
    477496    if Assigned(PlayerClient) then FormClient.Client := PlayerClient;
    478497  end;

  • trunk/UGame.pas

    r184 r185  
    88  Classes, SysUtils, ExtCtrls, Graphics, XMLConf, XMLRead, XMLWrite, Forms,
    99  DOM, Math, LazFileUtils, UXMLUtils, Dialogs, Types, LCLType, LCLIntf, fgl,
    10   UGeometry;
     10  UGeometry, SpecializedList;
    1111
    1212const
    … …  
    407407    procedure LoadFromNode(Node: TDOMNode);
    408408    procedure SaveToNode(Node: TDOMNode);
    409   end;
    410 
    411   TCommand = (cmdTextMessage);
    412   TReceiveEvent = procedure (Command: TCommand; DataIn, DataOut: Pointer);
    413   TCommandTextMessage = record
    414     Text: string;
    415409  end;
    416410

  • trunk/UGameClient.pas

    r184 r185  
    66
    77uses
    8   Classes, SysUtils, UGame, Forms, fgl;
     8  Classes, SysUtils, UGame, Forms, fgl, UGameProtocol;
    99
    1010type
    … …  
    1717    FControlPlayer: TPlayer;
    1818    FOnChange: TNotifyEvent;
    19     FOnReceive: TReceiveEvent;
     19    FOnReceive: TCommandEvent;
    2020    FOnMove: TMoveEvent;
    2121    procedure SetControlPlayer(AValue: TPlayer);
    … …  
    2424    procedure PlayerMove(CellFrom, CellTo: TCell; var CountOnce, CountRepeat: Integer;
    2525      Update: Boolean; var Confirm: Boolean);
     26    procedure ReceiveCmd(Command: TCommand; DataOut, DataIn: TStream);
    2627  public
    2728    Name: string;
    2829    View: TView;
     30    Protocol: TGameProtocolClient;
    2931    procedure DoChange;
    30     procedure Send(Command: TCommand; DataOut, DataIn: Pointer);
    3132    constructor Create;
    3233    destructor Destroy; override;
    … …  
    3536    property Form: TForm read FForm write SetForm;
    3637    property OnMove: TMoveEvent read FOnMove write FOnMove;
    37     property OnReceive: TReceiveEvent read FOnReceive write FOnReceive;
     38    property OnReceive: TCommandEvent read FOnReceive write FOnReceive;
    3839    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    3940  end;
    … …  
    101102end;
    102103
    103 procedure TClient.Send(Command: TCommand; DataOut, DataIn: Pointer);
     104procedure TClient.ReceiveCmd(Command: TCommand; DataOut, DataIn: TStream);
    104105begin
     106
    105107end;
    106108
    … …  
    126128  FControlPlayer := nil;
    127129  View := TView.Create;
     130  Protocol := TGameProtocolClient.Create;
    128131end;
    129132
    … …  
    132135  ControlPlayer := nil;
    133136  FreeAndNil(View);
     137  FreeAndNil(Protocol);
    134138  inherited Destroy;
    135139end;

  • trunk/UGameServer.pas

    r184 r185  
    66
    77uses
    8   Classes, SysUtils, UGame, UGameClient, DOM, XMLConf;
     8  Classes, SysUtils, UGame, UGameClient, DOM, XMLConf, fgl, SpecializedList,
     9  UGameProtocol;
    910
    1011type
    1112  TServerMode = (smLocal, smNetworkServer, smNetworkClient);
     13
     14  { TServerClient }
     15
     16  TServerClient = class
     17  private
     18    FOnReceiveCmd: TCommandEvent;
     19    procedure ReceiveCmd(Command: TCommand; DataOut, DataIn: TStream);
     20  public
     21    Game: TGame;
     22    Protocol: TGameProtocolServer;
     23    procedure DoChange;
     24    procedure SendCmd(Command: TCommand; DataOut, DataIn: TStream);
     25    property OnReceiveCmd: TCommandEvent read FOnReceiveCmd write
     26      FOnReceiveCmd;
     27    constructor Create;
     28    destructor Destroy; override;
     29  end;
     30
     31  TServerClients = class(TFPGObjectList<TServerClient>)
     32    Game: TGame;
     33  end;
    1234
    1335  { TServer }
    … …  
    2446    procedure GameStarted(Sender: TObject);
    2547  public
    26     Clients: TClients;
     48    Clients: TServerClients;
    2749    LocalNetworkAddress: string;
    2850    LocalNetworkPort: Word;
    … …  
    4264
    4365implementation
     66
     67{ TServerClient }
     68
     69procedure TServerClient.DoChange;
     70begin
     71
     72end;
     73
     74procedure TServerClient.SendCmd(Command: TCommand; DataOut, DataIn: TStream);
     75begin
     76
     77end;
     78
     79constructor TServerClient.Create;
     80begin
     81  Protocol := TGameProtocolServer.Create;
     82end;
     83
     84destructor TServerClient.Destroy;
     85begin
     86  Protocol.Free;
     87  inherited Destroy;
     88end;
     89
     90procedure TServerClient.ReceiveCmd(Command: TCommand; DataOut, DataIn: TStream);
     91begin
     92  if Assigned(FOnReceiveCmd) then
     93    FOnReceiveCmd(Command, DataOut, DataIn);
     94end;
    4495
    4596{ TServer }
    … …  
    102153procedure TServer.DoChange;
    103154var
    104   Client: TClient;
     155  Client: TServerClient;
    105156begin
    106157  for Client in Clients do
    … …  
    113164begin
    114165  for I := 0 to Clients.Count - 1 do
    115   with TClient(Clients[I]) do begin
    116     View.Clear;
     166  with TServerClient(Clients[I]) do begin
     167    //TODO View.Clear;
    117168  end;
    118169end;
    … …  
    142193procedure TServer.InitClients;
    143194var
    144   Client: TClient;
     195  Client: TServerClient;
    145196  Player: TPlayer;
    146197begin
    147198  Clients.Clear;
    148   Clients.New(SSpectator);
    149 
    150   for Player in Game.Players do
    151   with Player do
    152   if Mode = pmHuman then begin
    153     Clients.New(Player.Name).ControlPlayer := Player;
    154   end;
    155 
    156   for Client in Clients do
    157   with Client do begin
    158     View.Clear;
    159     View.Zoom := 1;
    160     if Assigned(ControlPlayer) and Assigned(ControlPlayer.StartCell) then
    161       View.CenterPlayerCity(ControlPlayer)
    162       else View.CenterMap;
    163   end;
    164199end;
    165200
    … …  
    173208begin
    174209  FGame := nil;
    175   Clients := TClients.Create;
     210  Clients := TServerClients.Create;
    176211end;
    177212

  • trunk/xtactics.lpi

    r184 r185  
    2828          <SearchPaths>
    2929            <IncludeFiles Value="$(ProjOutDir)"/>
    30             <OtherUnitFiles Value="Forms"/>
     30            <OtherUnitFiles Value="Forms;Packages/PinConnection"/>
    3131            <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)-$(BuildMode)"/>
    3232          </SearchPaths>
    … …  
    6565      </Item2>
    6666      <SharedMatrixOptions Count="2">
    67         <Item1 ID="257295799247" Targets="Common,CoolTranslator,TemplateGenerics" Modes="Debug" Value="-g -gl -gh -CirotR -O1"/>
    68         <Item2 ID="262602526292" Targets="Common,CoolTranslator,TemplateGenerics" Modes="Release" Value="-CX -XX -O3"/>
     67        <Item1 ID="257295799247" Targets="Common,CoolTranslator,TemplateGenerics,CoolStreaming" Modes="Debug" Value="-g -gl -gh -CirotR -O1"/>
     68        <Item2 ID="262602526292" Targets="Common,CoolTranslator,TemplateGenerics,CoolStreaming" Modes="Release" Value="-CX -XX -O3"/>
    6969      </SharedMatrixOptions>
    7070    </BuildModes>
    … …  
    7777      </local>
    7878    </RunParams>
    79     <RequiredPackages Count="6">
     79    <RequiredPackages Count="7">
    8080      <Item1>
    81         <PackageName Value="TAChartLazarusPkg"/>
     81        <PackageName Value="CoolStreaming"/>
     82        <DefaultFilename Value="Packages/CoolStreaming/CoolStreaming.lpk" Prefer="True"/>
    8283      </Item1>
    8384      <Item2>
     85        <PackageName Value="TAChartLazarusPkg"/>
     86      </Item2>
     87      <Item3>
    8488        <PackageName Value="TemplateGenerics"/>
    8589        <DefaultFilename Value="Packages/TemplateGenerics/TemplateGenerics.lpk" Prefer="True"/>
    86       </Item2>
    87       <Item3>
     90      </Item3>
     91      <Item4>
    8892        <PackageName Value="Common"/>
    8993        <DefaultFilename Value="Packages/Common/Common.lpk" Prefer="True"/>
    90       </Item3>
    91       <Item4>
    92         <PackageName Value="FCL"/>
    9394      </Item4>
    9495      <Item5>
     96        <PackageName Value="FCL"/>
     97      </Item5>
     98      <Item6>
    9599        <PackageName Value="CoolTranslator"/>
    96100        <DefaultFilename Value="Packages/CoolTranslator/CoolTranslator.lpk" Prefer="True"/>
    97       </Item5>
    98       <Item6>
     101      </Item6>
     102      <Item7>
    99103        <PackageName Value="LCL"/>
    100       </Item6>
     104      </Item7>
    101105    </RequiredPackages>
    102     <Units Count="20">
     106    <Units Count="22">
    103107      <Unit0>
    104108        <Filename Value="xtactics.lpr"/>
    … …  
    219223        <IsPartOfProject Value="True"/>
    220224      </Unit19>
     225      <Unit20>
     226        <Filename Value="UGameProtocol.pas"/>
     227        <IsPartOfProject Value="True"/>
     228      </Unit20>
     229      <Unit21>
     230        <Filename Value="Packages/PinConnection/UCommPin.pas"/>
     231        <IsPartOfProject Value="True"/>
     232      </Unit21>
    221233    </Units>
    222234  </ProjectOptions>
    … …  
    228240    <SearchPaths>
    229241      <IncludeFiles Value="$(ProjOutDir)"/>
    230       <OtherUnitFiles Value="Forms"/>
     242      <OtherUnitFiles Value="Forms;Packages/PinConnection"/>
    231243      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)-$(BuildMode)"/>
    232244    </SearchPaths>

  • trunk/xtactics.lpr

    r184 r185  
    1212  { you can add units after this },
    1313  SysUtils, UFormMain, UFormMove, UFormNew, UFormCharts, UFormUnitMoves,
    14   UFormChat, UTCP, UServerList, UFormPlayersStats, UGameServer, UGameClient;
     14  UFormChat, UTCP, UServerList, UFormPlayersStats, UGameServer, UGameClient,
     15  UGameProtocol, CoolStreaming;
    1516
    1617{$R *.res}
Note: See TracChangeset for help on using the changeset viewer.