Vulkan/projects/generator/HeaderGenerator.pas

unit HeaderGenerator;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, DOM, fgl, variants;

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  THeaderGenerator = class(TObject)
  private type
    TvkObjectType = (
      otUnknown,
      otType,
      otHandle,
      otEnum,
      otConst,
      otFuncPtr,
      otStruct,
      otCommand);
    TvkObjectTypes = set of TvkObjectType;

    TvkObject = class;
    TvkObjectList = class(specialize TFPGObjectList<TvkObject>)
    public
      function IndexOfObj(const aName: DOMstring; const aTypes: TvkObjectTypes): Integer;
      function FindObj(const aName: DOMstring; const aTypes: TvkObjectTypes; out aObject): Boolean;
      procedure MarkObj(const aName: DOMstring; const aTypes: TvkObjectTypes; const aMark: Integer);
      function GetPascalName(const aName: DOMString; const aPointer: Integer; const aArrSize: WideString = ''): WideString;
    end;

    ////////////////////////////////////////////////////////////////////////////////////////////
    TvkObject = class(TObject)
    private
      fType: TvkObjectType;
      fName: DOMString;
      fComment: DOMString;
      fMark: Integer;
      fConstGenerated: Boolean;
      fTypeGenerated: Boolean;
      fPtrGenerated: Boolean;
      fVarGenerated: Boolean;
      fImplGenerated: Boolean;
      fList: TvkObjectList;
    private
      procedure SetMark(aValue: Integer);
    protected
      function GetDependencyOrder: Integer; virtual;
      procedure DoMark(const aMark: Integer); virtual;
      procedure GenPascalName(var aName: WideString; const aPointer: Integer; const aArrSize: WideString); virtual;
    public
      property VkType:          TvkObjectType read fType;
      property Name:            DOMString     read fName    write fName;
      property Comment:         DOMString     read fComment write fComment;
      property Mark:            Integer       read fMark    write SetMark;
      property ConstGenerated:  Boolean       read fConstGenerated;
      property TypeGenerated:   Boolean       read fTypeGenerated;
      property PtrGenerated:    Boolean       read fPtrGenerated;
      property VarGenerated:    Boolean       read fVarGenerated;
      property ImplGenerated:   Boolean       read fImplGenerated;
      property DependencyOrder: Integer       read GetDependencyOrder;
      property List:            TvkObjectList read fList    write fList;

      procedure AddCommentFromXml(xml: TDOMNode);
      function GetPascalName(const aPointer: Integer; const aArrSize: WideString): WideString;

      function GenerateConst(const aCode: TStrings): Boolean; virtual;
      function GenerateType(const aCode: TStrings): Boolean; virtual;
      function GeneratePtr(const aCode: TStrings): Boolean; virtual;
      function GenerateVar(const aCode: TStrings): Boolean; virtual;
      function GenerateImpl(const aCode: TStrings): Boolean; virtual;

      constructor Create(const aType: TvkObjectType);
    public
      class function CreateFromXml(const xml: TDOMNode): THeaderGenerator.TvkObject;
    end;

    ////////////////////////////////////////////////////////////////////////////////////////////
    TvkTypeSimple = class(TvkObject)
    private
      fParent: DOMString;
      fAlias: DOMString;
    protected
      function GetDependencyOrder: Integer; override;
      procedure DoMark(const aMark: Integer); override;
      procedure GenPascalName(var aName: WideString; const aPointer: Integer; const aArrSize: WideString); override;
    public
      property Parent: DOMString read fParent write fParent;
      property Alias:  DOMString read fAlias  write fAlias;

      function GenerateType(const aCode: TStrings): Boolean; override;
      function GeneratePtr(const aCode: TStrings): Boolean; override;
    public
      class function CreateFromXml(const xml: TDOMNode): THeaderGenerator.TvkTypeSimple;
    end;

    ////////////////////////////////////////////////////////////////////////////////////////////
    TvkTypeHandle = class(TvkTypeSimple)
    private
      fNonDispatchable: Boolean;
    public
      property NonDispatchable: Boolean read fNonDispatchable write fNonDispatchable;
    public
      class function CreateFromXml(const xml: TDOMNode): THeaderGenerator.TvkTypeHandle;
    end;

    ////////////////////////////////////////////////////////////////////////////////////////////
    TvkTypeFunction = class(TvkObject)
    private type
      TArgument = class(TObject)
        Typ: DOMString;
        Name: DOMString;
        IsPointer: Integer;
        IsConst: Boolean;
      end;
      TArgumentList = specialize TFPGObjectList<TArgument>;
    private
      fReturnValue: TArgument;
      fArguments: TArgumentList;
    protected
      function GetDependencyOrder: Integer; override;
      procedure DoMark(const aMark: Integer); override;
      procedure GenPascalName(var aName: WideString; const aPointer: Integer; const aArrSize: WideString); override;

      procedure GenerateFunctionPtr(const aCode: TStrings);
    public
      property ReturnValue: TArgument     read fReturnValue;
      property Arguments:   TArgumentList read fArguments;

      constructor Create(const aType: TvkObjectType);
      destructor Destroy; override;
    end;

    ////////////////////////////////////////////////////////////////////////////////////////////
    TvkTypeFunctionPtr = class(TvkTypeFunction)
    public
      function GenerateType(const aCode: TStrings): Boolean; override;
    public
      class function CreateFromXml(const xml: TDOMNode): THeaderGenerator.TvkTypeFunctionPtr;
    end;

    ////////////////////////////////////////////////////////////////////////////////////////////
    TvkCommand = class(TvkTypeFunction)
    public
      function GenerateType(const aCode: TStrings): Boolean; override;
      function GenerateVar(const aCode: TStrings): Boolean; override;
      function GenerateImpl(const aCode: TStrings): Boolean; override;
    public
      class function CreateFromXml(const xml: TDOMNode): THeaderGenerator.TvkCommand;
    end;

    ////////////////////////////////////////////////////////////////////////////////////////////
    TvkTypeStruct = class(TvkObject)
    private type
      TMember = class(TObject)
        Typ: DOMString;
        Name: DOMString;
        ArrSize: DOMString;
        IsPointer: Integer;
        IsConst: Boolean;
      end;
      TMemberList = specialize TFPGObjectList<TMember>;
    private
      fIsUnion: Boolean;
      fMember: TMemberList;
    protected
      function GetDependencyOrder: Integer; override;
      procedure DoMark(const aMark: Integer); override;
      procedure GenPascalName(var aName: WideString; const aPointer: Integer; const aArrSize: WideString); override;
    public
      property Member: TMemberList read fMember;
      property IsUnion: Boolean read fIsUnion write fIsUnion;

      function GenerateType(const aCode: TStrings): Boolean; override;

      constructor Create(const aType: TvkObjectType);
      destructor Destroy; override;
    public
      class function CreateFromXml(const xml: TDOMNode): THeaderGenerator.TvkTypeStruct;
    end;

    ////////////////////////////////////////////////////////////////////////////////////////////
    TvkTypeEnum = class(TvkObject)
    private type
      TValue = class(TObject)
        Name: DOMString;
        Value: Variant;
        IsBit: Boolean;
      end;
      TValueList = specialize TFPGObjectList<TValue>;
    private
      fValues: TValueList;
    protected
      procedure GenPascalName(var aName: WideString; const aPointer: Integer; const aArrSize: WideString); override;
    public
      property Values: TValueList read fValues;

      function GenerateConst(const aCode: TStrings): Boolean; override;
      function GenerateType(const aCode: TStrings): Boolean; override;

      constructor Create(const aType: TvkObjectType);
      destructor Destroy; override;
     public
      class function CreateFromXml(const xml: TDOMNode): THeaderGenerator.TvkTypeEnum;
    end;

  private const
    VK_OBJECT_TYPES: TvkObjectTypes = [ otType, otHandle, otFuncPtr, otStruct, otEnum ];

  private
    fDocument: TXMLDocument;
    fObjects: TvkObjectList;
    fOutputFile: String;
    fTemplateFile: String;

  public
    property OutputFile:   String read fOutputFile   write fOutputFile;
    property TemplateFile: String read fTemplateFile write fTemplateFile;

    procedure ReadFile(const aFilename: String);
    procedure ReadFile(const aStream: TStream);

    procedure Clear;

    constructor Create;
    destructor Destroy; override;
  end;

