Changeset 213 for trunk


Ignore:
Timestamp:
May 24, 2018, 9:25:17 PM (7 years ago)
Author:
chronos
Message:
  • Added: Button with action to surrender the game.
  • Fixed: Added framing comm component for correct separation of network messages.
  • Added: New game protocol command NextPlayer. GUI client will redraw map on this event to see how other players/AI fight each other.
Location:
trunk
Files:
12 edited

Legend:

Unmodified
Added
Removed

  • trunk/Forms/UFormClient.lfm

    r211 r213  
    5252    object ToolButton6: TToolButton
    5353      Left = 1
    54       Top = 39
     54      Top = 71
    5555      Action = AZoomIn
    5656    end
    5757    object ToolButton7: TToolButton
    5858      Left = 1
    59       Top = 71
     59      Top = 103
    6060      Action = AZoomOut
    6161    end
    6262    object ToolButton8: TToolButton
    6363      Left = 1
    64       Top = 103
     64      Top = 135
    6565      Action = AZoomAll
    6666    end
    6767    object ToolButton9: TToolButton
    6868      Left = 1
    69       Top = 34
     69      Top = 66
    7070      Width = 32
    7171      AutoSize = True
    7272      Style = tbsDivider
     73    end
     74    object ToolButton1: TToolButton
     75      Left = 1
     76      Top = 34
     77      Action = ASurrender
    7378    end
    7479  end
    … …  
    134139      ShortCut = 16468
    135140    end
     141    object ASurrender: TAction
     142      Caption = 'Surrender'
     143      ImageIndex = 4
     144      OnExecute = ASurrenderExecute
     145    end
    136146  end
    137147  object PopupMenuToolbar: TPopupMenu

  • trunk/Forms/UFormClient.pas

    r211 r213  
    1919
    2020  TFormClient = class(TForm)
     21    ASurrender: TAction;
    2122    AGameEndTurn: TAction;
    2223    AStatusBarVisible: TAction;
    … …  
    3334    Timer1: TTimer;
    3435    ToolBar1: TToolBar;
     36    ToolButton1: TToolButton;
    3537    ToolButton2: TToolButton;
    3638    ToolButton6: TToolButton;
    … …  
    4042    procedure AGameEndTurnExecute(Sender: TObject);
    4143    procedure AStatusBarVisibleExecute(Sender: TObject);
     44    procedure ASurrenderExecute(Sender: TObject);
    4245    procedure AToolBarBigIconsExecute(Sender: TObject);
    4346    procedure AToolBarVisibleExecute(Sender: TObject);
    … …  
    8083    procedure DoClientChange(Sender: TObject);
    8184    procedure DoGameEnd(Sender: TObject);
     85    procedure DoNextPlayer(Sender: TObject);
    8286    procedure DoTurnStart(Sender: TObject);
    8387    procedure DoMove(CellFrom, CellTo: TCell; var CountOnce,
    … …  
    103107resourcestring
    104108  STurn = 'turn';
     109  SSurrender = 'Surrender';
     110  SSurrenderQuestion = 'Do you want to surrender current game?';
    105111
    106112{$R *.lfm}
    … …  
    233239    FClient.OnDestroy := DoClientDestroy;
    234240    FClient.OnGameEnd := DoGameEnd;
     241    FClient.OnNextPlayer := DoNextPlayer;
    235242    FClient.View.DestRect := TRect.CreateBounds(TPoint.Create(0, 0), TPoint.Create(PaintBox1.Width, PaintBox1.Height));
    236243  end;
    … …  
    248255end;
    249256
     257procedure TFormClient.DoNextPlayer(Sender: TObject);
     258begin
     259  Redraw;
     260end;
     261
    250262procedure TFormClient.DoTurnStart(Sender: TObject);
    251263begin
    252264  TurnActive := True;
    253   Synchronize(UpdateInterface);
    254   Synchronize(Redraw);
     265  UpdateInterface;
     266  Redraw;
    255267end;
    256268
    … …  
    290302  ToolBar1.Visible := AToolBarVisible.Checked;
    291303  StatusBar1.Visible := AStatusBarVisible.Checked;
    292   AGameEndTurn.Enabled := TurnActive;
     304  AGameEndTurn.Enabled := Assigned(Client.ControlPlayer) and
     305    Client.ControlPlayer.IsAlive and TurnActive;
     306  ASurrender.Enabled := Assigned(Client.ControlPlayer) and
     307    Client.ControlPlayer.IsAlive;
    293308end;
    294309
    … …  
    339354  AStatusBarVisible.Checked := not AStatusBarVisible.Checked;
    340355  UpdateInterface;
     356end;
     357
     358procedure TFormClient.ASurrenderExecute(Sender: TObject);
     359begin
     360  if MessageDlg(SSurrender, SSurrenderQuestion, mtConfirmation, mbYesNo, 0) =
     361    mrYes then begin
     362      Client.Protocol.Surrender;
     363      UpdateInterface;
     364    end;
    341365end;
    342366

  • trunk/Languages/xtactics.cs.po

    r208 r213  
    99"MIME-Version: 1.0\n"
    1010"Content-Transfer-Encoding: 8bit\n"
    11 "X-Generator: Poedit 1.8.8\n"
     11"X-Generator: Poedit 2.0.6\n"
    1212"Language: cs\n"
    1313
    … …  
    161161msgid "Statusbar visible"
    162162msgstr "Viditelná stavová lišta"
     163
     164#: tformclient.asurrender.caption
     165msgctxt "tformclient.asurrender.caption"
     166msgid "Surrender"
     167msgstr "Vzdát se"
    163168
    164169#: tformclient.atoolbarbigicons.caption
    … …  
    804809msgid "Win objective cells"
    805810msgstr "Buňky cíle vítězství"
     811
     812#: uformclient.ssurrender
     813msgctxt "uformclient.ssurrender"
     814msgid "Surrender"
     815msgstr "Vzdát se"
     816
     817#: uformclient.ssurrenderquestion
     818msgid "Do you want to surrender current game?"
     819msgstr "Chcete vzdát aktuální hru?"
    806820
    807821#: uformclient.sturn

  • trunk/Languages/xtactics.po

    r208 r213  
    152152msgstr ""
    153153
     154#: tformclient.asurrender.caption
     155msgctxt "tformclient.asurrender.caption"
     156msgid "Surrender"
     157msgstr ""
     158
    154159#: tformclient.atoolbarbigicons.caption
    155160msgctxt "tformclient.atoolbarbigicons.caption"
    … …  
    788793msgctxt "uformcharts.swinobjectivecells"
    789794msgid "Win objective cells"
     795msgstr ""
     796
     797#: uformclient.ssurrender
     798msgctxt "uformclient.ssurrender"
     799msgid "Surrender"
     800msgstr ""
     801
     802#: uformclient.ssurrenderquestion
     803msgid "Do you want to surrender current game?"
    790804msgstr ""
    791805

  • trunk/UClientAI.pas

    r203 r213  
    1313  TComputer = class(TClient)
    1414  protected
    15     procedure DoTurnStart(Sender: TObject); override;
     15    procedure DoTurnStart; override;
    1616  public
    1717    //Targets: TFPGObjectList<TPlayer>;
    … …  
    3131{ TComputer }
    3232
    33 procedure TComputer.DoTurnStart(Sender: TObject);
     33procedure TComputer.DoTurnStart;
    3434begin
    3535  Process;

  • trunk/UCore.lfm

    r211 r213  
    44  OldCreateOrder = False
    55  Height = 811
    6   HorizontalOffset = 314
    7   VerticalOffset = 244
     6  HorizontalOffset = 423
     7  VerticalOffset = 374
    88  Width = 1258
    99  PPI = 144

  • trunk/UCore.pas

    r211 r213  
    4545    procedure AExitExecute(Sender: TObject);
    4646    procedure AGameEndExecute(Sender: TObject);
    47     procedure AGameEndTurnExecute(Sender: TObject);
    4847    procedure AGameLoadExecute(Sender: TObject);
    4948    procedure AGameNewExecute(Sender: TObject);
    … …  
    9695    procedure SaveConfig;
    9796    procedure Spectate(Player: TPlayer);
    98     procedure UpdateActions;
     97    procedure UpdateInterface;
    9998    procedure ScaleDPI;
    10099    procedure Init;
    … …  
    250249end;
    251250
    252 procedure TCore.UpdateActions;
     251procedure TCore.UpdateInterface;
    253252begin
    254253  Core.AGameEnd.Enabled := Core.Game.Running;
    … …  
    276275    Game.Running := False;
    277276    Server.GameEnd;
    278     UpdateActions;
    279   end;
    280 end;
    281 
    282 procedure TCore.AGameEndTurnExecute(Sender: TObject);
    283 begin
    284 
     277    UpdateInterface;
     278  end;
    285279end;
    286280
    … …  
    302296    FormNew.PageControl1.TabIndex := FormNewTabIndex;
    303297    if FormNew.ShowModal = mrOk then begin
     298      Game.Running := False;
    304299      FormNew.Save(Server);
    305300      Game.Assign(GameSettings);
    … …  
    369364      Game.SaveConfig(XMLConfig1, 'Game');
    370365      Server.SaveConfig(XMLConfig1, 'Server');
     366      XMLConfig1.Flush;
    371367    end;
    372368  finally
    … …  
    457453  // Create local LocalClients for human players
    458454  LocalClients.Clear;
     455  FormClient.Client := nil;
    459456  for Player in Game.Players do
    460457  with Player do
    … …  
    484481  SelectClient;
    485482  LastOpenedList1.AddItem(FileName);
    486   with FormClient.Client do
    487     View.DestRect := TRect.CreateBounds(TPoint.Create(0, 0),
    488       TPoint.Create(FormClient.PaintBox1.Width, FormClient.PaintBox1.Height));
    489483  FormClient.AZoomAll.Execute;
    490484  UpdateOtherForms;
    491   UpdateActions;
     485  UpdateInterface;
    492486  ServerClient := Server.Clients.SearchByPlayer(Game.CurrentPlayer);
    493487  if Assigned(ServerClient) then ServerClient.TurnStart
    … …  
    507501  I: Integer;
    508502begin
     503  // Copy all actions from docked form to main form so keyboard shortcuts will be active
    509504  for I := 0 to FormClient.ActionList1.ActionCount - 1 do begin
    510505    Action := TAction.Create(FormMain);
    … …  
    539534  // Create local LocalClients for human players
    540535  LocalClients.Clear;
     536  FormClient.Client := nil;
    541537  for Player in Game.Players do
    542538  with Player do
    … …  
    569565    else ShowMessage(Format(SPlayersNotInitialized, [Game.Players.Count, Game.Players.GetAliveCount]));
    570566  UpdateOtherForms;
    571   UpdateActions;
     567  UpdateInterface;
    572568  ServerClient := Server.Clients.SearchByPlayer(Game.CurrentPlayer);
    573569  if Assigned(ServerClient) then ServerClient.TurnStart
    … …  
    580576  ServerClient: TServerClient;
    581577begin
     578  Application.ProcessMessages;
     579  Server.NextPlayer;
    582580  if Assigned(Game.CurrentPlayer) then begin
    583581    if Game.CurrentPlayer.Mode = pmHuman then begin

  • trunk/UGame.pas

    r211 r213  
    331331    function SetMove(CellFrom, CellTo: TCell; Power: Integer; Confirmation: Boolean = True): TUnitMove;
    332332    procedure Reset;
     333    procedure Surrender;
    333334    function IsAlive: Boolean;
    334335    procedure Clear;
    … …  
    25262527end;
    25272528
     2529procedure TPlayer.Surrender;
     2530var
     2531  I: Integer;
     2532begin
     2533  Moves.Clear;
     2534  for I := 0 to PlayerMap.Cells.Count - 1 do
     2535    if PlayerMap.Cells[I].MapCell.Player = Self then
     2536      PlayerMap.Cells[I].MapCell.Player := nil;
     2537end;
     2538
    25282539function TPlayer.IsAlive: Boolean;
    25292540begin

  • trunk/UGameClient.pas

    r211 r213  
    66
    77uses
    8   Classes, SysUtils, UGame, Forms, fgl, UGameProtocol, UGameServer, UCommThread;
     8  Classes, SysUtils, UGame, Forms, fgl, UGameProtocol, UGameServer, UCommThread,
     9  UThreading, UCommFrame;
    910
    1011type
    … …  
    2223    FOnDestroy: TNotifyEvent;
    2324    FOnGameEnd: TNotifyEvent;
     25    FOnNextPlayer: TNotifyEvent;
    2426    FOnReceive: TCommandEvent;
    2527    FOnMove: TMoveEvent;
    2628    FOnTurnStart: TNotifyEvent;
    2729    CommThread: TCommThread;
     30    CommFrame: TCommFrame;
    2831    procedure SetActive(AValue: Boolean);
    2932    procedure SetControlPlayer(AValue: TPlayer);
    … …  
    3538  protected
    3639    procedure ReceiveCmd(Command: TCommand; DataOut, DataIn: TStream); virtual;
    37     procedure DoTurnStart(Sender: TObject); virtual;
    38     procedure DoGameEnd(Sender: TObject);
     40    procedure DoTurnStartHandler(Sender: TObject); virtual;
     41    procedure DoTurnStart; virtual;
     42    procedure DoGameEndHandler(Sender: TObject);
     43    procedure DoGameEnd;
     44    procedure DoNextPlayerHandler(Sender: TObject);
     45    procedure DoNextPlayer;
    3946  public
    4047    Name: string;
    … …  
    5158    property Game: TGame read FGame write SetGame;
    5259    property Form: TForm read FForm write SetForm;
     60    property Active: Boolean read FActive write SetActive;
    5361    property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
    5462    property OnMove: TMoveEvent read FOnMove write SetOnMove;
    … …  
    5765    property OnTurnStart: TNotifyEvent read FOnTurnStart write FOnTurnStart;
    5866    property OnGameEnd: TNotifyEvent read FOnGameEnd write FOnGameEnd;
    59     property Active: Boolean read FActive write SetActive;
     67    property OnNextPlayer: TNotifyEvent read FOnNextPlayer write FOnNextPlayer;
    6068  end;
    6169
    … …  
    133141end;
    134142
    135 procedure TClient.DoTurnStart(Sender: TObject);
     143procedure TClient.DoTurnStartHandler(Sender: TObject);
     144begin
     145  Synchronize(DoTurnStart);
     146end;
     147
     148procedure TClient.DoTurnStart;
    136149begin
    137150  if Assigned(FOnTurnStart) then
    … …  
    139152end;
    140153
    141 procedure TClient.DoGameEnd(Sender: TObject);
    142 begin
    143   if Assigned(FOnGameEnd) then
    144     FOnGameEnd(Self);
     154procedure TClient.DoGameEndHandler(Sender: TObject);
     155begin
     156  Synchronize(DoGameEnd);
     157end;
     158
     159procedure TClient.DoGameEnd;
     160begin
     161  if Assigned(FOnGameEnd) then FOnGameEnd(Self);
     162end;
     163
     164procedure TClient.DoNextPlayerHandler(Sender: TObject);
     165begin
     166  Synchronize(DoNextPlayer);
     167end;
     168
     169procedure TClient.DoNextPlayer;
     170begin
     171  if Assigned(FOnNextPlayer) then FOnNextPlayer(Self);
    145172end;
    146173
    … …  
    174201    case ConnectType of
    175202      ctLocal: if LocalServer.Active then begin
     203        CommFrame.FrameDataPin.Connect(Protocol.Pin);
     204        CommFrame.RawDataPin.Connect(CommThread.Pin);
    176205        CommThread.Active := True;
    177         CommThread.Pin.Connect(Protocol.Pin);
     206        CommFrame.Active := True;
    178207        ServerClient := LocalServer.GetNewServerClient;
    179208        ServerClient.Player := ControlPlayer;
    180         ServerClient.Protocol.Pin.Connect(CommThread.Ext);
     209        ServerClient.CommFrame.RawDataPin.Connect(CommThread.Ext);
    181210      end else raise Exception.Create('Local server is not active');
    182211      //ctNetwork: ;
    … …  
    196225begin
    197226  CommThread := TCommThread.Create(nil);
     227  CommFrame := TCommFrame.Create(nil);
    198228  FControlPlayer := nil;
    199229  View := TView.Create;
    200230  Protocol := TGameProtocolClient.Create;
    201   Protocol.OnTurnStart := DoTurnStart;
    202   Protocol.OnGameEnd := DoGameEnd;
     231  Protocol.OnTurnStart := DoTurnStartHandler;
     232  Protocol.OnGameEnd := DoGameEndHandler;
     233  Protocol.OnNextPlayer := DoNextPlayerHandler;
    203234end;
    204235
    … …  
    210241  FreeAndNil(Protocol);
    211242  FreeAndNil(CommThread);
     243  FreeAndNil(CommFrame);
    212244  inherited Destroy;
    213245end;

  • trunk/UGameProtocol.pas

    r203 r213  
    66
    77uses
    8   Classes, SysUtils, UGame, UVarBlockSerializer, UCommPin, SpecializedList;
     8  Classes, SysUtils, UGame, UVarBlockSerializer, UCommPin, SpecializedList,
     9  UCommFrame;
    910
    1011type
    11   TCommand = (cmdTextMessage, cmdTurnStart, cmdTurnEnd, cmdGameStart, cmdGameEnd);
     12  TCommand = (cmdTextMessage, cmdTurnStart, cmdTurnEnd, cmdGameStart, cmdGameEnd,
     13    cmdSurrender, cmdNextPlayer);
    1214  TCommandEvent = procedure (Command: TCommand; DataIn, DataOut: TStream);
    1315
    … …  
    2224    FOnGameEnd: TNotifyEvent;
    2325    FOnGameStart: TNotifyEvent;
     26    FOnNextPlayer: TNotifyEvent;
    2427    FOnTurnStart: TNotifyEvent;
    2528    procedure Receive(Sender: TCommPin; Stream: TListByte);
    … …  
    2831    Pin: TCommPin;
    2932    procedure TurnEnd;
     33    procedure Surrender;
    3034    procedure SendMessage(Text: string);
    3135    constructor Create;
    3236    destructor Destroy; override;
    33     property OnGameStart: TNotifyEvent read FOnGameStart
    34       write FOnGameStart;
    35     property OnGameEnd: TNotifyEvent read FOnGameEnd
    36       write FOnGameEnd;
    37     property OnTurnStart: TNotifyEvent read FOnTurnStart
    38       write FOnTurnStart;
     37    property OnGameStart: TNotifyEvent read FOnGameStart write FOnGameStart;
     38    property OnGameEnd: TNotifyEvent read FOnGameEnd write FOnGameEnd;
     39    property OnTurnStart: TNotifyEvent read FOnTurnStart write FOnTurnStart;
     40    property OnNextPlayer: TNotifyEvent read FOnNextPlayer write FOnNextPlayer;
    3941  end;
    4042
    … …  
    4648  private
    4749    FOnSendMessage: TSendMessageEvent;
     50    FOnSurrender: TNotifyEvent;
    4851    FOnTurnEnd: TNotifyEvent;
     52    CommFrame: TCommFrame;
    4953    procedure Receive(Sender: TCommPin; Stream: TListByte);
    5054    procedure SendCmd(Command: TCommand);
    … …  
    5660    procedure GameEnd;
    5761    procedure TurnStart;
     62    procedure NextPlayer;
    5863    property OnSendMessage: TSendMessageEvent read FOnSendMessage
    5964      write FOnSendMessage;
    60     property OnTurnEnd: TNotifyEvent read FOnTurnEnd
    61       write FOnTurnEnd;
     65    property OnTurnEnd: TNotifyEvent read FOnTurnEnd write FOnTurnEnd;
     66    property OnSurrender: TNotifyEvent read FOnSurrender write FOnSurrender;
    6267  end;
    6368
    … …  
    8287    if Command = Integer(cmdTurnEnd) then begin
    8388      if Assigned(FOnTurnEnd) then FOnTurnEnd(Self);
     89    end else
     90    if Command = Integer(cmdSurrender) then begin
     91      if Assigned(FOnSurrender) then FOnSurrender(Self);
    8492    end;
    8593  finally
    … …  
    133141end;
    134142
     143procedure TGameProtocolServer.NextPlayer;
     144begin
     145  SendCmd(cmdNextPlayer);
     146end;
     147
    135148{ TGameProtocol }
    136149
    … …  
    153166    if Command = Integer(cmdTurnStart) then begin
    154167      if Assigned(FOnTurnStart) then FOnTurnStart(Self);
     168    end else
     169    if Command = Integer(cmdNextPlayer) then begin
     170      if Assigned(FOnNextPlayer) then FOnNextPlayer(Self);
    155171    end;
    156172  finally
    … …  
    180196begin
    181197  SendCmd(cmdTurnEnd);
     198end;
     199
     200procedure TGameProtocolClient.Surrender;
     201begin
     202  SendCmd(cmdSurrender);
    182203end;
    183204

  • trunk/UGameServer.pas

    r211 r213  
    66
    77uses
    8   Classes, SysUtils, UGame, DOM, XMLConf, fgl, UGameProtocol;
     8  Classes, SysUtils, UGame, DOM, XMLConf, fgl, UGameProtocol, UCommFrame;
    99
    1010type
    … …  
    1515  TServerClient = class
    1616  private
    17     FOnReceiveCmd: TCommandEvent;
    18     procedure ReceiveCmd(Command: TCommand; DataOut, DataIn: TStream);
    1917    procedure DoTurnEnd(Sender: TObject);
     18    procedure DoSurrender(Sender: TObject);
    2019  public
    2120    Game: TGame;
    2221    Protocol: TGameProtocolServer;
    2322    Player: TPlayer;
     23    CommFrame: TCommFrame;
    2424    procedure DoChange;
    25     procedure SendCmd(Command: TCommand; DataOut, DataIn: TStream);
    2625    procedure TurnStart;
    2726    procedure GameEnd;
    28     property OnReceiveCmd: TCommandEvent read FOnReceiveCmd write
    29       FOnReceiveCmd;
     27    procedure NextPlayer;
    3028    constructor Create;
    3129    destructor Destroy; override;
    … …  
    6260    procedure InitClients;
    6361    procedure GameEnd;
     62    procedure NextPlayer;
    6463    procedure Clear;
    6564    constructor Create;
    … …  
    9493end;
    9594
    96 procedure TServerClient.SendCmd(Command: TCommand; DataOut, DataIn: TStream);
    97 begin
    98 
    99 end;
    100 
    10195procedure TServerClient.TurnStart;
    10296begin
    … …  
    109103end;
    110104
     105procedure TServerClient.NextPlayer;
     106begin
     107  Protocol.NextPlayer;
     108end;
     109
    111110constructor TServerClient.Create;
    112111begin
     112  CommFrame := TCommFrame.Create(nil);
    113113  Protocol := TGameProtocolServer.Create;
    114114  Protocol.OnTurnEnd := DoTurnEnd;
     115  Protocol.OnSurrender := DoSurrender;
     116  Protocol.Pin.Connect(CommFrame.FrameDataPin);
    115117end;
    116118
    … …  
    118120begin
    119121  Protocol.Free;
     122  CommFrame.Free;
    120123  inherited Destroy;
    121124end;
    122125
    123 procedure TServerClient.ReceiveCmd(Command: TCommand; DataOut, DataIn: TStream);
    124 begin
    125   if Assigned(FOnReceiveCmd) then
    126     FOnReceiveCmd(Command, DataOut, DataIn);
    127 end;
    128 
    129126procedure TServerClient.DoTurnEnd(Sender: TObject);
    130127begin
     128  if Game.Running then Game.NextPlayer;
     129end;
     130
     131procedure TServerClient.DoSurrender(Sender: TObject);
     132begin
     133  Player.Surrender;
    131134  if Game.Running then Game.NextPlayer;
    132135end;
    … …  
    249252end;
    250253
     254procedure TServer.NextPlayer;
     255var
     256  I: Integer;
     257begin
     258  for I := 0 to Clients.Count - 1 do
     259    Clients[I].NextPlayer;
     260end;
     261
    251262procedure TServer.Clear;
    252263begin

  • trunk/xtactics.lpi

    r206 r213  
    104104      </Item7>
    105105    </RequiredPackages>
    106     <Units Count="29">
     106    <Units Count="30">
    107107      <Unit0>
    108108        <Filename Value="xtactics.lpr"/>
    … …  
    266266        <ResourceBaseClass Value="Form"/>
    267267      </Unit28>
     268      <Unit29>
     269        <Filename Value="Packages/PinConnection/UCommFrame.pas"/>
     270        <IsPartOfProject Value="True"/>
     271      </Unit29>
    268272    </Units>
    269273  </ProjectOptions>
Note: See TracChangeset for help on using the changeset viewer.