Changeset 220 for trunk

Timestamp:

Jun 10, 2018, 12:18:28 PM (6 years ago)

Author:

chronos

Message:

• Added: Allow to toggle Fog of war in debug mode from Debug menu.

Location:

trunk

Files:

• Forms/UFormMain.lfm (modified) (3 diffs)
• Forms/UFormMain.pas (modified) (2 diffs)
• Forms/UFormSettings.lfm (modified) (12 diffs)
• Languages/xtactics.cs.po (modified) (4 diffs)
• Languages/xtactics.po (modified) (3 diffs)
• UCore.lfm (modified) (1 diff)
• UCore.pas (modified) (3 diffs)
• UGame.pas (modified) (3 diffs)
• UGameClient.pas (modified) (3 diffs)
• UGameProtocol.pas (modified) (6 diffs)
• UGameServer.pas (modified) (3 diffs)

trunk/Forms/UFormMain.lfm

@@ -5 +5 @@
   Width = 775
   Caption = 'xTactics'
-  ClientHeight = 596
+  ClientHeight = 587
   ClientWidth = 775
-  DesignTimePPI = 120
+  DesignTimePPI = 144
   Menu = MainMenu1
   OnClose = FormClose
@@ -77 +77 @@
   object PanelMain: TPanel
     Left = 0
-    Height = 556
+    Height = 547
     Top = 40
     Width = 775
@@ -169 +169 @@
       end
     end
+    object MenuItemDebug: TMenuItem
+      Caption = 'Debug'
+      object MenuItem31: TMenuItem
+        Action = Core.AToggleFogOfWar
+      end
+    end
     object MenuItem16: TMenuItem
       Caption = 'Help'

trunk/Forms/UFormMain.pas

@@ -44 +44 @@
     MenuItem28: TMenuItem;
     MenuItem29: TMenuItem;
+    MenuItemDebug: TMenuItem;
+    MenuItem31: TMenuItem;
     MenuItem4: TMenuItem;
     MenuItemLoadRecent: TMenuItem;
@@ -149 +151 @@
   FormClient.ManualDock(PanelMain, nil, alClient);
   FormClient.Align := alClient;
+  {$IFDEF DEBUG}
+  MenuItemDebug.Visible := True;
+  MenuItemDebug.Enabled := True;
+  {$ELSE}
+  MenuItemDebug.Visible := False;
+  MenuItemDebug.Enabled := False;
+  {$ENDIF}
 end;
 

trunk/Forms/UFormSettings.lfm

@@ -10 +10 @@
   Constraints.MinHeight = 327
   Constraints.MinWidth = 554
-  DesignTimePPI = 120
+  DesignTimePPI = 144
   OnCreate = FormCreate
   OnShow = FormShow
@@ -40 +40 @@
     Top = 4
     Width = 546
-    ActivePage = TabSheetGeneral
+    ActivePage = TabSheetDebug
     Align = alTop
     Anchors = [akTop, akLeft, akRight, akBottom]
     BorderSpacing.Around = 4
-    TabIndex = 0
+    TabIndex = 1
     TabOrder = 2
     object TabSheetGeneral: TTabSheet
       Caption = 'General'
-      ClientHeight = 231
-      ClientWidth = 538
+      ClientHeight = 220
+      ClientWidth = 540
       object Label2: TLabel
         Left = 20
-        Height = 20
+        Height = 26
         Top = 78
-        Width = 116
+        Width = 150
         Caption = 'Animation speed:'
         ParentColor = False
@@ -60 +60 @@
       object SpinEditAnimSpeed: TSpinEdit
         Left = 232
-        Height = 28
+        Height = 36
         Top = 72
         Width = 122
@@ -67 +67 @@
       object Label3: TLabel
         Left = 368
-        Height = 20
+        Height = 26
         Top = 82
-        Width = 12
+        Width = 15
         Caption = '%'
         ParentColor = False
@@ -77 +77 @@
         Height = 27
         Top = 112
-        Width = 584
+        Width = 586
         Anchors = [akTop, akLeft, akRight]
         AutoSize = False
@@ -85 +85 @@
       object Label1: TLabel
         Left = 20
-        Height = 20
+        Height = 26
         Top = 26
-        Width = 68
+        Width = 88
         Caption = 'Language:'
         ParentColor = False
@@ -93 +93 @@
       object ComboBoxLanguage: TComboBox
         Left = 178
-        Height = 28
+        Height = 40
         Top = 24
         Width = 196