implementation

uses
  Math, XMLRead, RegExpr;

type
  XmlException = class(Exception)
  public
    xml: TDOMNode;
    constructor Create(const aMsg: WideString; const aXml: TDOMNode);
  end;

const
  COMMENT_HEAD  =                           '{ ============================================================================' + sLineBreak;
  COMMENT_BREAK = sLineBreak + sLineBreak + '==============================================================================' + sLineBreak + sLineBreak;
  COMMENT_TAIL  = sLineBreak +              '============================================================================ }';
  COMMENT_CONTENT =
  'This file is autogenerated from vk.xml' + sLineBreak +
  '' + sLineBreak +
  'You may retrieve the latest version of this file at the Delphi OpenGL' + sLineBreak +
  'Community home page, located at http://www.delphigl.com/' + sLineBreak +
  '' + sLineBreak +
  'The contents of this file are used with permission, subject to' + sLineBreak +
  'the Mozilla Public License Version 1.1 (the "License"); you may' + sLineBreak +
  'not use this file except in compliance with the License. You may' + sLineBreak +
  'obtain a copy of the License at' + sLineBreak +
  'http://www.mozilla.org/MPL/MPL-1.1.html' + sLineBreak +
  '' + sLineBreak +
  'Software distributed under the License is distributed on an' + sLineBreak +
  '"AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or' + sLineBreak +
  'implied. See the License for the specific language governing' + sLineBreak +
  'rights and limitations under the License.' + sLineBreak;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function PointerCount(const aStr: AnsiString): Integer;
var i: Integer;
begin
  result := 0;
  i := Length(aStr);
  while (i > 0) do begin
    if (aStr[i] = '*') then
      inc(result);
    dec(i);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function PrepareName(const aName, aType: WideString): WideString;
var rx: TRegExpr;
begin
  result := aName;
  if (result = 'type') then begin
    rx := TRegExpr.Create('^(T|P)?(Vk)?(.)');
    try
      if rx.Exec(String(aType))
        then result := WideString(LowerCase(rx.Match[3]) + 'Type')
        else result := 'mType';
    finally
      FreeAndNil(rx);
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function CompareVkObjDependency(const aItem1, aItem2: THeaderGenerator.TvkObject): Integer;
var
  w1, w2: WideString;
begin
  result := (aItem1.DependencyOrder - aItem2.DependencyOrder);
  if (result = 0) then begin
    w1 := aItem1.Name;
    w2 := aItem2.Name;
    result := strcomp(PWideChar(w1), PWideChar(w2));
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function FormatType(const aType: THeaderGenerator.TvkObjectType): WideString;
begin
  case aType of
    otType:    result := 'TYPE';
    otHandle:  result := 'HANDLE';
    otFuncPtr: result := 'FUNCPTR';
    otStruct:  result := 'STRUCT';
    otEnum:    result := 'ENUM';
    otConst:   result := 'CONSTANT';
    otCommand: result := 'COMMAND';
  else
    result := '';
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure WriteResolveWarning(const aName: DOMString);
begin
  WriteLn('WARNING! unable to resolve identifier: ' + aName);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function GetNodeValue(xml: TDOMNode; const aName: WideString): DOMString;
