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;
  18
  19 interface
  20
  21 {$IFDEF USE_MEMPOOL}
  22 uses
  23   mempool;
  24 {$ENDIF}
  25
  26 type
  27   TParam = record
  28    Param: ShortString;
  29    Value: ShortString;
  30    Section: Word;
  31   end;
  32
  33   TConfig = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF}
  34    private
  35     FParams: array of TParam;
  36     FSections: array of ShortString;
  37     FCurrentSection: Word;
  38     function ReadParam(Section, Param, Default: string): string;
  39     procedure WriteParam(Section, Param, Value: string);
  40     procedure ProcessStr(Str: string);
  41    public
  42     constructor Create();
  43     constructor CreateFile(FileName: string);
  44     constructor CreateMem(pData: Pointer; _Length: LongWord);
  45     destructor Destroy(); override;
  46     procedure FreeConfig();
  47     procedure SaveFile(FileName: string);
  48     function ReadInt(Section, Param: string; Default: Integer): Integer;
  49     function ReadStr(Section, Param: string; Default: String): string;
  50     function ReadBool(Section, Param: string; Default: Boolean): Boolean;
  51     function SectionExists(Section: string): Boolean;
  52     procedure WriteInt(Section, Param: string; Value: Integer);
  53     procedure WriteStr(Section, Param, Value: string);
  54     procedure WriteBool(Section, Param: string; Value: Boolean);
  55    end;
  56
  57 implementation
  58
  59 uses
  60   SysUtils, utils;
  61
  62 { TConfig }
  63
  64 constructor TConfig.Create();
  65 begin
  66  inherited Create;
  67
  68  FreeConfig();
  69 end;
  70
  71 constructor TConfig.CreateFile(FileName: string);
  72 var
  73   f: TextFile;
  74   a: string;
  75 begin
  76  FreeConfig();
  77
  78  if not FileExists(FileName) then Exit;
  79
  80  AssignFile(f, FileName);
  81  Reset(f);
  82  while not EOF(f) do
  83  begin
  84   Readln(f, a);
  85   ProcessStr(a);
  86  end;
  87  CloseFile(f);
  88 end;
  89
  90 constructor TConfig.CreateMem(pData: Pointer; _Length: LongWord);
  91 var
  92   a: Integer;
  93   str: string;
  94 begin
  95  FreeConfig();
  96
  97  if _Length = 0 then Exit;
  98  if pData = nil then Exit;
  99
 100  SetLength(str, _Length);
 101
 102  CopyMemory(@str[1], pData, _Length);
 103
 104  while Str <> '' do
 105  begin
 106   for a := 2 to Length(Str) do
 107    if (Str[a-1]+Str[a] = #13#10) or (a = Length(Str)) then
 108    begin
 109     if a <> Length(Str) then ProcessStr(Copy(Str, 1, a-2)) else ProcessStr(Str);
 110     Delete(Str, 1, a);
 111     Str := Trim(Str);
 112     Break;
 113    end;
 114  end;
 115 end;
 116
 117 destructor TConfig.Destroy();
 118 begin
 119  FParams := nil;
 120  FSections := nil;
 121
 122  inherited;
 123 end;
 124
 125 procedure TConfig.FreeConfig();
 126 begin
 127  FParams := nil;
 128  FSections := nil;
 129
 130  SetLength(FSections, 1);
 131  FSections[0] := '';
 132  FCurrentSection := 0;
 133 end;
 134
 135 procedure TConfig.ProcessStr(Str: string);
 136 var
 137   a, l: Integer;
 138 begin
 139  Str := Trim(Str);
 140
 141  if (Str <> '') and (Length(Str) > 2) and (Str[1] <> ';') then
 142  begin
 143   l := Length(Str);
 144
 145   if Pos('=', Str) > 0  then
 146   begin
 147    SetLength(FParams, Length(FParams)+1);
 148
 149    with FParams[High(FParams)] do
 150    begin
 151     a := Pos('=', Str);
 152     Param := Trim(Copy(Str, 1, a-1));
 153     Value := Trim(Copy(Str, a+1, l));
 154     Section := FCurrentSection;
 155    end;
 156   end
 157    else if (Str[1] = '[') and (Str[l] = ']') then
 158   begin
 159    SetLength(FSections, Length(FSections)+1);
 160    FCurrentSection := High(FSections);
 161    FSections[FCurrentSection] := Trim(Copy(Str, 2, l-2));
 162   end;
 163  end;
 164 end;
 165
 166 function TConfig.ReadBool(Section, Param: string; Default: Boolean): Boolean;
 167 var
 168   a: Integer;
 169 begin
 170  if Default then a := 1 else a := 0;
 171
 172  Result := StrToIntDef(ReadParam(Section, Param, IntToStr(a)), a) <> 0;
 173 end;
 174
 175 function TConfig.ReadInt(Section, Param: string; Default: Integer): Integer;
 176 begin
 177  Result := StrToIntDef(ReadParam(Section, Param, IntToStr(Default)), Default);
 178 end;
 179
 180 function TConfig.ReadParam(Section, Param, Default: string): string;
 181 var
 182   a: Integer;
 183   s: Word;
 184   ok: Boolean;
 185   p: string;
 186 begin
 187  Result := default;
 188
 189  if FParams = nil then Exit;
 190  if FSections = nil then Exit;
 191
 192  ok := False;
 193  s := 0;
 194  for a := 0 to High(FSections) do
 195   if LowerCase(FSections[a]) = LowerCase(Section) then
 196   begin
 197    s := a;
 198    ok := True;
 199   end;
 200
 201  if not ok then Exit;
 202
 203  p := LowerCase(Param);
 204
 205  for a := 0 to High(FParams) do
 206   if (FParams[a].Section = s) and (LowerCase(FParams[a].Param) = p) then
 207   begin
 208    Result := FParams[a].Value;
 209    Break;
 210   end;
 211 end;
 212
 213 function TConfig.ReadStr(Section, Param, Default: string): string;
 214 begin
 215  Result := ReadParam(Section, Param, Default);
 216 end;
 217
 218 procedure TConfig.SaveFile(FileName: string);
 219 var
 220   f: TextFile;
 221   a: Integer;
 222   b: Integer;
 223 begin
 224  AssignFile(f, FileName);
 225  Rewrite(f);
 226  if (FSections <> nil) or (FParams <> nil) then
 227  begin
 228   if FSections <> nil then
 229    for a := 0 to High(FSections) do
 230    begin
 231     if FSections[a] <> '' then Writeln(f, '['+FSections[a]+']');
 232
 233     if FParams <> nil then
 234      for b := 0 to High(FParams) do
 235       if FParams[b].Section = a then WriteLn(f, FParams[b].Param+'='+FParams[b].Value);
 236
 237     if (a <> High(FSections)) and (FSections[a] <> '') then WriteLn(f, '');
 238    end;
 239  end;
 240  CloseFile(f);
 241 end;
 242
 243 function TConfig.SectionExists(Section: string): Boolean;
 244 var
 245   a: Integer;
 246 begin
 247  Result := False;
 248
 249  if FSections = nil then Exit;
 250
 251  Section := LowerCase(Section);
 252
 253  for a := 0 to High(FSections) do
 254   if Section = LowerCase(FSections[a]) then
 255   begin
 256    Result := True;
 257    Exit;
 258   end;
 259 end;
 260
 261 procedure TConfig.WriteBool(Section, Param: string; Value: Boolean);
 262 begin
 263  WriteParam(Section, Param, BoolToStr(Value));
 264 end;
 265
 266 procedure TConfig.WriteInt(Section, Param: string; Value: Integer);
 267 begin
 268  WriteParam(Section, Param, IntToStr(Value));
 269 end;
 270
 271 procedure TConfig.WriteParam(Section, Param, Value: string);
 272 var
 273   a, b: Integer;
 274   ok: Boolean;
 275 begin
 276  a := 0;
 277  b := 0;
 278
 279  ok := False;
 280
 281  if FSections <> nil then
 282   for a := 0 to High(FSections) do
 283    if FSections[a] = Section then
 284    begin
 285     ok := True;
 286     Break;
 287    end;
 288
 289  if not ok then
 290  begin
 291   SetLength(FSections, Length(FSections)+1);
 292   a := High(FSections);
 293   FSections[a] := Section;
 294  end;
 295
 296  ok := False;
 297  if FParams <> nil then
 298   for b := 0 to High(FParams) do
 299    if (LowerCase(FParams[b].Param) = LowerCase(Param)) and (FParams[b].Section = a) then
 300    begin
 301     ok := True;
 302     Break;
 303    end;
 304
 305  if ok then FParams[b].Value := Value
 306   else
 307  begin
 308   SetLength(FParams, Length(FParams)+1);
 309   FParams[High(FParams)].Param := Param;
 310   FParams[High(FParams)].Value := Value;
 311   FParams[High(FParams)].Section := a;
 312  end;
 313 end;
 314
 315 procedure TConfig.WriteStr(Section, Param, Value: string);
 316 begin
 317  WriteParam(Section, Param, Value);
 318 end;
 319
 320 end.