-        ItemHeight = 20
+        ItemHeight = 0
         Style = csDropDownList
         TabOrder = 2
@@ -102 +102 @@
       object CheckBoxReopenLastFile: TCheckBox
         Left = 20
-        Height = 24
+        Height = 30
         Top = 152
-        Width = 198
+        Width = 249
         Caption = 'Reopen last game on start'
         TabOrder = 3
@@ -125 +125 @@
       object Label4: TLabel
         Left = 14
-        Height = 25
+        Height = 26
         Top = 67
-        Width = 32
+        Width = 35
         Caption = 'DPI:'
         ParentColor = False
@@ -133 +133 @@
       object SpinEditX: TSpinEdit
         Left = 104
-        Height = 33
+        Height = 36
         Top = 64
         Width = 96
@@ -143 +143 @@
       object SpinEditY: TSpinEdit
         Left = 232
-        Height = 33
+        Height = 36
         Top = 64
         Width = 90
@@ -153 +153 @@
       object Label5: TLabel
         Left = 208
-        Height = 25
+        Height = 26
         Top = 67
-        Width = 8
+        Width = 10
         Caption = 'x'
         ParentColor = False

trunk/Languages/xtactics.cs.po

@@ -103 +103 @@
 msgstr "Pohyby jednotek"
 
+#: tcore.atogglefogofwar.caption
+msgid "Toggle fog of war"
+msgstr "Přepnout Skrytou mapu"
+
 #: tformabout.buttonclose.caption
 msgid "Close"
@@ -278 +282 @@
 msgstr "Nástroje"
 
+#: tformmain.menuitemdebug.caption
+msgctxt "tformmain.menuitemdebug.caption"
+msgid "Debug"
+msgstr "Ladění"
+
 #: tformmain.menuitemloadrecent.caption
 msgctxt "tformmain.menuitemloadrecent.caption"
@@ -711 +720 @@
 
 #: tformsettings.tabsheetdebug.caption
+msgctxt "tformsettings.tabsheetdebug.caption"
 msgid "Debug"
 msgstr "Ladění"
@@ -1026 +1036 @@
 msgid "64-bit UInt read overflow."
 msgstr "Přetečení při čtení 64-bit UInt"
-

trunk/Languages/xtactics.po

@@ -93 +93 @@
 msgstr ""
 
+#: tcore.atogglefogofwar.caption
+msgid "Toggle fog of war"
+msgstr ""
+
 #: tformabout.buttonclose.caption
 msgid "Close"
@@ -267 +271 @@
 msgstr ""
 
+#: tformmain.menuitemdebug.caption
+msgctxt "tformmain.menuitemdebug.caption"
+msgid "Debug"
+msgstr ""
+
 #: tformmain.menuitemloadrecent.caption
 msgctxt "tformmain.menuitemloadrecent.caption"
@@ -696 +705 @@
 
 #: tformsettings.tabsheetdebug.caption
+msgctxt "tformsettings.tabsheetdebug.caption"
 msgid "Debug"
 msgstr ""

trunk/UCore.lfm

@@ -98 +98 @@
       Caption = 'Key shortcuts'
       OnExecute = AShowKeyShortcutsExecute
+    end
+    object AToggleFogOfWar: TAction
+      Caption = 'Toggle fog of war'
+      OnExecute = AToggleFogOfWarExecute
     end
   end

trunk/UCore.pas

@@ -17 +17 @@
   TCore = class(TDataModule)
     AAbout: TAction;
+    AToggleFogOfWar: TAction;
     AShowKeyShortcuts: TAction;
     AGameSave: TAction;
@@ -57 +58 @@
     procedure AShowKeyShortcutsExecute(Sender: TObject);
     procedure AShowUnitMovesExecute(Sender: TObject);
+    procedure AToggleFogOfWarExecute(Sender: TObject);
     procedure CoolTranslator1Translate(Sender: TObject);
     procedure DataModuleCreate(Sender: TObject);
@@ -389 +391 @@
 end;
 
+procedure TCore.AToggleFogOfWarExecute(Sender: TObject);
+begin
+  Game.FogOfWar := not Game.FogOfWar;
+  Server.DoChange(Self);
+end;
+
 procedure TCore.CoolTranslator1Translate(Sender: TObject);
 begin

trunk/UGame.pas

@@ -207 +207 @@
     CellLinks: TCellLinks;
     Areas: TMapAreas;