var x: TDOMNode;
begin
  x := xml.FindNode(aName);
  if not Assigned(x) then
    raise XmlException.Create(xml.NodeName + ' witout child ''' + aName + '''', xml);
  result := x.TextContent;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TryGetNodeValue(xml: TDOMNode; const aName: WideString; out aValue: DOMString): Boolean;
var x: TDOMNode;
begin
  x := xml.FindNode(aName);
  result := Assigned(x);
  if result then
    aValue := x.TextContent;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function GetNodeValue(xml: TDOMNode; const aName: WideString; const aDefault: DOMString): DOMString;
var x: TDOMNode;
begin
  x := xml.FindNode(aName);
  if not Assigned(x)
    then result := aDefault
    else result := x.TextContent;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function GetNodeAttrib(xml: TDOMNode; const aName: WideString): DOMString;
var x: TDOMNode;
begin
  if xml.HasAttributes then begin
    x := xml.Attributes.GetNamedItem(aName);
    if Assigned(x) then begin
      result := x.TextContent;
      exit;
    end;
  end;
  raise XmlException.Create(xml.NodeName + ' without ''' + aName + ''' attribute', xml);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function GetNodeAttrib(xml: TDOMNode; const aName: WideString; const aDefault: DOMString): DOMString;
var x: TDOMNode;
begin
  result := aDefault;
  if xml.HasAttributes then begin
    x := xml.Attributes.GetNamedItem(aName);
    if Assigned(x) then
      result := x.TextContent;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//XmlException//////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor XmlException.Create(const aMsg: WideString; const aXml: TDOMNode);
begin
  inherited Create(String(aMsg + ': ' + aXml.TextContent));
  xml := aXml;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//THeaderGenerator.TvkObjectList////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function THeaderGenerator.TvkObjectList.IndexOfObj(const aName: DOMstring; const aTypes: TvkObjectTypes): Integer;
var o: TvkObject;
begin
  if (aName = '') then
    raise Exception.Create('empty name');

  for result := 0 to Count-1 do begin
    o := Get(result);
    if (o.VkType in aTypes) and (o.Name = aName) then
      exit;
  end;
  result := -1;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function THeaderGenerator.TvkObjectList.FindObj(const aName: DOMstring; const aTypes: TvkObjectTypes; out aObject): Boolean;
var i: Integer;
begin
  i := IndexOfObj(aName, aTypes);
  result := (i >= 0);
  if result
    then TvkObject(aObject) := Get(i)
    else TvkObject(aObject) := nil;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure THeaderGenerator.TvkObjectList.MarkObj(const aName: DOMstring; const aTypes: TvkObjectTypes; const aMark: Integer);
var o: TvkObject;
begin
  if FindObj(aName, aTypes, o)
    then o.Mark := aMark
    else WriteResolveWarning(aName);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function THeaderGenerator.TvkObjectList.GetPascalName(const aName: DOMString; const aPointer: Integer;
  const aArrSize: WideString): WideString;
var o: TvkObject;
begin
  if FindObj(aName, VK_OBJECT_TYPES, o)
    then result := o.GetPascalName(aPointer, aArrSize)
    else result := aName;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//THeaderGenerator.TvkObject////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure THeaderGenerator.TvkObject.SetMark(aValue: Integer);
begin
  if (fMark <> 0) then
    exit;
  fMark := aValue;
  DoMark(fMark);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function THeaderGenerator.TvkObject.GetDependencyOrder: Integer;
begin
  result := 0;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure THeaderGenerator.TvkObject.DoMark(const aMark: Integer);
begin
  WriteLn(Format('  %-10s%-50s marked for generation', [FormatType(fType), fName]));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure THeaderGenerator.TvkObject.GenPascalName(var aName: WideString; const aPointer: Integer; const aArrSize: WideString);
var
  i: Integer;
begin
  if (aName = '') then begin
    aName := fName;
    if (aName = 'void') then
      aName := 'VkVoid';
    for i := 0 to aPointer-1 do
      aName := 'P' + aName;
  end;
  if (aName = 'VkVoid') then
    raise Exception.Create('void can not be used as type');
  if (aArrSize <> '') then begin
    if TryStrToInt(String(aArrSize), i)
      then aName := WideString(Format('array[0..%d] of %s', [i, aName]))
      else aName := WideString(Format('array[0..%s-1] of %s', [aArrSize, aName]));
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure THeaderGenerator.TvkObject.AddCommentFromXml(xml: TDOMNode);
begin
  xml := xml.FindNode('comment');
  if Assigned(xml) then
    fComment := xml.TextContent;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function THeaderGenerator.TvkObject.GetPascalName(const aPointer: Integer; const aArrSize: WideString): WideString;
begin
  result := '';
  GenPascalName(result, aPointer, aArrSize);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function THeaderGenerator.TvkObject.GenerateConst(const aCode: TStrings): Boolean;
begin
  result := not fConstGenerated;
  if not fConstGenerated then begin
    fConstGenerated := true;
    WriteLn(Format('  %-10s%-50s constants generated', [FormatType(fType), fName]));
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function THeaderGenerator.TvkObject.GenerateType(const aCode: TStrings): Boolean;
begin
  result := not fTypeGenerated;
  if not fTypeGenerated then begin
    fTypeGenerated := true;
    WriteLn(Format('  %-10s%-50s type generated', [FormatType(fType), fName]));
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function THeaderGenerator.TvkObject.GeneratePtr(const aCode: TStrings): Boolean;
begin
  result := not fPtrGenerated;
  if not fPtrGenerated then begin
    fPtrGenerated := true;
    WriteLn(Format('  %-10s%-50s pointer type generated', [FormatType(fType), fName]));
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function THeaderGenerator.TvkObject.GenerateVar(const aCode: TStrings): Boolean;
begin
  result := not fVarGenerated;
  if not fVarGenerated then begin
    fVarGenerated := true;
    WriteLn(Format('  %-10s%-50s variables generated', [FormatType(fType), fName]));
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function THeaderGenerator.TvkObject.GenerateImpl(const aCode: TStrings): Boolean;
begin
  result := not fImplGenerated;
  if not fImplGenerated then begin
    fImplGenerated := true;
    WriteLn(Format('  %-10s%-50s implementation generated', [FormatType(fType), fName]));
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor THeaderGenerator.TvkObject.Create(const aType: TvkObjectType);
begin
  inherited Create;
  fType := aType;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function THeaderGenerator.TvkObject.CreateFromXml(const xml: TDOMNode): THeaderGenerator.TvkObject;
var
  s, n: DOMString;
  x: TDOMNode;

  function GenerateVersionEnum: TvkTypeEnum;
  var
    rx: TRegExpr;
    v: TvkTypeEnum.TValue;
  begin
    result := TvkTypeEnum.Create(otConst);
    rx := TRegExpr.Create('\(\s*(\d+)\s*,\s*(\d+)\s*,\s*(\d+)\s*\)');
    try try
      if not rx.Exec(xml.TextContent) then
        raise XmlException.Create('VK_API_VERSION with malformed version', xml);
      v := TvkTypeEnum.TValue.Create;
      result.Values.Add(v);
      v.Name  := 'VK_API_VERSION';
      v.Value := (StrToInt(rx.Match[1]) shl 22) or
                 (StrToInt(rx.Match[2]) shl 12) or
                 (StrToInt(rx.Match[3]) shl  0);

      v := TvkTypeEnum.TValue.Create;
      result.Values.Add(v);
      v.Name  := 'VK_API_VERSION_MAJOR';
      v.Value := StrToInt(rx.Match[1]);

      v := TvkTypeEnum.TValue.Create;
      result.Values.Add(v);
      v.Name  := 'VK_API_VERSION_MINOR';
      v.Value := StrToInt(rx.Match[2]);

      v := TvkTypeEnum.TValue.Create;
      result.Values.Add(v);
      v.Name  := 'VK_API_VERSION_BUGFIX';
      v.Value := StrToInt(rx.Match[3]);
    finally
      FreeAndNil(rx);
    end;
    except
      FreeAndNil(result);
      raise;
    end;
  end;


begin
  result := nil;
  if (xml.NodeName = 'type') and xml.HasAttributes then begin
    x := xml.Attributes.GetNamedItem('category');
    if not Assigned(x) then
      exit;
    s := x.TextContent;
    if (s = 'basetype') or (s = 'bitmask') then
      result := TvkTypeSimple.CreateFromXml(xml)
    else if (s = 'handle') then
      result := TvkTypeHandle.CreateFromXml(xml)
    else if (s = 'funcpointer') then
      result := TvkTypeFunctionPtr.CreateFromXml(xml)
    else if (s = 'struct') or (s = 'union') then
      result := TvkTypeStruct.CreateFromXml(xml)
    else if (s = 'define') and TryGetNodeValue(xml, 'name', n) and (n = 'VK_API_VERSION') then begin
      result := GenerateVersionEnum;
    end;
  end else if (xml.NodeName = 'command') then
    result := TvkCommand.CreateFromXml(xml);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//THeaderGenerator.TvkTypeSimple////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function THeaderGenerator.TvkTypeSimple.GetDependencyOrder: Integer;
begin
  result := inherited GetDependencyOrder;
  if Assigned(List) and (fParent <> '') then
    result := max(result, List.IndexOfObj(fParent, VK_OBJECT_TYPES) + 1);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure THeaderGenerator.TvkTypeSimple.DoMark(const aMark: Integer);
begin
  inherited DoMark(aMark);
  if (fParent <> '') and Assigned(fList) then
    fList.MarkObj(fParent, VK_OBJECT_TYPES, aMark);
  if (fAlias <> '') and Assigned(fList) then
    fList.MarkObj(fAlias, VK_OBJECT_TYPES, aMark);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure THeaderGenerator.TvkTypeSimple.GenPascalName(var aName: WideString; const aPointer: Integer; const aArrSize: WideString);
var i: Integer;
begin
  if (fAlias <> '')
    then aName := fAlias
    else aName := fName;
  if (aName = 'void') then
    aName := 'VkVoid';
  for i := 0 to aPointer-1 do
    aName := 'P' + aName;
  inherited GenPascalName(aName, aPointer, aArrSize);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function THeaderGenerator.TvkTypeSimple.GenerateType(const aCode: TStrings): Boolean;
begin
  result := inherited GenerateType(aCode);
  if result and (fParent <> '') and Assigned(List) then
    aCode.Add(Format('  %-62s = %s;', [ fName, List.GetPascalName(fParent, 0) ]));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function THeaderGenerator.TvkTypeSimple.GeneratePtr(const aCode: TStrings): Boolean;
begin
  result := inherited GeneratePtr(aCode);
  if result and (fParent <> '') and Assigned(List) then begin
    aCode.Add(Format('  P%-61s = ^%0:s;', [ fName ]));
    aCode.Add(Format('  PP%-60s = ^P%0:s;', [ fName ]));
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function THeaderGenerator.TvkTypeSimple.CreateFromXml(const xml: TDOMNode): THeaderGenerator.TvkTypeSimple;
begin
  result := TvkTypeSimple.Create(otType);
  try
    result.Name   := GetNodeValue(xml, 'name');
    result.Parent := GetNodeValue(xml, 'type');
  except
    FreeAndNil(result);
    raise;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//THeaderGenerator.TvkTypeHandle////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function THeaderGenerator.TvkTypeHandle.CreateFromXml(const xml: TDOMNode): THeaderGenerator.TvkTypeHandle;
begin
  result := TvkTypeHandle.Create(otHandle);
  try
    result.Name            :=  GetNodeValue(xml, 'name');
    result.Parent          :=  GetNodeValue(xml, 'parent', 'VkHandle');
    result.NonDispatchable := (GetNodeValue(xml, 'type', '') = 'VK_DEFINE_NON_DISPATCHABLE_HANDLE');
  except
    FreeAndNil(result);
    raise;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function THeaderGenerator.TvkTypeFunction.GetDependencyOrder: Integer;
var a: TArgument;
begin
  result := inherited GetDependencyOrder;
  if not Assigned(List) then
    exit;
  for a in fArguments do
    result := max(result, List.IndexOfObj(a.Typ, VK_OBJECT_TYPES));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure THeaderGenerator.TvkTypeFunction.DoMark(const aMark: Integer);
var a: TArgument;
begin
  inherited DoMark(aMark);
  if Assigned(fList) then begin
    fList.MarkObj(fReturnValue.Typ, VK_OBJECT_TYPES, aMark);
    for a in fArguments do
      fList.MarkObj(a.Typ, VK_OBJECT_TYPES, aMark);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure THeaderGenerator.TvkTypeFunction.GenPascalName(var aName: WideString; const aPointer: Integer;
  const aArrSize: WideString);
var rx: TRegExpr;
begin
  if (aPointer > 0) then
    Exception.Create('function pointer can not be used as pointer type');
  if (aArrSize <> '') then
    Exception.Create('function pointer can not be used as array type');

  rx := TRegExpr.Create('PFN_([-_A-Za-z0-9]+)');
  try
    if rx.Exec(String(fName))
      then aName := 'T' + WideString(rx.Match[1])
      else aName := 'T' + fName;
  finally
    FreeAndNil(rx);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure THeaderGenerator.TvkTypeFunction.GenerateFunctionPtr(const aCode: TStrings);
var
  s: WideString;
  i: Integer;
  a: TArgument;
begin
  s := WideString(Format('  %-50s', [ GetPascalName(0, '') ]));
  if (ReturnValue.Typ = 'void') and (ReturnValue.IsPointer = 0)
    then s := s + ' = procedure('
    else s := s + ' = function (';
  for i := 0 to fArguments.Count-1 do begin
    a := fArguments[i];
    if a.IsConst then
      s := s + 'const ';
    s := s + PrepareName(a.Name, a.Typ) + ': ' + List.GetPascalName(a.Typ, a.IsPointer);
    if (i < fArguments.Count-1) then
      s := s + '; ';
  end;
  s := s + ')';
  if (ReturnValue.Typ <> 'void') or (ReturnValue.IsPointer > 0) then
    s := s + ': ' + List.GetPascalName(ReturnValue.Typ, ReturnValue.IsPointer);
  s := s + '; {$IFDEF VK_CDECL}cdecl{$ELSE}stdcall{$ENDIF};';
  aCode.Add(String(s));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor THeaderGenerator.TvkTypeFunction.Create(const aType: TvkObjectType);
begin
  inherited Create(aType);
  fReturnValue := TArgument.Create;
  fArguments   := TArgumentList.Create;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor THeaderGenerator.TvkTypeFunction.Destroy;
begin
  FreeAndNil(fReturnValue);
  FreeAndNil(fArguments);
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//THeaderGenerator.TvkTypeFunctionPtr///////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function THeaderGenerator.TvkTypeFunctionPtr.GenerateType(const aCode: TStrings): Boolean;

begin
  result := inherited GenerateType(aCode);
  if result and Assigned(List) then
    GenerateFunctionPtr(aCode);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function THeaderGenerator.TvkTypeFunctionPtr.CreateFromXml(const xml: TDOMNode): THeaderGenerator.TvkTypeFunctionPtr;
var
  x, p: TDOMNode;
  a: TArgument;
  rx: TRegExpr;
begin
  result := TvkTypeFunctionPtr.Create(otFuncPtr);
  try
    x := xml.FindNode('name');
    if not Assigned(x) then
      raise XmlException.Create(xml.NodeName + ' witout child ''name''', xml);
    result.Name := x.TextContent;

    p := x.PreviousSibling;
    if not Assigned(p) then
      raise XmlException.Create(xml.NodeName + ' witout return type', xml);

    rx := TRegExpr.Create('typedef\s+((const)?)\s*([-_A-Za-z0-9\s]+?)\s*((\*\s*(const)?\s*)*)\s*\(');
    try
      if not rx.Exec(String(p.TextContent)) then
        raise XmlException.Create('unable to parse return type of function pointer', xml);

      result.ReturnValue.IsConst   := (Trim(rx.Match[1]) = 'const');
      result.ReturnValue.Typ       := WideString(Trim(rx.Match[3]));
      result.ReturnValue.IsPointer := PointerCount(Trim(rx.Match[4]));

      x := xml.FirstChild;
      while Assigned(x) do begin
        if (x.NodeName = 'type') then begin
          a := TArgument.Create;
          try
            p := x.PreviousSibling;
            if not Assigned(p) then
              raise XmlException.Create('unable to parse function pointer arguments', xml);
            rx.Expression := '[A-Za-z]*';
            a.IsConst := rx.Exec(String(p.TextContent)) and (rx.Match[0] = 'const');
            a.Typ     := x.TextContent;

            p := x.NextSibling;
            if not Assigned(p) then
              raise XmlException.Create('unable to parse function pointer arguments', xml);
            rx.Expression := '((\*\s*(const)?\s*)*)\s*([-_A-Za-z0-9]+)';
            if not rx.Exec(String(p.TextContent)) then
              raise XmlException.Create('unable to parse function pointer arguments', xml);

            a.IsPointer := PointerCount((rx.Match[1]));
            a.Name      := WideString(Trim(rx.Match[4]));
            result.Arguments.Add(a);
          except
            FreeAndNil(a)
          end;
        end;
        x := x.NextSibling;
      end;
    finally
      FreeAndNil(rx);
    end;
  except
    FreeAndNil(result);
    raise;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//THeaderGenerator.TvkCommand///////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function THeaderGenerator.TvkCommand.GenerateType(const aCode: TStrings): Boolean;
