GoldSrc.KeyValues.pas

(*=========== (C) Copyright 2020, Alexander B. All rights reserved. ===========*)
(*                                                                             *)
(*  Module:                                                                    *)
(*    GoldSrc.KeyValues                                                        *)
(*                                                                             *)
(*  License:                                                                   *)
(*    You may freely use this code provided you retain this copyright message. *)
(*                                                                             *)
(*  Description:                                                               *)
(*=============================================================================*)

unit GoldSrc.KeyValues;

interface

uses
  Xander.ThisWrap;

{$A2}
{$Z2}
type
  KeyValueType = (kvNone, kvStr, kvInt, kvFloat, kvPointer, kvWStr, kvColor, kvUInt64);
{$A4}
{$Z4}

type
  PIFileSystem = Pointer;

  PVKeyValues = ^VKeyValues;
  VKeyValues = record
    GetName: function: PAnsiChar; stdcall;
    GetNameSymbol: function: Integer; stdcall;
	  LoadFromFile: function(FileSystem: PIFileSystem; ResourceName: PAnsiChar; PathID: PAnsiChar = nil): Boolean; stdcall;
    SaveToFile: function(FileSystem: PIFileSystem; ResourceName: PAnsiChar; PathID: PAnsiChar = nil): Boolean; stdcall;
  {$IFDEF MSWINDOWS}
    FindKeyByValue: function(KeySymbol: Integer): Pointer; stdcall;
    FindKeyByName: function(KeyName: PAnsiChar; Create: Boolean = False): Pointer; stdcall;
  {$ELSE}
    FindKeyByName: function(KeyName: PAnsiChar; Create: Boolean = False): Pointer; stdcall;
    FindKeyByValue: function(KeySymbol: Integer): Pointer; stdcall;
  {$ENDIF}
  	CreateNewKey: function: Pointer; stdcall; // creates a new key, with an autogenerated name.  name is guaranteed to be an integer, of value 1 higher than the highest other integer key name
    RemoveSubKey: procedure(SubKey: Pointer); stdcall; // removes a subkey from the list, DOES NOT DELETE IT
	  GetFirstSubKey: function: Pointer; stdcall; // returns the first subkey in the list
  	GetNextKey: function: Pointer; stdcall; // returns the next subkey
    GetInt: function(KeyName: PAnsiChar = nil; DefaultValue: Integer = 0): Integer; stdcall;
    GetFloat: function(KeyName: PAnsiChar = nil; DefaultValue: Single = 0.0): Single; stdcall;
  	GetString: function(KeyValue: PAnsiChar; DefaultValue: PAnsiChar): PAnsiChar; stdcall;
	  GetWString: function(KeyName: PAnsiChar; DefaultValue: PWideChar): PWideChar; stdcall;
  	GetPtr: function(KeyName: PAnsiChar = nil; DefaultValue: Pointer = nil): Pointer; stdcall;
    IsEmpty: function(KeyName: PAnsiChar = nil): Boolean; stdcall;
  	SetWString: procedure(KeyName: PAnsiChar; Value: PWideChar); stdcall;
	  SetString: procedure(KeyName: PAnsiChar; Value: PAnsiChar); stdcall;
  	SetInt: procedure(KeyName: PAnsiChar; Value: Integer); stdcall;
	  SetFloat: procedure(KeyName: PAnsiChar; Value: Single); stdcall;
  	SetPtr: procedure(KeyName: PAnsiChar; Value: Pointer); stdcall;
    MakeCopy: function: Pointer; stdcall;
    Clear: procedure; stdcall;
	  GetDataType: function(KeyName: PAnsiChar = nil): KeyValueType; stdcall;
    deleteThis: procedure; stdcall;
  end;

type
  PKeyValues = ^KeyValues;

  DKeyValues = record
    KeyName: Integer;

    KeyValue: record
      case Byte of
        0: (Integer: Integer);
        1: (Float: Single);
        2: (Ptr: Pointer);
        3: (Color: Integer);
        4: (AString: PAnsiChar);
        5: (WString: PWideChar);
      end;

    DataType: KeyValueType;
    AllocationSize: Word;
    Peer: PKeyValues;
    Sub: PKeyValues;
  end;

  KeyValues = record
    VTable: PVKeyValues;
    Data: DKeyValues;
  end;

const
  INVALID_KEY_SYMBOL = -1;

