Changeset 128

Timestamp:

Jun 17, 2017, 5:55:16 PM (7 years ago)

Author:

chronos

Message:

• Added: Graph window can be shown from menu which presents development of various statistic values during game turns.

Location:

trunk

Files:

• Forms/UFormCharts.lfm (added)
• Forms/UFormCharts.lrt (added)
• Forms/UFormCharts.pas (added)
• Forms/UFormMain.lfm (modified) (1 diff)
• Forms/UFormMain.pas (modified) (1 diff)
• Languages/xtactics.cs.po (modified) (2 diffs)
• Languages/xtactics.po (modified) (2 diffs)
• UCore.lfm (modified) (1 diff)
• UCore.lrt (modified) (1 diff)
• UCore.pas (modified) (7 diffs)
• UGame.pas (modified) (14 diffs)
• xtactics.lpi (modified) (3 diffs)
• xtactics.lpr (modified) (2 diffs)

trunk/Forms/UFormMain.lfm

@@ -194 +194 @@
         Action = Core.ASettings
       end
+      object MenuItem24: TMenuItem
+        Action = Core.AShowCharts
+      end
     end
     object MenuItem16: TMenuItem

trunk/Forms/UFormMain.pas

@@ -42 +42 @@
     MenuItem22: TMenuItem;
     MenuItem23: TMenuItem;
+    MenuItem24: TMenuItem;
     MenuItemLoadRecent: TMenuItem;
     MenuItem3: TMenuItem;

trunk/Languages/xtactics.cs.po

@@ -85 +85 @@
 msgstr "Nastavení aplikace"
 
+#: tcore.ashowcharts.caption
+msgid "Show charts"
+msgstr "Ukázat grafy"
+
 #: tformabout.buttonclose.caption
 msgid "Close"
@@ -111 +115 @@
 msgid "Turn-based strategy game inspired by classic Risk board game. The game is highly configurable to allow to adjust battle field and game rules."
 msgstr "Tahová strategie inspirovaná klasickou deskovou hrou Risk. Hra je vysoce nastavitelná a umožňuje přizpůsobit bitevní pole a herní pravidla."
+
+#: tformcharts.caption
+msgid "Charts"
+msgstr "Grafy"
+
+#: tformcharts.combobox1.text
+msgid "Occupied cells"
+msgstr "Obsazené buňky"
 
 #: tformhelp.caption

trunk/Languages/xtactics.po

@@ -75 +75 @@
 msgstr ""
 
+#: tcore.ashowcharts.caption
+msgid "Show charts"
+msgstr ""
+
 #: tformabout.buttonclose.caption
 msgid "Close"
@@ -102 +106 @@
 msgstr ""
 
+#: tformcharts.caption
+msgid "Charts"
+msgstr ""
+
+#: tformcharts.combobox1.text
+msgid "Occupied cells"
+msgstr ""
+
 #: tformhelp.caption
 msgctxt "TFORMHELP.CAPTION"

trunk/UCore.lfm

@@ -73 +73 @@
       Caption = 'Help'
       OnExecute = AHelpExecute
+    end
+    object AShowCharts: TAction
+      Caption = 'Show charts'
+      OnExecute = AShowChartsExecute
     end
   end

trunk/UCore.lrt

@@ -15 +15 @@
 TCORE.AABOUT.CAPTION=About
 TCORE.AHELP.CAPTION=Help
+TCORE.ASHOWCHARTS.CAPTION=Show charts

trunk/UCore.pas

@@ -16 +16 @@
   TCore = class(TDataModule)
     AAbout: TAction;
+    AShowCharts: TAction;
     AHelp: TAction;
     AGameSave: TAction;
@@ -46 +47 @@
     procedure AHelpExecute(Sender: TObject);
     procedure ASettingsExecute(Sender: TObject);
+    procedure AShowChartsExecute(Sender: TObject);
     procedure CoolTranslator1Translate(Sender: TObject);
     procedure DataModuleCreate(Sender: TObject);
@@ -92 +94 @@
 uses
   UFormMove, UFormMain, UFormNew, UFormSettings, UFormAbout, UFormPlayer,
-  UFormHelp;
+  UFormHelp, UFormCharts;
 
 const
@@ -354 +356 @@
 end;
 
+procedure TCore.AShowChartsExecute(Sender: TObject);
+begin
+  FormCharts.Show;
+end;
+
 procedure TCore.CoolTranslator1Translate(Sender: TObject);
 begin
@@ -400 +407 @@
   FormMain.AZoomAll.Execute;
   FormMain.Redraw;
+  if FormCharts.Visible then FormCharts.Redraw;
 end;
 
@@ -408 +416 @@
   Game.Running := True;
   FormMain.Redraw;
+  if FormCharts.Visible then FormCharts.Redraw;
   UpdateActions;
 end;