begin
  result := inherited GenerateType(aCode);
  if result and Assigned(List) then
    GenerateFunctionPtr(aCode);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function THeaderGenerator.TvkCommand.GenerateVar(const aCode: TStrings): Boolean;
begin
  result := inherited GenerateVar(aCode);
  if result then
    aCode.Add(Format('  %-50s %s = nil;', [ fName + ':', GetPascalName(0, '') ]));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function THeaderGenerator.TvkCommand.GenerateImpl(const aCode: TStrings): Boolean;
begin
  result := inherited GenerateImpl(aCode);
  if result then
    aCode.Add(Format('  %-50s := vkGetProcAddress(''%0:s'');', [ fName ]));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function THeaderGenerator.TvkCommand.CreateFromXml(const xml: TDOMNode): THeaderGenerator.TvkCommand;

  procedure ParseProto(const x: TDOMNode);
  begin
    result.Name := GetNodeValue(x, 'name');
    result.ReturnValue.Typ := GetNodeValue(x, 'type');
  end;

  procedure ParseParam(const x: TDOMNode);
  var
    p: TDOMNode;
    a: TArgument;
    rx: TRegExpr;
  begin
    a := TArgument.Create;
    rx := TRegExpr.Create;
    try try
      p := x.FindNode('name');
      if not Assigned(p) then
        raise XmlException.Create('unable to parse command; param without name', xml);
      a.Name := p.TextContent;

      p := x.FindNode('type');
      if not Assigned(p) then
        raise XmlException.Create('unable to parse command; param without type', xml);
      a.Typ       := p.TextContent;
      a.IsConst   := Assigned(p.PreviousSibling) and (Trim(p.PreviousSibling.TextContent) = 'const');

      rx.Expression := '((\*\s*(const)?\s*)*)';
      if Assigned(p.NextSibling) and rx.Exec(String(p.NextSibling.TextContent)) then
        a.IsPointer := PointerCount(rx.Match[0]);
      result.Arguments.Add(a);
    finally
      FreeAndNil(rx);
    end;
    except
      FreeAndNil(a);
      raise;
    end;
  end;

