DEADSOFTWARE

typo in mapcvt: microseconds -> milliseconds
[d2df-sdl.git] / src / shared / CONFIG.pas
1 (* Copyright (C) DooM 2D:Forever Developers
2 *
3 * This program is free software: you can redistribute it and/or modify
4 * it under the terms of the GNU General Public License as published by
5 * the Free Software Foundation, either version 3 of the License, or
6 * (at your option) any later version.
7 *
8 * This program is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 * GNU General Public License for more details.
12 *
13 * You should have received a copy of the GNU General Public License
14 * along with this program. If not, see <http://www.gnu.org/licenses/>.
15 *)
16 {$INCLUDE a_modes.inc}
17 unit CONFIG;
19 {
20 -----------------------------------
21 CONFIG.PAS ÂÅÐÑÈß ÎÒ 24.09.06
22 -----------------------------------
23 }
25 interface
27 type
28 TParam = record
29 Param: ShortString;
30 Value: ShortString;
31 Section: Word;
32 end;
34 TConfig = class(TObject)
35 private
36 FParams: array of TParam;
37 FSections: array of ShortString;
38 FCurrentSection: Word;
39 function ReadParam(Section, Param, Default: string): string;
40 procedure WriteParam(Section, Param, Value: string);
41 procedure ProcessStr(Str: string);
42 public
43 constructor Create();
44 constructor CreateFile(FileName: string);
45 constructor CreateMem(pData: Pointer; _Length: LongWord);
46 destructor Destroy(); override;
47 procedure FreeConfig();
48 procedure SaveFile(FileName: string);
49 function ReadInt(Section, Param: string; Default: Integer): Integer;
50 function ReadStr(Section, Param: string; Default: String): string;
51 function ReadBool(Section, Param: string; Default: Boolean): Boolean;
52 function SectionExists(Section: string): Boolean;
53 procedure WriteInt(Section, Param: string; Value: Integer);
54 procedure WriteStr(Section, Param, Value: string);
55 procedure WriteBool(Section, Param: string; Value: Boolean);
56 end;
58 implementation
60 uses
61 SysUtils, BinEditor;
63 { TConfig }
65 constructor TConfig.Create();
66 begin
67 inherited Create;
69 FreeConfig();
70 end;
72 constructor TConfig.CreateFile(FileName: string);
73 var
74 f: TextFile;
75 a: string;
76 begin
77 FreeConfig();
79 if not FileExists(FileName) then Exit;
81 AssignFile(f, FileName);
82 Reset(f);
83 while not EOF(f) do
84 begin
85 Readln(f, a);
86 ProcessStr(a);
87 end;
88 CloseFile(f);
89 end;
91 constructor TConfig.CreateMem(pData: Pointer; _Length: LongWord);
92 var
93 a: Integer;
94 str: string;
95 begin
96 FreeConfig();
98 if _Length = 0 then Exit;
99 if pData = nil then Exit;
101 SetLength(str, _Length);
103 CopyMemory(@str[1], pData, _Length);
105 while Str <> '' do
106 begin
107 for a := 2 to Length(Str) do
108 if (Str[a-1]+Str[a] = #13#10) or (a = Length(Str)) then
109 begin
110 if a <> Length(Str) then ProcessStr(Copy(Str, 1, a-2)) else ProcessStr(Str);
111 Delete(Str, 1, a);
112 Str := Trim(Str);
113 Break;
114 end;
115 end;
116 end;
118 destructor TConfig.Destroy();
119 begin
120 FParams := nil;
121 FSections := nil;
123 inherited;
124 end;
126 procedure TConfig.FreeConfig();
127 begin
128 FParams := nil;
129 FSections := nil;
131 SetLength(FSections, 1);
132 FSections[0] := '';
133 FCurrentSection := 0;
134 end;
136 procedure TConfig.ProcessStr(Str: string);
137 var
138 a, l: Integer;
139 begin
140 Str := Trim(Str);
142 if (Str <> '') and (Length(Str) > 2) and (Str[1] <> ';') then
143 begin
144 l := Length(Str);
146 if Pos('=', Str) > 0 then
147 begin
148 SetLength(FParams, Length(FParams)+1);
150 with FParams[High(FParams)] do
151 begin
152 a := Pos('=', Str);
153 Param := Trim(Copy(Str, 1, a-1));
154 Value := Trim(Copy(Str, a+1, l));
155 Section := FCurrentSection;
156 end;
157 end
158 else if (Str[1] = '[') and (Str[l] = ']') then
159 begin
160 SetLength(FSections, Length(FSections)+1);
161 FCurrentSection := High(FSections);
162 FSections[FCurrentSection] := Trim(Copy(Str, 2, l-2));
163 end;
164 end;
165 end;
167 function TConfig.ReadBool(Section, Param: string; Default: Boolean): Boolean;
168 var
169 a: Integer;
170 begin
171 if Default then a := 1 else a := 0;
173 Result := StrToIntDef(ReadParam(Section, Param, IntToStr(a)), a) <> 0;
174 end;
176 function TConfig.ReadInt(Section, Param: string; Default: Integer): Integer;
177 begin
178 Result := StrToIntDef(ReadParam(Section, Param, IntToStr(Default)), Default);
179 end;
181 function TConfig.ReadParam(Section, Param, Default: string): string;
182 var
183 a: Integer;
184 s: Word;
185 ok: Boolean;
186 p: string;
187 begin
188 Result := default;
190 if FParams = nil then Exit;
191 if FSections = nil then Exit;
193 ok := False;
194 s := 0;
195 for a := 0 to High(FSections) do
196 if LowerCase(FSections[a]) = LowerCase(Section) then
197 begin
198 s := a;
199 ok := True;
200 end;
202 if not ok then Exit;
204 p := LowerCase(Param);
206 for a := 0 to High(FParams) do
207 if (FParams[a].Section = s) and (LowerCase(FParams[a].Param) = p) then
208 begin
209 Result := FParams[a].Value;
210 Break;
211 end;
212 end;
214 function TConfig.ReadStr(Section, Param, Default: string): string;
215 begin
216 Result := ReadParam(Section, Param, Default);
217 end;
219 procedure TConfig.SaveFile(FileName: string);
220 var
221 f: TextFile;
222 a: Integer;
223 b: Integer;
224 begin
225 AssignFile(f, FileName);
226 Rewrite(f);
227 if (FSections <> nil) or (FParams <> nil) then
228 begin
229 if FSections <> nil then
230 for a := 0 to High(FSections) do
231 begin
232 if FSections[a] <> '' then Writeln(f, '['+FSections[a]+']');
234 if FParams <> nil then
235 for b := 0 to High(FParams) do
236 if FParams[b].Section = a then WriteLn(f, FParams[b].Param+'='+FParams[b].Value);
238 if (a <> High(FSections)) and (FSections[a] <> '') then WriteLn(f, '');
239 end;
240 end;
241 CloseFile(f);
242 end;
244 function TConfig.SectionExists(Section: string): Boolean;
245 var
246 a: Integer;
247 begin
248 Result := False;
250 if FSections = nil then Exit;
252 Section := LowerCase(Section);
254 for a := 0 to High(FSections) do
255 if Section = LowerCase(FSections[a]) then
256 begin
257 Result := True;
258 Exit;
259 end;
260 end;
262 procedure TConfig.WriteBool(Section, Param: string; Value: Boolean);
263 begin
264 WriteParam(Section, Param, BoolToStr(Value));
265 end;
267 procedure TConfig.WriteInt(Section, Param: string; Value: Integer);
268 begin
269 WriteParam(Section, Param, IntToStr(Value));
270 end;
272 procedure TConfig.WriteParam(Section, Param, Value: string);
273 var
274 a, b: Integer;
275 ok: Boolean;
276 begin
277 a := 0;
278 b := 0;
280 ok := False;
282 if FSections <> nil then
283 for a := 0 to High(FSections) do
284 if FSections[a] = Section then
285 begin
286 ok := True;
287 Break;
288 end;
290 if not ok then
291 begin
292 SetLength(FSections, Length(FSections)+1);
293 a := High(FSections);
294 FSections[a] := Section;
295 end;
297 ok := False;
298 if FParams <> nil then
299 for b := 0 to High(FParams) do
300 if (LowerCase(FParams[b].Param) = LowerCase(Param)) and (FParams[b].Section = a) then
301 begin
302 ok := True;
303 Break;
304 end;
306 if ok then FParams[b].Value := Value
307 else
308 begin
309 SetLength(FParams, Length(FParams)+1);
310 FParams[High(FParams)].Param := Param;
311 FParams[High(FParams)].Value := Value;
312 FParams[High(FParams)].Section := a;
313 end;
314 end;
316 procedure TConfig.WriteStr(Section, Param, Value: string);
317 begin
318 WriteParam(Section, Param, Value);
319 end;
321 end.