@@ -415 +424 @@
   if Assigned(Game.CurrentPlayer) and Assigned(Game.CurrentPlayer.Client) then
     CurrentClient := Game.CurrentPlayer.Client;
+  if FormCharts.Visible then FormCharts.Redraw;
 end;
 

trunk/UGame.pas

@@ -7 +7 @@
 uses
   Classes, SysUtils, ExtCtrls, Graphics, Contnrs, XMLConf, XMLRead, XMLWrite,
-  DOM, Math, FileUtil, UXMLUtils, Dialogs, Types, LCLType, LCLIntf;
+  DOM, Math, LazFileUtils, UXMLUtils, Dialogs, Types, LCLType, LCLIntf;
 
 const
@@ -243 +243 @@
   end;
 
+  { TGameTurnStat }
+
+  TGameTurnStat = class
+    OccupiedCells: Integer;
+    Units: Integer;
+    DiscoveredCells: Integer;
+    Cities: Integer;
+    procedure LoadFromNode(Node: TDOMNode);
+    procedure SaveToNode(Node: TDOMNode);
+  end;
+
+  { TGameTurnStats }
+
+  TGameTurnStats = class(TObjectList)
+    procedure LoadFromNode(Node: TDOMNode);
+    procedure SaveToNode(Node: TDOMNode);
+  end;
+
   TPlayerMode = (pmHuman, pmComputer);
   TComputerAgressivity = (caLow, caMedium, caHigh);
@@ -262 +280 @@
     TotalCells: Integer;
     TotalCities: Integer;
+    TotalDiscovered: Integer;
     StartUnits: Integer;
     StartCell: TCell;
@@ -267 +286 @@
     Defensive: Boolean;
     Agressivity: TComputerAgressivity;
+    TurnStats: TGameTurnStats;
+    procedure Clear;
     procedure LoadFromNode(Node: TDOMNode);
     procedure SaveToNode(Node: TDOMNode);
@@ -385 +406 @@
     procedure MoveAll(Player: TPlayer);
     procedure ClearMovesFromCell(Cell: TCell);
+    procedure RecordTurnStats;
     procedure SetMapType(AValue: TMapType);
     function SetMove(CellFrom, CellTo: TCell; Power: Integer; Confirmation: Boolean = True): TUnitMove;
@@ -543 +565 @@
 end;
 
+{ TGameTurnStat }
+
+procedure TGameTurnStat.LoadFromNode(Node: TDOMNode);
+begin
+  OccupiedCells := ReadInteger(Node, 'OccupiedCells', 0);
+  Units := ReadInteger(Node, 'Units', 0);
+  DiscoveredCells := ReadInteger(Node, 'DiscoveredCells', 0);
+  Cities := ReadInteger(Node, 'Cities', 0);
+end;
+
+procedure TGameTurnStat.SaveToNode(Node: TDOMNode);
+begin
+  WriteInteger(Node, 'OccupiedCells', OccupiedCells);
+  WriteInteger(Node, 'Units', Units);
+  WriteInteger(Node, 'DiscoveredCells', DiscoveredCells);
+  WriteInteger(Node, 'Cities', Cities);
+end;
+
+{ TGameTurnStats }
+
+procedure TGameTurnStats.LoadFromNode(Node: TDOMNode);
+var
+  Node2: TDOMNode;
+  NewTurnStat: TGameTurnStat;
+begin
+  Count := 0;
+  Node2 := Node.FirstChild;
+  while Assigned(Node2) and (Node2.NodeName = 'TurnStat') do begin
+    NewTurnStat := TGameTurnStat.Create;
+    NewTurnStat.LoadFromNode(Node2);
+    Add(NewTurnStat);
+    Node2 := Node2.NextSibling;
+  end;
+end;
+
+procedure TGameTurnStats.SaveToNode(Node: TDOMNode);
+var
+  I: Integer;
+  NewNode: TDOMNode;
+begin
+  for I := 0 to Count - 1 do begin;
+    NewNode := Node.OwnerDocument.CreateElement('TurnStat');
+    Node.AppendChild(NewNode);
+    TGameTurnStat(Items[I]).SaveToNode(NewNode);
+  end;
+end;
+
 { TClients }
 
@@ -1817 +1886 @@
 end;
 
+procedure TPlayer.Clear;
+begin
+  TurnStats.Clear;
+end;
+
 procedure TPlayer.SetClient(AValue: TClient);
 begin
@@ -1843 +1917 @@
       PlayerMap.LoadFromNode(NewNode);
   end;
+  with Node do begin
+    NewNode := FindNode('TurnStats');
+    if Assigned(NewNode) then
+      TurnStats.LoadFromNode(NewNode);
+  end;
 end;
 
@@ -1862 +1941 @@
     AppendChild(NewNode);
     PlayerMap.SaveToNode(NewNode);
+  end;
+  with Node do begin
+    NewNode := OwnerDocument.CreateElement('TurnStats');
+    AppendChild(NewNode);
+    TurnStats.SaveToNode(NewNode);
   end;
 end;