var
  x: TDOMNode;
begin
  result := TvkCommand.Create(otCommand);
  try
    x := xml.FirstChild;
    while Assigned(x) do begin
      if (x.NodeName = 'proto') then
        ParseProto(x)
      else if (x.NodeName = 'param') then
        ParseParam(x);
      x := x.NextSibling;
    end;
  except
    FreeAndNil(result);
    raise;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//THeaderGenerator.TvkTypeStruct////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function THeaderGenerator.TvkTypeStruct.GetDependencyOrder: Integer;
var
  m: TMember;
begin
  result := inherited GetDependencyOrder;
  if not Assigned(List) then
    exit;
  for m in fMember do
    result := max(result, List.IndexOfObj(m.Typ, VK_OBJECT_TYPES) + 1);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure THeaderGenerator.TvkTypeStruct.DoMark(const aMark: Integer);
var m: TMember;
begin
  inherited DoMark(aMark);
  if Assigned(fList) then begin
    for m in fMember do
      fList.MarkObj(m.Typ, VK_OBJECT_TYPES, aMark);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure THeaderGenerator.TvkTypeStruct.GenPascalName(var aName: WideString; const aPointer: Integer; const aArrSize: WideString);
var i: Integer;
begin
  if (aPointer > 0) then begin
    aName := fName;
    for i := 0 to aPointer-1 do
      aName := 'P' + aName;
  end else
    aName := 'T' + fName;
  inherited GenPascalName(aName, aPointer, aArrSize);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function THeaderGenerator.TvkTypeStruct.GenerateType(const aCode: TStrings): Boolean;
