Changeset 128 for trunk


Ignore:
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:
3 added
10 edited

Legend:

Unmodified
Added
Removed

  • trunk/Forms/UFormMain.lfm

    r127 r128  
    194194        Action = Core.ASettings
    195195      end
     196      object MenuItem24: TMenuItem
     197        Action = Core.AShowCharts
     198      end
    196199    end
    197200    object MenuItem16: TMenuItem

  • trunk/Forms/UFormMain.pas

    r127 r128  
    4242    MenuItem22: TMenuItem;
    4343    MenuItem23: TMenuItem;
     44    MenuItem24: TMenuItem;
    4445    MenuItemLoadRecent: TMenuItem;
    4546    MenuItem3: TMenuItem;

  • trunk/Languages/xtactics.cs.po

    r127 r128  
    8585msgstr "Nastavení aplikace"
    8686
     87#: tcore.ashowcharts.caption
     88msgid "Show charts"
     89msgstr "Ukázat grafy"
     90
    8791#: tformabout.buttonclose.caption
    8892msgid "Close"
    … …  
    111115msgid "Turn-based strategy game inspired by classic Risk board game. The game is highly configurable to allow to adjust battle field and game rules."
    112116msgstr "Tahová strategie inspirovaná klasickou deskovou hrou Risk. Hra je vysoce nastavitelná a umožňuje přizpůsobit bitevní pole a herní pravidla."
     117
     118#: tformcharts.caption
     119msgid "Charts"
     120msgstr "Grafy"
     121
     122#: tformcharts.combobox1.text
     123msgid "Occupied cells"
     124msgstr "Obsazené buňky"
    113125
    114126#: tformhelp.caption

  • trunk/Languages/xtactics.po

    r127 r128  
    7575msgstr ""
    7676
     77#: tcore.ashowcharts.caption
     78msgid "Show charts"
     79msgstr ""
     80
    7781#: tformabout.buttonclose.caption
    7882msgid "Close"
    … …  
    102106msgstr ""
    103107
     108#: tformcharts.caption
     109msgid "Charts"
     110msgstr ""
     111
     112#: tformcharts.combobox1.text
     113msgid "Occupied cells"
     114msgstr ""
     115
    104116#: tformhelp.caption
    105117msgctxt "TFORMHELP.CAPTION"

  • trunk/UCore.lfm

    r127 r128  
    7373      Caption = 'Help'
    7474      OnExecute = AHelpExecute
     75    end
     76    object AShowCharts: TAction
     77      Caption = 'Show charts'
     78      OnExecute = AShowChartsExecute
    7579    end
    7680  end

  • trunk/UCore.lrt

    r124 r128  
    1515TCORE.AABOUT.CAPTION=About
    1616TCORE.AHELP.CAPTION=Help
     17TCORE.ASHOWCHARTS.CAPTION=Show charts

  • trunk/UCore.pas

    r127 r128  
    1616  TCore = class(TDataModule)
    1717    AAbout: TAction;
     18    AShowCharts: TAction;
    1819    AHelp: TAction;
    1920    AGameSave: TAction;
    … …  
    4647    procedure AHelpExecute(Sender: TObject);
    4748    procedure ASettingsExecute(Sender: TObject);
     49    procedure AShowChartsExecute(Sender: TObject);
    4850    procedure CoolTranslator1Translate(Sender: TObject);
    4951    procedure DataModuleCreate(Sender: TObject);
    … …  
    9294uses
    9395  UFormMove, UFormMain, UFormNew, UFormSettings, UFormAbout, UFormPlayer,
    94   UFormHelp;
     96  UFormHelp, UFormCharts;
    9597
    9698const
    … …  
    354356end;
    355357
     358procedure TCore.AShowChartsExecute(Sender: TObject);
     359begin
     360  FormCharts.Show;
     361end;
     362
    356363procedure TCore.CoolTranslator1Translate(Sender: TObject);
    357364begin
    … …  
    400407  FormMain.AZoomAll.Execute;
    401408  FormMain.Redraw;
     409  if FormCharts.Visible then FormCharts.Redraw;
    402410end;
    403411
    … …  
    408416  Game.Running := True;
    409417  FormMain.Redraw;
     418  if FormCharts.Visible then FormCharts.Redraw;
    410419  UpdateActions;
    411420end;
    … …  
    415424  if Assigned(Game.CurrentPlayer) and Assigned(Game.CurrentPlayer.Client) then
    416425    CurrentClient := Game.CurrentPlayer.Client;
     426  if FormCharts.Visible then FormCharts.Redraw;
    417427end;
    418428

  • trunk/UGame.pas

    r127 r128  
    77uses
    88  Classes, SysUtils, ExtCtrls, Graphics, Contnrs, XMLConf, XMLRead, XMLWrite,
    9   DOM, Math, FileUtil, UXMLUtils, Dialogs, Types, LCLType, LCLIntf;
     9  DOM, Math, LazFileUtils, UXMLUtils, Dialogs, Types, LCLType, LCLIntf;
    1010
    1111const
    … …  
    243243  end;
    244244
     245  { TGameTurnStat }
     246
     247  TGameTurnStat = class
     248    OccupiedCells: Integer;
     249    Units: Integer;
     250    DiscoveredCells: Integer;
     251    Cities: Integer;
     252    procedure LoadFromNode(Node: TDOMNode);
     253    procedure SaveToNode(Node: TDOMNode);
     254  end;
     255
     256  { TGameTurnStats }
     257
     258  TGameTurnStats = class(TObjectList)
     259    procedure LoadFromNode(Node: TDOMNode);
     260    procedure SaveToNode(Node: TDOMNode);
     261  end;
     262
    245263  TPlayerMode = (pmHuman, pmComputer);
    246264  TComputerAgressivity = (caLow, caMedium, caHigh);
    … …  
    262280    TotalCells: Integer;
    263281    TotalCities: Integer;
     282    TotalDiscovered: Integer;
    264283    StartUnits: Integer;
    265284    StartCell: TCell;
    … …  
    267286    Defensive: Boolean;
    268287    Agressivity: TComputerAgressivity;
     288    TurnStats: TGameTurnStats;
     289    procedure Clear;
    269290    procedure LoadFromNode(Node: TDOMNode);
    270291    procedure SaveToNode(Node: TDOMNode);
    … …  
    385406    procedure MoveAll(Player: TPlayer);
    386407    procedure ClearMovesFromCell(Cell: TCell);
     408    procedure RecordTurnStats;
    387409    procedure SetMapType(AValue: TMapType);
    388410    function SetMove(CellFrom, CellTo: TCell; Power: Integer; Confirmation: Boolean = True): TUnitMove;
    … …  
    543565end;
    544566
     567{ TGameTurnStat }
     568
     569procedure TGameTurnStat.LoadFromNode(Node: TDOMNode);
     570begin
     571  OccupiedCells := ReadInteger(Node, 'OccupiedCells', 0);
     572  Units := ReadInteger(Node, 'Units', 0);
     573  DiscoveredCells := ReadInteger(Node, 'DiscoveredCells', 0);
     574  Cities := ReadInteger(Node, 'Cities', 0);
     575end;
     576
     577procedure TGameTurnStat.SaveToNode(Node: TDOMNode);
     578begin
     579  WriteInteger(Node, 'OccupiedCells', OccupiedCells);
     580  WriteInteger(Node, 'Units', Units);
     581  WriteInteger(Node, 'DiscoveredCells', DiscoveredCells);
     582  WriteInteger(Node, 'Cities', Cities);
     583end;
     584
     585{ TGameTurnStats }
     586
     587procedure TGameTurnStats.LoadFromNode(Node: TDOMNode);
     588var
     589  Node2: TDOMNode;
     590  NewTurnStat: TGameTurnStat;
     591begin
     592  Count := 0;
     593  Node2 := Node.FirstChild;
     594  while Assigned(Node2) and (Node2.NodeName = 'TurnStat') do begin
     595    NewTurnStat := TGameTurnStat.Create;
     596    NewTurnStat.LoadFromNode(Node2);
     597    Add(NewTurnStat);
     598    Node2 := Node2.NextSibling;
     599  end;
     600end;
     601
     602procedure TGameTurnStats.SaveToNode(Node: TDOMNode);
     603var
     604  I: Integer;
     605  NewNode: TDOMNode;
     606begin
     607  for I := 0 to Count - 1 do begin;
     608    NewNode := Node.OwnerDocument.CreateElement('TurnStat');
     609    Node.AppendChild(NewNode);
     610    TGameTurnStat(Items[I]).SaveToNode(NewNode);
     611  end;
     612end;
     613
    545614{ TClients }
    546615
    … …  
    18171886end;
    18181887
     1888procedure TPlayer.Clear;
     1889begin
     1890  TurnStats.Clear;
     1891end;
     1892
    18191893procedure TPlayer.SetClient(AValue: TClient);
    18201894begin
    … …  
    18431917      PlayerMap.LoadFromNode(NewNode);
    18441918  end;
     1919  with Node do begin
     1920    NewNode := FindNode('TurnStats');
     1921    if Assigned(NewNode) then
     1922      TurnStats.LoadFromNode(NewNode);
     1923  end;
    18451924end;
    18461925
    … …  
    18621941    AppendChild(NewNode);
    18631942    PlayerMap.SaveToNode(NewNode);
     1943  end;
     1944  with Node do begin
     1945    NewNode := OwnerDocument.CreateElement('TurnStats');
     1946    AppendChild(NewNode);
     1947    TurnStats.SaveToNode(NewNode);
    18641948  end;
    18651949end;
    … …  
    22472331  PlayerMap := TPlayerMap.Create;
    22482332  PlayerMap.Player := Self;
     2333  TurnStats := TGameTurnStats.Create;
    22492334end;
    22502335
    22512336destructor TPlayer.Destroy;
    22522337begin
     2338  FreeAndNil(TurnStats);
    22532339  FreeAndNil(PlayerMap);
    22542340  inherited Destroy;
    … …  
    28842970var
    28852971  I: Integer;
     2972  J: Integer;
    28862973begin
    28872974  for I := 0 to Players.Count - 1 do
    … …  
    28902977    TotalCells := 0;
    28912978    TotalCities := 0;
    2892   end;
     2979
     2980    TotalDiscovered := 0;
     2981    for J := 0 to PlayerMap.Cells.Count - 1 do
     2982    with TPlayerCell(PlayerMap.Cells[J]) do begin
     2983      if Explored then Inc(TotalDiscovered);
     2984    end;
     2985  end;
     2986
    28932987  Map.ComputePlayerStats;
     2988end;
     2989
     2990procedure TGame.RecordTurnStats;
     2991var
     2992  I: Integer;
     2993  NewStat: TGameTurnStat;
     2994begin
     2995  for I := 0 to Players.Count - 1 do
     2996  with TPlayer(Players[I]) do begin
     2997    NewStat := TGameTurnStat.Create;
     2998    NewStat.DiscoveredCells := TotalDiscovered;
     2999    NewStat.OccupiedCells := TotalCells;
     3000    NewStat.Units := TotalUnits;
     3001    NewStat.Cities := TotalCities;
     3002    TurnStats.Add(NewStat);
     3003  end;
    28943004end;
    28953005
    … …  
    29273037  UpdateRepeatMoves(CurrentPlayer);
    29283038  ComputePlayerStats;
     3039  RecordTurnStats;
    29293040  PrevPlayer := CurrentPlayer;
    29303041  // Skip dead players
    … …  
    30453156  for I := 0 to Players.Count - 1 do
    30463157  with TPlayer(Players[I]) do begin
     3158    Clear;
    30473159    PlayerMap.Update;
    30483160    if (Map.Size.X > 0) and (Map.Size.Y > 0) then begin

  • trunk/xtactics.lpi

    r125 r128  
    153153      </local>
    154154    </RunParams>
    155     <RequiredPackages Count="5">
     155    <RequiredPackages Count="6">
    156156      <Item1>
     157        <PackageName Value="TAChartLazarusPkg"/>
     158      </Item1>
     159      <Item2>
    157160        <PackageName Value="TemplateGenerics"/>
    158161        <DefaultFilename Value="Packages/TemplateGenerics/TemplateGenerics.lpk" Prefer="True"/>
    159       </Item1>
    160       <Item2>
     162      </Item2>
     163      <Item3>
    161164        <PackageName Value="Common"/>
    162165        <DefaultFilename Value="Packages/Common/Common.lpk" Prefer="True"/>
    163       </Item2>
    164       <Item3>
    165         <PackageName Value="FCL"/>
    166166      </Item3>
    167167      <Item4>
     168        <PackageName Value="FCL"/>
     169      </Item4>
     170      <Item5>
    168171        <PackageName Value="CoolTranslator"/>
    169172        <DefaultFilename Value="Packages/CoolTranslator/CoolTranslator.lpk" Prefer="True"/>
    170       </Item4>
    171       <Item5>
     173      </Item5>
     174      <Item6>
    172175        <PackageName Value="LCL"/>
    173       </Item5>
     176      </Item6>
    174177    </RequiredPackages>
    175     <Units Count="11">
     178    <Units Count="12">
    176179      <Unit0>
    177180        <Filename Value="xtactics.lpr"/>
    … …  
    242245        <IsPartOfProject Value="True"/>
    243246      </Unit10>
     247      <Unit11>
     248        <Filename Value="Forms/UFormCharts.pas"/>
     249        <IsPartOfProject Value="True"/>
     250        <ComponentName Value="FormCharts"/>
     251        <ResourceBaseClass Value="Form"/>
     252      </Unit11>
    244253    </Units>
    245254  </ProjectOptions>
    … …  
    284293    </Linking>
    285294    <Other>
     295      <CompilerMessages>
     296        <IgnoredMessages idx5024="True"/>
     297      </CompilerMessages>
    286298      <CustomOptions Value="-dDEBUG"/>
    287299    </Other>

  • trunk/xtactics.lpr

    r115 r128  
    88  {$ENDIF}
    99  Interfaces, // this includes the LCL widgetset
    10   Forms, UGame, UCore, Common, CoolTranslator, TemplateGenerics,
    11   UFormPlayer
     10  Forms, tachartlazaruspkg, UGame, UCore, Common, CoolTranslator,
     11  TemplateGenerics, UFormPlayer
    1212  { you can add units after this },
    1313  SysUtils, UFormSettings, UFormMain, UFormMove, UFormNew, UFormAbout,
    14   UFormHelp, UMap;
     14  UFormHelp, UMap, UFormCharts;
    1515
    1616{$R *.res}
    … …  
    3737  Application.CreateForm(TFormPlayer, FormPlayer);
    3838  Application.CreateForm(TFormSettings, FormSettings);
     39  Application.CreateForm(TFormCharts, FormCharts);
    3940  Application.Run;
    4041end.
Note: See TracChangeset for help on using the changeset viewer.