Changeset 36 for trunk


Ignore:
Timestamp:
Mar 8, 2014, 12:01:08 AM (11 years ago)
Author:
chronos
Message:
  • Added: Save and load game setting to persistent XML config file.
  • Fixed: Show error on player start cell initialization if there is not free place for other start cells.
Location:
trunk
Files:
10 edited

Legend:

Unmodified
Added
Removed

  • trunk

    • Property svn:ignore

      •  

        old new  
        55xtactics.dbg
        66heaptrclog.trc
         7Config.xml

  • trunk/Forms/UFormNew.lfm

    r34 r36  
    8989    Left = 16
    9090    Height = 22
    91     Top = 206
    92     Width = 75
    93     Caption = 'Map size:'
     91    Top = 224
     92    Width = 88
     93    Caption = 'Map width:'
    9494    ParentColor = False
    9595  end
    … …  
    9797    Left = 136
    9898    Height = 32
    99     Top = 200
     99    Top = 219
    100100    Width = 98
    101101    MinValue = 2
     102    OnChange = SpinEditMapSizeXChange
    102103    TabOrder = 6
    103104    Value = 2
    104105  end
    105106  object SpinEditMapSizeY: TSpinEdit
    106     Left = 256
     107    Left = 136
    107108    Height = 32
    108     Top = 200
    109     Width = 90
     109    Top = 270
     110    Width = 98
    110111    MinValue = 2
     112    OnChange = SpinEditMapSizeYChange
    111113    TabOrder = 7
    112114    Value = 2
    113   end
    114   object Label2: TLabel
    115     Left = 240
    116     Height = 22
    117     Top = 208
    118     Width = 9
    119     Caption = 'x'
    120     ParentColor = False
    121115  end
    122116  object ButtonPlayerModify: TButton
    … …  
    130124    TabOrder = 8
    131125  end
    132   object SpinEdit1: TSpinEdit
     126  object SpinEditVoidPercent: TSpinEdit
    133127    Left = 224
    134128    Height = 32
    … …  
    147141    ParentColor = False
    148142  end
     143  object TrackBarSizeX: TTrackBar
     144    Left = 248
     145    Height = 43
     146    Top = 216
     147    Width = 451
     148    Max = 100
     149    Min = 2
     150    OnChange = TrackBarSizeXChange
     151    Position = 2
     152    TickStyle = tsNone
     153    Anchors = [akTop, akLeft, akRight]
     154    TabOrder = 11
     155  end
     156  object TrackBarSizeY: TTrackBar
     157    Left = 248
     158    Height = 43
     159    Top = 264
     160    Width = 451
     161    Max = 100
     162    Min = 2
     163    OnChange = TrackBarSizeYChange
     164    Position = 2
     165    TickStyle = tsNone
     166    Anchors = [akTop, akLeft, akRight]
     167    TabOrder = 10
     168  end
     169  object Label2: TLabel
     170    Left = 16
     171    Height = 22
     172    Top = 272
     173    Width = 94
     174    Caption = 'Map height:'
     175    ParentColor = False
     176  end
    149177end

  • trunk/Forms/UFormNew.lrt

    r34 r36  
    99TFORMNEW.BUTTONPLAYERADD.CAPTION=Add
    1010TFORMNEW.BUTTONPLAYERREMOVE.CAPTION=Remove
    11 TFORMNEW.LABEL1.CAPTION=Map size:
    12 TFORMNEW.LABEL2.CAPTION=x
     11TFORMNEW.LABEL1.CAPTION=Map width:
    1312TFORMNEW.BUTTONPLAYERMODIFY.CAPTION=Modify
    1413TFORMNEW.LABEL3.CAPTION=%
     14TFORMNEW.LABEL2.CAPTION=Map height:

  • trunk/Forms/UFormNew.pas

    r34 r36  
    2424    Label3: TLabel;
    2525    ListView1: TListView;
    26     SpinEdit1: TSpinEdit;
     26    SpinEditVoidPercent: TSpinEdit;
    2727    SpinEditMapSizeX: TSpinEdit;
    2828    SpinEditMapSizeY: TSpinEdit;
     29    TrackBarSizeX: TTrackBar;
     30    TrackBarSizeY: TTrackBar;
    2931    procedure ButtonPlayerAddClick(Sender: TObject);
    3032    procedure ButtonPlayerModifyChangeBounds(Sender: TObject);
    … …  
    3840    procedure ListView1SelectItem(Sender: TObject; Item: TListItem;
    3941      Selected: Boolean);
     42    procedure SpinEditMapSizeXChange(Sender: TObject);
     43    procedure SpinEditMapSizeYChange(Sender: TObject);
     44    procedure TrackBarSizeYChange(Sender: TObject);
     45    procedure TrackBarSizeXChange(Sender: TObject);
    4046  private
    4147    Players: TPlayers;
    … …  
    7682end;
    7783
     84procedure TFormNew.SpinEditMapSizeXChange(Sender: TObject);
     85begin
     86  TrackBarSizeX.Position := SpinEditMapSizeX.Value;
     87end;
     88
     89procedure TFormNew.SpinEditMapSizeYChange(Sender: TObject);
     90begin
     91  TrackBarSizeY.Position := SpinEditMapSizeY.Value;
     92end;
     93
     94procedure TFormNew.TrackBarSizeYChange(Sender: TObject);
     95begin
     96  SpinEditMapSizeY.Value := TrackBarSizeY.Position;
     97end;
     98
     99procedure TFormNew.TrackBarSizeXChange(Sender: TObject);
     100begin
     101  SpinEditMapSizeX.Value := TrackBarSizeX.Position;
     102end;
     103
    78104procedure TFormNew.ReloadView;
    79105begin
    … …  
    104130procedure TFormNew.CheckBoxVoidChange(Sender: TObject);
    105131begin
    106   SpinEdit1.Enabled := CheckBoxVoid.Checked;
     132  SpinEditVoidPercent.Enabled := CheckBoxVoid.Checked;
    107133end;
    108134
    … …  
    142168begin
    143169  CheckBoxVoid.Checked := Game.VoidEnabled;
    144   SpinEdit1.Value := Game.VoidPercentage;
    145   SpinEdit1.Enabled := Game.VoidEnabled;
     170  SpinEditVoidPercent.Value := Game.VoidPercentage;
     171  SpinEditVoidPercent.Enabled := Game.VoidEnabled;
    146172  for I := 0 to Players.Count - 1 do
    147173    Players[I] := nil;
    … …  
    168194  end;
    169195  Game.VoidEnabled := CheckBoxVoid.Checked;
    170   Game.VoidPercentage := SpinEdit1.Value;
     196  Game.VoidPercentage := SpinEditVoidPercent.Value;
    171197  Game.Map.Size := Point(SpinEditMapSizeX.Value, SpinEditMapSizeY.Value);
    172198end;

  • trunk/Languages/xtactics.cs.po

    r35 r36  
    1818#: tcore.aexit.hint
    1919msgid "Exit application"
    20 msgstr ""
     20msgstr "Ukončit aplikaci"
    2121
    2222#: tcore.agameend.caption
    … …  
    2727#: tcore.agameend.hint
    2828msgid "End game"
    29 msgstr ""
     29msgstr "Ukončit hru"
    3030
    3131#: tcore.agameendturn.caption
    … …  
    3636#: tcore.agameendturn.hint
    3737msgid "End player turn"
    38 msgstr ""
     38msgstr "Ukončit tah hráče"
    3939
    4040#: tcore.agamenew.caption
    … …  
    5555#: tcore.agamerestart.hint
    5656msgid "Restart game"
    57 msgstr ""
     57msgstr "Restartovat hru"
    5858
    5959#: tcore.asettings.caption
    … …  
    6464#: tcore.asettings.hint
    6565msgid "Application settings"
    66 msgstr ""
     66msgstr "Nastavení aplikace"
    6767
    6868#: tformmain.azoomall.caption
    6969msgid "Zoom all"
    70 msgstr ""
     70msgstr "Zobrazit vše"
    7171
    7272#: tformmain.azoomin.caption
    7373msgid "Zoom in"
    74 msgstr ""
     74msgstr "Přiblížit"
    7575
    7676#: tformmain.azoomout.caption
    7777msgid "Zoom out"
    78 msgstr ""
     78msgstr "Oddálit"
    7979
    8080#: tformmain.caption
    … …  
    8888#: tformmain.menuitem10.caption
    8989msgid "View"
    90 msgstr ""
     90msgstr "Zobrazení"
    9191
    9292#: tformmain.menuitem5.caption
    … …  
    154154
    155155#: tformnew.label1.caption
    156 msgid "Map size:"
     156#, fuzzy
     157#| msgid "Map size:"
     158msgid "Map width:"
    157159msgstr "Velikost mapy:"
    158160
    159161#: tformnew.label2.caption
    160 msgid "x"
     162#, fuzzy
     163#| msgid "x"
     164msgid "Map height:"
    161165msgstr "x"
    162166

  • trunk/Languages/xtactics.po

    r35 r36  
    144144
    145145#: tformnew.label1.caption
    146 msgid "Map size:"
     146msgid "Map width:"
    147147msgstr ""
    148148
    149149#: tformnew.label2.caption
    150 msgid "x"
     150msgid "Map height:"
    151151msgstr ""
    152152

  • trunk/UCore.lfm

    r34 r36  
    428428    }
    429429  end
     430  object XMLConfig1: TXMLConfig
     431    Filename = 'Config.xml'
     432    StartEmpty = False
     433    RootName = 'CONFIG'
     434    left = 209
     435    top = 360
     436  end
    430437end

  • trunk/UCore.pas

    r34 r36  
    66
    77uses
    8   Classes, SysUtils, FileUtil, ActnList, Controls, Dialogs, Forms, UGame,
    9   UCoolTranslator;
     8  Classes, SysUtils, XMLConf, FileUtil, ActnList, Controls, Dialogs, Forms,
     9  UGame, UCoolTranslator;
    1010
    1111type
    … …  
    2424    ImageListLarge: TImageList;
    2525    ImageListSmall: TImageList;
     26    XMLConfig1: TXMLConfig;
    2627    procedure AExitExecute(Sender: TObject);
    2728    procedure AGameEndExecute(Sender: TObject);
    … …  
    120121    Game.New;
    121122    Game.Running := True;
    122     FormMain.Redraw;
     123    FormMain.AZoomAll.Execute;
    123124  end;
    124125end;
    … …  
    152153procedure TCore.DataModuleDestroy(Sender: TObject);
    153154begin
     155  Game.SaveConfig(XMLConfig1, 'Game');
     156  XMLConfig1.SetValue('Language', CoolTranslator1.Language.Code);
    154157  FreeAndNil(Game);
    155158end;
    … …  
    160163begin
    161164  FInitialized := True;
     165  CoolTranslator1.Language := CoolTranslator1.Languages.SearchByCode(XMLConfig1.GetValue('Language', ''));
    162166  for I := 0 to Game.Players.Count - 1 do
    163167    TPlayer(Game.Players[I]).View.DestRect := Rect(0, 0, FormMain.PaintBox1.Width,
    164168      FormMain.PaintBox1.Height);
     169  Game.LoadConfig(XMLConfig1, 'Game');
    165170  Game.New;
    166171  Game.Running := True;
    167   FormMain.Redraw;
     172  FormMain.AZoomAll.Execute;
    168173end;
    169174

  • trunk/UGame.pas

    r35 r36  
    66
    77uses
    8   Classes, SysUtils, ExtCtrls, Graphics, Contnrs;
     8  Classes, SysUtils, ExtCtrls, Graphics, Contnrs, XMLConf;
    99
    1010const
    … …  
    2929
    3030  TCell = class
     31  private
     32    FPower: Integer;
     33    procedure SetPower(AValue: Integer);
     34  public
    3135    Pos: TPoint;
    3236    Terrain: TTerrainType;
    33     Power: Integer;
    3437    Player: TPlayer;
    3538    MovesFrom: TObjectList;
    … …  
    3942    constructor Create;
    4043    destructor Destroy; override;
     44    property Power: Integer read FPower write SetPower;
    4145  end;
    4246
    … …  
    176180    Moves: TObjectList; // TList<TMove>
    177181    TurnCounter: Integer;
    178 
     182    procedure SaveConfig(Config: TXmlConfig; Path: string);
     183    procedure LoadConfig(Config: TXmlConfig; Path: string);
    179184    procedure ComputePlayerStats;
    180185    function GetAlivePlayers: TPlayerArray;
    … …  
    362367
    363368{ TCell }
     369
     370procedure TCell.SetPower(AValue: Integer);
     371begin
     372  if FPower = AValue then Exit;
     373  if AValue < 0 then
     374    raise Exception.Create('Not allowed to substract power under zero do negative value');
     375  FPower := AValue;
     376end;
    364377
    365378function TCell.GetColor: TColor;
    … …  
    568581  DefenderRoll: Integer;
    569582begin
     583  if AttackPower < 1 then
     584    raise Exception.Create('Attacker power have to be higher then 0.');
     585  if DefendPower < 0 then
     586    raise Exception.Create('Defender power have to be higher then or equal to 0.');
    570587  while (AttackPower > 0) and (DefendPower > 0) do begin
    571588    // Earch side do dice roll and compare result. Defender wins tie
    … …  
    590607      if CellTo.Player = Player then begin
    591608        // Inner move
    592         CellTo.Power := CellTo.Power + CountOnce;
    593609      end else begin
    594610        AttackerPower := CountOnce;
    … …  
    705721end;
    706722
     723procedure TGame.SaveConfig(Config: TXmlConfig; Path: string);
     724begin
     725  with Config do begin
     726    SetValue(Path + '/VoidEnabled', VoidEnabled);
     727    SetValue(Path + '/VoidPercentage', VoidPercentage);
     728    SetValue(Path + '/MapSizeX', Map.Size.X);
     729    SetValue(Path + '/MapSizeY', Map.Size.Y);
     730  end;
     731end;
     732
     733procedure TGame.LoadConfig(Config: TXmlConfig; Path: string);
     734begin
     735  with Config do begin
     736    VoidEnabled := GetValue(Path + '/VoidEnabled', True);
     737    VoidPercentage := GetValue(Path + '/VoidPercentage', 20);
     738    Map.Size := Point(GetValue(Path + '/MapSizeX', 15),
     739      GetValue(Path + '/MapSizeY', 15));
     740  end;
     741end;
     742
    707743procedure TGame.ComputePlayerStats;
    708744var
    … …  
    796832  I: Integer;
    797833  StartCell: TCell;
     834  Counter: Integer;
    798835begin
    799836  TurnCounter := 1;
    … …  
    811848    View.Clear;
    812849    if (Map.Size.X > 0) and (Map.Size.Y > 0) then begin
    813       StartCell := Map.Cells[Random(Map.Size.Y), Random(Map.Size.X)];
     850      // Try to obtain start cell for each player
     851      StartCell := nil;
     852      Counter := 0;
     853      while not Assigned(StartCell) or Assigned(StartCell.Player) do begin
     854        StartCell := Map.Cells[Random(Map.Size.Y), Random(Map.Size.X)];
     855        Inc(Counter);
     856        if Counter > 100 then
     857          raise Exception.Create('Cannot choose start cell for player');
     858      end;
    814859      StartCell.Terrain := ttNormal;
    815860      StartCell.Player := TPlayer(Players[I]);

  • trunk/xtactics.lpi

    r34 r36  
    7272      </local>
    7373    </RunParams>
    74     <RequiredPackages Count="2">
     74    <RequiredPackages Count="3">
    7575      <Item1>
     76        <PackageName Value="FCL"/>
     77      </Item1>
     78      <Item2>
    7679        <PackageName Value="CoolTranslator"/>
    7780        <DefaultFilename Value="Packages/CoolTranslator/CoolTranslator.lpk" Prefer="True"/>
    78       </Item1>
    79       <Item2>
     81      </Item2>
     82      <Item3>
    8083        <PackageName Value="LCL"/>
    81       </Item2>
     84      </Item3>
    8285    </RequiredPackages>
    8386    <Units Count="8">
    … …  
    133136        <Filename Value="Forms/UFormNew.pas"/>
    134137        <IsPartOfProject Value="True"/>
    135         <HasResources Value="True"/>
     138        <ComponentName Value="FormNew"/>
     139        <HasResources Value="True"/>
     140        <ResourceBaseClass Value="Form"/>
    136141        <UnitName Value="UFormNew"/>
    137142      </Unit7>
Note: See TracChangeset for help on using the changeset viewer.