var
  prefix, postfix: String;
  i, indent: Integer;
  m: TMember;
begin
  result := inherited GenerateType(aCode);
  result := inherited GeneratePtr(aCode) or result;
  if result and Assigned(List) then begin
    postfix := ';';
    indent  := 50;
    aCode.Add('  T%s = record', [ fName ]);
    if IsUnion then begin
      aCode.Add('    case Integer of');
      postfix := ');';
      indent  := 42;
    end;
    for i := 0 to fMember.Count-1 do begin
      m := fMember[i];
      if IsUnion
        then prefix := Format('      %.3d: (', [ i ])
        else prefix := '    ';
      aCode.Add(Format('%s%-*s%s%s', [ prefix, indent, PrepareName(m.Name, m.Typ) + ': ', List.GetPascalName(m.Typ, m.IsPointer, m.ArrSize), postfix ]));
    end;
    aCode.Add('  end;');
    aCode.Add('  P%s = ^T%0:s;', [ fName ]);
    aCode.Add('  PP%s = ^P%0:s;', [ fName ]);
    aCode.Add('');
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//THeaderGenerator.TvkTypeStruct////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor THeaderGenerator.TvkTypeStruct.Create(const aType: TvkObjectType);
begin
  inherited Create(aType);
  fMember := TMemberList.Create;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor THeaderGenerator.TvkTypeStruct.Destroy;
begin
  FreeAndNil(fMember);
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function THeaderGenerator.TvkTypeStruct.CreateFromXml(const xml: TDOMNode): THeaderGenerator.TvkTypeStruct;
var
  x, p: TDOMNode;
  m: TMember;
  rx: TRegExpr;
begin
  result := TvkTypeStruct.Create(otStruct);
  try
    result.Name    := GetNodeAttrib(xml, 'name');
    result.IsUnion := (GetNodeAttrib(xml, 'category') = 'union');

    x := xml.FirstChild;
    while Assigned(x) do begin
      if (x.NodeName = 'member') then begin
        m := TMember.Create;
        rx := TRegExpr.Create('');
        try try
          // read name
          p := x.FindNode('name');
          if not Assigned(p) then
            raise XmlException.Create('struct member without name', xml);
          m.Name := p.TextContent;
          p := p.NextSibling;
          while Assigned(p) do begin
            m.Name := m.Name + p.TextContent;
            p := p.NextSibling;
          end;
          m.Name := Trim(m.Name);

          rx.Expression := '([-_A-Za-z0-9]+)\s*\[\s*([-_A-Za-z0-9]+)\s*\]';
          if rx.Exec(String(m.Name)) then begin
            m.Name := WideString(rx.Match[1]);
            m.ArrSize := WideString(rx.Match[2]);
          end;

          // read type
          p := x.FindNode('type');
          if not Assigned(p) then
            raise XmlException.Create('struct member without type', xml);
          m.Typ       := p.TextContent;
          m.IsConst   := Assigned(p.PreviousSibling) and (Trim(p.PreviousSibling.TextContent) = 'const');
          rx.Expression := '((\*\s*(const)?\s*)*)';
          if Assigned(p.NextSibling) and rx.Exec(String(p.NextSibling.TextContent)) then
            m.IsPointer := PointerCount(rx.Match[0]);
          result.Member.Add(m);
        finally
          FreeAndNil(rx);
        end;
        except
          FreeAndNil(m);
        end;
      end;
      x := x.NextSibling;
    end;
  except
    FreeAndNil(result);
    raise;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//THeaderGenerator.TvkTypeEnum//////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure THeaderGenerator.TvkTypeEnum.GenPascalName(var aName: WideString; const aPointer: Integer; const aArrSize: WideString);
var i: Integer;
begin
  if (fName = '') then
    raise Exception.Create('enum with empty name');
  if (aPointer > 0) then begin
    aName := fName;
    for i := 0 to aPointer-1 do
      aName := 'P' + aName;
  end else
    aName := 'T' + fName;
  inherited GenPascalName(aName, aPointer, aArrSize);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function THeaderGenerator.TvkTypeEnum.GenerateConst(const aCode: TStrings): Boolean;
var
  value: String;
  i: Integer;
  v: TValue;
begin
  result := inherited GenerateConst(aCode);
  if result and (VkType = otConst) then begin
    for i := 0 to fValues.Count-1 do begin
      v := fValues[i];
      if v.IsBit
        then value := Format('(1 shl %s)', [ IntToStr(v.Value) ])
        else value := v.Value;
      aCode.Add(Format('  %-62s = %s;', [ v.Name, value ]));
    end;
    aCode.Add('');
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function THeaderGenerator.TvkTypeEnum.GenerateType(const aCode: TStrings): Boolean;
var
  value: String;
  i: Integer;
  v: TValue;