type
  PListPanelItem = ^ListPanelItem;
  ListPanelItem = record
    KV: PKeyValues;
    UserData: Cardinal;
    DragData: Pointer;
    Image: Boolean;
    ImageIndex: Integer;
    ImageIndexSelected: Integer;
    Icon: Pointer;
  end;

  HKeySymbol = Integer;

  PVKeyValuesSystem = ^VKeyValuesSystem;
  VKeyValuesSystem = record
    Destroy: procedure(Dispose: Boolean); stdcall;

    RegisterSizeofKeyValues: procedure(Size: Integer); stdcall;
    AllocKeyValuesMemory: function(Size: Integer): Pointer; stdcall;
    FreeKeyValuesMemory: procedure(Mem: Pointer); stdcall;
    GetSymbolForString: function(Name: PAnsiChar): HKeySymbol; stdcall;
    GetStringForSymbol: function(Symbol: HKeySymbol): PAnsiChar; stdcall;
	  GetLocalizedFromANSI: procedure(ANSI: PAnsiChar; OutBuf: PWideChar; UnicodeBufferSizeInBytes: Integer); stdcall;
    GetANSIFromLocalized: procedure(WChar: PWideChar; OutBuf: PAnsiChar; AnsiBufferSizeInBytes: Integer); stdcall;
    AddKeyValuesToMemoryLeakList: procedure(Mem: Pointer; Name: HKeySymbol); stdcall;
    RemoveKeyValuesFromMemoryLeakList: procedure(Mem: Pointer); stdcall;
  end;

  PIKeyValuesSystem = ^IKeyValuesSystem;
  IKeyValuesSystem = record
    VTable: PVKeyValuesSystem;
  end;

type
  TKeyValueEnumerator = reference to procedure(KeyValue: PKeyValues; Name: PAnsiChar);

  KeyValuesHelper = record helper for KeyValues
    procedure EnumKeys(Enumerator: TKeyValueEnumerator);

    function ReadInt: Integer; overload;
    function ReadInt(KeyName: PAnsiChar; Default: Integer): Integer; overload;
    function ReadString: PAnsiChar; overload;
    function ReadString(KeyName, Default: PAnsiChar): PAnsiChar; overload;
    function ReadPtr: Pointer; overload;
    function ReadPtr(KeyName: PansiChar; Default: Pointer): Pointer; overload;

    procedure WriteInt(Value: Integer); overload;
    procedure WriteInt(KeyName: PAnsiChar; Value: Integer); overload;
    procedure WriteString(Value: PAnsiChar); overload;
    procedure WriteString(KeyName, Value: PAnsiChar); overload;
    procedure WriteWString(KeyName: PAnsiChar; Value: PWideChar); overload;
    procedure WriteWString(Value: PWideChar); overload;
  end;

implementation

procedure KeyValuesHelper.EnumKeys(Enumerator: TKeyValueEnumerator);
var
  KV: PKeyValues;
begin
  if @Enumerator = nil then
    Exit;

  KV := @Self;
  KV := ThisCall(KV, @KV.VTable.GetFirstSubKey);

  while True do
  begin
    Enumerator(KV, ThisCall(KV, @KV.VTable.GetName));

    KV := ThisCall(KV, @KV.VTable.GetNextKey);

    if KV = nil then
      Break;
  end;
end;

function KeyValuesHelper.ReadInt(KeyName: PAnsiChar; Default: Integer): Integer;
begin
  Result := Integer(ThisCall(@Self, @Self.VTable.GetInt, KeyName, Default));
end;

function KeyValuesHelper.ReadPtr: Pointer;
begin
  Result := ThisCall(@Self, @Self.VTable.GetPtr, nil, nil);
end;

function KeyValuesHelper.ReadPtr(KeyName: PansiChar; Default: Pointer): Pointer;
begin
  Result := ThisCall(@Self, @Self.VTable.GetPtr, KeyName, Default);
end;

function KeyValuesHelper.ReadString(KeyName, Default: PAnsiChar): PAnsiChar;
begin
  Result := ThisCall(@Self, @Self.VTable.GetString, KeyName, Default);
end;

function KeyValuesHelper.ReadString: PAnsiChar;
begin
  Result := ThisCall(@Self, @Self.VTable.GetString, nil, nil);
end;

procedure KeyValuesHelper.WriteInt(KeyName: PAnsiChar; Value: Integer);
begin
  ThisCall(@Self, @Self.VTable.SetInt, KeyName, Value);
end;

procedure KeyValuesHelper.WriteString(KeyName, Value: PAnsiChar);
begin
  ThisCall(@Self, @Self.VTable.SetString, KeyName, Value);
end;

procedure KeyValuesHelper.WriteWString(KeyName: PAnsiChar; Value: PWideChar);
begin
  ThisCall(@Self, @Self.VTable.SetWString, KeyName, Value);
end;

procedure KeyValuesHelper.WriteWString(Value: PWideChar);
begin
  ThisCall(@Self, @Self.VTable.SetWString, nil, Value);
end;

procedure KeyValuesHelper.WriteInt(Value: Integer);
begin
  ThisCall(@Self, @Self.VTable.SetInt, nil, Value);
end;

procedure KeyValuesHelper.WriteString(Value: PAnsiChar);
begin
  ThisCall(@Self, @Self.VTable.SetString, nil, Value);
end;

function KeyValuesHelper.ReadInt: Integer;
begin
  Result := Integer(ThisCall(@Self, @Self.VTable.GetInt, nil, 0));
end;

end.