* initial commit

.gitignore

@@ -0,0 +1,4 @@
+*.exe
+*.dbg
+*.log
+**/lib/

doc/Khronos Vulkan Registry.URL

@@ -0,0 +1,6 @@
+[InternetShortcut]
+URL=https://www.khronos.org/registry/vulkan/
+IDList=
+HotKey=0
+IconFile=C:\Users\Erik\AppData\Local\Mozilla\Firefox\Profiles\im13wiwe.default\shortcutCache\vZzMhGHbEc_XxCO1gmt9ew==.ico
+IconIndex=0

projects/generator/HeaderGenerator.pas

@@ -0,0 +1,851 @@
+unit HeaderGenerator;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, DOM, fgl, variants;
+
+type
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+  THeaderGenerator = class(TObject)
+  private type
+    TvkObjectType = (
+      otUnknown,
+      otType,
+      otHandle,
+      otFuncPtr,
+      otStruct,
+      otEnum,
+      otCommand);
+    TvkObjectTypes = set of TvkObjectType;
+
+    TvkObject = class;
+    TvkObjectList = class(specialize TFPGObjectList<TvkObject>)
+    public
+      function FindObj(const aName: DOMstring; const aTypes: TvkObjectTypes; out aObject): Boolean;
+      procedure MarkObj(const aName: DOMstring; const aTypes: TvkObjectTypes; const aMark: Integer);
+    end;
+
+    ////////////////////////////////////////////////////////////////////////////////////////////
+    TvkObject = class(TObject)
+    private
+      fType: TvkObjectType;
+      fMark: Integer;
+      fName: DOMString;
+      fComment: DOMString;
+      fList: TvkObjectList;
+    private
+      procedure SetMark(aValue: Integer);
+    protected
+      procedure DoMark(const aMark: Integer); virtual;
+    public
+      property Mark: Integer read fMark write SetMark;
+      property Name: DOMString read fName write fName;
+      property Comment: DOMString read fComment write fComment;
+      property VkType: TvkObjectType read fType;
+      property List: TvkObjectList read fList write fList;
+
+      procedure AddCommentFromXml(xml: TDOMNode);
+
+      constructor Create(const aType: TvkObjectType);
+    public
+      class function CreateFromXml(const xml: TDOMNode): THeaderGenerator.TvkObject;
+    end;
+
+    ////////////////////////////////////////////////////////////////////////////////////////////
+    TvkTypeSimple = class(TvkObject)
+    private
+      fParent: DOMString;
+    protected
+      procedure DoMark(const aMark: Integer); override;
+    public
+      property Parent: DOMString read fParent write fParent;
+    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: Boolean;
+        IsConst: Boolean;
+      end;
+      TArgumentList = specialize TFPGObjectList<TArgument>;
+    private
+      fReturnValue: TArgument;
+      fArguments: TArgumentList;
+    protected
+      procedure DoMark(const aMark: Integer); override;
+    public
+      property ReturnValue: TArgument     read fReturnValue;
+      property Arguments:   TArgumentList read fArguments;
+
+      constructor Create(const aType: TvkObjectType);
+      destructor Destroy; override;
+    end;
+
+    ////////////////////////////////////////////////////////////////////////////////////////////
+    TvkTypeFunctionPtr = class(TvkTypeFunction)
+    public
+      class function CreateFromXml(const xml: TDOMNode): THeaderGenerator.TvkTypeFunctionPtr;
+    end;
+
+    ////////////////////////////////////////////////////////////////////////////////////////////
+    TvkCommand = class(TvkTypeFunction)
+    public
+      class function CreateFromXml(const xml: TDOMNode): THeaderGenerator.TvkCommand;
+    end;
+
+    ////////////////////////////////////////////////////////////////////////////////////////////
+    TvkTypeStruct = class(TvkObject)
+    private type
+      TMember = class(TObject)
+        Typ: DOMString;
+        Name: DOMString;
+        ArrSize: Integer;
+        IsPointer: Boolean;
+        IsConst: Boolean;
+      end;
+      TMemberList = specialize TFPGObjectList<TMember>;
+    private
+      fIsUnion: Boolean;
+      fMember: TMemberList;
+    protected
+      procedure DoMark(const aMark: Integer); override;
+    public
+      property Member: TMemberList read fMember;
+      property IsUnion: Boolean read fIsUnion write fIsUnion;
+
+      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;
+    public
+      property Values: TValueList read fValues;
+
+      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;
+    fComment: DOMString;
+    fObjects: TvkObjectList;
+
+  public
+    procedure ReadFile(const aFilename: String);
+    procedure ReadFile(const aStream: TStream);
+
+    procedure Clear;
+
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
+implementation
+
+uses
+  XMLRead, RegExpr;
+
+type
+  XmlException = class(Exception)
+  public
+    xml: TDOMNode;
+    constructor Create(const aMsg: WideString; const aXml: TDOMNode);
+  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';
+    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 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.FindObj(const aName: DOMstring; const aTypes: TvkObjectTypes; out aObject): Boolean;
+var
+  o: TvkObject;
+begin
+  if (aName = '') then
+    raise Exception.Create('empty name');
+
+  result             := true;
+  TvkObject(aObject) := nil;
+  for o in self do begin
+    if (o.VkType in aTypes) and (o.Name = aName) then begin
+      TvkObject(aObject) := o;
+      exit;
+    end;
+  end;
+  result := false;
+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;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//THeaderGenerator.TvkObject////////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure THeaderGenerator.TvkObject.SetMark(aValue: Integer);
+begin
+  if (fMark <> 0) then
+    exit;
+  fMark := aValue;
+  DoMark(fMark);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure THeaderGenerator.TvkObject.DoMark(const aMark: Integer);
+begin
+  WriteLn(Format('  %-10s%-50s marked for generation', [FormatType(fType), fName]));
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure THeaderGenerator.TvkObject.AddCommentFromXml(xml: TDOMNode);
+begin
+  xml := xml.FindNode('comment');
+  if Assigned(xml) then
+    fComment := xml.TextContent;
+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: DOMString;
+  x: TDOMNode;
+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);
+  end else if (xml.NodeName = 'command') then
+    result := TvkCommand.CreateFromXml(xml);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//THeaderGenerator.TvkTypeSimple////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure THeaderGenerator.TvkTypeSimple.DoMark(const aMark: Integer);
+begin
+  inherited DoMark(aMark);
+  if (fParent <> '') and Assigned(fList) then
+      fList.MarkObj(fParent, VK_OBJECT_TYPES, aMark);
+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;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+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;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//THeaderGenerator.TvkTypeFunction///////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+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///////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+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*\(');
+    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 := (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*([-_A-Za-z0-9]+)';
+            if not rx.Exec(String(p.TextContent)) then
+              raise XmlException.Create('unable to parse function pointer arguments', xml);
+
+            a.IsPointer := (rx.Match[1] = '*');
+            a.Name      := WideString(Trim(rx.Match[2]));
+            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///////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+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;
+  begin
+    a := TArgument.Create;
+    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');
+      a.IsPointer := Assigned(p.NextSibling)     and (Trim(p.NextSibling.TextContent)     = '*');
+      result.Arguments.Add(a);
+    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;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+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;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//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;
+        try
+          // read name
+          p := x.FindNode('name');
+          if not Assigned(p) then
+            raise XmlException.Create('struct member without name', xml);
+          m.Name := p.TextContent;
+          if Assigned(p.NextSibling) then
+            m.Name := m.Name + p.NextSibling.TextContent;
+          m.Name := Trim(m.Name);
+          rx := TRegExpr.Create('([-_A-Za-z0-9]+)\s*\[\s*([0-9]+)\s*\]');
+          try
+            if rx.Exec(String(m.Name)) then begin
+              m.Name := WideString(rx.Match[1]);
+              m.ArrSize := StrToInt(rx.Match[2]);
+            end;
+          finally
+            FreeAndNil(rx);
+          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');
+          m.IsPointer := Assigned(p.NextSibling)     and (Trim(p.NextSibling.TextContent)     = '*');
+          result.Member.Add(m);
+        except
+          FreeAndNil(m);
+        end;
+      end;
+      x := x.NextSibling;
+    end;
+  except
+    FreeAndNil(result);
+    raise;
+  end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+//THeaderGenerator.TvkTypeEnum//////////////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+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 := '^-?(0x)?([0-9A-Fa-f]+)$';
+      if rx.Exec(s) then
+        result := StrToInt(rx.Match[1] + rx.Match[2]);
+
+      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 := High(Cardinal)
+          else result := High(UInt64);
+      end;
+
+      if (result = Unassigned) then
+        raise XmlException.Create(WideString('invalid enum value (' + s + ')'), xml);
+    finally
+      FreeAndNil(rx);
+    end;
+  end;
+
+begin
+  result := TvkTypeEnum.Create(otEnum);
+  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 := false;
+            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);
+var
+  xml: TDOMNode;
+  CurrentMark: Integer;
+
+  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]));
+    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 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;
+  end;
+
+begin
+  Clear;
+  ReadXMLFile(fDocument, aStream);
+
+  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
+      fComment := xml.TextContent
+    else if (xml.NodeName = 'feature') then
+      EnableFeature(xml);
+    xml := xml.NextSibling;
+  end;
+
+  WriteLn('generate header');
+
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure THeaderGenerator.Clear;
+
+  procedure CreateBaseType(const aName: DOMString);
+  var o: TvkObject;
+  begin
+    o := TvkTypeSimple.Create(otType);
+    try
+      o.Name := aName;
+      o.List := fObjects;
+      fObjects.Add(o);
+    except
+      FreeAndNil(o);
+      raise;
+    end;
+  end;
+
+begin
+  fComment := '';
+  fObjects.Clear;
+  CreateBaseType('void');
+  CreateBaseType('uint16_t');
+  CreateBaseType('uint32_t');
+  CreateBaseType('uint64_t');
+  CreateBaseType('int16_t');
+  CreateBaseType('int32_t');
+  CreateBaseType('int64_t');
+  CreateBaseType('float');
+  CreateBaseType('double');
+  CreateBaseType('char');
+  CreateBaseType('uint8_t');
+  CreateBaseType('size_t');
+  CreateBaseType('VkHandle');
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+constructor THeaderGenerator.Create;
+begin
+  inherited Create;
+  fObjects := TvkObjectList.Create;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+destructor THeaderGenerator.Destroy;
+begin
+  FreeAndNil(fObjects);
+  FreeAndNil(fDocument);
+  inherited Destroy;
+end;
+
+end.
+

