source: trunk/GameSystem.pas

Last change on this file was 342, checked in by chronos, 5 hours ago
  • Added: More tests.
File size: 6.8 KB
Line 
1unit GameSystem;
2
3interface
4
5uses
6 Classes, SysUtils, Generics.Collections, Units, DOM, XMLRead, XMLWrite, XML,
7 XMLConf, FileUtil, LazFileUtils, MapType, Nation, Building, ItemList, UnitKind;
8
9type
10 TActionExecutionPhase = (epEndOfTurn, epInstantly);
11
12 { TGameSystem }
13
14 TGameSystem = class
15 FileName: string;
16 MaxPlayerCount: Integer;
17 UnitKinds: TUnitKinds;
18 UnitsSplitMerge: Boolean;
19 EmptyCellsNeutral: Boolean;
20 UnitsMoveImmediately: Boolean;
21 PreferedMapType: TMapType;
22 Nations: TNations;
23 BuildingKinds: TBuildingKinds;
24 constructor Create;
25 destructor Destroy; override;
26 procedure Clear;
27 function GetName: string;
28 procedure Assign(Source: TGameSystem);
29 function Compare(GameSystem: TGameSystem): Boolean;
30 procedure LoadFromNode(Node: TDOMNode);
31 procedure SaveToNode(Node: TDOMNode);
32 procedure LoadFromFile(FileName: string);
33 procedure SaveToFile(FileName: string);
34 procedure LoadConfig(Config: TXmlConfig; Path: string);
35 procedure SaveConfig(Config: TXmlConfig; Path: string);
36 end;
37
38 { TGameSystems }
39
40 TGameSystems = class(TObjectList<TGameSystem>)
41 function AddNew(Name: string): TGameSystem;
42 function SearchByName(Name: string): TGameSystem;
43 procedure LoadFromDir(Dir: string);
44 end;
45
46const
47 GameSystemExt = '.xts';
48
49resourcestring
50 SGameSystem = 'Game system';
51
52
53implementation
54
55resourcestring
56 SWrongFileFormat = 'Wrong file format';
57
58{ TGameSystems }
59
60function TGameSystems.AddNew(Name: string): TGameSystem;
61begin
62 Result := TGameSystem.Create;
63 Result.FileName := Name;
64 Add(Result);
65end;
66
67function TGameSystems.SearchByName(Name: string): TGameSystem;
68var
69 I: Integer;
70begin
71 I := 0;
72 while (I < Count) and (Items[I].GetName <> Name) do Inc(I);
73 if I < Count then Result := Items[I]
74 else Result := nil;
75end;
76
77procedure TGameSystems.LoadFromDir(Dir: string);
78var
79 Files: TStringList;
80 I: Integer;
81 NewItem: TGameSystem;
82begin
83 Files := TStringList.Create;
84 try
85 FindAllFiles(Files, Dir, '*' + GameSystemExt, True, faAnyFile);
86 for I := 0 to Files.Count - 1 do begin
87 NewItem := TGameSystem.Create;
88 NewItem.LoadFromFile(Files[I]);
89 Add(NewItem);
90 end;
91 finally
92 Files.Free;
93 end;
94end;
95
96{ TGameSystem }
97
98constructor TGameSystem.Create;
99begin
100 UnitKinds := TUnitKinds.Create;
101 BuildingKinds := TBuildingKinds.Create;
102 Nations := TNations.Create;
103end;
104
105destructor TGameSystem.Destroy;
106begin
107 FreeAndNil(Nations);
108 FreeAndNil(BuildingKinds);
109 FreeAndNil(UnitKinds);
110 inherited;
111end;
112
113procedure TGameSystem.Clear;
114begin
115 UnitKinds.Clear;
116 BuildingKinds.Clear;
117 Nations.Clear;
118end;
119
120function TGameSystem.GetName: string;
121begin
122 Result := ExtractFileNameWithoutExt(ExtractFileName(FileName));
123end;
124
125procedure TGameSystem.Assign(Source: TGameSystem);
126begin
127 FileName := Source.FileName;
128 UnitsMoveImmediately := Source.UnitsMoveImmediately;
129 MaxPlayerCount := Source.MaxPlayerCount;
130 UnitsSplitMerge := Source.UnitsSplitMerge;
131 EmptyCellsNeutral := Source.EmptyCellsNeutral;
132 PreferedMapType := Source.PreferedMapType;
133 UnitKinds.Assign(Source.UnitKinds);
134 BuildingKinds.Assign(Source.BuildingKinds);
135 Nations.Assign(Source.Nations);
136end;
137
138function TGameSystem.Compare(GameSystem: TGameSystem): Boolean;
139begin
140 Result := (FileName = GameSystem.FileName) and
141 (UnitsMoveImmediately = GameSystem.UnitsMoveImmediately) and
142 (MaxPlayerCount = GameSystem.MaxPlayerCount) and
143 (UnitsSplitMerge = GameSystem.UnitsSplitMerge) and
144 (EmptyCellsNeutral = GameSystem.EmptyCellsNeutral) and
145 (PreferedMapType = GameSystem.PreferedMapType); // and
146 //(UnitKinds.Assign(GameSystem.UnitKinds) and
147 //(BuildingKinds.Assign(GameSystem.BuildingKinds) and
148 //(Nations.Assign(GameSystem.Nations);
149end;
150
151procedure TGameSystem.LoadFromNode(Node: TDOMNode);
152var
153 NewNode: TDOMNode;
154begin
155 UnitsSplitMerge := ReadBoolean(Node, 'UnitsSplitMerge', False);
156 EmptyCellsNeutral := ReadBoolean(Node, 'EmptyCellsNeutral', False);
157 UnitsMoveImmediately := ReadBoolean(Node, 'UnitsMoveImmediately', False);
158 PreferedMapType := TMapType(ReadInteger(Node, 'PreferedMapType', Integer(mtNone)));
159
160 NewNode := Node.FindNode('UnitKinds');
161 if Assigned(NewNode) then
162 UnitKinds.LoadFromNode(NewNode);
163 NewNode := Node.FindNode('BuildingKinds');
164 if Assigned(NewNode) then
165 BuildingKinds.LoadFromNode(NewNode);
166 NewNode := Node.FindNode('Nations');
167 if Assigned(NewNode) then
168 Nations.LoadFromNode(NewNode);
169end;
170
171procedure TGameSystem.SaveToNode(Node: TDOMNode);
172var
173 NewNode: TDOMNode;
174begin
175 WriteBoolean(Node, 'UnitsSplitMerge', UnitsSplitMerge);
176 WriteBoolean(Node, 'EmptyCellsNeutral', EmptyCellsNeutral);
177 WriteBoolean(Node, 'UnitsMoveImmediately', UnitsMoveImmediately);
178 WriteInteger(Node, 'PreferedMapType', Integer(PreferedMapType));
179
180 NewNode := Node.OwnerDocument.CreateElement('UnitKinds');
181 Node.AppendChild(NewNode);
182 UnitKinds.SaveToNode(NewNode);
183 NewNode := Node.OwnerDocument.CreateElement('BuildingKinds');
184 Node.AppendChild(NewNode);
185 BuildingKinds.SaveToNode(NewNode);
186 NewNode := Node.OwnerDocument.CreateElement('Nations');
187 Node.AppendChild(NewNode);
188 Nations.SaveToNode(NewNode);
189end;
190
191procedure TGameSystem.LoadFromFile(FileName: string);
192var
193 Doc: TXMLDocument;
194 RootNode: TDOMNode;
195begin
196 ReadXMLFile(Doc, FileName);
197 Self.FileName := FileName;
198 Clear;
199 with Doc do try
200 if Doc.DocumentElement.NodeName <> 'XtacticsGameSystem' then
201 raise Exception.Create(SWrongFileFormat);
202 RootNode := Doc.DocumentElement;
203 LoadFromNode(RootNode);
204 finally
205 FreeAndNil(Doc);
206 end;
207end;
208
209procedure TGameSystem.SaveToFile(FileName: string);
210var
211 Doc: TXMLDocument;
212 RootNode: TDOMNode;
213begin
214 Self.FileName := FileName;
215 Doc := TXMLDocument.Create;
216 with Doc do try
217 RootNode := CreateElement('XtacticsGameSystem');
218 AppendChild(RootNode);
219 SaveToNode(RootNode);
220 if ExtractFileDir(FileName) <> '' then
221 ForceDirectories(ExtractFileDir(FileName));
222 WriteXMLFile(Doc, FileName);
223 finally
224 FreeAndNil(Doc);
225 end;
226end;
227
228procedure TGameSystem.LoadConfig(Config: TXmlConfig; Path: string);
229begin
230 with Config do begin
231 UnitsSplitMerge := GetValue(DOMString(Path + '/UnitsSplitMerge'), True);
232 EmptyCellsNeutral := GetValue(DOMString(Path + '/EmptyCellsNeutral'), False);
233 UnitsMoveImmediately := GetValue(DOMString(Path + '/UnitsMoveImmediately'), False);
234 PreferedMapType := TMapType(GetValue(DOMString(Path + '/PreferedMapType'), Integer(mtNone)));
235 end;
236end;
237
238procedure TGameSystem.SaveConfig(Config: TXmlConfig; Path: string);
239begin
240 with Config do begin
241 SetValue(DOMString(Path + '/UnitsSplitMerge'), UnitsSplitMerge);
242 SetValue(DOMString(Path + '/EmptyCellsNeutral'), EmptyCellsNeutral);
243 SetValue(DOMString(Path + '/UnitsMoveImmediately'), UnitsMoveImmediately);
244 SetValue(DOMString(Path + '/PreferedMapType'), Integer(PreferedMapType));
245 end;
246end;
247
248end.
249
Note: See TracBrowser for help on using the repository browser.