1 | unit GameSystem;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses
|
---|
6 | Classes, SysUtils, Generics.Collections, Units, DOM, XMLRead, XMLWrite, XML,
|
---|
7 | XMLConf, FileUtil, LazFileUtils, MapType, Nation, Building, ItemList, UnitKind;
|
---|
8 |
|
---|
9 | type
|
---|
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 |
|
---|
46 | const
|
---|
47 | GameSystemExt = '.xts';
|
---|
48 |
|
---|
49 | resourcestring
|
---|
50 | SGameSystem = 'Game system';
|
---|
51 |
|
---|
52 |
|
---|
53 | implementation
|
---|
54 |
|
---|
55 | resourcestring
|
---|
56 | SWrongFileFormat = 'Wrong file format';
|
---|
57 |
|
---|
58 | { TGameSystems }
|
---|
59 |
|
---|
60 | function TGameSystems.AddNew(Name: string): TGameSystem;
|
---|
61 | begin
|
---|
62 | Result := TGameSystem.Create;
|
---|
63 | Result.FileName := Name;
|
---|
64 | Add(Result);
|
---|
65 | end;
|
---|
66 |
|
---|
67 | function TGameSystems.SearchByName(Name: string): TGameSystem;
|
---|
68 | var
|
---|
69 | I: Integer;
|
---|
70 | begin
|
---|
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;
|
---|
75 | end;
|
---|
76 |
|
---|
77 | procedure TGameSystems.LoadFromDir(Dir: string);
|
---|
78 | var
|
---|
79 | Files: TStringList;
|
---|
80 | I: Integer;
|
---|
81 | NewItem: TGameSystem;
|
---|
82 | begin
|
---|
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;
|
---|
94 | end;
|
---|
95 |
|
---|
96 | { TGameSystem }
|
---|
97 |
|
---|
98 | constructor TGameSystem.Create;
|
---|
99 | begin
|
---|
100 | UnitKinds := TUnitKinds.Create;
|
---|
101 | BuildingKinds := TBuildingKinds.Create;
|
---|
102 | Nations := TNations.Create;
|
---|
103 | end;
|
---|
104 |
|
---|
105 | destructor TGameSystem.Destroy;
|
---|
106 | begin
|
---|
107 | FreeAndNil(Nations);
|
---|
108 | FreeAndNil(BuildingKinds);
|
---|
109 | FreeAndNil(UnitKinds);
|
---|
110 | inherited;
|
---|
111 | end;
|
---|
112 |
|
---|
113 | procedure TGameSystem.Clear;
|
---|
114 | begin
|
---|
115 | UnitKinds.Clear;
|
---|
116 | BuildingKinds.Clear;
|
---|
117 | Nations.Clear;
|
---|
118 | end;
|
---|
119 |
|
---|
120 | function TGameSystem.GetName: string;
|
---|
121 | begin
|
---|
122 | Result := ExtractFileNameWithoutExt(ExtractFileName(FileName));
|
---|
123 | end;
|
---|
124 |
|
---|
125 | procedure TGameSystem.Assign(Source: TGameSystem);
|
---|
126 | begin
|
---|
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);
|
---|
136 | end;
|
---|
137 |
|
---|
138 | function TGameSystem.Compare(GameSystem: TGameSystem): Boolean;
|
---|
139 | begin
|
---|
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);
|
---|
149 | end;
|
---|
150 |
|
---|
151 | procedure TGameSystem.LoadFromNode(Node: TDOMNode);
|
---|
152 | var
|
---|
153 | NewNode: TDOMNode;
|
---|
154 | begin
|
---|
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);
|
---|
169 | end;
|
---|
170 |
|
---|
171 | procedure TGameSystem.SaveToNode(Node: TDOMNode);
|
---|
172 | var
|
---|
173 | NewNode: TDOMNode;
|
---|
174 | begin
|
---|
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);
|
---|
189 | end;
|
---|
190 |
|
---|
191 | procedure TGameSystem.LoadFromFile(FileName: string);
|
---|
192 | var
|
---|
193 | Doc: TXMLDocument;
|
---|
194 | RootNode: TDOMNode;
|
---|
195 | begin
|
---|
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;
|
---|
207 | end;
|
---|
208 |
|
---|
209 | procedure TGameSystem.SaveToFile(FileName: string);
|
---|
210 | var
|
---|
211 | Doc: TXMLDocument;
|
---|
212 | RootNode: TDOMNode;
|
---|
213 | begin
|
---|
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;
|
---|
226 | end;
|
---|
227 |
|
---|
228 | procedure TGameSystem.LoadConfig(Config: TXmlConfig; Path: string);
|
---|
229 | begin
|
---|
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;
|
---|
236 | end;
|
---|
237 |
|
---|
238 | procedure TGameSystem.SaveConfig(Config: TXmlConfig; Path: string);
|
---|
239 | begin
|
---|
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;
|
---|
246 | end;
|
---|
247 |
|
---|
248 | end.
|
---|
249 |
|
---|