@@ -2247 +2331 @@
   PlayerMap := TPlayerMap.Create;
   PlayerMap.Player := Self;
+  TurnStats := TGameTurnStats.Create;
 end;
 
 destructor TPlayer.Destroy;
 begin
+  FreeAndNil(TurnStats);
   FreeAndNil(PlayerMap);
   inherited Destroy;
@@ -2884 +2970 @@
 var
   I: Integer;
+  J: Integer;
 begin
   for I := 0 to Players.Count - 1 do
@@ -2890 +2977 @@
     TotalCells := 0;
     TotalCities := 0;
-  end;
+
+    TotalDiscovered := 0;
+    for J := 0 to PlayerMap.Cells.Count - 1 do
+    with TPlayerCell(PlayerMap.Cells[J]) do begin
+      if Explored then Inc(TotalDiscovered);
+    end;
+  end;
+
   Map.ComputePlayerStats;
+end;
+
+procedure TGame.RecordTurnStats;
+var
+  I: Integer;
+  NewStat: TGameTurnStat;
+begin
+  for I := 0 to Players.Count - 1 do
+  with TPlayer(Players[I]) do begin
+    NewStat := TGameTurnStat.Create;
+    NewStat.DiscoveredCells := TotalDiscovered;
+    NewStat.OccupiedCells := TotalCells;
+    NewStat.Units := TotalUnits;
+    NewStat.Cities := TotalCities;
+    TurnStats.Add(NewStat);
+  end;
 end;
 
@@ -2927 +3037 @@
   UpdateRepeatMoves(CurrentPlayer);
   ComputePlayerStats;
+  RecordTurnStats;
   PrevPlayer := CurrentPlayer;
   // Skip dead players
@@ -3045 +3156 @@
   for I := 0 to Players.Count - 1 do
   with TPlayer(Players[I]) do begin
+    Clear;
     PlayerMap.Update;
     if (Map.Size.X > 0) and (Map.Size.Y > 0) then begin

trunk/xtactics.lpi

@@ -153 +153 @@
       </local>
     </RunParams>
-    <RequiredPackages Count="5">
+    <RequiredPackages Count="6">
       <Item1>
+        <PackageName Value="TAChartLazarusPkg"/>
+      </Item1>
+      <Item2>
         <PackageName Value="TemplateGenerics"/>
         <DefaultFilename Value="Packages/TemplateGenerics/TemplateGenerics.lpk" Prefer="True"/>
-      </Item1>
-      <Item2>
+      </Item2>
+      <Item3>
         <PackageName Value="Common"/>
         <DefaultFilename Value="Packages/Common/Common.lpk" Prefer="True"/>
-      </Item2>
-      <Item3>
-        <PackageName Value="FCL"/>
       </Item3>
       <Item4>
+        <PackageName Value="FCL"/>
+      </Item4>
+      <Item5>
         <PackageName Value="CoolTranslator"/>
         <DefaultFilename Value="Packages/CoolTranslator/CoolTranslator.lpk" Prefer="True"/>
-      </Item4>
-      <Item5>
+      </Item5>
+      <Item6>
         <PackageName Value="LCL"/>
-      </Item5>
+      </Item6>
     </RequiredPackages>
-    <Units Count="11">
+    <Units Count="12">
       <Unit0>
         <Filename Value="xtactics.lpr"/>
@@ -242 +245 @@
         <IsPartOfProject Value="True"/>
       </Unit10>
+      <Unit11>
+        <Filename Value="Forms/UFormCharts.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="FormCharts"/>
+        <ResourceBaseClass Value="Form"/>
+      </Unit11>
     </Units>
   </ProjectOptions>
@@ -284 +293 @@
     </Linking>
     <Other>
+      <CompilerMessages>
+        <IgnoredMessages idx5024="True"/>
+      </CompilerMessages>
       <CustomOptions Value="-dDEBUG"/>
     </Other>

trunk/xtactics.lpr

@@ -8 +8 @@
   {$ENDIF}
   Interfaces, // this includes the LCL widgetset
-  Forms, UGame, UCore, Common, CoolTranslator, TemplateGenerics,
-  UFormPlayer
+  Forms, tachartlazaruspkg, UGame, UCore, Common, CoolTranslator,
+  TemplateGenerics, UFormPlayer
   { you can add units after this },
   SysUtils, UFormSettings, UFormMain, UFormMove, UFormNew, UFormAbout,
-  UFormHelp, UMap;
+  UFormHelp, UMap, UFormCharts;
 
 {$R *.res}
@@ -37 +37 @@
   Application.CreateForm(TFormPlayer, FormPlayer);
   Application.CreateForm(TFormSettings, FormSettings);
+  Application.CreateForm(TFormCharts, FormCharts);
   Application.Run;
 end.