projects/generator/generator.lpi

@@ -0,0 +1,76 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <PathDelim Value="\"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="generator"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <i18n>
+      <EnableI18N LFM="False"/>
+    </i18n>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <CommandLineParams Value="-i ..\..\data\vk.xml -t ..\..\data\vulkan.tpl"/>
+      </local>
+    </RunParams>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="generator.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="HeaderGenerator.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="generator"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Debugging>
+        <UseHeaptrc Value="True"/>
+        <UseExternalDbgSyms Value="True"/>
+      </Debugging>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

projects/generator/generator.lpr

@@ -0,0 +1,91 @@
+program generator;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Classes, SysUtils,
+  HeaderGenerator;
+
+var
+  InputFile: String;
+  OutputFile: String;
+  TemplateFile: String;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure ParseArg(var i: Integer);
+var
+  s: String;
+begin
+  s := ParamStr(i);
+  if (s = '-i') or (s = '--input') then begin
+    inc(i);
+    if (i > ParamCount) then
+      raise Exception.Create('invalid argument count');
+    InputFile := ExpandFileName(ParamStr(i));
+
+  end else if (s = '-o') or (s = '--output') then begin
+    inc(i);
+    if (i > ParamCount) then
+      raise Exception.Create('invalid argument count');
+    OutputFile := ExpandFileName(ParamStr(i));
+
+  end else if (s = '-t') or (s = '--template') then begin
+    inc(i);
+    if (i > ParamCount) then
+      raise Exception.Create('invalid argument count');
+    TemplateFile := ExpandFileName(ParamStr(i));
+
+  end else
+    raise Exception.Create('invalid argument: ' + s);
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure ParseArgs;
+var
+  i: Integer;
+begin
+  i := 1;
+  while i <= ParamCount do begin
+    ParseArg(i);
+    inc(i);
+  end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+procedure GenerateHeader;
+var
+  gen: THeaderGenerator;
+begin
+  WriteLn('Generating Vulkan Header for PFC', InputFile);
+  WriteLn('  InputFile:    ', InputFile);
+  WriteLn('  OutputFile:   ', OutputFile);
+  WriteLn('  TemplateFile: ', TemplateFile);
+
+  gen := THeaderGenerator.Create;
+  try
+    gen.ReadFile(InputFile);
+  finally
+    FreeAndNil(gen);
+  end;
+end;
+
+begin
+  try
+    InputFile    := ExtractFilePath(ParamStr(0)) + 'vk.xml';
+    OutputFile   := ExtractFilePath(ParamStr(0)) + 'vulkan.pas';
+    TemplateFile := ExtractFilePath(ParamStr(0)) + 'vulkan.tpl';
+    ParseArgs;
+    GenerateHeader;
+  except
+    on ex: Exception do begin
+      WriteLn('Error: ' + ex.Message);
+    end;
+  end;
+
+  WriteLn('finished!');
+  ReadLn; // DEBUG!!!
+end.
+

