DEADSOFTWARE

put network interp back in
[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, version 3 of the License ONLY.
6 *
7 * This program is distributed in the hope that it will be useful,
8 * but WITHOUT ANY WARRANTY; without even the implied warranty of
9 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
10 * GNU General Public License for more details.
11 *
12 * You should have received a copy of the GNU General Public License
13 * along with this program. If not, see <http://www.gnu.org/licenses/>.
14 *)
15 {$INCLUDE a_modes.inc}
16 unit CONFIG;
18 interface
20 {$IFDEF USE_MEMPOOL}
21 uses
22 mempool;
23 {$ENDIF}
25 type
26 TParam = record
27 Param: ShortString;
28 Value: ShortString;
29 Section: Word;
30 end;
32 TConfig = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF}
33 private
34 FParams: array of TParam;
35 FSections: array of ShortString;
36 FCurrentSection: Word;
37 function ReadParam(Section, Param, Default: string): string;
38 procedure WriteParam(Section, Param, Value: string);
39 procedure ProcessStr(Str: string);
40 public
41 constructor Create();
42 constructor CreateFile(FileName: string);
43 constructor CreateMem(pData: Pointer; _Length: LongWord);
44 destructor Destroy(); override;
45 procedure FreeConfig();
46 procedure SaveFile(FileName: string);
47 function ReadInt(Section, Param: string; Default: Integer): Integer;
48 function ReadStr(Section, Param: string; Default: String): string;
49 function ReadBool(Section, Param: string; Default: Boolean): Boolean;
50 function SectionExists(Section: string): Boolean;
51 procedure WriteInt(Section, Param: string; Value: Integer);
52 procedure WriteStr(Section, Param, Value: string);
53 procedure WriteBool(Section, Param: string; Value: Boolean);
54 end;
56 implementation
58 uses
59 SysUtils, utils;
61 { TConfig }
63 constructor TConfig.Create();
64 begin
65 inherited Create;
67 FreeConfig();
68 end;
70 constructor TConfig.CreateFile(FileName: string);
71 var
72 f: TextFile;
73 a: string;
74 begin
75 FreeConfig();
77 if not FileExists(FileName) then Exit;
79 AssignFile(f, FileName);
80 Reset(f);
81 while not EOF(f) do
82 begin
83 Readln(f, a);
84 ProcessStr(a);
85 end;
86 CloseFile(f);
87 end;
89 constructor TConfig.CreateMem(pData: Pointer; _Length: LongWord);
90 var
91 a: Integer;
92 str: string;
93 begin
94 FreeConfig();
96 if _Length = 0 then Exit;
97 if pData = nil then Exit;
99 SetLength(str, _Length);
101 CopyMemory(@str[1], pData, _Length);
103 while Str <> '' do
104 begin
105 for a := 2 to Length(Str) do
106 if (Str[a-1]+Str[a] = #13#10) or (a = Length(Str)) then
107 begin
108 if a <> Length(Str) then ProcessStr(Copy(Str, 1, a-2)) else ProcessStr(Str);
109 Delete(Str, 1, a);
110 Str := Trim(Str);
111 Break;
112 end;
113 end;
114 end;
116 destructor TConfig.Destroy();
117 begin
118 FParams := nil;
119 FSections := nil;
121 inherited;
122 end;
124 procedure TConfig.FreeConfig();
125 begin
126 FParams := nil;
127 FSections := nil;
129 SetLength(FSections, 1);
130 FSections[0] := '';
131 FCurrentSection := 0;
132 end;
134 procedure TConfig.ProcessStr(Str: string);
135 var
136 a, l: Integer;
137 begin
138 Str := Trim(Str);
140 if (Str <> '') and (Length(Str) > 2) and (Str[1] <> ';') then
141 begin
142 l := Length(Str);
144 if Pos('=', Str) > 0 then
145 begin
146 SetLength(FParams, Length(FParams)+1);
148 with FParams[High(FParams)] do
149 begin
150 a := Pos('=', Str);
151 Param := Trim(Copy(Str, 1, a-1));
152 Value := Trim(Copy(Str, a+1, l));
153 Section := FCurrentSection;
154 end;
155 end
156 else if (Str[1] = '[') and (Str[l] = ']') then
157 begin
158 SetLength(FSections, Length(FSections)+1);
159 FCurrentSection := High(FSections);
160 FSections[FCurrentSection] := Trim(Copy(Str, 2, l-2));
161 end;
162 end;
163 end;
165 function TConfig.ReadBool(Section, Param: string; Default: Boolean): Boolean;
166 var
167 a: Integer;
168 begin
169 if Default then a := 1 else a := 0;
171 Result := StrToIntDef(ReadParam(Section, Param, IntToStr(a)), a) <> 0;
172 end;
174 function TConfig.ReadInt(Section, Param: string; Default: Integer): Integer;
175 begin
176 Result := StrToIntDef(ReadParam(Section, Param, IntToStr(Default)), Default);
177 end;
179 function TConfig.ReadParam(Section, Param, Default: string): string;
180 var
181 a: Integer;
182 s: Word;
183 ok: Boolean;
184 p: string;
185 begin
186 Result := default;
188 if FParams = nil then Exit;
189 if FSections = nil then Exit;
191 ok := False;
192 s := 0;
193 for a := 0 to High(FSections) do
194 if LowerCase(FSections[a]) = LowerCase(Section) then
195 begin
196 s := a;
197 ok := True;
198 end;
200 if not ok then Exit;
202 p := LowerCase(Param);
204 for a := 0 to High(FParams) do
205 if (FParams[a].Section = s) and (LowerCase(FParams[a].Param) = p) then
206 begin
207 Result := FParams[a].Value;
208 Break;
209 end;
210 end;
212 function TConfig.ReadStr(Section, Param, Default: string): string;
213 begin
214 Result := ReadParam(Section, Param, Default);
215 end;
217 procedure TConfig.SaveFile(FileName: string);
218 var
219 f: TextFile;
220 a: Integer;
221 b: Integer;
222 begin
223 AssignFile(f, FileName);
224 Rewrite(f);
225 if (FSections <> nil) or (FParams <> nil) then
226 begin
227 if FSections <> nil then
228 for a := 0 to High(FSections) do
229 begin
230 if FSections[a] <> '' then Writeln(f, '['+FSections[a]+']');
232 if FParams <> nil then
233 for b := 0 to High(FParams) do
234 if FParams[b].Section = a then WriteLn(f, FParams[b].Param+'='+FParams[b].Value);
236 if (a <> High(FSections)) and (FSections[a] <> '') then WriteLn(f, '');
237 end;
238 end;
239 CloseFile(f);
240 end;
242 function TConfig.SectionExists(Section: string): Boolean;
243 var
244 a: Integer;
245 begin
246 Result := False;
248 if FSections = nil then Exit;
250 Section := LowerCase(Section);
252 for a := 0 to High(FSections) do
253 if Section = LowerCase(FSections[a]) then
254 begin
255 Result := True;
256 Exit;
257 end;
258 end;
260 procedure TConfig.WriteBool(Section, Param: string; Value: Boolean);
261 begin
262 WriteParam(Section, Param, BoolToStr(Value));
263 end;
265 procedure TConfig.WriteInt(Section, Param: string; Value: Integer);
266 begin
267 WriteParam(Section, Param, IntToStr(Value));
268 end;
270 procedure TConfig.WriteParam(Section, Param, Value: string);
271 var
272 a, b: Integer;
273 ok: Boolean;
274 begin
275 a := 0;
276 b := 0;
278 ok := False;
280 if FSections <> nil then
281 for a := 0 to High(FSections) do
282 if FSections[a] = Section then
283 begin
284 ok := True;
285 Break;
286 end;
288 if not ok then
289 begin
290 SetLength(FSections, Length(FSections)+1);
291 a := High(FSections);
292 FSections[a] := Section;
293 end;
295 ok := False;
296 if FParams <> nil then
297 for b := 0 to High(FParams) do
298 if (LowerCase(FParams[b].Param) = LowerCase(Param)) and (FParams[b].Section = a) then
299 begin
300 ok := True;
301 Break;
302 end;
304 if ok then FParams[b].Value := Value
305 else
306 begin
307 SetLength(FParams, Length(FParams)+1);
308 FParams[High(FParams)].Param := Param;
309 FParams[High(FParams)].Value := Value;
310 FParams[High(FParams)].Section := a;
311 end;
312 end;
314 procedure TConfig.WriteStr(Section, Param, Value: string);
315 begin
316 WriteParam(Section, Param, Value);
317 end;
319 end.