begin
  result  := inherited GenerateType(aCode);
  if result and (VkType = otEnum) then begin
    aCode.Add(Format('  T%s = (', [ fName ]));
    for i := 0 to fValues.Count-1 do begin
      v := fValues[i];
      if v.IsBit
        then value := Format('(1 shl %s)', [ IntToStr(v.Value) ])
        else value := v.Value;
      aCode.Add(Format('    %-60s = %s', [ v.Name, value ]));
      if (i < fValues.Count-1) then
        aCode[aCode.Count-1] := aCode[aCode.Count-1] + ',';
    end;
    aCode.Add('  );');
    aCode.Add(Format('  P%s = ^T%0:s;', [ fName ]));
    aCode.Add('');
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor THeaderGenerator.TvkTypeEnum.Create(const aType: TvkObjectType);
begin
  inherited Create(aType);
  fValues := TValueList.Create;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor THeaderGenerator.TvkTypeEnum.Destroy;
begin
  FreeAndNil(fValues);
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function THeaderGenerator.TvkTypeEnum.CreateFromXml(const xml: TDOMNode): THeaderGenerator.TvkTypeEnum;
var
  x, p: TDOMNode;
  v: TValue;

  function StrToValue(s: String): Variant;
  var
    f: TFormatSettings;
    rx: TRegExpr;
  begin
    f.DecimalSeparator := '.';
    rx := TRegExpr.Create;
    try
      result := Unassigned;

      rx.Expression := '^-?([0-9]+)$';
      if rx.Exec(s) then
        result := StrToInt(rx.Match[0]);

      rx.Expression := '^0x([0-9A-Fa-f]+)$';
      if rx.Exec(s) then
        result := '$' + rx.Match[1];

      rx.Expression := '^([0-9\.]+)(f|d)?$';
      if rx.Exec(s) then begin
        result := StrToFloat(rx.Match[1], f);
        if (rx.Match[2] = 'd') then
          result := Double(result);
      end;

      rx.Expression := '^\(~0U([L]*)\)$';
      if rx.Exec(s) then begin
        if (rx.Match[2] = '')
          then result := '$' + IntToHex(High(UInt32), 2 * sizeof(UInt32))
          else result := '$' + IntToHex(High(UInt64), 2 * sizeof(UInt64));
      end;

      if (result = Unassigned) then
        raise XmlException.Create(WideString('invalid enum value (' + s + ')'), xml);
    finally
      FreeAndNil(rx);
    end;
  end;

begin
  x := xml.Attributes.GetNamedItem('type');
  if Assigned(x)
    then result := TvkTypeEnum.Create(otEnum)
    else result := TvkTypeEnum.Create(otConst);
  try
    result.Name := GetNodeAttrib(xml, 'name');
    x := xml.FirstChild;
    while Assigned(x) do begin
      if (x.NodeName = 'enum') then begin
        v := TValue.Create;
        try
          v.Name := GetNodeAttrib(x, 'name');
          p := x.Attributes.GetNamedItem('value');
          if Assigned(p) then begin
            v.IsBit := false;
            v.Value := StrToValue(String(p.TextContent));
          end else begin
            p := x.Attributes.GetNamedItem('bitpos');
            if not Assigned(p) then
              raise XmlException.Create('enum without value or bitpos', xml);
            v.IsBit := true;
            v.Value := StrToValue(String(p.TextContent));
          end;
          result.Values.Add(v);
        except
          FreeAndNil(v);
          raise;
        end;
      end;
      x := x.NextSibling;
    end;
  except
    FreeAndNil(result);
    raise;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//THeaderGenerator//////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure THeaderGenerator.ReadFile(const aFilename: String);
var
  fs: TFileStream;
begin
  if not FileExists(aFilename) then
    raise Exception.Create('file does not exist: ' + aFilename);
  fs := TFileStream.Create(aFilename, fmOpenRead);
  try
    ReadFile(fs);
  finally
    FreeAndNil(fs);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure THeaderGenerator.ReadFile(const aStream: TStream);
type
  TGenPass = (
    gpConst,
    gpType,
    gpPointer,
    gpVar,
    gpImpl
  );

