Changeset 336


Ignore:
Timestamp:
Sep 7, 2024, 10:29:16 PM (9 days ago)
Author:
chronos
Message:
  • Added: Automated tests accessible in debug mode.
  • Fixed: Player units internal links.
  • Fixed: List items id regeneration before game save.
Location:
trunk
Files:
1 added
13 edited

Legend:

Unmodified
Added
Removed

  • trunk/Core.lfm

    r335 r336  
    1313    Top = 60
    1414    object AExit: TAction
     15      Category = 'Game'
    1516      Caption = 'Exit'
    1617      Hint = 'Exit application'
    … …  
    6465    end
    6566    object ASettings: TAction
     67      Category = 'Tools'
    6668      Caption = 'Settings'
    6769      Hint = 'Application settings'
    … …  
    7173    end
    7274    object AAbout: TAction
     75      Category = 'Help'
    7376      Caption = 'About'
    7477      ImageIndex = 2
    … …  
    7679    end
    7780    object AHelp: TAction
     81      Category = 'Help'
    7882      Caption = 'Help'
    7983      ImageIndex = 14
    … …  
    8185    end
    8286    object AShowCharts: TAction
     87      Category = 'Tools'
    8388      Caption = 'Charts'
    8489      OnExecute = AShowChartsExecute
    8590    end
    8691    object AShowUnitMoves: TAction
     92      Category = 'Tools'
    8793      Caption = 'Unit moves'
    8894      OnExecute = AShowUnitMovesExecute
    … …  
    9399    end
    94100    object APlayersStats: TAction
     101      Category = 'Tools'
    95102      Caption = 'Players statistics'
    96103      ImageIndex = 15
    … …  
    98105    end
    99106    object AShowKeyShortcuts: TAction
     107      Category = 'Help'
    100108      Caption = 'Key shortcuts'
    101109      ImageIndex = 12
    … …  
    103111    end
    104112    object AToggleFogOfWar: TAction
     113      Category = 'Debug'
    105114      Caption = 'Toggle fog of war'
    106115      OnExecute = AToggleFogOfWarExecute
    107116    end
    108117    object AFullscreen: TAction
     118      Category = 'View'
    109119      Caption = 'Full screen mode'
    110120      ImageIndex = 13
    111121      OnExecute = AFullscreenExecute
    112122      ShortCut = 122
     123    end
     124    object ATests: TAction
     125      Category = 'Debug'
     126      Caption = 'Tests'
     127      OnExecute = ATestsExecute
    113128    end
    114129  end

  • trunk/Core.lrj

    r335 r336  
    2222{"hash":91608562,"name":"tcore.atogglefogofwar.caption","sourcebytes":[84,111,103,103,108,101,32,102,111,103,32,111,102,32,119,97,114],"value":"Toggle fog of war"},
    2323{"hash":108810549,"name":"tcore.afullscreen.caption","sourcebytes":[70,117,108,108,32,115,99,114,101,101,110,32,109,111,100,101],"value":"Full screen mode"},
     24{"hash":5950131,"name":"tcore.atests.caption","sourcebytes":[84,101,115,116,115],"value":"Tests"},
    2425{"hash":160200403,"name":"tcore.savedialog1.title","sourcebytes":[83,97,118,101,32,97,115],"value":"Save as"},
    2526{"hash":131198430,"name":"tcore.applicationinfo.description","sourcebytes":[65,32,116,117,114,110,45,98,97,115,101,100,32,115,116,114,97,116,101,103,121,32,103,97,109,101,32,105,110,115,112,105,114,101,100,32,98,121,32,99,108,97,115,115,105,99,32,82,105,115,107,32,98,111,97,114,100,32,103,97,109,101,46,32,84,104,101,32,103,97,109,101,32,105,115,32,104,105,103,104,108,121,32,99,111,110,102,105,103,117,114,97,98,108,101,32,116,111,32,97,108,108,111,119,32,116,111,32,97,100,106,117,115,116,32,98,97,116,116,108,101,32,102,105,101,108,100,32,97,110,100,32,103,97,109,101,32,114,117,108,101,115,46],"value":"A turn-based strategy game inspired by classic Risk board game. The game is highly configurable to allow to adjust battle field and game rules."}

  • trunk/Core.pas

    r330 r336  
    1616  TCore = class(TDataModule)
    1717    AAbout: TAction;
     18    ATests: TAction;
    1819    AFullscreen: TAction;
    1920    AToggleFogOfWar: TAction;
    … …  
    6061    procedure AShowKeyShortcutsExecute(Sender: TObject);
    6162    procedure AShowUnitMovesExecute(Sender: TObject);
     63    procedure ATestsExecute(Sender: TObject);
    6264    procedure AToggleFogOfWarExecute(Sender: TObject);
    6365    procedure Translator1Translate(Sender: TObject);
    … …  
    127129
    128130uses
    129   FormNew, FormSettings, ClientAI, FormKeyShortcuts, Common, FormEx,
    130   FormHelp, FormUnitMoves, FormPlayersStats, ClientGUI, FormAbout;
     131  FormNew, FormSettings, ClientAI, FormKeyShortcuts, Common, FormEx, FormTests,
     132  FormHelp, FormUnitMoves, FormPlayersStats, ClientGUI, FormAbout, Tests;
    131133
    132134const
    … …  
    292294procedure TCore.UpdateInterface;
    293295begin
    294   Core.AGameEnd.Enabled := Game.Running;
    295   Core.AFullscreen.Checked := FormMain.FullScreen;
     296  AGameEnd.Enabled := Game.Running;
     297  AFullscreen.Checked := FormMain.FullScreen;
     298  {$ifdef DEBUG}
     299  ATests.Visible := True;
     300  ATests.Enabled := True;
     301  {$else}
     302  ATests.Visible := False;
     303  ATests.Enabled := False;
     304  {$endif}
    296305end;
    297306
    … …  
    470479  FormMain.FormUnitMoves.Game := Game;
    471480  FormMain.FormUnitMoves.Show;
     481end;
     482
     483procedure TCore.ATestsExecute(Sender: TObject);
     484var
     485  FormTests: TFormTests;
     486begin
     487  FormTests := TFormTests.Create(nil);
     488  FormTests.TestCases := GetTestCases;
     489  FormTests.ShowModal;
     490  FormTests.Free;
    472491end;
    473492

  • trunk/Forms/FormMain.lfm

    r331 r336  
    193193        Action = Core.AToggleFogOfWar
    194194      end
     195      object MenuItem36: TMenuItem
     196        Action = Core.ATests
     197      end
    195198    end
    196199    object MenuItem16: TMenuItem

  • trunk/Forms/FormMain.pas

    r333 r336  
    5151    MenuItem34: TMenuItem;
    5252    MenuItem35: TMenuItem;
     53    MenuItem36: TMenuItem;
    5354    MenuItemDebug: TMenuItem;
    5455    MenuItem31: TMenuItem;

  • trunk/Game.pas

    r317 r336  
    9999    procedure New;
    100100    procedure EndGame(Winner: TPlayer = nil);
     101    function Compare(Game: TGame): Boolean;
    101102    property Running: Boolean read FRunning write SetRunning;
    102103    property MapType: TMapType read FMapType write SetMapType;
    … …  
    887888  for I := 0 to Players.Count - 1 do TPlayer(Players[I]).Clear;
    888889  Map.Clear;
     890  Units.Clear;
    889891end;
    890892
    … …  
    924926end;
    925927
     928function TGame.Compare(Game: TGame): Boolean;
     929begin
     930  Result := BridgeEnabled = Game.BridgeEnabled;
     931end;
     932
    926933end.

  • trunk/ItemList.pas

    r334 r336  
    7979  private
    8080    procedure RecalculateNewId(Reset: Boolean);
     81    procedure RecalculateItemsId;
    8182  public
    8283    NewId: Integer;
    … …  
    147148  for I := 0 to Count - 1 do
    148149    TItem(Items[I]).Assign(Source.Items[I]);
    149   RecalculateNewId(True);
    150150end;
    151151
    … …  
    176176    Node2 := Node2.NextSibling;
    177177  end;
    178   RecalculateNewId(True);
    179178end;
    180179
    … …  
    184183  NewNode2: TDOMNode;
    185184begin
     185  RecalculateItemsId;
    186186  for I := 0 to Count - 1 do
    187187  with TItem(Items[I]) do begin
    … …  
    207207    NewId := Max(NewId, Id + 1);
    208208  end;
     209end;
     210
     211procedure TItemList.RecalculateItemsId;
     212var
     213  I: Integer;
     214begin
     215  for I := 0 to Count - 1 do
     216    Items[I].Id := I + 1;
     217  NewId := Count + 1;
    209218end;
    210219

  • trunk/Languages/xtactics.cs.po

    r332 r336  
    1010"Content-Type: text/plain; charset=UTF-8\n"
    1111"Content-Transfer-Encoding: 8bit\n"
    12 "X-Generator: Poedit 3.3.1\n"
     12"X-Generator: Poedit 3.4.2\n"
    1313
    1414#: building.sbonusattack
    … …  
    604604msgstr "Pohyby jednotek"
    605605
     606#: tcore.atests.caption
     607msgid "Tests"
     608msgstr "Testy"
     609
    606610#: tcore.atogglefogofwar.caption
    607611msgid "Toggle fog of war"
    … …  
    13301334msgid "View range"
    13311335msgstr "Dohled"
    1332 

  • trunk/Languages/xtactics.pot

    r332 r336  
    582582msgstr ""
    583583
     584#: tcore.atests.caption
     585msgid "Tests"
     586msgstr ""
     587
    584588#: tcore.atogglefogofwar.caption
    585589msgid "Toggle fog of war"

  • trunk/Player.pas

    r335 r336  
    776776begin
    777777  inherited;
    778   WriteInteger(Node, 'StartCell', StartCell.Id);
     778  if Assigned(StartCell) then
     779    WriteInteger(Node, 'StartCell', StartCell.Id);
    779780
    780781  with Node do begin
    … …  
    809810
    810811destructor TPlayer.Destroy;
     812var
     813  I: Integer;
    811814begin
    812815  //Client := nil;
    … …  
    814817  FreeAndNil(PlayerMap);
    815818  FreeAndNil(Moves);
     819  for I := Units.Count - 1 downto 0 do
     820    Units[I].Player := nil;
    816821  FreeAndNil(Units);
    817822  inherited;
    … …  
    828833  TotalWinObjectiveCells := TPlayer(Source).TotalWinObjectiveCells;
    829834  StartCell := TPlayer(Source).StartCell;
     835  Color := TPlayer(Source).Color;
     836  //Units.Assign(TPlayer(Source).Units);
     837  Nation := TPlayer(Source).Nation;
    830838end;
    831839
    … …  
    978986  // Clean from cell from empty units
    979987  if UnitMove.CellFrom.MapCell.OneUnit.Power = 0 then begin
    980     Units.Remove(UnitMove.CellFrom.MapCell.OneUnit);
     988    UnitMove.CellFrom.MapCell.OneUnit.Player := nil;
    981989    UnitMove.CellFrom.MapCell.OneUnit := nil;
    982990  end;
    … …  
    10361044      OneUnit := MapCell.OneUnit;
    10371045      MapCell.OneUnit := nil;
    1038       Units.Remove(OneUnit);
     1046      OneUnit.Player := nil;
    10391047    end;
    10401048  end;
    … …  
    12861294        NewUnit.Player := Self;
    12871295        NewUnit.MapCell := Cells[I];
    1288         Units.Add(NewUnit);
    12891296      end;
    12901297      if OneUnit.Power < MaxPower then begin

  • trunk/Unit.pas

    r317 r336  
    243243
    244244procedure TUnit.SetPlayer(AValue: TObject);
     245var
     246  OldValue: TPlayer;
    245247begin
    246248  if FPlayer = AValue then Exit;
    247   if Assigned(FPlayer) then TPlayer(FPlayer).Units.Remove(Self);
     249  OldValue := TPlayer(FPlayer);
     250  FPlayer := nil;
     251  if Assigned(OldValue) then TPlayer(OldValue).Units.Remove(Self);
    248252  FPlayer := AValue;
    249253  if Assigned(FPlayer) then TPlayer(FPlayer).Units.Add(Self);
    … …  
    301305destructor TUnit.Destroy;
    302306begin
     307  Player := nil;
    303308  inherited;
    304309end;

  • trunk/xtactics.lpi

    r333 r336  
    110110      </Item6>
    111111    </RequiredPackages>
    112     <Units Count="39">
     112    <Units Count="40">
    113113      <Unit0>
    114114        <Filename Value="xtactics.lpr"/>
    … …  
    316316        <ResourceBaseClass Value="Form"/>
    317317      </Unit38>
     318      <Unit39>
     319        <Filename Value="Tests.pas"/>
     320        <IsPartOfProject Value="True"/>
     321      </Unit39>
    318322    </Units>
    319323  </ProjectOptions>

  • trunk/xtactics.lpr

    r328 r336  
    88  Forms, tachartlazaruspkg, Game, Core, Common, TemplateGenerics
    99  { you can add units after this },
    10   SysUtils, FormMain, CoolStreaming;
     10  SysUtils, FormMain, CoolStreaming, Tests;
    1111
    1212{$R *.res}
Note: See TracChangeset for help on using the changeset viewer.