+    Cyclic: Boolean;
     function IsOutsideShape(Coord: TPoint): Boolean; virtual;
     function IsCellsNeighbor(Cell1, Cell2: TCell): Boolean; virtual;
@@ -946 +947 @@
         else Pen.Width := 1;
       Angle := ArcTan((PosTo.Y - PosFrom.Y) / (PosTo.X - PosFrom.X));
+      if (Angle > +Pi) or (Angle < -Pi) then
+        raise Exception.Create('Wrong arrow angle ' + FloatToStr(Angle));
+
       if Sign(PosTo.X - PosFrom.X) = -1 then Angle := Angle + Pi;
       ArrowCenter := View.CellToCanvasPos(TPoint.Create(Trunc(PosFrom.X + (PosTo.X - PosFrom.X) / 2),
@@ -3246 +3250 @@
     for I := 0 to Cells.Count - 1 do begin
       if I = 0 then Player := Cells[I].Player;
-      if not Assigned(Cells[I].Player) or (Cells[I].Player <> Player) then begin
+      if not Assigned(Cells[I].Player) then begin
+        R := False;
+        Break;
+      end;
+      if (Cells[I].Player <> Player) then begin
         R := False;
         Break;

trunk/UGameClient.pas

@@ -44 +44 @@
     procedure DoNextPlayerHandler(Sender: TObject);
     procedure DoNextPlayer;
+    procedure DoParametersChangedHandler(Sender: TObject);
   public
     Name: string;
@@ -172 +173 @@
 end;
 
+procedure TClient.DoParametersChangedHandler(Sender: TObject);
+begin
+  Synchronize(DoChange);
+end;
+
 procedure TClient.SetControlPlayer(AValue: TPlayer);
 begin
@@ -232 +238 @@
   Protocol.OnGameEnd := DoGameEndHandler;
   Protocol.OnNextPlayer := DoNextPlayerHandler;
+  Protocol.OnParametersChanged := DoParametersChangedHandler;
 end;
 

trunk/UGameProtocol.pas

@@ -10 +10 @@
 type
   TCommand = (cmdTextMessage, cmdTurnStart, cmdTurnEnd, cmdGameStart, cmdGameEnd,
-    cmdSurrender, cmdNextPlayer);
+    cmdSurrender, cmdNextPlayer, cmdParametersChanged);
   TCommandEvent = procedure (Command: TCommand; DataIn, DataOut: TStream);
 
@@ -24 +24 @@
     FOnGameStart: TNotifyEvent;
     FOnNextPlayer: TNotifyEvent;
+    FOnParametersChanged: TNotifyEvent;
     FOnTurnStart: TNotifyEvent;
     procedure Receive(Sender: TCommPin; Stream: TListByte);
@@ -38 +39 @@
     property OnTurnStart: TNotifyEvent read FOnTurnStart write FOnTurnStart;
     property OnNextPlayer: TNotifyEvent read FOnNextPlayer write FOnNextPlayer;
+    property OnParametersChanged: TNotifyEvent read FOnParametersChanged
+      write FOnParametersChanged;
   end;
 
@@ -58 +61 @@
     procedure GameEnd;
     procedure TurnStart;
+    procedure ParametersChanged;
     procedure NextPlayer;
     property OnSendMessage: TSendMessageEvent read FOnSendMessage
@@ -139 +143 @@
 end;
 
+procedure TGameProtocolServer.ParametersChanged;
+begin
+  SendCmd(cmdParametersChanged);
+end;
+
 procedure TGameProtocolServer.NextPlayer;
 begin
@@ -167 +176 @@
     if Command = Integer(cmdNextPlayer) then begin
       if Assigned(FOnNextPlayer) then FOnNextPlayer(Self);
+    end else
+    if Command = Integer(cmdParametersChanged) then begin
+      if Assigned(FOnParametersChanged) then FOnParametersChanged(Self);
     end;
   finally

trunk/UGameServer.pas

@@ -47 +47 @@
     procedure SetGame(AValue: TGame);
     procedure SetServerMode(AValue: TServerMode);
-    procedure DoChange(Sender: TObject);
     procedure GameStarted(Sender: TObject);
   public
@@ -55 +54 @@
     RemoteNetworkAddress: string;
     RemoteNetworkPort: Word;
+    procedure DoChange(Sender: TObject);
     function GetNewServerClient: TServerClient;
     procedure LoadConfig(Config: TXmlConfig; Path: string);
@@ -90 +90 @@
 procedure TServerClient.DoChange;
 begin
-
+  Protocol.ParametersChanged;
 end;