var
  xml: TDOMNode;
  CurrentMark: Integer;
  tpl: TStringList;

  procedure AddObject(const aObj: TvkObject);
  begin
    if Assigned(aObj) then begin
      fObjects.Add(aObj);
      aObj.List := fObjects;
      WriteLn(Format('  %-10s%s', [FormatType(aObj.VkType), aObj.Name]));
      if (aObj.VkType = otConst) then
        aObj.Mark := CurrentMark;
    end;
  end;

  procedure ParseTypes(const xml: TDOMNode);
  var
    x: TDOMNode;
  begin
    x := xml.FirstChild;
    while Assigned(x) do begin
      AddObject(TvkObject.CreateFromXml(x));
      x := x.NextSibling;
    end;
  end;

  procedure GenerateType(const aCode: TStrings; const aType: TvkObjectType; const aPass: TGenPass);
  var
    o: TvkObject;
  begin
    for o in fObjects do begin
      if (o.VkType = aType) and (o.Mark = CurrentMark) then begin
        case aPass of
          gpConst:   o.GenerateConst(aCode);
          gpType:    o.GenerateType(aCode);
          gpPointer: o.GeneratePtr(aCode);
          gpVar:     o.GenerateVar(aCode);
          gpImpl:    o.GenerateImpl(aCode);
        end;
      end;
    end;
  end;

  procedure InsertAt(const aPlaceholder: String; const aText: TStrings);
  var i, j: Integer;
  begin
    for i := tpl.Count-1 downto 0 do begin
      if (Pos(aPlaceholder, tpl[i]) > 0) then begin
        for j := aText.Count-1 downto 0 do
          tpl.Insert(i, aText[j]);
      end;
    end;
  end;

  procedure InsertAt(const aPlaceholder: String; const aText: String);
  var sl: TStringList;
  begin
    sl := TStringList.Create;
    try
      sl.Text := aText;
      InsertAt(aPlaceholder, sl);
    finally
      FreeAndNil(sl);
    end;
  end;

  procedure GeneratePass(const aType: TvkObjectType; const aPass: TGenPass; const aPrefix, aPlaceholder: String);
  var sl: TStringList;
  begin
    sl := TStringList.Create;
    try
      GenerateType(sl, aType, aPass);
      if (sl.Count > 0) then begin
        sl.Insert(0, aPrefix);
        sl.Add('');
      end;
      InsertAt(aPlaceholder, sl);
    finally
      FreeAndNil(sl);
    end;
  end;

  procedure Generate(const aTypes: TvkObjectTypes);
  var t: TvkObjectType;
  begin
    for t in aTypes do begin
      GeneratePass(t, gpConst,   Format('const { %ss }',        [ LowerCase(FormatType(t)) ]), '{%INTERFACE%}');
      GeneratePass(t, gpType,    Format('type { %ss }',         [ LowerCase(FormatType(t)) ]), '{%INTERFACE%}');
      GeneratePass(t, gpPointer, Format('type { %s pointers }', [ LowerCase(FormatType(t)) ]), '{%INTERFACE%}');
      GeneratePass(t, gpVar,     Format('var { %s variables }', [ LowerCase(FormatType(t)) ]), '{%INTERFACE%}');
      GeneratePass(t, gpImpl,    '', '{%IMPLEMENTATION%}');
    end;
  end;

  procedure Generate(const aName: DOMString);
  begin
    fObjects.Sort(@CompareVkObjDependency);
    InsertAt('{%INTERFACE%}',      Format('{********************************* %s *********************************}', [ aName ]));
    InsertAt('{%IMPLEMENTATION%}', Format('{********************************* %s *********************************}', [ aName ]));
    Generate([ otConst ]);
    Generate([ otType, otHandle, otEnum, otStruct, otFuncPtr ]);
    Generate([ otCommand ]);
    inc(CurrentMark);
  end;

  procedure EnableFeature(const xml: TDOMNode);
  var
    x: TDOMNode;
  begin
    x := xml.FirstChild;
    while Assigned(x) do begin
      if (x.NodeName = 'require') then
        EnableFeature(x)
      else if (x.NodeName = 'type') then
        fObjects.MarkObj(GetNodeAttrib(x, 'name'), VK_OBJECT_TYPES, CurrentMark)
      else if (x.NodeName = 'command') then
        fObjects.MarkObj(GetNodeAttrib(x, 'name'), [ otCommand ], CurrentMark);

      x := x.NextSibling;
    end;

    if (xml.NodeName = 'feature') or (xml.NodeName = 'extension') then
      Generate(GetNodeAttrib(xml, 'name'));
  end;

  procedure RemoveLines(const aText: TStrings);
  var
    i: Integer;
    b: Boolean;
    rx: TRegExpr;
  begin
    i := 0;
    rx := TRegExpr.Create('{%.*?%}');
    try
      while (i < aText.Count) do begin
        if (rx.Exec(aText[i])) then begin
          aText.Delete(i);
          continue;
        end;

        if (Trim(aText[i]) = '') then begin
          if b then begin
            aText.Delete(i);
            continue;
          end else
            b := true;
        end else
          b := false;

        inc(i);
      end;
    finally
      FreeAndNil(rx);
    end;
  end;

begin
  Clear;
  ReadXMLFile(fDocument, aStream);

  if not FileExists(TemplateFile) then
    raise Exception.Create('file does not exist: ' + TemplateFile);

  tpl := TStringList.Create;
  try
    tpl.LoadFromFile(TemplateFile);
    CurrentMark := 1;
    WriteLn('read xml data');
    xml := fDocument.DocumentElement.FirstChild;
    while Assigned(xml) do begin
      if (xml.NodeName = 'types') or (xml.NodeName = 'commands') then
        ParseTypes(xml)
      else if (xml.NodeName = 'enums') then
        AddObject(TvkTypeEnum.CreateFromXml(xml))
      else if (xml.NodeName = 'comment') then
        tpl.Text := Trim(COMMENT_HEAD + Trim(xml.TextContent) + COMMENT_BREAK + COMMENT_CONTENT + COMMENT_TAIL) + sLineBreak + tpl.Text
      else if (xml.NodeName = 'feature') then
        EnableFeature(xml);
      xml := xml.NextSibling;
    end;
    RemoveLines(tpl);
    tpl.SaveToFile(OutputFile);
  finally
    FreeAndNil(tpl);
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure THeaderGenerator.Clear;

  procedure CreateBaseType(const aName, aAlias, aParent: DOMString);
  var t: TvkTypeSimple;
  begin
    t := TvkTypeSimple.Create(otType);
    try
      t.Name   := aName;
      t.Alias  := aAlias;
      t.Parent := aParent;
      t.List   := fObjects;
      t.Mark   := 1;
      fObjects.Add(t);
    except
      FreeAndNil(t);
      raise;
    end;
  end;

begin
  fObjects.Clear;

  CreateBaseType('PVkVoid',   '', 'Pointer');
  CreateBaseType('VkHandle',  '', 'Pointer');
  CreateBaseType('VkUint8',   '', 'Byte');
  CreateBaseType('VkUint16',  '', 'Word');
  CreateBaseType('VkUint32',  '', 'Cardinal');
  CreateBaseType('VkUint64',  '', 'QWord');
  CreateBaseType('VkInt16',   '', 'SmallInt');
  CreateBaseType('VkInt32',   '', 'Integer');
  CreateBaseType('VkInt64',   '', 'Int64');
  CreateBaseType('VkFloat',   '', 'Single');
  CreateBaseType('VkDouble',  '', 'Double');
  CreateBaseType('VkChar',    '', 'AnsiChar');
  CreateBaseType('VkSize',    '', 'SizeUInt');

  CreateBaseType('void',      'VkVoid',   '');
  CreateBaseType('uint8_t',   'VkUint8',  '');
  CreateBaseType('uint16_t',  'VkUint16', '');
  CreateBaseType('uint32_t',  'VkUint32', '');
  CreateBaseType('uint64_t',  'VkUint64', '');
  CreateBaseType('int16_t',   'VkInt16',  '');
  CreateBaseType('int32_t',   'VkInt32',  '');
  CreateBaseType('int64_t',   'VkInt64',  '');
  CreateBaseType('float',     'VkFloat',  '');
  CreateBaseType('double',    'VkDouble', '');
  CreateBaseType('char',      'VkChar',   '');
  CreateBaseType('size_t',    'VkSize',   '');
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor THeaderGenerator.Create;
begin
  inherited Create;
  fObjects := TvkObjectList.Create;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor THeaderGenerator.Destroy;
begin
  FreeAndNil(fObjects);
  FreeAndNil(fDocument);
  inherited Destroy;
end;

end.