projects/generator/generator.lps

@@ -0,0 +1,197 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectSession>
+    <PathDelim Value="\"/>
+    <Version Value="9"/>
+    <BuildModes Active="Default"/>
+    <Units Count="7">
+      <Unit0>
+        <Filename Value="generator.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <TopLine Value="60"/>
+        <CursorPos Y="91"/>
+        <UsageCount Value="30"/>
+        <Loaded Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="HeaderGenerator.pas"/>
+        <IsPartOfProject Value="True"/>
+        <IsVisibleTab Value="True"/>
+        <EditorIndex Value="1"/>
+        <TopLine Value="450"/>
+        <CursorPos X="62" Y="461"/>
+        <UsageCount Value="30"/>
+        <Loaded Value="True"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="Logger.pas"/>
+        <EditorIndex Value="-1"/>
+        <TopLine Value="5"/>
+        <CursorPos X="21" Y="27"/>
+        <UsageCount Value="30"/>
+      </Unit2>
+      <Unit3>
+        <Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\packages\fcl-xml\src\dom.pp"/>
+        <UnitName Value="DOM"/>
+        <EditorIndex Value="4"/>
+        <TopLine Value="102"/>
+        <CursorPos X="3" Y="118"/>
+        <UsageCount Value="15"/>
+        <Loaded Value="True"/>
+      </Unit3>
+      <Unit4>
+        <Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\packages\fcl-xml\src\xmlutils.pp"/>
+        <EditorIndex Value="5"/>
+        <TopLine Value="12"/>
+        <CursorPos X="3" Y="28"/>
+        <UsageCount Value="15"/>
+        <Loaded Value="True"/>
+      </Unit4>
+      <Unit5>
+        <Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\objpas\sysutils\sysutilh.inc"/>
+        <EditorIndex Value="3"/>
+        <TopLine Value="96"/>
+        <CursorPos X="19" Y="112"/>
+        <UsageCount Value="14"/>
+        <Loaded Value="True"/>
+      </Unit5>
+      <Unit6>
+        <Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\objpas\sysutils\sysstrh.inc"/>
+        <EditorIndex Value="2"/>
+        <TopLine Value="82"/>
+        <CursorPos X="10" Y="97"/>
+        <UsageCount Value="14"/>
+        <Loaded Value="True"/>
+      </Unit6>
+    </Units>
+    <JumpHistory Count="30" HistoryIndex="29">
+      <Position1>
+        <Filename Value="HeaderGenerator.pas"/>
+        <Caret Line="25" Column="47" TopLine="12"/>
+      </Position1>
+      <Position2>
+        <Filename Value="HeaderGenerator.pas"/>
+        <Caret Line="191" Column="11" TopLine="165"/>
+      </Position2>
+      <Position3>
+        <Filename Value="HeaderGenerator.pas"/>
+        <Caret Line="353" Column="45" TopLine="327"/>
+      </Position3>
+      <Position4>
+        <Filename Value="HeaderGenerator.pas"/>
+        <Caret Line="359" Column="40" TopLine="340"/>
+      </Position4>
+      <Position5>
+        <Filename Value="HeaderGenerator.pas"/>
+        <Caret Line="393" Column="43" TopLine="365"/>
+      </Position5>
+      <Position6>
+        <Filename Value="HeaderGenerator.pas"/>
+        <Caret Line="542" Column="43" TopLine="516"/>
+      </Position6>
+      <Position7>
+        <Filename Value="HeaderGenerator.pas"/>
+        <Caret Line="739" Column="67" TopLine="714"/>
+      </Position7>
+      <Position8>
+        <Filename Value="HeaderGenerator.pas"/>
+        <Caret Line="16" Column="13"/>
+      </Position8>
+      <Position9>
+        <Filename Value="HeaderGenerator.pas"/>
+        <Caret Line="27" Column="20" TopLine="6"/>
+      </Position9>
+      <Position10>
+        <Filename Value="HeaderGenerator.pas"/>
+        <Caret Line="155" TopLine="144"/>
+      </Position10>
+      <Position11>
+        <Filename Value="HeaderGenerator.pas"/>
+        <Caret Line="749" TopLine="740"/>
+      </Position11>
+      <Position12>
+        <Filename Value="HeaderGenerator.pas"/>
+        <Caret Line="582" Column="35" TopLine="561"/>
+      </Position12>
+      <Position13>
+        <Filename Value="HeaderGenerator.pas"/>
+        <Caret Line="595" Column="23" TopLine="574"/>
+      </Position13>
+      <Position14>
+        <Filename Value="HeaderGenerator.pas"/>
+        <Caret Line="136" TopLine="114"/>
+      </Position14>
+      <Position15>
+        <Filename Value="HeaderGenerator.pas"/>
+        <Caret Line="339" Column="33" TopLine="364"/>
+      </Position15>
+      <Position16>
+        <Filename Value="HeaderGenerator.pas"/>
+        <Caret Line="187" Column="14" TopLine="209"/>
+      </Position16>
+      <Position17>
+        <Filename Value="HeaderGenerator.pas"/>
+        <Caret Line="740" Column="25" TopLine="758"/>
+      </Position17>
+      <Position18>
+        <Filename Value="HeaderGenerator.pas"/>
+        <Caret Line="764" Column="22" TopLine="758"/>
+      </Position18>
+      <Position19>
+        <Filename Value="HeaderGenerator.pas"/>
+        <Caret Line="289" Column="3" TopLine="284"/>
+      </Position19>
+      <Position20>
+        <Filename Value="HeaderGenerator.pas"/>
+        <Caret Line="322" Column="4" TopLine="305"/>
+      </Position20>
+      <Position21>
+        <Filename Value="generator.lpr"/>
+        <Caret Line="10" Column="3" TopLine="48"/>
+      </Position21>
+      <Position22>
+        <Filename Value="generator.lpr"/>
+        <Caret Line="9" Column="13"/>
+      </Position22>
+      <Position23>
+        <Filename Value="generator.lpr"/>
+        <Caret Line="68" TopLine="52"/>
+      </Position23>
+      <Position24>
+        <Filename Value="HeaderGenerator.pas"/>
+        <Caret Line="825" Column="20" TopLine="811"/>
+      </Position24>
+      <Position25>
+        <Filename Value="HeaderGenerator.pas"/>
+        <Caret Line="687" Column="32" TopLine="673"/>
+      </Position25>
+      <Position26>
+        <Filename Value="HeaderGenerator.pas"/>
+        <Caret Line="274" TopLine="266"/>
+      </Position26>
+      <Position27>
+        <Filename Value="HeaderGenerator.pas"/>
+        <Caret Line="292" TopLine="266"/>
+      </Position27>
+      <Position28>
+        <Filename Value="HeaderGenerator.pas"/>
+        <Caret Line="400" TopLine="384"/>
+      </Position28>
+      <Position29>
+        <Filename Value="HeaderGenerator.pas"/>
+        <Caret Line="305" TopLine="289"/>
+      </Position29>
+      <Position30>
+        <Filename Value="HeaderGenerator.pas"/>
+        <Caret Line="397" Column="25" TopLine="384"/>
+      </Position30>
+    </JumpHistory>
+  </ProjectSession>
+  <Debugging>
+    <Watches Count="1">
+      <Item1>
+        <Expression Value="result.fName"/>
+      </Item1>
+    </Watches>
+  </Debugging>
+</CONFIG>