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;
  17
  18 interface
  19
  20 {$IFDEF USE_MEMPOOL}
  21 uses
  22   mempool;
  23 {$ENDIF}
  24
  25 type
  26   TParam = record
  27    Param: ShortString;
  28    Value: ShortString;
  29    Section: Word;
  30   end;
  31
  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;
  55
  56 implementation
  57
  58 uses
  59   SysUtils, utils;
  60
  61 { TConfig }
  62
  63 constructor TConfig.Create();
  64 begin
  65  inherited Create;
  66
  67  FreeConfig();
  68 end;
  69
  70 constructor TConfig.CreateFile(FileName: string);
  71 var
  72   f: TextFile;
  73   a: string;
  74 begin
  75  FreeConfig();
  76
  77  if not FileExists(FileName) then Exit;
  78
  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;
  88
  89 constructor TConfig.CreateMem(pData: Pointer; _Length: LongWord);
  90 var
  91   a: Integer;
  92   str: string;
  93 begin
  94  FreeConfig();
  95
  96  if _Length = 0 then Exit;
  97  if pData = nil then Exit;
  98
  99  SetLength(str, _Length);
 100
 101  CopyMemory(@str[1], pData, _Length);
 102
 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;
 115
 116 destructor TConfig.Destroy();
 117 begin
 118  FParams := nil;
 119  FSections := nil;
 120
 121  inherited;
 122 end;
 123
 124 procedure TConfig.FreeConfig();
 125 begin
 126  FParams := nil;
 127  FSections := nil;
 128
 129  SetLength(FSections, 1);
 130  FSections[0] := '';
 131  FCurrentSection := 0;
 132 end;
 133
 134 procedure TConfig.ProcessStr(Str: string);
 135 var
 136   a, l: Integer;
 137 begin
 138  Str := Trim(Str);
 139
 140  if (Str <> '') and (Length(Str) > 2) and (Str[1] <> ';') then
 141  begin
 142   l := Length(Str);
 143
 144   if Pos('=', Str) > 0  then
 145   begin
 146    SetLength(FParams, Length(FParams)+1);
 147
 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;
 164
 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;
 170
 171  Result := StrToIntDef(ReadParam(Section, Param, IntToStr(a)), a) <> 0;
 172 end;
 173
 174 function TConfig.ReadInt(Section, Param: string; Default: Integer): Integer;
 175 begin
 176  Result := StrToIntDef(ReadParam(Section, Param, IntToStr(Default)), Default);
 177 end;
 178
 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;
 187
 188  if FParams = nil then Exit;
 189  if FSections = nil then Exit;
 190
 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;
 199
 200  if not ok then Exit;
 201
 202  p := LowerCase(Param);
 203
 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;
 211
 212 function TConfig.ReadStr(Section, Param, Default: string): string;
 213 begin
 214  Result := ReadParam(Section, Param, Default);
 215 end;
 216
 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]+']');
 231
 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);
 235
 236     if (a <> High(FSections)) and (FSections[a] <> '') then WriteLn(f, '');
 237    end;
 238  end;
 239  CloseFile(f);
 240 end;
 241
 242 function TConfig.SectionExists(Section: string): Boolean;
 243 var
 244   a: Integer;
 245 begin
 246  Result := False;
 247
 248  if FSections = nil then Exit;
 249
 250  Section := LowerCase(Section);
 251
 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;
 259
 260 procedure TConfig.WriteBool(Section, Param: string; Value: Boolean);
 261 begin
 262  WriteParam(Section, Param, BoolToStr(Value));
 263 end;
 264
 265 procedure TConfig.WriteInt(Section, Param: string; Value: Integer);
 266 begin
 267  WriteParam(Section, Param, IntToStr(Value));
 268 end;
 269
 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;
 277
 278  ok := False;
 279
 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;
 287
 288  if not ok then
 289  begin
 290   SetLength(FSections, Length(FSections)+1);
 291   a := High(FSections);
 292   FSections[a] := Section;
 293  end;
 294
 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;
 303
 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;
 313
 314 procedure TConfig.WriteStr(Section, Param, Value: string);
 315 begin
 316  WriteParam(Section, Param, Value);
 317 end;
 318
 319 end.