|
- unit uengShaderFile;
-
- { Package: SpaceEngine
- Prefix: eng - ENGine
- Beschreibung: stellt Klassen zum laden von Shader-Datein zur Verfügung
- beim laden des Codes wird gleichzeitig die Präprozessor-Sprache ausgewertet
- Hint: 'USE_VFS' in Projekt-Einstellungen definieren um VFS Support zu aktivieren
- 'SHADER_FILE_NO_VFS' in Projekt-Einstellungen um VFS Support für diese Unit zu deaktivieren}
-
- {$mode objfpc}{$H+}
- {.$DEFINE EXPRESSION_ADD_BRACKET}
- {.$DEFINE DEBUG}
-
- interface
-
- {$IFDEF SHADER_FILE_NO_VFS}
- {$UNDEF USE_VFS}
- {$ENDIF}
-
- uses
- //System
- Classes, SysUtils, variants,
-
- //bitSpaceEngine
- uutlGenerics, uutlCommon;
-
- type
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //EXPRESSIONS///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengShaderPartScope = class;
- TengGenCodeArgs = class;
-
- TengExpressionItem = class
- protected
- fLine: Integer;
- fCol: Integer;
- fFilename: String;
- public
- function GetText: String; virtual;
- function GetValue(const aScope: TengShaderPartScope; const aGenCodeArgs: TengGenCodeArgs): Variant; virtual;
- constructor Create(const aLine, aCol: Integer; const aFilename: String);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengExpressionValue = class(TengExpressionItem)
- private
- fValue: Variant;
- public
- function GetText: String; override;
- function GetValue(const aScope: TengShaderPartScope; const aGenCodeArgs: TengGenCodeArgs): Variant; override;
- constructor Create(const aValue: Variant; const aLine, aCol: Integer; const aFilename: String);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengExpressionVariable = class(TengExpressionItem)
- private
- fVariableName: String;
- public
- function GetText: String; override;
- function GetValue(const aScope: TengShaderPartScope; const aGenCodeArgs: TengGenCodeArgs): Variant; override;
- constructor Create(const aVariableName: String; const aLine, aCol: Integer; const aFilename: String);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengExpressionGroup = class(TengExpressionItem)
- private
- fChild: TengExpressionItem;
- public
- property Child: TengExpressionItem read fChild write fChild;
- function GetText: String; override;
- function GetValue(const aScope: TengShaderPartScope; const aGenCodeArgs: TengGenCodeArgs): Variant; override;
- constructor Create(const aChild: TengExpressionItem; const aLine, aCol: Integer; const aFilename: String);
- destructor Destroy; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengExpressionUnaryOperator = (
- opBinaryNot, opLogicalNot, opDefined, opSet
- );
- TengExpressionUnaryOperation = class(TengExpressionItem)
- private
- fChild: TengExpressionItem;
- fUnaryOp: TengExpressionUnaryOperator;
- public
- property Child: TengExpressionItem read fChild write fChild;
- property UnaryOp: TengExpressionUnaryOperator read fUnaryOp;
-
- function GetText: String; override;
- function GetValue(const aScope: TengShaderPartScope; const aGenCodeArgs: TengGenCodeArgs): Variant; override;
-
- constructor Create(const aUnaryOp: TengExpressionUnaryOperator; const aLine, aCol: Integer; const aFilename: String);
- destructor Destroy; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengExpressionBinaryOperator = ( //order of elements in this enum is also the weight of the operators
- opBinaryOr, opBinaryAnd, opBinaryXor, // binary
- opMultiply, opDivide, opAdd, opSubtract, // arithmetic
- opLogicalOr, opLogicalAnd, opLogicalXor, // logical
- opEquals, opLesser, opGreater, opLEquals, opGEquals, opUnequals // comparison
- );
- TengExpressionBinaryOperation = class(TengExpressionItem)
- private
- fFirst: TengExpressionItem;
- fSecond: TengExpressionItem;
- fBinaryOp: TengExpressionBinaryOperator;
- public
- property First: TengExpressionItem read fFirst write fFirst;
- property Second: TengExpressionItem read fSecond write fSecond;
- property BinaryOp: TengExpressionBinaryOperator read fBinaryOp;
-
- function GetText: String; override;
- function GetValue(const aScope: TengShaderPartScope; const aGenCodeArgs: TengGenCodeArgs): Variant; override;
-
- constructor Create(const aOperator: TengExpressionBinaryOperator; const aLine, aCol: Integer; const aFilename: String);
- destructor Destroy; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //EXCEPTIONS////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengShaderPart = class;
- CengShaderPart = class of TengShaderPart;
-
- EengShaderPart = class(Exception)
- public
- Line, Col: Integer;
- Filename: String;
- constructor Create(const aMsg: String; const aLine, aCol: Integer; const aFilename: String); overload;
- end;
-
- EengInvalidParamter = class(EengShaderPart)
- constructor Create(const aMsg: String; const aLine, aCol: Integer; const aFilename: String); overload;
- end;
-
- EengInvalidIdentifier = class(EengShaderPart)
- constructor Create(const aIdentifier: String; const aLine, aCol: Integer; const aFilename: String); overload;
- end;
-
- EengEmptyToken = class(EengShaderPart)
- constructor Create(const aLine, aCol: Integer; const aFilename: String); overload;
- end;
-
- EengInvalidToken = class(EengShaderPart)
- constructor Create(const aClassName: String; const aToken: String; const aLine, aCol: Integer; const aFilename: String); overload;
- end;
-
- EengInvalidParamterCount = class(EengShaderPart)
- constructor Create(const aToken: String; const aLine, aCol: Integer; const aFilename: String); overload;
- end;
-
- EengDuplicateIdentifier = class(EengShaderPart)
- constructor Create(const aName: String; const aNew, aOld: TengShaderPart); overload;
- end;
-
- EengInternal = class(EengShaderPart)
- constructor Create(const aMsg: String); overload;
- constructor Create(const aMsg: String; const aLine, aCol: Integer; const aFilename: String); overload;
- end;
-
- EengUnknownIdentifier = class(EengShaderPart)
- constructor Create(const aIdent: String; const aLine, aCol: Integer; const aFilename: String); overload;
- end;
-
- EengExpression = class(EengShaderPart);
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //SHADER PARTS//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengShaderFile = class;
- TengParseArgs = class;
-
- TengTokenParameter = packed record
- Name: String;
- Quoted: Boolean;
- Line: Integer;
- Col: Integer;
- end;
- TengTokenParameterList = specialize TutlSimpleList<TengTokenParameter>;
-
- TengMapDataFlag = (
- mdfIfEvaluate, //evaluate if parts and add suitable subtree
- mdfIfAll, //do not evaluate if parts and add all subtrees
- mdfAddInherited, //add inherited scopes to parent
- mdfMapInherited, //map parts of inherited scopes
- mdfCurrentScope, //do not map child scopes
- mdfChild //is set if current node is not that node the recursion started
- );
- TengMapDataFlags = set of TengMapDataFlag;
-
- TengShaderPartFlag = (
- spfCodeGenVisited //this item was visited by code gen routine
- );
- TengShaderPartFlags = set of TengShaderPartFlag;
- TengShaderPart = class(TutlInterfaceNoRefCount)
- { Load & Store Code }
- protected type
- TengShaderPartEnumerator = class(TObject)
- private
- fOwner: TengShaderPart;
- fPosition: Integer;
- function GetCurrent: TengShaderPart;
- public
- property Current: TengShaderPart read GetCurrent;
- function MoveNext: Boolean;
- constructor Create(const aOwner: TengShaderPart);
- end;
-
- private
- fRoot: TengShaderFile;
- fParent: TengShaderPart;
- fLine: Integer;
- fCol: Integer;
- protected
- function GetCount: Integer; virtual;
- function GetChild(const aIndex: Integer): TengShaderPart; virtual;
- function GetFilename: String; virtual;
- function GetShaderClass: String; virtual;
- function GetText: String; virtual;
-
- function ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String; virtual;
- function ParseText(const aParseArgs: TengParseArgs): String;
-
- { Generate Shader Code }
- private
- fFlags: TengShaderPartFlags;
- protected
- procedure MapData(const aFlags: TengMapDataFlags; const aTypes: array of CengShaderPart); virtual;
- procedure GenCodeIntern(const aGenCodeArgs: TengGenCodeArgs); virtual;
- procedure ClearGenCode; virtual;
- public
- property Flags: TengShaderPartFlags read fFlags;
-
- { General }
- public
- property Root: TengShaderFile read fRoot;
- property Line: Integer read fLine;
- property Col: Integer read fCol;
- property Filename: String read GetFilename;
- property ShaderClass: String read GetShaderClass;
- property Parent: TengShaderPart read fParent;
- property Count: Integer read GetCount;
- property Children[const aIndex: Integer]: TengShaderPart read GetChild; default;
- property Text: String read GetText;
-
- function HasParentType(const aParentType: CengShaderPart; const aIncludeSelf: Boolean = false): Boolean;
- procedure GetParentByType(const aParentType: CengShaderPart; out aPart);
- function GetEnumerator: TengShaderPartEnumerator;
-
- constructor Create(const aParent: TengShaderPart); virtual;
- public
- class function GetTokenName: String; virtual;
- class function CheckToken(const aToken: String): Boolean; virtual;
- class procedure CheckToken(const aParseArgs: TengParseArgs; const aParent: TengShaderPart); virtual;
- end;
- TengShaderPartList = specialize TutlList<TengShaderPart>;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengShaderPartContainer = class(TengShaderPart)
- { Load & Store Code }
- private
- fChildren: TengShaderPartList;
- function HandleToken(var aToken: String; const aParseArgs: TengParseArgs): String;
- protected
- function GetCount: Integer; override;
- function GetChild(const aIndex: Integer): TengShaderPart; override;
- function GetText: String; override;
- function ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String; override;
-
- { Generate Shader Code }
- protected
- procedure MapData(const aFlags: TengMapDataFlags; const aTypes: array of CengShaderPart); override;
- procedure GenCodeIntern(const aGenCodeArgs: TengGenCodeArgs); override;
- procedure ClearGenCode; override;
-
- { General }
- public
- procedure AddChild(const aChild: TengShaderPart; const aPrepend: Boolean = false);
- constructor Create(const aParent: TengShaderPart); override;
- destructor Destroy; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengFindMappedPartFlag = (
- // general
- ffGlobal, // set current node to root before searching
- ffDescending, // depth search starting at current node
- ffAscending, // search in parents and grand parents starting at current node
- ffLocal, // search in mapped parts of current item (will be reseted when entering next or previous recursion level)
- ffFindFirst, // return after finding at least one result
- ffVisited, // only search in scopes that are already visited by GenCode
-
- // class data
- ffInherited, // search in inherited classes (this is not a new recursion level!)
- ffFile, // search in file that belongs to this class (this is not a new recursion level!)
-
- // file GenCodeIntern
- ffIgnoreClasses // ignore class parts
- );
- TengFindMappedPartFlags = set of TengFindMappedPartFlag;
-
- TengShaderPartScope = class(TengShaderPartContainer)
- { Generate Shader Code }
- private type
- TengShaderPartScopeHashSet = specialize TutlHashSet<TengShaderPartScope>;
- TengShaderPartMap = specialize TutlMap<string, TengShaderPart>;
- private
- fInherited: TengShaderPartScopeHashSet;
- fChildScopes: TengShaderPartScopeHashSet;
- fMappedParts: TengShaderPartMap;
-
- function CheckName(const aName: String; const aShaderPart: TengShaderPart): Boolean;
- protected
- procedure MapChildScope(const aScope: TengShaderPartScope);
- procedure MapInheritedScope(const aScope: TengShaderPartScope);
- function MapShaderPart(const aName: String; const aShaderPart: TengShaderPart): Boolean;
-
- procedure FindMappedPart(out aShaderPart; const aName: String; const aFlags: TengFindMappedPartFlags; const aType: CengShaderPart = nil);
- procedure FindMappedParts(const aParts: TengShaderPartList; const aName: String; const aFlags: TengFindMappedPartFlags; const aType: CengShaderPart = nil); virtual;
-
- function GetFindPropertyFlags: TengFindMappedPartFlags; virtual;
- procedure CheckDuplicate(const aName: String; const aOld, aNew: TengShaderPart); virtual;
- procedure MapData(const aFlags: TengMapDataFlags; const aTypes: array of CengShaderPart); override;
- procedure GenCodeIntern(const aGenCodeArgs: TengGenCodeArgs); override;
- procedure ClearGenCode; override;
- procedure ClearMappedData(const aExcludedTypes: array of CengShaderPart); overload;
- procedure ClearMappedData; overload;
- public
- constructor Create(const aParent: TengShaderPart); override;
- destructor Destroy; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengShaderCode = class;
- TengShaderPartProperty = class;
- TengShaderPartDefine = class;
- TengCodeGenerator = class(TengShaderPartScope)
- private
- function GetProperty(const aName: String): TengShaderPartProperty;
- protected
- procedure GenerateCode(const aGenCodeArgs: TengGenCodeArgs); virtual;
- public
- property Properties[const aName: String]: TengShaderPartProperty read GetProperty; default;
-
- function GenerateCode: TengShaderCode;
- procedure ListProperties(const aList: TStrings); virtual;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengShaderPartClass = class(TengCodeGenerator)
- { Load & Store Code }
- private
- fName: String;
- fExtends: TStringList;
- function GetExtendCount: Integer;
- function GetExtends(const aIndex: Integer): String;
- protected
- function GetText: String; override;
- function GetShaderClass: String; override;
-
- function ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String; override;
- public
- property Name: String read fName;
- property ExtendCount: Integer read GetExtendCount;
- property Extends[const aIndex: Integer]: String read GetExtends;
-
- { Generate Shader Code }
- protected
- procedure CheckDuplicate(const aName: String; const aOld, aNew: TengShaderPart); override;
- function GetFindPropertyFlags: TengFindMappedPartFlags; override;
- procedure GenCodeIntern(const aGenCodeArgs: TengGenCodeArgs); override;
- procedure GenerateCode(const aGenCodeArgs: TengGenCodeArgs); override;
- public
- procedure FindMappedParts(const aParts: TengShaderPartList; const aName: String; const aFlags: TengFindMappedPartFlags; const aType: CengShaderPart = nil); override;
- procedure MapData(const aFlags: TengMapDataFlags; const aTypes: array of CengShaderPart); override;
-
- { General }
- public
- constructor Create(const aParent: TengShaderPart); override;
- destructor Destroy; override;
- public
- class function GetTokenName: String; override;
- class procedure CheckToken(const aParseArgs: TengParseArgs; const aParent: TengShaderPart); override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengShaderFile = class(TengCodeGenerator)
- { Load & Store Code }
- private
- fFilename: String;
- protected
- function GetFilename: String; override;
- public
- property Filename: String read fFilename;
- procedure LoadFromFile(const aFilename: String);
- procedure SaveToFile(const aFilename: String);
- procedure LoadFromStream(const aStream: TStream; const aFilename: String);
- procedure SaveToStream(const aStream: TStream);
-
- { Generate Shader Code }
- private type
- TengShaderPartClassMap = specialize TutlMap<string, TengShaderPartClass>;
- private
- fClasses: TengShaderPartClassMap;
- function GetGenerator(const aName: String): TengCodeGenerator;
- protected
- function GetFindPropertyFlags: TengFindMappedPartFlags; override;
- procedure MapData(const aFlags: TengMapDataFlags; const aTypes: array of CengShaderPart); override;
- function GetClass(const aName: String): TengShaderPartClass;
- procedure AddClass(const aClass: TengShaderPartClass);
- procedure GenerateCode(const aGenCodeArgs: TengGenCodeArgs); override;
- public
- { be carefull with the returned object, it will be destroyed
- when the shaderfile is cleared, reloaded or destroyed }
- property Generator[const aName: String]: TengCodeGenerator read GetGenerator;
- procedure ListGenerators(const aList: TStrings);
-
- { General }
- public
- procedure Clear;
- constructor Create(const aParent: TengShaderPart); override; overload;
- constructor Create; overload;
- destructor Destroy; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengShaderPartInclude = class(TengShaderPart)
- { Load & Store Code }
- private
- fShaderFile: TengShaderFile;
- fIncludeFile: String;
- fAbsoluteFile: String;
- protected
- function GetCount: Integer; override;
- function GetChild(const aIndex: Integer): TengShaderPart; override;
- function GetText: String; override;
- function ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String; override;
-
- { Generate Code }
- private
- procedure CheckShaderFile;
- protected
- procedure MapData(const aFlags: TengMapDataFlags; const aTypes: array of CengShaderPart); override;
- procedure GenCodeIntern(const aGenCodeArgs: TengGenCodeArgs); override;
-
- { General }
- public
- property IncludeFile: String read fIncludeFile;
- constructor Create(const aParent: TengShaderPart); override;
- destructor Destroy; override;
- public
- class function GetTokenName: String; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengShaderPartComment = class(TengShaderPart)
- private
- fText: String;
- protected
- function GetText: String; override;
- function ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String; override;
- public
- class function GetTokenName: String; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengShaderPartInherited = class(TengShaderPart)
- { Load & Store Code }
- private
- fInheritedName: String;
- fParameters: TStringList;
- protected
- function GetText: String; override;
- function ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String; override;
-
- { Generate Shader Code }
- protected
- procedure GenCodeIntern(const aGenCodeArgs: TengGenCodeArgs); override;
-
- { General }
- public
- constructor Create(const aParent: TengShaderPart); override;
- destructor Destroy; override;
- public
- class function GetTokenName: String; override;
- class procedure CheckToken(const aParseArgs: TengParseArgs; const aParent: TengShaderPart); override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengMetaType = (metaNormal, metaVersion, metaExtension, metaLayout);
- IengMetaData = interface(IUnknown)
- ['{8064AB43-4A82-4E77-BE46-E222827522FF}']
- function GetValues(const aIndex: Integer): String;
- function GetCount: Integer;
- function GetMetaType: TengMetaType;
- function GetName: String;
-
- property MetaType: TengMetaType read GetMetaType;
- property Name: String read GetName;
- property Count: Integer read GetCount;
- property Values[const aIndex: Integer]: String read GetValues; default;
- end;
- TengMetaData = class(TInterfacedObject, IengMetaData)
- private
- fMetaType: TengMetaType;
- fName: String;
- fValues: TStringList;
- function GetValues(const aIndex: Integer): String;
- function GetCount: Integer;
- function GetMetaType: TengMetaType;
- function GetName: String;
- public
- property MetaType: TengMetaType read GetMetaType;
- property Name: String read GetName;
- property Count: Integer read GetCount;
- property Values[const aIndex: Integer]: String read GetValues; default;
-
- procedure AddValue(const aValue: String);
-
- constructor Create(const aName: String; const aType: TengMetaType);
- destructor Destroy; override;
- end;
- TengShaderPartMeta = class(TengShaderPart)
- private
- fMetaData: IengMetaData;
- protected
- function GetText: String; override;
- function ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String; override;
- procedure GenCodeIntern(const aGenCodeArgs: TengGenCodeArgs); override;
- public
- property Data: IengMetaData read fMetaData;
- public
- destructor Destroy; override;
- public
- class function GetTokenName: String; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengShaderPartKeyValuePair = class(TengShaderPart)
- { Load & Store Code }
- protected
- fName: String;
- fValue: Variant;
- fValueName: String;
-
- function GetText: String; override;
- function ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String; override;
- public
- property Name: String read fName;
- property Value: Variant read fValue;
-
- constructor CreateValue(const aParent: TengShaderPart; const aName: String; const aValue: Variant);
- constructor CreateName(const aParent: TengShaderPart; const aName, aValueName: String);
- { Generate Code }
- protected
- procedure GenCodeIntern(const aGenCodeArgs: TengGenCodeArgs); override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengShaderPartProperty = class(TengShaderPartKeyValuePair)
- public
- property Value: Variant read fValue write fValue;
- procedure MapData(const aFlags: TengMapDataFlags; const aTypes: array of CengShaderPart); override;
- public
- class function GetTokenName: String; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengShaderPartDefine = class(TengShaderPartKeyValuePair)
- protected
- function ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String; override;
- procedure MapData(const aFlags: TengMapDataFlags; const aTypes: array of CengShaderPart); override;
- public
- class function GetTokenName: String; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengShaderPartCodeProperty = class(TengShaderPart)
- { Load & Store Code }
- protected
- fName: String;
- fType: String;
- function GetText: String; override;
- function ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String; override;
-
- { Generate Code }
- protected
- property Name: String read fName;
- property PropType: String read fType;
- function IsEquals(const aCodeProp: TengShaderPartCodeProperty): Boolean; virtual;
- procedure MapData(const aFlags: TengMapDataFlags; const aTypes: array of CengShaderPart); override;
- procedure GenCodeIntern(const aGenCodeArgs: TengGenCodeArgs); override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengShaderPartVar = class(TengShaderPartCodeProperty)
- { Load & Store Cde }
- private
- fDefault: String;
- protected
- function GetText: String; override;
- function ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String; override;
-
- { Generate Shader Code }
- protected
- function IsEquals(const aCodeProp: TengShaderPartCodeProperty): Boolean; override;
- procedure GenCodeIntern(const aGenCodeArgs: TengGenCodeArgs); override;
-
- { General }
- public
- class function GetTokenName: String; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengShaderPartVarying = class(TengShaderPartCodeProperty)
- { Generate Shader Code }
- protected
- procedure GenCodeIntern(const aGenCodeArgs: TengGenCodeArgs); override;
-
- { General }
- public
- class function GetTokenName: String; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengShaderPartUniform = class(TengShaderPartCodeProperty)
- { Generate Shader Code }
- protected
- procedure GenCodeIntern(const aGenCodeArgs: TengGenCodeArgs); override;
-
- { General }
- public
- class function GetTokenName: String; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengShaderPartCall = class(TengShaderPart)
- { Load & Store Code }
- private
- fName: String;
- fParameters: TStringList;
- protected
- function GetText: String; override;
- function ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String; override;
-
- { Generate Shader Code }
- protected
- procedure GenCodeIntern(const aGenCodeArgs: TengGenCodeArgs); override;
-
- { General }
- public
- constructor Create(const aParent: TengShaderPart); override;
- destructor Destroy; override;
- public
- class function GetTokenName: String; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengShaderPartProcParam = packed record
- Typ: String;
- Name: String;
- end;
- TengShaderPartProcParamList = specialize TutlSimpleList<TengShaderPartProcParam>;
- TengShaderPartProc = class(TengShaderPartScope)
- { Load & Store Code }
- private
- fName: String;
- fIsInline: Boolean;
- fParameters: TengShaderPartProcParamList;
- protected
- function GetHeaderText: String; virtual;
- function GetText: String; override;
- function ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String; override;
-
- { Generate Shader Code }
- protected
- function GenHeaderCode: String; virtual;
- procedure GenInlineCode(const aGenCodeArgs: TengGenCodeArgs; const aAddToken: Boolean = true); virtual;
- procedure GenCodeIntern(const aGenCodeArgs: TengGenCodeArgs); override;
- procedure MapData(const aFlags: TengMapDataFlags; const aTypes: array of CengShaderPart); override;
-
- { General }
- public
- property Name: String read fName;
- property IsInline: Boolean read fIsInline;
- constructor Create(const aParent: TengShaderPart); override;
- destructor Destroy; override;
- public
- class function GetTokenName: String; override;
- class procedure CheckToken(const aParseArgs: TengParseArgs; const aParent: TengShaderPart); override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengShaderPartMain = class(TengShaderPartProc)
- { Save & Store Code }
- protected
- function GetHeaderText: String; override;
- function ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String; override;
-
- { Generate Code }
- protected
- function GenHeaderCode: String; override;
-
- { General }
- public
- class function GetTokenName: String; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengShaderPartFunc = class(TengShaderPartProc)
- { Save & Store Code }
- private
- fReturnType: String;
- protected
- function GetHeaderText: String; override;
- function ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String; override;
- public
- property ReturnType: String read fReturnType;
-
- { Generate Code }
- protected
- procedure GenInlineCode(const aGenCodeArgs: TengGenCodeArgs; const aAddToken: Boolean = true); override;
- function GenHeaderCode: String; override;
-
- { General }
- public
- class function GetTokenName: String; override;
- class procedure CheckToken(const aParseArgs: TengParseArgs; const aParent: TengShaderPart); override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengShaderPartIf = class(TengShaderPart)
- { Load & Store Code }
- private
- fExpression: TengExpressionItem;
- fIfPart: TengShaderPart;
- fElsePart: TengShaderPart;
-
- function ParseExpression(const aParameters: TengTokenParameterList; aIndex: Integer): TengExpressionItem;
- protected
- function GetCount: Integer; override;
- function GetChild(const aIndex: Integer): TengShaderPart; override;
- function GetText: String; override;
- function ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String; override;
-
- function HandleToken(const aToken: String; const aParseArgs: TengParseArgs): String;
- function HandleEndToken(const aToken: String; const aParseArgs: TengParseArgs): String; virtual;
-
- { Generate Shader Code }
- protected
- procedure MapData(const aFlags: TengMapDataFlags; const aTypes: array of CengShaderPart); override;
- procedure GenCodeIntern(const aGenCodeArgs: TengGenCodeArgs); override;
-
- { General }
- public
- destructor Destroy; override;
- public
- class function GetTokenName: String; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengShaderPartElIf = class(TengShaderPartIf)
- protected
- function GetText: String; override;
- function HandleEndToken(const aToken: String; const aParseArgs: TengParseArgs): String; override;
- public
- class function GetTokenName: String; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengShaderPartElse = class(TengShaderPartContainer)
- protected
- function GetText: String; override;
- public
- class function GetTokenName: String; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengShaderPartEcho = class(TengShaderPart)
- { Load & Store Code }
- private
- fName: String;
- protected
- function GetText: String; override;
- function ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String; override;
-
- { Generate Shader Code }
- protected
- procedure GenCodeIntern(const aGenCodeArgs: TengGenCodeArgs); override;
-
- { General }
- public
- class function GetTokenName: String; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengShaderPartMessage = class(TengShaderPart)
- private
- fMessage: String;
- protected
- function GetText: String; override;
- function ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String; override;
- public
- class function GetTokenName: String; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengShaderPartWarning = class(TengShaderPartMessage)
- public
- class function GetTokenName: String; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengShaderPartError = class(TengShaderPartMessage)
- protected
- procedure GenCodeIntern(const aGenCodeArgs: TengGenCodeArgs); override;
- public
- class function GetTokenName: String; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengShaderPartCode = class(TengShaderPart)
- { Load & Store Code }
- private
- fCode: String;
- protected
- function GetText: String; override;
- function ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String; override;
- public
- property Code: String read fCode;
-
- { Generate Shader Code }
- protected
- procedure GenCodeIntern(const aGenCodeArgs: TengGenCodeArgs); override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengShaderPartLineBreak = class(TengShaderPart)
- { Load & Store Code }
- protected
- function GetText: String; override;
- function ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String; override;
-
- { Generate Shader Code }
- protected
- procedure GenCodeIntern(const aGenCodeArgs: TengGenCodeArgs); override;
-
- { General }
- public
- class function GetTokenName: String; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengShaderPartCommandEnd = class(TengShaderPart)
- { Load & Store Code }
- private
- fToken: String;
- protected
- function GetText: String; override;
- function ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String; override;
-
- { Generate Shader Code }
- protected
- procedure GenCodeIntern(const aGenCodeArgs: TengGenCodeArgs); override;
-
- { General }
- public
- class function CheckToken(const aToken: String): Boolean; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //HELPER////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengShaderCode = class(TStringList)
- private type
- TMetaList = specialize TutlList<IengMetaData>;
- private
- function GetMeta(const aIndex: Integer): IengMetaData;
- function GetMetaCount: Integer;
- protected
- fMetaList: TMetaList;
- public
- property Meta[const aIndex: Integer]: IengMetaData read GetMeta;
- property MetaCount: Integer read GetMetaCount;
-
- constructor Create;
- destructor Destroy; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengShaderCodeIntern = class(TengShaderCode)
- public
- property MetaList: TMetaList read fMetaList;
- procedure AddMeta(const aMeta: IengMetaData);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengParseArgs = class
- private
- fCode: TStringList;
- fLineLength: Integer;
- fLineCount: Integer;
- fCurrentLine: String;
- fCurrentChar: Char;
- fCol: Integer;
- fLine: Integer;
- fOwner: TengShaderFile;
-
- procedure SetCol(const aValue: Integer);
- procedure SetLine(const aValue: Integer);
- function GetEndOfLine: Boolean;
- function GetEndOfFile: Boolean;
- function GetCode: TStrings;
- public
- property Code: TStrings read GetCode;
- property LineLength: Integer read fLineLength;
- property LineCount: Integer read fLineCount;
- property CurrentLine: String read fCurrentLine;
- property CurrentChar: Char read fCurrentChar;
- property EndOfLine: Boolean read GetEndOfLine;
- property EndOfFile: Boolean read GetEndOfFile;
- property Col: Integer read fCol write SetCol;
- property Line: Integer read fLine write SetLine;
-
- procedure IncCol;
- procedure IncLine;
- function ParseParameters(const aParameters: TengTokenParameterList): Boolean;
- procedure LoadCode(const aStream: TStream);
-
- constructor Create(const aOwner: TengShaderFile);
- destructor Destroy; override;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TengGenCodeFlag = (
- gcfGenProcedure, // generate shader code for procedure or function
- gcfGenProcInline, // generate inline shader code for procedure or function
- gcfGenProcCall, // generate procedure call
- gcfGenCodeProp // generate shader code for code properties (e.g. Var, Varying, Uniform)
- );
- TengGenCodeFlags = set of TengGenCodeFlag;
- TengGenCodeArgs = class(TObject)
- private type
- TCodeItem = class
- public
- function GetText: String; virtual;
- function IsEmpty: Boolean;
- end;
-
- TCodeItemStart = class(TCodeItem)
- function GetText: String; override;
- end;
-
- TCodeItemText = class(TCodeItem)
- public
- Text: String;
- function GetText: String; override;
- constructor Create(const aText: String);
- end;
-
- TCodeItemLineBreak = class(TCodeItem)
- public
- function GetText: String; override;
- end;
-
- TCodeItemCommandEnd = class(TCodeItem)
- public
- Token: String;
- function GetText: String; override;
- constructor Create(const aToken: String);
- end;
-
- TTokenType = (ttBegin, ttEnd, ttSingle);
- TCodeItemToken = class(TCodeItem)
- public
- TokenType: TTokenType;
- Level: Integer;
- constructor Create(const aTokenType: TTokenType; const aLevel: Integer = -1);
- end;
-
- TCodeItemList = specialize TutlList<TCodeItem>;
- TCodeStackItem = class
- private type
- TFlag = (cfIgnoreNextSemicolon);
- TFlags = set of TFlag;
- private
- fFlags: TFlags;
- fItems: TCodeItemList;
- function GetEmpty: Boolean;
- public
- property Items: TCodeItemList read fItems;
- property Empty: Boolean read GetEmpty;
-
- {$IFDEF DEBUG}
- function GetDebugText: String;
- {$ENDIF}
- function GetText: String;
- procedure SplitCurrentCommand(const aItem: TCodeStackItem);
- function Merge(const aItem: TCodeStackItem; aIndex: Integer): Integer;
-
- procedure AddText(const aText: String);
- procedure AddCommandEnd(const aToken: String = '');
- procedure AddToken(const aTokenType: TTokenType; const aLevel: Integer = -1);
- procedure AddLineEnd;
-
- function GetMinLineOffset: Integer;
- procedure IgnoreNextSemicolon;
-
- procedure ReplaceIdents(const aOld, aNew: TStrings);
- procedure ReplaceReturns(const aItem: TCodeStackItem; const aRetType, aFuncName: String; const aCntr: Integer);
-
- constructor Create;
- destructor Destroy; override;
- end;
-
- TProcWrapper = class
- public
- Proc: TengShaderPartProc;
- Code: TCodeStackItem;
- constructor Create;
- destructor Destroy; override;
- end;
-
- TCodeStack = specialize TutlList<TCodeStackItem>;
- TProcParamStack = specialize TutlList<TStrings>;
- TGenCodeFlagsStack = specialize TutlList<TengGenCodeFlags>;
- TProcedureList = specialize TutlList<TProcWrapper>;
- TCodePropertyMap = specialize TutlMap<string, TengShaderPartCodeProperty>;
- public type
- TPopCodeFlag = (
- pcfAppend,
- pcfPrepend,
- pcfAddEmptyLine
- );
- TPopCodeFlags = set of TPopCodeFlag;
- private
- fMaxPropNameLen: Integer;
- fRoot: TengShaderPartScope;
- fFlags: TGenCodeFlagsStack;
- fProcParams: TProcParamStack;
- fProcedures: TProcedureList;
- fProperties: TCodePropertyMap;
- fCode: TCodeStack;
- fCommands: TCodeStack;
- fShaderCode: TengShaderCodeIntern;
- fInlineRetCounter: Integer;
-
- function GetFlags: TengGenCodeFlags;
- function GetText: String;
- function GetCode: TCodeStackItem;
- function GetProcParams: TStrings;
- public
- property Root: TengShaderPartScope read fRoot;
- property Flags: TengGenCodeFlags read GetFlags;
- property Code: TCodeStackItem read GetCode;
- property ProcParams: TStrings read GetProcParams;
- property MaxPropNameLen: Integer read fMaxPropNameLen;
-
- procedure PushCode;
- procedure InsertCode(const aCodeStackItem: TCodeStackItem);
- function PushCurrentCommand: TCodeStackItem;
- procedure PushFlags(const aFlags: TengGenCodeFlags);
- procedure PushProcParams(const aParams: TStrings);
-
- procedure PopCode(const aFlags: TPopCodeFlags = [pcfAppend]);
- function ExtractCode: TCodeStackItem;
- procedure PopCurrentCommand(const aRetType, aFuncName: String);
- procedure PopFlags;
- procedure PopProcParams;
-
- procedure AddProcedure(const aProc: TengShaderPartProc);
- procedure AddCodeProperty(const aProp: TengShaderPartCodeProperty);
- procedure AddMeta(const aMeta: IengMetaData);
-
- function HasCodeProperty(const aName: String): Boolean;
-
- procedure GenProcedureCode(const aAppend: Boolean = false);
- procedure GenCodePropertyCode(const aTypes: array of CengShaderPart);
- procedure GenMetaCode;
-
- constructor Create(const aShaderCode: TengShaderCodeIntern; const aRoot: TengShaderPartScope);
- destructor Destroy; override;
- end;
-
- function TrySetProperty(const aGenerator: TengCodeGenerator; const aName: String; const aValue: Variant): Boolean;
-
- {$IFDEF DEBUG}
- procedure SaveAsXMindXml(const aShaderPart: TengShaderPart; const aDirectory: String);
- {$ENDIF}
-
- implementation
-
- uses
- uutlExceptions, FileUtil, RegExpr, Math{$IFDEF USE_VFS}, uvfsManager{$ENDIF};
-
- const
- PRECOMPILER_STATEMENT_BEGIN = '{';
- PRECOMPILER_STATEMENT_END = '}';
- PRECOMPILER_QUOTE_CHAR = '''';
- TOKEN_IDENTIFIER = '$';
- TOKEN_COMMAND_END = ';';
- TOKEN_SCOPE_BEGIN = '{';
- TOKEN_SCOPE_END = '}';
- TOKEN_LINE_BREAK = sLineBreak;
- COMMENT_IDENTIFIER = '.';
-
- TOKEN_CLASS = TOKEN_IDENTIFIER + 'CLASS'; //{$CLASS PhongLight $EXTENDS Normal Glow}
- TOKEN_EXTENDS = TOKEN_IDENTIFIER + 'EXTENDS';
- TOKEN_INHERITED = TOKEN_IDENTIFIER + 'INHERITED'; //{$INHERITED} {$INHERITED BaseClass}
-
- TOKEN_INCLUDE = TOKEN_IDENTIFIER + 'INCLUDE'; //{$INCLUDE 'Normal.frag'}
-
- TOKEN_META = TOKEN_IDENTIFIER + 'META'; //{$META 'Fuu' 'Bar'}
- TOKEN_VERSION = TOKEN_IDENTIFIER + 'VERSION'; //{$META $VERSION 'version'}
- TOKEN_EXTENSION = TOKEN_IDENTIFIER + 'EXTENSION'; //{$META $EXTENSION 'GL_ARB_geometry_shader4' 'enable'}
- TOKEN_LAYOUT = TOKEN_IDENTIFIER + 'LAYOUT'; //{$META $LAYOUT '(line_strip, max_vertices = 6) out'}
-
- TOKEN_PROPERTY = TOKEN_IDENTIFIER + 'PROPERTY'; //{$PROPERTY InvertRoughmap 'false'}
- TOKEN_DEFINE = TOKEN_IDENTIFIER + 'DEFINE'; //{$DEFINE RENDER_FACE_FRONT '0'}
- TOKEN_ECHO = TOKEN_IDENTIFIER + 'ECHO'; //{$ECHO InvertRoughmap}
-
- TOKEN_VAR = TOKEN_IDENTIFIER + 'VAR'; //{$VAR 'float' 'refractivity' '0.0'}
- TOKEN_VARYING = TOKEN_IDENTIFIER + 'VARYING'; //{$VARYING 'vec3' 'vVertex'}
- TOKEN_UNIFORM = TOKEN_IDENTIFIER + 'UNIFORM'; //{$UNIFORM 'sampler2D' 'uShadowMap'}
-
- TOKEN_CALL = TOKEN_IDENTIFIER + 'CALL'; //{$CALL CalcLight}
- TOKEN_PROC = TOKEN_IDENTIFIER + 'PROC'; //{$PROC CalcLight} Code... {$END}
- TOKEN_FUNC = TOKEN_IDENTIFIER + 'FUNC'; //{$FUND 'float' 'ShadowPoisson' 'vec2' 'shadowMapST' 'float' 'receiver'} Code... {$END}
- TOKEN_MAIN = TOKEN_IDENTIFIER + 'MAIN';
- TOKEN_INLINE = TOKEN_IDENTIFIER + 'INLINE'; //{$PROC CalcLight $INLINE} Code... {$END}
-
- TOKEN_IF = TOKEN_IDENTIFIER + 'IF'; //{$IF PhongLight = '0'} Code ... {$END}
- TOKEN_ELIF = TOKEN_IDENTIFIER + 'ELIF';
- TOKEN_ELSE = TOKEN_IDENTIFIER + 'ELSE';
- TOKEN_END = TOKEN_IDENTIFIER + 'END';
-
- TOKEN_MESSAGE = TOKEN_IDENTIFIER + 'MESSAGE'; //{$MESSAGE 'message'}
- TOKEN_WARNING = TOKEN_IDENTIFIER + 'WARNING'; //{$WARNING 'message'}
- TOKEN_ERROR = TOKEN_IDENTIFIER + 'ERROR'; //{$ERROR 'message'}
-
- TOKEN_OP_LOGICAL_NOT = TOKEN_IDENTIFIER + 'NOT'; //{$IF $NOT test}
- TOKEN_OP_LOGICAL_OR = TOKEN_IDENTIFIER + 'OR'; //{$IF test1 $OR test2}
- TOKEN_OP_LOGICAL_AND = TOKEN_IDENTIFIER + 'AND'; //{$IF test1 $AND test2}
- TOKEN_OP_LOGICAL_XOR = TOKEN_IDENTIFIER + 'XOR'; //{$IF test1 $XOR test2}
- TOKEN_OP_DEFINED = TOKEN_IDENTIFIER + 'DEFINED'; //{$IF $DEFINED test2}
- TOKEN_OP_SET = TOKEN_IDENTIFIER + 'SET'; //{$IF $SET vVertex}
- TOKEN_OP_ADD = '+'; //{$IF test1 + test2}
- TOKEN_OP_SUBTRACT = '-'; //{$IF test1 - test2}
- TOKEN_OP_MULTIPLY = '*'; //{$IF test1 * test2}
- TOKEN_OP_DIVIDE = '/'; //{$IF test1 / test2}
- TOKEN_OP_EQUALS = '='; //{$IF test1 = test2}
- TOKEN_OP_LESSER = '<'; //{$IF test1 < test2}
- TOKEN_OP_GREATER = '>'; //{$IF test1 > test2}
- TOKEN_OP_LEQUALS = '<='; //{$IF test1 <= test2}
- TOKEN_OP_GEQUALS = '>='; //{$IF test1 >= test2}
- TOKEN_OP_UNEQUALS = '<>'; //{$IF test1 <> test2}
- TOKEN_OP_BINARY_OR = '|'; //{$IF test1 | test2}
- TOKEN_OP_BINARY_AND = '&'; //{$IF test1 & test2}
- TOKEN_OP_BINARY_XOR = '^'; //{$IF test1 ^ test2}
- TOKEN_OP_BINARY_NOT = '!'; //{$IF !test1}
- TOKEN_OP_GROUP_BEGIN = '('; //{$IF (test1 $OR test2) >= '0'}
- TOKEN_OP_GROUP_END = ')';
-
- WHITESPACES = [' ', #9];
- VALID_IDENT_CHARS = ['A'..'Z', 'a'..'z', '0'..'9', '_'];
- VALID_TOKEN_CHARS = ['$'] + VALID_IDENT_CHARS;
- TOKEN_SPLIT_CHARS = [' ', #9, TOKEN_OP_GROUP_BEGIN, TOKEN_OP_GROUP_END];
-
- LAYOUT_MIN_VERSION = 150;
- VERSION_EXTRA_COMPAT = 'compatibility'; //{$META $VERSION 'compatibility'}
-
- EXPRESSION_UNARY_OPERATIONS: array[TengExpressionUnaryOperator] of String = (
- TOKEN_OP_BINARY_NOT, //opBinaryNot
- TOKEN_OP_LOGICAL_NOT, //opLogicalNot
- TOKEN_OP_DEFINED, //opDefined
- TOKEN_OP_SET //opSet
- );
-
- EXPRESSION_BINARY_OPERATIONS: array[TengExpressionBinaryOperator] of String = (
- TOKEN_OP_BINARY_OR, //opBinaryOr
- TOKEN_OP_BINARY_AND, //opBinaryAnd
- TOKEN_OP_BINARY_XOR, //opBinaryXor
-
- TOKEN_OP_MULTIPLY, //opMultiply
- TOKEN_OP_DIVIDE, //opDivide
- TOKEN_OP_ADD, //opAdd
- TOKEN_OP_SUBTRACT, //opSubtract
-
- TOKEN_OP_LOGICAL_OR, //opLogicalOr
- TOKEN_OP_LOGICAL_AND, //opLogicalAnd
- TOKEN_OP_LOGICAL_XOR, //opLogicalXor
-
- TOKEN_OP_EQUALS, //opEquals
- TOKEN_OP_LESSER, //opLesser
- TOKEN_OP_GREATER, //opGreater
- TOKEN_OP_LEQUALS, //opLEquals
- TOKEN_OP_GEQUALS, //opGEquals
- TOKEN_OP_UNEQUALS //opUnequals,
- );
-
- TOKEN_CLASSES: array[0..20] of CengShaderPart = (
- TengShaderPartProperty,
- TengShaderPartClass,
- TengShaderPartDefine,
- TengShaderPartError,
- TengShaderPartIf,
- TengShaderPartInclude,
- TengShaderPartMessage,
- TengShaderPartMeta,
- TengShaderPartCall,
- TengShaderPartProc,
- TengShaderPartFunc,
- TengShaderPartMain,
- TengShaderPartInherited,
- TengShaderPartUniform,
- TengShaderPartVar,
- TengShaderPartVarying,
- TengShaderPartWarning,
- TengShaderPartLineBreak,
- TengShaderPartCommandEnd,
- TengShaderPartComment,
- TengShaderPartEcho);
-
- COMMAND_END_TOKENS = [TOKEN_COMMAND_END, TOKEN_SCOPE_BEGIN, TOKEN_SCOPE_END];
-
- FIND_OVERWRITTEN_FLAGS: TengFindMappedPartFlags = [ffLocal, ffInherited]; // search all ShaderParts in current and inherited scopes
- FIND_INHERITED_FLAGS: TengFindMappedPartFlags = [ffInherited]; // search in inherited scropes only
- FIND_IN_SCOPE_FLAGS: TengFindMappedPartFlags = [ffLocal, ffAscending, ffInherited, ffFile]; // search in current, all parent, all interhited scopes and in file the scope
- FIND_GLOBAL: TengFindMappedPartFlags = [ffGlobal, ffLocal]; // search in root file only (for defines that are set from the program)
- GEN_CODE_FIND_FLAGS: TengFindMappedPartFlags = [ffLocal, ffAscending, ffInherited, ffFile, ffVisited]; // search in current, all parent, all inherited scopes and in file scope, but search only in already visited scopes
- FIND_PROPERTY_FLAGS: TengFindMappedPartFlags = [ffLocal, ffDescending, ffInherited]; // search in current, all inherited and all child scopes
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- {$IFDEF DEBUG}
- function MakeDebugStr(const aItems: TengGenCodeArgs.TCodeItemList; const aFilename: String): String;
- var
- i: TengGenCodeArgs.TCodeItem;
- fs: TFileStream;
- begin
- fs := TFileStream.Create(aFilename, fmCreate);
- try
- result := '';
- for i in aItems do begin
- result := result + i.ClassName;
- result := result + '(';
- if (i is TengGenCodeArgs.TCodeItemLineBreak) then
- result := result + 'LB)' + sLineBreak + sLineBreak
- else
- result := result + i.GetText + ')' + sLineBreak;
- end;
- fs.Write(result[1], Length(result));
- finally
- FreeAndNil(fs);
- end;
- end;
- {$ENDIF}
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TrySetProperty(const aGenerator: TengCodeGenerator; const aName: String; const aValue: Variant): Boolean;
- var
- prop: TengShaderPartProperty;
- begin
- prop := aGenerator.Properties[aName];
- result := Assigned(prop);
- if result then
- prop.Value := aValue;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function IsValidIdentifier(const aIdent: String): Boolean;
- var
- i, len: Integer;
- begin
- len := Length(aIdent);
- result := false;
- for i := 1 to len do
- if not (aIdent[i] in VALID_IDENT_CHARS) then
- exit;
- result := true;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function CheckEndToken(const aParseArgs: TengParseArgs; const aShaderPart: TengShaderPart): String;
- var
- oldLine, oldCol: Integer;
- param: TengTokenParameterList;
- begin
- param := TengTokenParameterList.Create;
- try
- oldLine := aParseArgs.Line;
- oldCol := aParseArgs.Col;
- if not aParseArgs.ParseParameters(param) then
- raise EengInvalidToken.Create('expected ' + TOKEN_END, oldLine, oldCol, aShaderPart.Filename);
- if (param[0].Name <> TOKEN_END) then
- raise EengInvalidToken.Create(aShaderPart.ClassName, param[0].Name, oldLine, oldCol, aShaderPart.Filename);
- if (param.Count <> 1) then
- raise EengInvalidParamterCount.Create(TOKEN_END, oldLine, oldCol, aShaderPart.Filename);
- result := '';
- finally
- FreeAndNil(param);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function CheckType(const aShaderPart: TengShaderPart; const aTypes: array of CengShaderPart): Boolean;
- var
- t: CengShaderPart;
- begin
- result := true;
- for t in aTypes do
- if (aShaderPart is t) then
- exit;
- result := (Length(aTypes) = 0);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function CheckParentScope(const aShaderPart: TengShaderPart): TengShaderPartScope;
- begin
- aShaderPart.GetParentType(TengShaderPartScope, result);
- if not Assigned(result) then
- raise EengInternal.Create('this part has no container parent');
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengExpressionItem////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengExpressionItem.GetText: String;
- begin
- result := '';
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengExpressionItem.GetValue(const aScope: TengShaderPartScope; const aGenCodeArgs: TengGenCodeArgs): Variant;
- begin
- result := Unassigned;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TengExpressionItem.Create(const aLine, aCol: Integer; const aFilename: String);
- begin
- inherited Create;
- fLine := aLine;
- fCol := aCol;
- fFilename := aFilename;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengExpressionItemSingle//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengExpressionValue.GetText: String;
- begin
- result := '''' + fValue + '''';
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengExpressionValue.GetValue(const aScope: TengShaderPartScope; const aGenCodeArgs: TengGenCodeArgs): Variant;
- begin
- result := fValue;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TengExpressionValue.Create(const aValue: Variant; const aLine, aCol: Integer; const aFilename: String);
- begin
- inherited Create(aLine, aCol, aFilename);
- fValue := aValue;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengExpressionVariable////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengExpressionVariable.GetText: String;
- begin
- result := fVariableName;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengExpressionVariable.GetValue(const aScope: TengShaderPartScope; const aGenCodeArgs: TengGenCodeArgs): Variant;
- var
- p: TengShaderPart;
- begin
- aScope.FindMappedPart(p, fVariableName, FIND_IN_SCOPE_FLAGS);
- if not Assigned(p) then begin
- aScope.FindMappedPart(p, fVariableName, FIND_GLOBAL);
- if not Assigned(p) then
- raise EengUnknownIdentifier.Create(fVariableName, fLine, fCol, fFilename)
- end
- else if not (p is TengShaderPartProperty) and not (p is TengShaderPartDefine) then
- raise EengInvalidParamter.Create('unexpected type, expected ' +
- TengShaderPartProperty.GetTokenName + ' or ' +
- TengShaderPartDefine.GetTokenName,
- fLine, fCol, fFilename)
- else
- result := (p as TengShaderPartKeyValuePair).Value;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TengExpressionVariable.Create(const aVariableName: String; const aLine, aCol: Integer; const aFilename: String);
- begin
- inherited Create(aLine, aCol, aFilename);
- fVariableName := aVariableName;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengExpressionGroup///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengExpressionGroup.GetText: String;
- begin
- if Assigned(fChild) then
- result := TOKEN_OP_GROUP_BEGIN + fChild.GetText + TOKEN_OP_GROUP_END
- else
- result := '';
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengExpressionGroup.GetValue(const aScope: TengShaderPartScope; const aGenCodeArgs: TengGenCodeArgs): Variant;
- begin
- result := fChild.GetValue(aScope, aGenCodeArgs);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TengExpressionGroup.Create(const aChild: TengExpressionItem; const aLine, aCol: Integer; const aFilename: String);
- begin
- inherited Create(aLine, aCol, aFilename);
- fChild := aChild;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TengExpressionGroup.Destroy;
- begin
- FreeAndNil(fChild);
- inherited Destroy;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengExpressionUnaryOperation.GetText: String;
- begin
- if not Assigned(fChild) then
- EengExpression.Create('no child assigned');
- result :=
- {$IFDEF EXPRESSION_ADD_BRACKET}TOKEN_OP_GROUP_BEGIN +{$ENDIF}
- EXPRESSION_UNARY_OPERATIONS[fUnaryOp] + ' ' + fChild.GetText
- {$IFDEF EXPRESSION_ADD_BRACKET} + TOKEN_OP_GROUP_END{$ENDIF};
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengExpressionUnaryOperation.GetValue(const aScope: TengShaderPartScope; const aGenCodeArgs: TengGenCodeArgs): Variant;
- var
- p: TengShaderPart;
- v: Variant;
- begin
- try
- case fUnaryOp of
-
- opBinaryNot: begin
- v := fChild.GetValue(aScope, aGenCodeArgs);
- result := not Integer(v);
- end;
-
- opLogicalNot: begin
- v := fChild.GetValue(aScope, aGenCodeArgs);
- result := not Boolean(v);
- end;
-
- opDefined: begin
- v := (fChild as TengExpressionVariable).fVariableName;
- if not (fChild is TengExpressionVariable) then
- raise EengInternal.Create('child is not a variable', fLine, fCol, fFilename);
- aScope.FindMappedPart(p, (fChild as TengExpressionVariable).fVariableName, FIND_IN_SCOPE_FLAGS);
- result := Assigned(p);
- if result and (not (p is TengShaderPartProperty) or not (p is TengShaderPartDefine)) then with fChild do
- raise EengInvalidParamter.Create('unexpected type, expected ' +
- TengShaderPartProperty.GetTokenName + ' or ' +
- TengShaderPartDefine.GetTokenName,
- fLine, fCol, fFilename);
- end;
-
- opSet: begin
- if Assigned(aGenCodeArgs) then begin
- if not (fChild is TengExpressionVariable) then
- raise EengInternal.Create('child is not a variable', fLine, fCol, fFilename);
- result := aGenCodeArgs.HasCodeProperty((fChild as TengExpressionVariable).fVariableName);
- end else
- result := false;
- end
-
- else
- result := inherited GetValue(aScope, aGenCodeArgs);
- end;
- except
- on ex: Exception do
- raise EengInvalidParamter.Create(ex.Message + ' ("' + GetText + '" ==> "' + EXPRESSION_UNARY_OPERATIONS[fUnaryOp] + ' ' + v + '")', fLine, fCol, fFilename);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TengExpressionUnaryOperation.Create(const aUnaryOp: TengExpressionUnaryOperator; const aLine, aCol: Integer; const aFilename: String);
- begin
- inherited Create(aLine, aCol, aFilename);
- fUnaryOp := aUnaryOp;
- fChild := nil;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TengExpressionUnaryOperation.Destroy;
- begin
- FreeAndNil(fChild);
- inherited Destroy;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengExpressionBinaryOperation///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengExpressionBinaryOperation.GetText: String;
- begin
- if not Assigned(fFirst) or not Assigned(fSecond) then
- raise EengExpression.Create('first or second item not assigned');
- result :=
- {$IFDEF EXPRESSION_ADD_BRACKET}TOKEN_OP_GROUP_BEGIN +{$ENDIF}
- fFirst.GetText + ' ' + EXPRESSION_BINARY_OPERATIONS[fBinaryOp] + ' ' + fSecond.GetText
- {$IFDEF EXPRESSION_ADD_BRACKET} + TOKEN_OP_GROUP_END{$ENDIF};
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengExpressionBinaryOperation.GetValue(const aScope: TengShaderPartScope; const aGenCodeArgs: TengGenCodeArgs): Variant;
- var
- v1, v2: Variant;
- begin
- v1 := fFirst.GetValue(aScope, aGenCodeArgs);
- v2 := fSecond.GetValue(aScope, aGenCodeArgs);
- try
- case fBinaryOp of
- opBinaryOr: result := (Integer(v1) or Integer(v2));
- opBinaryAnd: result := (Integer(v1) and Integer(v2));
- opBinaryXor: result := (Integer(v1) xor Integer(v2));
-
- opMultiply: result := (v1 * v2);
- opDivide: result := (v1 / v2);
- opAdd: result := (v1 + v2);
- opSubtract: result := (v1 - v2);
-
- opLogicalOr: result := (Boolean(v1) or Boolean(v2));
- opLogicalAnd: result := (Boolean(v1) and Boolean(v2));
- opLogicalXor: result := (Boolean(v1) xor Boolean(v2));
-
- opEquals: result := (v1 = v2);
- opLesser: result := (v1 < v2);
- opGreater: result := (v1 > v2);
- opLEquals: result := (v1 <= v2);
- opGEquals: result := (v1 >= v2);
- opUnequals: result := (v1 <> v2);
- end;
- except
- on ex: Exception do
- raise EengInvalidParamter.Create(ex.Message + ' ("' + GetText + '" ==> "' + v1 + ' ' + EXPRESSION_BINARY_OPERATIONS[fBinaryOp] + ' ' + v2 + '")', fLine, fCol, fFilename);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TengExpressionBinaryOperation.Create(const aOperator: TengExpressionBinaryOperator; const aLine, aCol: Integer; const aFilename: String);
- begin
- inherited Create(aLine, aCol, aFilename);
- fBinaryOp := aOperator;
- fFirst := nil;
- fSecond := nil;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TengExpressionBinaryOperation.Destroy;
- begin
- FreeAndNil(fFirst);
- FreeAndNil(fSecond);
- inherited Destroy;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //EengShaderPart////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor EengShaderPart.Create(const aMsg: String; const aLine, aCol: Integer; const aFilename: String);
- begin
- inherited Create(aMsg + format(' (file: %s; line: %d; col: %d)', [ExtractFileName(aFilename), aLine+1, aCol]));
- Line := aLine;
- Col := aCol;
- Filename := aFilename;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //EengInvalidParamter///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor EengInvalidParamter.Create(const aMsg: String; const aLine, aCol: Integer; const aFilename: String);
- begin
- inherited Create('invalid parameter: ' + aMsg, aLine, aCol, aFilename);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //EengInvalidIdentifier/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor EengInvalidIdentifier.Create(const aIdentifier: String; const aLine, aCol: Integer; const aFilename: String);
- begin
- inherited Create('invalid identifier: ' + aIdentifier, aLine, aCol, aFilename);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //EengEmptyToken////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor EengEmptyToken.Create(const aLine, aCol: Integer; const aFilename: String);
- begin
- inherited Create('empty token', aLine, aCol, aFilename);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //EengInvalidToken//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor EengInvalidToken.Create(const aClassName: String; const aToken: String; const aLine, aCol: Integer; const aFilename: String);
- begin
- inherited Create('invalid token: ' + aClassName + ' <> '+ aToken, aLine, aCol, aFilename);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //EengInvalidParamterCount//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor EengInvalidParamterCount.Create(const aToken: String; const aLine, aCol: Integer; const aFilename: String);
- begin
- inherited Create('invalid parameter count in ' + aToken, aLine, aCol, aFilename);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor EengDuplicateIdentifier.Create(const aName: String; const aNew, aOld: TengShaderPart);
- begin
- inherited Create(format('duplicate identifier: %s (previously declared here: %s %d:%d)',
- [aName, aOld.Filename, aOld.Line, aOld.Col]), aNew.Line, aNew.Col, aNew.Filename);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //EengInternal//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor EengInternal.Create(const aMsg: String);
- begin
- inherited Create(aMsg);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor EengInternal.Create(const aMsg: String; const aLine, aCol: Integer; const aFilename: String);
- begin
- inherited Create(aMsg, aLine, aCol, aFilename);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //EengUnknownIdentifier/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor EengUnknownIdentifier.Create(const aIdent: String; const aLine, aCol: Integer; const aFilename: String);
- begin
- inherited Create('unknown identifier: ' + aIdent, aLine, aCol, aFilename);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengShaderPart.TengShaderPartEnumerator///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPart.TengShaderPartEnumerator.GetCurrent: TengShaderPart;
- begin
- result := fOwner[fPosition];
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPart.TengShaderPartEnumerator.MoveNext: Boolean;
- begin
- inc(fPosition);
- result := (fPosition < fOwner.Count);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TengShaderPart.TengShaderPartEnumerator.Create(const aOwner: TengShaderPart);
- begin
- inherited Create;
- fOwner := aOwner;
- fPosition := -1;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengShaderPart////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPart.GetCount: Integer;
- begin
- result := 0;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPart.{%H-}GetChild(const aIndex: Integer): TengShaderPart;
- begin
- raise EengShaderPart.Create('this part does not have any children');
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPart.GetFilename: String;
- begin
- if Assigned(fParent) then
- result := fParent.Filename
- else
- result := '';
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPart.GetShaderClass: String;
- begin
- if Assigned(fParent) then
- result := fParent.ShaderClass
- else
- result := '';
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPart.GetText: String;
- begin
- result := ''; //DUMMY
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPart.ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String;
- begin
- result := ''; //DUMMY
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPart.ParseText(const aParseArgs: TengParseArgs): String;
- var
- param: TengTokenParameterList;
- begin
- param := TengTokenParameterList.Create;
- try
- fCol := aParseArgs.Col;
- fLine := aParseArgs.Line;
- if (GetTokenName <> '') then
- aParseArgs.ParseParameters(param);
- result := ParseTextIntern(aParseArgs, param);
- finally
- FreeAndNil(param);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPart.MapData(const aFlags: TengMapDataFlags; const aTypes: array of CengShaderPart);
- begin
- //DUMMY
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPart.GenCodeIntern(const aGenCodeArgs: TengGenCodeArgs);
- begin
- fFlags := fFlags + [spfCodeGenVisited];
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPart.ClearGenCode;
- begin
- fFlags := fFlags - [spfCodeGenVisited];
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPart.HasParentType(const aParentType: CengShaderPart; const aIncludeSelf: Boolean): Boolean;
- var
- p: TengShaderPart;
- begin
- result := aIncludeSelf and (self is aParentType);
- if not result then begin
- GetParentType(aParentType, p);
- result := Assigned(p);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPart.ParentOrSelfHasType(const aParentType: CengShaderPart): Boolean;
- begin
- result := (self is aParentType) or ParentHasType(aParentType);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPart.GetParentByType(const aParentType: CengShaderPart; out aPart);
- begin
- if (fParent is aParentType) then
- TengShaderPart(aPart) := fParent
- else if Assigned(fParent) then
- fParent.GetParentType(aParentType, aPart)
- else
- TengShaderPart(aPart) := nil;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPart.GetEnumerator: TengShaderPartEnumerator;
- begin
- result := TengShaderPartEnumerator.Create(self);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TengShaderPart.Create(const aParent: TengShaderPart);
- begin
- inherited Create;
- fParent := aParent;
- if Assigned(fParent) then
- fRoot := aParent.Root
- else
- fRoot := nil;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- class function TengShaderPart.GetTokenName: String;
- begin
- result := '';
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- class function TengShaderPart.CheckToken(const aToken: String): Boolean;
- begin
- result := (aToken = GetTokenName);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- class procedure TengShaderPart.CheckToken(const aParseArgs: TengParseArgs; const aParent: TengShaderPart);
- begin
- //DUMMY
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengShaderPartContainer///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartContainer.HandleToken(var aToken: String; const aParseArgs: TengParseArgs): String;
- var
- obj: TengShaderPart;
- c: CengShaderPart;
- begin
- obj := nil;
- for c in TOKEN_CLASSES do
- if c.CheckToken(aToken) then begin
- c.CheckToken(aParseArgs, self);
- obj := c.Create(self);
- fChildren.Add(obj);
- break;
- end;
-
- if Assigned(obj) then
- result := obj.ParseText(aParseArgs)
- else
- result := aToken;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartContainer.GetCount: Integer;
- begin
- result := fChildren.Count;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartContainer.GetChild(const aIndex: Integer): TengShaderPart;
- begin
- result := fChildren[aIndex];
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartContainer.GetText: String;
- var
- p: TengShaderPart;
- begin
- result := '';
- for p in self do
- result := result + p.Text;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartContainer.ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String;
- var
- codeObj: TengShaderPartCode;
- begin
- fChildren.Clear;
- while not aParseArgs.EndOfFile do begin
- codeObj := TengShaderPartCode.Create(self);
- try
- result := codeObj.ParseText(aParseArgs);
- if (codeObj.Code <> '') then
- AddChild(codeObj)
- else
- FreeAndNil(codeObj);
- except
- FreeAndNil(codeObj);
- raise;
- end;
- if (result <> '') then begin
- result := HandleToken(result, aParseArgs);
- if (result <> '') then
- break;
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartContainer.MapData(const aFlags: TengMapDataFlags; const aTypes: array of CengShaderPart);
- var
- p: TengShaderPart;
- begin
- inherited MapData(aFlags, aTypes);
- for p in fChildren do
- p.MapData(aFlags, aTypes);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartContainer.GenCodeIntern(const aGenCodeArgs: TengGenCodeArgs);
- var
- p: TengShaderPart;
- begin
- inherited GenCodeIntern(aGenCodeArgs);
- for p in fChildren do
- if not (p is TengShaderPartClass) then
- p.GenCodeIntern(aGenCodeArgs);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartContainer.ClearGenCode;
- var
- p: TengShaderPart;
- begin
- inherited ClearGenCode;
- for p in fChildren do
- p.ClearGenCode;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartContainer.AddChild(const aChild: TengShaderPart; const aPrepend: Boolean);
- begin
- if aPrepend then
- fChildren.PushFirst(aChild)
- else
- fChildren.PushLast(aChild);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TengShaderPartContainer.Create(const aParent: TengShaderPart);
- begin
- inherited Create(aParent);
- fChildren := TengShaderPartList.Create(true);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TengShaderPartContainer.Destroy;
- begin
- FreeAndNil(fChildren);
- inherited Destroy;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengShaderPartScope///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartScope.CheckName(const aName: String; const aShaderPart: TengShaderPart): Boolean;
- var
- old: TengShaderPart;
- begin
- result := false;
-
- // check properties (global)
- FindMappedPart(old, aName, [ffGlobal, ffLocal, ffDescending], TengShaderPartProperty);
- if Assigned(old) then begin
- if (old <> aShaderPart) then
- raise EengDuplicateIdentifier.Create(aName, aShaderPart, old)
- else
- exit;
- end;
-
- // check all others
- FindMappedPart(old, aName, FIND_IN_SCOPE_FLAGS);
- if Assigned(old) then begin
- if (old <> aShaderPart) then
- CheckDuplicate(aName, old, aShaderPart)
- else
- exit;
- end;
-
- result := true;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartScope.MapChildScope(const aScope: TengShaderPartScope);
- begin
- if (CheckParentScope(aScope) <> self) then
- raise EengInternal.Create('container is not a direct child of this container');
- if not fChildScopes.Contains(aScope) then
- fChildScopes.Add(aScope);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartScope.MapInheritedScope(const aScope: TengShaderPartScope);
- begin
- if not fInherited.Contains(aScope) then
- fInherited.Add(aScope);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartScope.MapShaderPart(const aName: String; const aShaderPart: TengShaderPart): Boolean;
- begin
- if (CheckParentScope(aShaderPart) <> self) then
- raise EengInternal.Create('shader part does not belong to this container');
-
- result := CheckName(aName, aShaderPart);
- if result then
- fMappedParts.Add(aName, aShaderPart);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartScope.FindMappedPart(out aShaderPart; const aName: String; const aFlags: TengFindMappedPartFlags; const aType: CengShaderPart);
- var
- list: TengShaderPartList;
- begin
- TengShaderPart(aShaderPart) := nil;
- list := TengShaderPartList.Create(false);
- try
- FindMappedParts(list, aName, aFlags + [ffFindFirst], aType);
- if (list.Count > 0) then
- TengShaderPart(aShaderPart) := list[0];
- finally
- FreeAndNil(list);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartScope.FindMappedParts(const aParts: TengShaderPartList; const aName: String; const aFlags: TengFindMappedPartFlags; const aType: CengShaderPart);
-
- procedure AddPart(const aShaderPart: TengShaderPart);
- begin
- if Assigned(aShaderPart) and
- (not Assigned(aType) or (aShaderPart is aType)) and
- (aParts.IndexOf(aShaderPart) < 0) then
- aParts.Add(aShaderPart);
- end;
-
- var
- s: TengShaderPartScope;
- p: TengShaderPart;
- begin
- if (ffFindFirst in aFlags) and (aParts.Count > 0) then
- exit;
-
- if not (ffGlobal in aFlags) then begin
-
- // local
- if (ffLocal in aFlags) then begin
- if (aName <> '') then
- AddPart(fMappedParts[aName])
- else
- for p in fMappedParts do
- AddPart(p);
- end;
-
- // descending
- if (ffDescending in aFlags) then
- for s in fChildScopes do
- s.FindMappedParts(aParts, aName, aFlags + [ffLocal], aType);
-
- // ascending
- if (ffAscending in aFlags) then begin
- GetParentType(TengShaderPartScope, s);
- if Assigned(s) and s.fChildScopes.Contains(self) then
- s.FindMappedParts(aParts, aName, aFlags + [ffLocal], aType);
- end;
-
- // search in inherited scopes
- if (ffInherited in aFlags) then
- for s in fInherited do
- s.FindMappedParts(aParts, aName, aFlags + [ffLocal], aType);
-
- end else
- fRoot.FindMappedParts(aParts, aName, aFlags - [ffGlobal], aType);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartScope.GetFindPropertyFlags: TengFindMappedPartFlags;
- begin
- result := FIND_PROPERTY_FLAGS;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartScope.CheckDuplicate(const aName: String; const aOld, aNew: TengShaderPart);
- begin
- raise EengDuplicateIdentifier.Create(aName, aNew, aOld);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartScope.MapData(const aFlags: TengMapDataFlags; const aTypes: array of CengShaderPart);
- var
- s: TengShaderPartScope;
- p: TengShaderPart;
- begin
- if (mdfCurrentScope in aFlags) and (mdfChild in aFlags) then
- exit;
-
- GetParentType(TengShaderPartScope, s);
- if Assigned(s) then
- s.MapChildScope(self);
-
- for p in fChildren do
- p.MapData(aFlags + [mdfChild], aTypes);
-
- if (mdfMapInherited in aFlags) then
- for s in fInherited do
- s.MapData(aFlags, aTypes);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartScope.GenCodeIntern(const aGenCodeArgs: TengGenCodeArgs);
- begin
- MapData([mdfMapInherited, mdfCurrentScope, mdfIfEvaluate], []);
- inherited GenCodeIntern(aGenCodeArgs);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartScope.ClearGenCode;
- var
- p: TengShaderPartScope;
- begin
- inherited ClearGenCode;
- for p in fInherited do
- p.ClearGenCode;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartScope.ClearMappedData(const aExcludedTypes: array of CengShaderPart);
- var
- s: TengShaderPartScope;
- i: Integer;
- begin
- for s in fChildScopes do
- s.ClearMappedData(aExcludedTypes);
- for s in fInherited do
- s.ClearMappedData(aExcludedTypes);
- for i := fMappedParts.Count-1 downto 0 do
- if not CheckType(fMappedParts.ValueAt[i], aExcludedTypes) then
- fMappedParts.DeleteAt(i);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartScope.ClearMappedData;
- var
- s: TengShaderPartScope;
- begin
- for s in fChildScopes do
- s.ClearMappedData;
- fChildScopes.Clear;
-
- for s in fInherited do
- s.ClearMappedData;
- fInherited.Clear;
-
- fMappedParts.Clear;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TengShaderPartScope.Create(const aParent: TengShaderPart);
- begin
- inherited Create(aParent);
- fInherited := TengShaderPartScopeHashSet.Create(false);
- fChildScopes := TengShaderPartScopeHashSet.Create(false);
- fMappedParts := TengShaderPartMap.Create(false);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TengShaderPartScope.Destroy;
- begin
- FreeAndNil(fMappedParts);
- FreeAndNil(fChildScopes);
- FreeAndNil(fInherited);
- inherited Destroy;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengCodeGenerator/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengCodeGenerator.GetProperty(const aName: String): TengShaderPartProperty;
- begin
- FindMappedPart(result, aName, GetFindPropertyFlags, TengShaderPartProperty);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengCodeGenerator.GenerateCode(const aGenCodeArgs: TengGenCodeArgs);
- begin
- //DUMMY
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengCodeGenerator.GenerateCode: TengShaderCode;
- var
- args: TengGenCodeArgs;
- begin
- result := TengShaderCodeIntern.Create;
- args := TengGenCodeArgs.Create((result as TengShaderCodeIntern), self);
- try
- ClearGenCode;
- ClearMappedData([TengShaderPartProperty]);
-
- GenCodeIntern(args);
-
- args.PushCode;
- try
- GenerateCode(args);
- args.GenProcedureCode;
- finally
- args.PopCode;
- end;
-
- args.GenCodePropertyCode([TengShaderPartVar]);
- args.GenCodePropertyCode([TengShaderPartVarying]);
- args.GenCodePropertyCode([TengShaderPartUniform]);
- args.GenMetaCode;
- finally
- FreeAndNil(args);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengCodeGenerator.ListProperties(const aList: TStrings);
- var
- list: TengShaderPartList;
- p: TengShaderPart;
- begin
- list := TengShaderPartList.Create(false);
- try
- FindMappedParts(list, '', GetFindPropertyFlags, TengShaderPartProperty);
- for p in list do
- aList.Add((p as TengShaderPartProperty).Name);
- finally
- FreeAndNil(list);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengShaderPartClass///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartClass.GetExtendCount: Integer;
- begin
- result := fExtends.Count;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartClass.GetExtends(const aIndex: Integer): String;
- begin
- if (aIndex >= 0) and (aIndex < fExtends.Count) then
- result := fExtends[aIndex]
- else
- raise EOutOfRange.Create(aIndex, 0, fExtends.Count-1);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartClass.GetText: String;
- var
- s: String;
- begin
- result := PRECOMPILER_STATEMENT_BEGIN + GetTokenName + ' ' + fName;
- if (fExtends.Count > 0) then begin
- result := result + ' ' + TOKEN_EXTENDS;
- for s in fExtends do
- result := result + ' ' + s;
- end;
- result := result + PRECOMPILER_STATEMENT_END +
- inherited GetText +
- PRECOMPILER_STATEMENT_BEGIN + TOKEN_END + PRECOMPILER_STATEMENT_END;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartClass.GetShaderClass: String;
- begin
- result := fName;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartClass.ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String;
- var
- i: Integer;
- begin
- if (aParameters[0].Name <> GetTokenName) then
- raise EengInvalidToken.Create(ClassName, aParameters[0].Name, Line, Col, Filename);
- if (aParameters.Count < 2) then
- raise EengInvalidParamterCount.Create(GetTokenName, Line, Col, Filename);
- fName := aParameters[1].Name;
- if not IsValidIdentifier(fName) then
- raise EengShaderPart.Create('invalid name: ' + fName, Line, Col, GetFilename);
- if (aParameters.Count > 2) then begin
- if (aParameters.Count < 4) then
- raise EengInvalidParamterCount.Create(GetTokenName, Line, Col, Filename);
- if (aParameters[2].Name <> TOKEN_EXTENDS) then
- raise EengInvalidParamter.Create(aParameters[2].Name + ' (expected ' + TOKEN_EXTENDS + ')', Line, Col, Filename);
- fExtends.Clear;
- for i := 3 to aParameters.Count-1 do
- fExtends.Add(aParameters[i].Name);
- end;
-
- fRoot.AddClass(self);
-
- inherited ParseTextIntern(aParseArgs, aParameters);
- result := CheckEndToken(aParseArgs, self);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartClass.CheckDuplicate(const aName: String; const aOld, aNew: TengShaderPart);
-
- function IsInherited(const aRoot: TengShaderPartScope; const aClass: TengShaderPartClass): Boolean;
- var
- p: TengShaderPartScope;
- begin
- result := true;
- for p in fInherited do
- if (p is TengShaderPartClass) and ((p = aClass) or IsInherited(p, aClass)) then
- exit;
- result := false;
- end;
-
- function CompareParam(const p1, p2: TengShaderPartProcParam): Boolean;
- begin
- result := (p1.Name = p2.Name) and (p1.Typ = p2.Typ);
- end;
-
- var
- i: Integer;
- o, n: TengShaderPartProc;
- c: TengShaderPartClass;
- begin
- if (aOld is TengShaderPartProc) and (aNew is TengShaderPartProc) then begin
- o := (aOld as TengShaderPartProc);
- n := (aNew as TengShaderPartProc);
- o.GetParentType(TengShaderPartClass, c);
- if (o.fParameters.Count <> n.fParameters.Count) then
- raise EengInvalidParamterCount.Create('method must have the same parameters as the overwritten one', n.Line, n.Col, n.Filename);
- for i := 0 to o.fParameters.Count-1 do
- if not CompareParam(n.fParameters[i], o.fParameters[i]) then
- raise EengInvalidParamter.Create('parameters must have the same name and type as the overwritten one', n.Line, n.Col, n.Filename);
- if (o.ClassName <> n.ClassName) then
- raise EengInvalidToken.Create('method must be the same type as the overwritten one', n.Line, n.Col, n.Filename);
- if (o is TengShaderPartFunc) and ((o as TengShaderPartFunc).ReturnType <> (n as TengShaderPartFunc).ReturnType) then
- raise EengInvalidParamter.Create('return type must be the same as the overwritten one', n.Line, n.Col, n.Filename);
- end else
- inherited CheckDuplicate(aName, aOld, aNew);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartClass.GetFindPropertyFlags: TengFindMappedPartFlags;
- begin
- result := inherited GetFindPropertyFlags + [ffFile];
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartClass.GenCodeIntern(const aGenCodeArgs: TengGenCodeArgs);
- var
- p: TengShaderPartScope;
- begin
- for p in fInherited do
- p.GenCodeIntern(aGenCodeArgs);
- aGenCodeArgs.Code.AddToken(ttBegin);
- try
- inherited GenCodeIntern(aGenCodeArgs);
- finally
- aGenCodeArgs.Code.AddToken(ttEnd);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartClass.GenerateCode(const aGenCodeArgs: TengGenCodeArgs);
- var
- main: TengShaderPartMain;
- begin
- FindMappedPart(main, '', FIND_IN_SCOPE_FLAGS, TengShaderPartMain);
- if not Assigned(main) then
- raise EengInternal.Create('no main routine found');
-
- aGenCodeArgs.PushFlags([gcfGenProcedure]);
- try
- main.GenCodeIntern(aGenCodeArgs);
- finally
- aGenCodeArgs.PopFlags;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartClass.FindMappedParts(const aParts: TengShaderPartList; const aName: String; const aFlags: TengFindMappedPartFlags; const aType: CengShaderPart);
- var
- f: TengShaderFile;
- begin
- if (ffIgnoreClasses in aFlags) or
- ((ffFindFirst in aFlags) and (aParts.Count > 0)) then
- exit;
-
- // search in file
- if not (ffGlobal in aFlags) and (ffFile in aFlags) then begin
- GetParentType(TengShaderFile, f);
- if not Assigned(f) then
- EengInternal.Create('unable to find file object');
- f.FindMappedParts(aParts, aName, aFlags + [ffIgnoreClasses], aType);
- end;
-
- inherited FindMappedParts(aParts, aName, aFlags, aType);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartClass.MapData(const aFlags: TengMapDataFlags; const aTypes: array of CengShaderPart);
- var
- s: String;
- sc: TengShaderPartScope;
- begin
- if (mdfAddInherited in aFlags) then begin
- for s in fExtends do begin
- sc := fRoot.GetClass(s);
- if not Assigned(sc) then
- raise EengUnknownIdentifier.Create(s, Line, Col, Filename);
- MapInheritedScope(sc);
- end;
- end;
- inherited MapData(aFlags, aTypes);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TengShaderPartClass.Create(const aParent: TengShaderPart);
- begin
- inherited Create(aParent);
- fExtends := TStringList.Create;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TengShaderPartClass.Destroy;
- begin
- FreeAndNil(fExtends);
- inherited Destroy;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- class function TengShaderPartClass.GetTokenName: String;
- begin
- result := TOKEN_CLASS;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- class procedure TengShaderPartClass.CheckToken(const aParseArgs: TengParseArgs; const aParent: TengShaderPart);
-
- procedure RaiseEx(const aToken: String);
- begin
- with aParseArgs do
- raise EengShaderPart.Create('token ' + GetTokenName + ' is not allowed in ' + aToken, Line, Col, aParent.Filename);
- end;
-
- begin
- if (aParent is TengShaderPartClass) or aParent.ParentHasType(TengShaderPartClass) then
- RaiseEx(TengShaderPartClass.GetTokenName);
- if (aParent is TengShaderPartIf) or aParent.ParentHasType(TengShaderPartIf) then
- RaiseEx(TengShaderPartIf.GetTokenName);
- if (aParent is TengShaderPartElse) or aParent.ParentHasType(TengShaderPartElse) then
- RaiseEx(TengShaderPartElse.GetTokenName);
- if (aParent is TengShaderPartElIf) or aParent.ParentHasType(TengShaderPartElIf) then
- RaiseEx(TengShaderPartElIf.GetTokenName);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengShaderFile////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderFile.GetFilename: String;
- begin
- result := fFilename;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderFile.LoadFromFile(const aFilename: String);
- var
- s: TStream;
- {$IFDEF USE_VFS}sHandle: IStreamHandle;{$ENDIF}
-
- function GetStream(out aStream: TStream): Boolean;
- begin
- {$IFDEF USE_VFS}
- result := vfsManager.ReadFile(aFilename, sHandle);
- if result then
- aStream := sHandle.GetStream
- else
- aStream := nil;;
- {$ELSE}
- result := true;
- aStream := TFileStream.Create(aFilename, fmOpenRead);
- {$ENDIF}
- end;
-
- procedure FreeStream(var aStream: TStream);
- begin
- {$IFDEF USE_VFS}
- aStream := nil;
- sHandle := nil;
- {$ELSE}
- FreeAndNil(aStream);
- {$ENDIF}
- end;
-
- begin
- if not {$IFDEF USE_VFS}vfsManager.{$ENDIF}FileExists(aFilename) then
- if Assigned(fParent) then with fParent do
- raise EengShaderPart.Create('file does not exist: ' + aFilename, Line, Col, Filename)
- else
- raise EengShaderPart.Create('file does not exist: ' + aFilename);
-
- if GetStream(s) then begin
- try
- LoadFromStream(s, aFilename);
- finally
- FreeStream(s);
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderFile.SaveToFile(const aFilename: String);
- var
- s: TStream;
- {$IFDEF USE_VFS}sHandle: IStreamHandle;{$ENDIF}
-
- function GetStream(out aStream: TStream): Boolean;
- begin
- {$IFDEF USE_VFS}
- result := vfsManager.CreateFile(aFilename, sHandle);
- if result then
- aStream := sHandle.GetStream
- else
- aStream := nil;;
- {$ELSE}
- result := true;
- aStream := TFileStream.Create(aFilename, fmCreate);
- {$ENDIF}
- end;
-
- procedure FreeStream(var aStream: TStream);
- begin
- {$IFDEF USE_VFS}
- aStream := nil;
- sHandle := nil;
- {$ELSE}
- FreeAndNil(aStream);
- {$ENDIF}
- end;
-
- begin
- fFilename := aFilename;
- if GetStream(s) then begin
- try
- SaveToStream(s);
- finally
- FreeStream(s);
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderFile.LoadFromStream(const aStream: TStream; const aFilename: String);
- var
- token: String;
- args: TengParseArgs;
- begin
- fFilename := aFilename;
- Clear;
- args := TengParseArgs.Create(self);
- try
- args.LoadCode(aStream);
- token := ParseText(args);
- if (token <> '') then
- raise EengShaderPart.Create('unknown token ''' + token + '''', args.Line, args.Col, Filename);
- finally
- FreeAndNil(args);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderFile.SaveToStream(const aStream: TStream);
- var
- sl: TStringList;
- begin
- sl := TStringList.Create;
- try
- sl.Text := Text;
- sl.SaveToStream(aStream);
- finally
- FreeAndNil(sl);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderFile.GetGenerator(const aName: String): TengCodeGenerator;
- begin
- ClearMappedData;
- MapData([], [TengShaderPartDefine]);
- MapData([mdfIfAll, mdfAddInherited], [TengShaderPartProperty]);
- if (aName <> '') then
- result := fClasses[aName]
- else
- result := self;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderFile.GetFindPropertyFlags: TengFindMappedPartFlags;
- begin
- result := inherited GetFindPropertyFlags + [ffIgnoreClasses];
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderFile.MapData(const aFlags: TengMapDataFlags; const aTypes: array of CengShaderPart);
- var
- s: TengShaderPartScope;
- p: TengShaderPart;
- begin
- // do not call inherited or included files will map themself as child to this file-scope,
- // but files are all inherited to each other
- if (mdfCurrentScope in aFlags) and (mdfChild in aFlags) then
- exit;
-
- if (mdfAddInherited in aFlags) then begin
- GetParentType(TengShaderPartScope, s);
- if Assigned(s) then begin
- if(s is TengShaderFile) then
- s.MapInheritedScope(self)
- else
- s.MapChildScope(self);
- end;
- end;
-
- for p in fChildren do
- p.MapData(aFlags + [mdfChild], aTypes);
-
- if (mdfMapInherited in aFlags) then
- for s in fInherited do
- s.MapData(aFlags, aTypes);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderFile.GetClass(const aName: String): TengShaderPartClass;
- begin
- result := fClasses[aName];
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderFile.AddClass(const aClass: TengShaderPartClass);
- var
- c: TengShaderPartClass;
- begin
- c := fClasses[aClass.Name];
- if not Assigned(c) then
- fClasses.Add(aClass.Name, aClass)
- else if (c <> aClass) then
- raise EengInternal.Create('name is already registred for other class data object: ' + aClass.Name);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderFile.GenerateCode(const aGenCodeArgs: TengGenCodeArgs);
- var
- main: TengShaderPartMain;
- begin
- FindMappedPart(main, '', FIND_IN_SCOPE_FLAGS, TengShaderPartMain);
- if Assigned(main) then begin
- aGenCodeArgs.PushFlags([gcfGenProcedure]);
- try
- main.GenCodeIntern(aGenCodeArgs);
- finally
- aGenCodeArgs.PopFlags;
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderFile.ListGenerators(const aList: TStrings);
- var
- s: String;
- begin
- ClearMappedData;
- MapData([], [TengShaderPartDefine]);
- MapData([mdfIfAll, mdfAddInherited], [TengShaderPartProperty]);
- for s in fClasses.Keys do
- aList.Add(s);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderFile.Clear;
- begin
- ClearMappedData;
- ClearGenCode;
- fClasses.Clear;
- fChildren.Clear;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TengShaderFile.Create(const aParent: TengShaderPart);
- begin
- inherited Create(aParent);
- fClasses := TengShaderPartClassMap.Create(false);
- if not Assigned(fRoot) then
- fRoot := self;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TengShaderFile.Create;
- begin
- Create(nil);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TengShaderFile.Destroy;
- begin
- FreeAndNil(fClasses);
- inherited Destroy;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengShaderPartInclude/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartInclude.GetCount: Integer;
- begin
- if Assigned(fShaderFile) then
- result := 1
- else
- result := 0;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartInclude.GetChild(const aIndex: Integer): TengShaderPart;
- begin
- if Assigned(fShaderFile) then
- result := fShaderFile
- else
- raise EOutOfRange.Create(aIndex, 0, -1);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartInclude.GetText: String;
- begin
- result := PRECOMPILER_STATEMENT_BEGIN + GetTokenName + ' ''' + fIncludeFile + '''' + PRECOMPILER_STATEMENT_END;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartInclude.ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String;
- begin
- if (aParameters[0].Name <> GetTokenName) then
- raise EengInvalidToken.Create(ClassName, aParameters[0].Name, Line, Col, Filename);
- if (aParameters.Count <> 2) then
- raise EengInvalidParamterCount.Create(GetTokenName, Line, Col, Filename);
- fIncludeFile := aParameters[1].Name;
- fAbsoluteFile := CreateAbsolutePath(fIncludeFile, ExtractFilePath(Filename));
- result := '';
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartInclude.CheckShaderFile;
- begin
- if not Assigned(fShaderFile) then
- fShaderFile := TengShaderFile.Create(self);
- if (fShaderFile.Filename <> fAbsoluteFile) then
- fShaderFile.LoadFromFile(fAbsoluteFile);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartInclude.MapData(const aFlags: TengMapDataFlags; const aTypes: array of CengShaderPart);
- begin
- inherited MapData(aFlags, aTypes);
- CheckShaderFile;
- fShaderFile.MapData(aFlags, aTypes);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartInclude.GenCodeIntern(const aGenCodeArgs: TengGenCodeArgs);
- begin
- inherited GenCodeIntern(aGenCodeArgs);
- CheckShaderFile;
- aGenCodeArgs.Code.AddToken(ttBegin);
- try
- aGenCodeArgs.Code.AddToken(ttSingle);
- aGenCodeArgs.Code.AddLineEnd;
- fShaderFile.GenCodeIntern(aGenCodeArgs);
- finally
- aGenCodeArgs.Code.AddToken(ttEnd);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TengShaderPartInclude.Create(const aParent: TengShaderPart);
- begin
- inherited Create(aParent);
- fShaderFile := nil;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TengShaderPartInclude.Destroy;
- begin
- FreeAndNil(fShaderFile);
- inherited Destroy;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- class function TengShaderPartInclude.GetTokenName: String;
- begin
- result := TOKEN_INCLUDE;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengShaderPartComment/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartComment.GetText: String;
- begin
- result := PRECOMPILER_STATEMENT_BEGIN + GetTokenName + fText + PRECOMPILER_STATEMENT_END;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartComment.ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String;
- begin
- if (aParameters[0].Name <> GetTokenName) then
- raise EengInvalidToken.Create(ClassName, aParameters[0].Name, Line, Col, Filename);
- if (aParameters.Count <> 2) then
- raise EengInvalidParamterCount.Create(GetTokenName, Line, Col, Filename);
- fText := aParameters[1].Name;
- result := '';
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- class function TengShaderPartComment.GetTokenName: String;
- begin
- result := COMMENT_IDENTIFIER;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengShaderPartInherited///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartInherited.GetText: String;
- begin
- result := PRECOMPILER_STATEMENT_BEGIN + GetTokenName;
- if (fInheritedName <> '') then
- result := ' ' + fInheritedName;
- result := result + PRECOMPILER_STATEMENT_END;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartInherited.ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String;
- var
- i: Integer;
- begin
- if (aParameters[0].Name <> GetTokenName) then
- raise EengInvalidToken.Create(ClassName, aParameters[0].Name, Line, Col, Filename);
- if (aParameters.Count < 1) then
- raise EengInvalidParamterCount.Create(GetTokenName, Line, Col, Filename);
-
- fParameters.Clear;
- if (aParameters.Count >= 2) then begin
- if not IsValidIdentifier(aParameters[1].Name) and (aParameters[1].Name <> TOKEN_MAIN) then
- raise EengInvalidIdentifier.Create(aParameters[1].Name, Line, Col, Filename);
- fInheritedName := aParameters[1].Name;
- for i := 2 to aParameters.Count-1 do
- fParameters.Add(aParameters[i].Name);
- end else
- fInheritedName := '';
- result := '';
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartInherited.GenCodeIntern(const aGenCodeArgs: TengGenCodeArgs);
-
- function FindProc(const aParentProc: TengShaderPartProc): TengShaderPartProc;
- var
- c: TengShaderPartClass;
- p: TengShaderPart;
- s: TengShaderPartScope;
- procs: TengShaderPartList;
- begin
- procs := TengShaderPartList.Create(false);
- try
- s := CheckParentScope(aParentProc);
- if not (s is TengShaderPartClass) then
- raise EengInternal.Create('parent scope of method with inherited token must be a class', Line, Col, Filename);
- s.FindMappedParts(procs, aParentProc.Name, FIND_INHERITED_FLAGS, TengShaderPartProc);
- if (fInheritedName <> '') then begin
- for p in procs do begin
- result := (p as TengShaderPartProc);
- result.GetParentType(TengShaderPartClass, c);
- if not Assigned(c) then
- raise EengInternal.Create('inherited method without class', Line, Col, Filename);
- if (c.Name = fInheritedName) then
- exit;
- end;
- raise EengInvalidIdentifier.Create('could not find inherited method: ' + aParentProc.Name, Line, Col, Filename)
- end else if (procs.Count > 1) then
- raise EengInvalidParamterCount.Create(GetTokenName + ' is ambiguous: specify inherited class')
- else if (procs.Count <= 0) then
- raise EengInvalidIdentifier.Create('could not find inherited method: ' + aParentProc.Name, Line, Col, Filename)
- else
- result := (procs[0] as TengShaderPartProc);
- finally
- FreeAndNil(procs);
- end;
- end;
-
- procedure GenCode(const aProc: TengShaderPartProc; const aParams: TStrings);
- begin
- aGenCodeArgs.PushFlags(aGenCodeArgs.Flags + [gcfGenProcInline]);
- aGenCodeArgs.PushProcParams(aParams);
- try
- aProc.GenCodeIntern(aGenCodeArgs);
- finally
- aGenCodeArgs.PopProcParams;
- aGenCodeArgs.PopFlags;
- end;
- end;
-
- var
- proc: TengShaderPartProc;
- params: TStringList;
- p: TengShaderPartProcParam;
- begin
- inherited GenCodeIntern(aGenCodeArgs);
-
- GetParentType(TengShaderPartProc, proc);
- if not Assigned(proc) then
- raise EengInternal.Create('inherited without parent procedure', Line, Col, Filename);
-
- proc := FindProc(proc);
- if (fParameters.Count > 0) then begin
- if (fParameters.Count <> proc.fParameters.Count) then
- raise EengInvalidParamterCount.Create(proc.Name + ' expects ' + IntToStr(proc.fParameters.Count) + ' parameter', Line, Col, Filename);
- GenCode(proc, fParameters);
- end else begin
- params := TStringList.Create;
- try
- for p in proc.fParameters do
- params.Add(p.Name);
- GenCode(proc, params);
- finally
- FreeAndNil(params);
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TengShaderPartInherited.Create(const aParent: TengShaderPart);
- begin
- inherited Create(aParent);
- fParameters := TStringList.Create;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TengShaderPartInherited.Destroy;
- begin
- FreeAndNil(fParameters);
- inherited Destroy;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- class function TengShaderPartInherited.GetTokenName: String;
- begin
- result := TOKEN_INHERITED;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- class procedure TengShaderPartInherited.CheckToken(const aParseArgs: TengParseArgs; const aParent: TengShaderPart);
- begin
- inherited CheckToken(aParseArgs, aParent);
- if not ((aParent is TengShaderPartProc) or aParent.ParentHasType(TengShaderPartProc)) or
- not (aParent.ParentHasType(TengShaderPartClass)) then
- with aParseArgs do
- raise EengShaderPart.Create(GetTokenName + ' is not allowed outside of a function or procedure', Line, Col, aParent.GetFilename);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengMetaData//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengMetaData.GetCount: Integer;
- begin
- result := fValues.Count;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengMetaData.GetMetaType: TengMetaType;
- begin
- result := fMetaType;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengMetaData.GetName: String;
- begin
- result := fName;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengMetaData.GetValues(const aIndex: Integer): String;
- begin
- result := fValues[aIndex];
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengMetaData.AddValue(const aValue: String);
- begin
- fValues.Add(aValue);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TengMetaData.Create(const aName: String; const aType: TengMetaType);
- begin
- inherited Create;
- fName := aName;
- fMetaType := aType;
- fValues := TStringList.Create;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TengMetaData.Destroy;
- begin
- FreeAndNil(fValues);
- inherited Destroy;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengShaderPartMeta////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartMeta.GetText: String;
- var
- i: Integer;
- begin
- result := PRECOMPILER_STATEMENT_BEGIN + GetTokenName + ' ' + fMetaData.Name;
- for i := 0 to fMetaData.Count-1 do
- result := result + ' ' + fMetaData[i];
- result := result + PRECOMPILER_STATEMENT_END;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartMeta.ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String;
- var
- i: Integer;
- t: TengMetaType;
- d: TengMetaData;
- n: String;
- begin
- if (aParameters[0].Name <> GetTokenName) then
- raise EengInvalidToken.Create(ClassName, aParameters[0].Name, Line, Col, Filename);
- if (aParameters.Count < 2) then
- raise EengInvalidParamterCount.Create(GetTokenName, Line, Col, Filename);
-
- result := '';
- n := aParameters[1].Name;
-
- {.$VERSION}
- if (n = TOKEN_VERSION) then begin
- t := metaVersion;
- if (aParameters.Count >= 3) and (aParameters.Count <= 4) then
-
- if (aParameters.Count = 3) then begin
- if (aParameters[2].Name <> VERSION_EXTRA_COMPAT) and not TryStrToInt(aParameters[2].Name, i) then
- raise EengInvalidParamter.Create('version must be an number or "' + VERSION_EXTRA_COMPAT + '"', Line, Col, Filename);
- end else if (aParameters.Count = 4) then begin
- if (aParameters[2].Name <> VERSION_EXTRA_COMPAT) and not TryStrToInt(aParameters[2].Name, i) then
- raise EengInvalidParamter.Create('version must be an number or "' + VERSION_EXTRA_COMPAT + '"', Line, Col, Filename);
- if (aParameters[3].Name <> VERSION_EXTRA_COMPAT) then
- raise EengInvalidParamter.Create('only "' + VERSION_EXTRA_COMPAT + '" is alowed as second parameter', Line, Col, Filename);
- end else
- raise EengInvalidParamterCount.Create(GetTokenName, Line, Col, Filename);
-
- {.$EXTENSION}
- end else if (n = TOKEN_EXTENSION) then begin
- t := metaExtension;
- if (aParameters.Count <> 4) then
- raise EengInvalidParamterCount.Create(GetTokenName, Line, Col, Filename);
-
- {.$LAYOUT}
- end else if (n = TOKEN_LAYOUT) then begin
- t := metaLayout;
- if (aParameters.Count <> 3) then
- raise EengInvalidParamterCount.Create(GetTokenName, Line, Col, Filename);
-
- {.VALUES}
- end else
- t := metaNormal;
-
- d := TengMetaData.Create(n, t);
- for i := 2 to aParameters.Count-1 do
- d.AddValue(aParameters[i].Name);
- fMetaData := d;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartMeta.GenCodeIntern(const aGenCodeArgs: TengGenCodeArgs);
- begin
- inherited GenCodeIntern(aGenCodeArgs);
- aGenCodeArgs.AddMeta(fMetaData);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TengShaderPartMeta.Destroy;
- begin
- fMetaData := nil;
- inherited Destroy;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- class function TengShaderPartMeta.GetTokenName: String;
- begin
- result := TOKEN_META;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengShaderPartKeyValuePair////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartKeyValuePair.GetText: String;
- begin
- result := PRECOMPILER_STATEMENT_BEGIN + GetTokenName + ' ' + fName;
- if (fValueName <> '') then
- result := result + ' ' + fValueName
- else if (fValue <> Unassigned) then
- result := result + ' ''' + String(fValue) + '''';
- result := result + PRECOMPILER_STATEMENT_END;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartKeyValuePair.ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String;
- begin
- if (aParameters[0].Name <> GetTokenName) then
- raise EengInvalidToken.Create(ClassName, GetTokenName, Line, Col, Filename);
- if (aParameters.Count < 2) or (aParameters.Count > 3) then
- raise EengInvalidParamterCount.Create(GetTokenName, Line, Col, Filename);
-
- result := '';
- fName := aParameters[1].Name;
- if not IsValidIdentifier(fName) then
- raise EengInvalidIdentifier.Create(fName, Line, Col, Filename);
- if (aParameters.Count >= 3) then
- if aParameters[2].Quoted then begin
- fValue := aParameters[2].Name;
- fValueName := '';
- end else begin
- fValue := Unassigned;
- fValueName := aParameters[2].Name;
- end
- else begin
- fValue := Unassigned;
- fValueName := '';
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TengShaderPartKeyValuePair.CreateValue(const aParent: TengShaderPart; const aName: String; const aValue: Variant);
- begin
- inherited Create(aParent);
- fName := aName;
- fValue := aValue;
- fValueName := '';
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TengShaderPartKeyValuePair.CreateName(const aParent: TengShaderPart; const aName, aValueName: String);
- begin
- inherited Create(aParent);
- fName := aName;
- fValue := Unassigned;
- fValueName := aValueName;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartKeyValuePair.GenCodeIntern(const aGenCodeArgs: TengGenCodeArgs);
- begin
- inherited GenCodeIntern(aGenCodeArgs);
- aGenCodeArgs.Code.AddToken(ttSingle);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengShaderPartProperty//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartProperty.MapData(const aFlags: TengMapDataFlags; const aTypes: array of CengShaderPart);
- var
- p: TengShaderPart;
- s: TengShaderPartScope;
- begin
- inherited MapData(aFlags, aTypes);
- if CheckType(self, aTypes) then begin
- s := CheckParentScope(self);
- if s.MapShaderPart(Name, self) and (fValueName <> '') then begin
- s.FindMappedPart(p, fValueName, FIND_IN_SCOPE_FLAGS);
- if not Assigned(p) then
- raise EengUnknownIdentifier.Create(fValueName, Line, Col, Filename)
- else if not (p is TengShaderPartDefine) then
- raise EengInvalidParamter.Create('invalid type, expected ' + TengShaderPartDefine.GetTokenName, Line, Col, Filename)
- else
- fValue := (p as TengShaderPartDefine).Value;
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- class function TengShaderPartProperty.GetTokenName: String;
- begin
- result := TOKEN_PROPERTY;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengShaderPartDefine//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartDefine.ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String;
- begin
- if (aParameters.Count <> 3) then
- raise EengInvalidParamterCount.Create(GetTokenName, Line, Col, GetFilename);
- result := inherited ParseTextIntern(aParseArgs, aParameters);
- if (fValueName <> '') then
- fValue := fValueName;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartDefine.MapData(const aFlags: TengMapDataFlags; const aTypes: array of CengShaderPart);
- begin
- if CheckType(self, aTypes) then
- CheckParentScope(self).MapShaderPart(Name, self);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- class function TengShaderPartDefine.GetTokenName: String;
- begin
- result := TOKEN_DEFINE;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengShaderPartCodeProperty////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartCodeProperty.GetText: String;
- begin
- result := PRECOMPILER_STATEMENT_BEGIN + GetTokenName + ' ''' + fType + ''' ''' + fName + '''' + PRECOMPILER_STATEMENT_END;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartCodeProperty.ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String;
- begin
- if (aParameters[0].Name <> GetTokenName) then
- raise EengInvalidToken.Create(ClassName, aParameters[0].Name, Line, Col, Filename);
- if (aParameters.Count <> 3) then
- raise EengInvalidParamterCount.Create(GetTokenName, Line, Col, Filename);
-
- result := '';
- fType := aParameters[1].Name;
- fName := aParameters[2].Name;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartCodeProperty.IsEquals(const aCodeProp: TengShaderPartCodeProperty): Boolean;
- begin
- result :=
- (ClassName = aCodeProp.ClassName) and
- (fName = aCodeProp.fName) and
- (fType = aCodeProp.fType);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartCodeProperty.MapData(const aFlags: TengMapDataFlags; const aTypes: array of CengShaderPart);
- begin
- if CheckType(self, aTypes) then
- CheckParentScope(self).MapShaderPart(fName, self);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartCodeProperty.GenCodeIntern(const aGenCodeArgs: TengGenCodeArgs);
- begin
- inherited GenCodeIntern(aGenCodeArgs);
- if not (gcfGenCodeProp in aGenCodeArgs.Flags) then begin
- aGenCodeArgs.AddCodeProperty(self);
- aGenCodeArgs.Code.AddToken(ttSingle);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengShaderPartVar/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartVar.GetText: String;
- begin
- result := PRECOMPILER_STATEMENT_BEGIN + GetTokenName + ' ''' + fType + ''' ''' + fName + '''';
- if (fDefault <> Unassigned) then
- result := result + ' ''' + fDefault + '''';
- result := result + PRECOMPILER_STATEMENT_END;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartVar.ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String;
- begin
- if (aParameters[0].Name <> GetTokenName) then
- raise EengInvalidToken.Create(ClassName, aParameters[0].Name, Line, Col, Filename);
- if (aParameters.Count < 3) or (aParameters.Count > 4) then
- raise EengInvalidParamterCount.Create(GetTokenName, Line, Col, Filename);
-
- result := '';
- fType := aParameters[1].Name;
- fName := aParameters[2].Name;
- if (aParameters.Count >= 4) then
- fDefault := aParameters[3].Name
- else
- fDefault := Unassigned;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartVar.IsEquals(const aCodeProp: TengShaderPartCodeProperty): Boolean;
- begin
- result := inherited IsEquals(aCodeProp);
- if result and ((aCodeProp as TengShaderPartVar).fDefault <> '') and (fDefault <> '') then
- result := ((aCodeProp as TengShaderPartVar).fDefault = fDefault);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartVar.GenCodeIntern(const aGenCodeArgs: TengGenCodeArgs);
- begin
- inherited GenCodeIntern(aGenCodeArgs);
- if (gcfGenCodeProp in aGenCodeArgs.Flags) then begin
- aGenCodeArgs.Code.AddText(Format('%'+IntToStr(aGenCodeArgs.MaxPropNameLen)+'s %s', [fType, fName]));
- if (fDefault <> '') then
- aGenCodeArgs.Code.AddText(' = ' + fDefault);
- aGenCodeArgs.Code.AddText(';');
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- class function TengShaderPartVar.GetTokenName: String;
- begin
- result := TOKEN_VAR;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengShaderPartVarying/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartVarying.GenCodeIntern(const aGenCodeArgs: TengGenCodeArgs);
- begin
- inherited GenCodeIntern(aGenCodeArgs);
- if (gcfGenCodeProp in aGenCodeArgs.Flags) then
- aGenCodeArgs.Code.AddText(Format('varying %'+IntToStr(aGenCodeArgs.MaxPropNameLen)+'s %s;', [fType, fName]));
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- class function TengShaderPartVarying.GetTokenName: String;
- begin
- result := TOKEN_VARYING;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengShaderPartUniform/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartUniform.GenCodeIntern(const aGenCodeArgs: TengGenCodeArgs);
- begin
- inherited GenCodeIntern(aGenCodeArgs);
- if (gcfGenCodeProp in aGenCodeArgs.Flags) then
- aGenCodeArgs.Code.AddText(Format('uniform %'+IntToStr(aGenCodeArgs.MaxPropNameLen)+'s %s;', [fType, fName]));
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- class function TengShaderPartUniform.GetTokenName: String;
- begin
- result := TOKEN_UNIFORM;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengShaderPartCall////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartCall.GetText: String;
- var
- i: Integer;
- begin
- result := PRECOMPILER_STATEMENT_BEGIN + GetTokenName + ' ' + fName;
- for i := 0 to fParameters.Count-1 do
- if (PtrInt(fParameters.Objects[i]) <> 0) then
- result := result + ' ''' + fParameters[i] + ''''
- else
- result := result + ' ' + fParameters[i];
- result := result + PRECOMPILER_STATEMENT_END;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartCall.ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String;
- var
- i: Integer;
- begin
- if (aParameters[0].Name <> GetTokenName) then
- raise EengInvalidToken.Create(ClassName, aParameters[0].Name, Line, Col, Filename);
- if (aParameters.Count < 2) then
- raise EengInvalidParamterCount.Create(GetTokenName, Line, Col, Filename);
-
- fParameters.Clear;
- result := '';
- fName := aParameters[1].Name;
- if not IsValidIdentifier(fName) then
- raise EengShaderPart.Create('invalid name: ' + fName, Line, Col, GetFilename);
- for i := 2 to aParameters.Count-1 do
- fParameters.AddObject(aParameters[i].Name, TObject(PtrInt(aParameters[i].Quoted)));
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartCall.GenCodeIntern(const aGenCodeArgs: TengGenCodeArgs);
- var
- p: TengShaderPartProc;
- begin
- aGenCodeArgs.Root.FindMappedPart(p, fName, FIND_OVERWRITTEN_FLAGS, TengShaderPartProc);
- if not Assigned(p) then
- CheckParentScope(self).FindMappedPart(p, fName, GEN_CODE_FIND_FLAGS, TengShaderPartProc);
-
- if not Assigned(p) then
- raise EengUnknownIdentifier.Create(fName, Line, Col, Filename);
- if not (p is TengShaderPartProc) then
- raise EengInvalidParamter.Create('Expected ' + TengShaderPartFunc.GetTokenName + ' or ' + TengShaderPartProc.GetTokenName, Line, Col, Filename);
- if ((p as TengShaderPartProc).fParameters.Count <> fParameters.Count) then
- raise EengInvalidParamterCount.Create(fName + ' expects ' + IntToStr((p as TengShaderPartProc).fParameters.Count) + ' parameter', Line, Col, Filename);
-
- aGenCodeArgs.PushProcParams(fParameters);
- aGenCodeArgs.PushFlags(aGenCodeArgs.Flags - [gcfGenProcedure, gcfGenProcInline] + [gcfGenProcCall]);
- try
- p.GenCodeIntern(aGenCodeArgs);
- finally
- aGenCodeArgs.PopProcParams;
- aGenCodeArgs.PopFlags;
- end;
- inherited GenCodeIntern(aGenCodeArgs);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TengShaderPartCall.Create(const aParent: TengShaderPart);
- begin
- inherited Create(aParent);
- fParameters := TStringList.Create;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TengShaderPartCall.Destroy;
- begin
- FreeAndNil(fParameters);
- inherited Destroy;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- class function TengShaderPartCall.GetTokenName: String;
- begin
- result := TOKEN_CALL;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengShaderPartProc////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartProc.GetHeaderText: String;
- var
- p: TengShaderPartProcParam;
- begin
- result := PRECOMPILER_STATEMENT_BEGIN + GetTokenName + ' ''' + fName + '''';
- for p in fParameters do
- result := result + ' ''' + p.Typ + ''' ''' + p.Name + '''';
- result := result + PRECOMPILER_STATEMENT_END;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartProc.GetText: String;
- begin
- result := GetHeaderText +
- inherited GetText +
- PRECOMPILER_STATEMENT_BEGIN + TOKEN_END + PRECOMPILER_STATEMENT_END;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartProc.ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String;
- type
- TParseArgsState = (pasType, pasName);
- var
- i: Integer;
- state: TParseArgsState;
- param: TengShaderPartProcParam;
- begin
- if (aParameters[0].Name <> GetTokenName) then
- raise EengInvalidToken.Create(ClassName, aParameters[0].Name, Line, Col, Filename);
- if (aParameters.Count < 2) then
- raise EengInvalidParamterCount.Create(GetTokenName, Line, Col, Filename);
-
- result := '';
- fName := aParameters[1].Name;
- state := pasType;
- fParameters.Clear;
- i := 2;
- while (i < aParameters.Count) do begin
- case state of
- pasType: begin
- if (aParameters[i].Name = TOKEN_INLINE) then begin
- fIsInline := true;
- end else begin
- param.Typ := aParameters[i].Name;
- state := pasName;
- end;
- end;
-
- pasName: begin
- if (aParameters[i].Name = TOKEN_INLINE) then begin
- raise EengInvalidParamter.Create('expected parameter name, found ' + TOKEN_INLINE, aParameters[i].Line, aParameters[i].Col, Filename);
- end else begin
- param.Name := aParameters[i].Name;
- fParameters.Add(param);
- state := pasType;
- end;
- end;
- end;
- inc(i);
- end;
- if (state <> pasType) then
- raise EengInvalidParamterCount.Create(GetTokenName, Line, Col, Filename);
-
- inherited ParseTextIntern(aParseArgs, aParameters);
- result := CheckEndToken(aParseArgs, self);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartProc.GenHeaderCode: String;
- var
- p: TengShaderPartProcParam;
- begin
- result := '';
- for p in fParameters do begin
- if (result <> '') then
- result := result + ', ';
- result := result + p.Typ + ' ' + p.Name;
- end;
- if (result = '') then
- result := 'void';
- result := 'void ' + fName + '(' + result + ')';
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartProc.GenInlineCode(const aGenCodeArgs: TengGenCodeArgs; const aAddToken: Boolean);
- var
- old, new: TStringList;
- p: TengShaderPartProcParam;
- rx: TRegExpr;
- s: String;
- begin
- aGenCodeArgs.PushCode;
- if aAddToken then
- aGenCodeArgs.Code.AddToken(ttBegin);
- try
- inherited GenCodeIntern(aGenCodeArgs);
-
- old := TStringList.Create;
- new := TStringList.Create;
- rx := TRegExpr.Create;
- try
- //prepare old parameter
- for p in fParameters do
- old.Add(p.Name);
-
- //prepare new parameter
- rx.Expression := '[^A-z0-9_]+';
- for s in aGenCodeArgs.ProcParams do
- if (rx.Exec(s)) then
- new.Add('(' + s + ')')
- else
- new.Add(s);
-
- //replace parameter
- aGenCodeArgs.Code.ReplaceIdents(old, new);
- finally
- FreeAndNil(rx);
- FreeAndNil(old);
- FreeAndNil(new);
- end;
- finally
- if aAddToken then
- aGenCodeArgs.Code.AddToken(ttEnd);
- aGenCodeArgs.PopCode;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartProc.GenCodeIntern(const aGenCodeArgs: TengGenCodeArgs);
- var
- s, params: String;
- begin
- // generate inline code
- if (aGenCodeArgs.Flags * [gcfGenProcCall, gcfGenProcedure] <> []) and
- ((gcfGenProcInline in aGenCodeArgs.Flags) or fIsInline) then
- begin
- GenInlineCode(aGenCodeArgs);
- if (ClassType = TengShaderPartProc) then
- aGenCodeArgs.Code.IgnoreNextSemicolon;
-
- // generate code
- end else if (gcfGenProcedure in aGenCodeArgs.Flags) then begin
- aGenCodeArgs.Code.AddLineEnd;
- aGenCodeArgs.Code.AddText(GenHeaderCode);
- aGenCodeArgs.Code.AddLineEnd;
- aGenCodeArgs.Code.AddText('{');
- aGenCodeArgs.Code.AddLineEnd;
- aGenCodeArgs.Code.AddToken(ttBegin);
- aGenCodeArgs.Code.AddCommandEnd();
- try
- inherited GenCodeIntern(aGenCodeArgs);
- finally
- aGenCodeArgs.Code.AddText('}');
- aGenCodeArgs.Code.AddToken(ttEnd);
- aGenCodeArgs.Code.AddCommandEnd();
- aGenCodeArgs.Code.AddLineEnd;
- end;
-
- // generate call
- end else if (gcfGenProcCall in aGenCodeArgs.Flags) then begin
- params := '';
- for s in aGenCodeArgs.ProcParams do begin
- if (params <> '') then
- params := params + ', ';
- params := params + s;
- end;
- aGenCodeArgs.Code.AddText(fName + '(' + params + ')');
- aGenCodeArgs.AddProcedure(self);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartProc.MapData(const aFlags: TengMapDataFlags; const aTypes: array of CengShaderPart);
- begin
- if CheckType(self, aTypes) then begin
- with CheckParentScope(self) do begin
- MapShaderPart(fName, self); // Procs are named shader parts
- MapChildScope(self); // and also Child Scopes
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TengShaderPartProc.Create(const aParent: TengShaderPart);
- begin
- inherited Create(aParent);
- fParameters := TengShaderPartProcParamList.Create(true);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TengShaderPartProc.Destroy;
- begin
- FreeAndNil(fParameters);
- inherited Destroy;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- class function TengShaderPartProc.GetTokenName: String;
- begin
- result := TOKEN_PROC;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- class procedure TengShaderPartProc.CheckToken(const aParseArgs: TengParseArgs; const aParent: TengShaderPart);
- begin
- if (aParent is TengShaderPartProc) or (aParent.ParentHasType(TengShaderPartProc)) then
- with aParseArgs do
- raise EengShaderPart.Create('token ' + GetTokenName + ' is not allowed in procedure or function', Line, Col, aParent.Filename);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengShaderPartMain////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartMain.GetHeaderText: String;
- begin
- result := PRECOMPILER_STATEMENT_BEGIN + GetTokenName + PRECOMPILER_STATEMENT_END;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartMain.ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String;
- var
- p: TengTokenParameter;
- begin
- if (aParameters[0].Name <> GetTokenName) then
- raise EengInvalidToken.Create(ClassName, aParameters[0].Name, Line, Col, Filename);
- if (aParameters.Count <> 1) then
- raise EengInvalidParamterCount.Create(GetTokenName, Line, Col, Filename);
-
- result := '';
- p.Name := 'main';
- p.Quoted := false;
- aParameters.Add(p);
- inherited ParseTextIntern(aParseArgs, aParameters);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartMain.GenHeaderCode: String;
- begin
- result := 'void main(void)';
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- class function TengShaderPartMain.GetTokenName: String;
- begin
- result := TOKEN_MAIN;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengShaderPartFunc////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartFunc.GetHeaderText: String;
- var
- p: TengShaderPartProcParam;
- begin
- result := PRECOMPILER_STATEMENT_BEGIN + GetTokenName + ' ''' + fReturnType + ''' ''' + fName + '''';
- for p in fParameters do
- result := result + ' ''' + p.Typ + ''' ''' + p.Name + '''';
- result := result + PRECOMPILER_STATEMENT_END;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartFunc.ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String;
- begin
- if (aParameters[0].Name <> GetTokenName) then
- raise EengInvalidToken.Create(ClassName, aParameters[0].Name, Line, Col, Filename);
- if (aParameters.Count < 3) then
- raise EengInvalidParamterCount.Create(GetTokenName, Line, Col, Filename);
-
- fReturnType := aParameters[1].Name;
- aParameters.Delete(1);
- result := inherited ParseTextIntern(aParseArgs, aParameters);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartFunc.GenInlineCode(const aGenCodeArgs: TengGenCodeArgs; const aAddToken: Boolean);
- var
- o: Integer;
- begin
- o := aGenCodeArgs.PushCurrentCommand.GetMinLineOffset;
- aGenCodeArgs.PushCode;
- aGenCodeArgs.Code.AddLineEnd;
- aGenCodeArgs.Code.AddToken(ttBegin, o);
- try
- inherited GenInlineCode(aGenCodeArgs, false);
- finally
- aGenCodeArgs.PopCurrentCommand(fReturnType, fName);
- aGenCodeArgs.Code.AddToken(ttEnd);
- aGenCodeArgs.PopCode;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartFunc.GenHeaderCode: String;
- var
- p: TengShaderPartProcParam;
- begin
- result := '';
- for p in fParameters do begin
- if (result <> '') then
- result := result + ', ';
- result := result + p.Typ + ' ' + p.Name;
- end;
- if (result = '') then
- result := 'void';
- result := fReturnType + ' ' + fName + '(' + result + ')';
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- class function TengShaderPartFunc.GetTokenName: String;
- begin
- result := TOKEN_FUNC;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- class procedure TengShaderPartFunc.CheckToken(const aParseArgs: TengParseArgs; const aParent: TengShaderPart);
- begin
- if (aParent is TengShaderPartFunc) or (aParent.ParentHasType(TengShaderPartFunc)) then
- with aParseArgs do
- raise EengShaderPart.Create('token ' + GetTokenName + ' is not allowed in function', Line, Col, aParent.Filename);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengShaderPartIf//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartIf.ParseExpression(const aParameters: TengTokenParameterList; aIndex: Integer): TengExpressionItem;
- type
- TExpectedParam = (exVariable, exValue, exGroupBegin, exGroupEnd, exUnaryOperation, exBinaryOperation);
- TExpectedParams = set of TExpectedParam;
- TExpressionItemStack = specialize TutlList<TengExpressionItem>;
-
- var
- param: TengTokenParameter;
-
- function NextParam: Boolean;
- begin
- inc(aIndex);
- result := (aIndex < aParameters.Count);
- if result then
- param := aParameters[aIndex];
- end;
-
- function IsUnaryOperation(const aParam: String; out aOperator: TengExpressionUnaryOperator): Boolean;
- begin
- result := true;
- for aOperator in TengExpressionUnaryOperator do
- if (aParam = EXPRESSION_UNARY_OPERATIONS[aOperator]) then
- exit;
- result := false;
- end;
-
- function IsBinaryOperation(const aParam: String; out aOperator: TengExpressionBinaryOperator): Boolean;
- begin
- result := true;
- for aOperator in TengExpressionBinaryOperator do
- if (aParam = EXPRESSION_BINARY_OPERATIONS[aOperator]) then
- exit;
- result := false;
- end;
-
- procedure MergeItems(const aStack: TExpressionItemStack; const aNew: TengExpressionItem);
- var
- itm: TengExpressionItem;
- begin
- if (aStack.Count > 0) then begin
- itm := aStack.Last;
- if (itm is TengExpressionBinaryOperation) then begin
- if (aNew is TengExpressionBinaryOperation) then begin
-
- //both are binary operators, new is weaker then existing
- if ((aNew as TengExpressionBinaryOperation).BinaryOp < (itm as TengExpressionBinaryOperation).BinaryOp) then begin
- aStack.PopLast;
- (aNew as TengExpressionBinaryOperation).First := itm;
- aStack.PushLast(aNew);
-
- //both are binary operators, new is stronger than existing
- end else begin
- if not Assigned((itm as TengExpressionBinaryOperation).Second) then
- raise EengExpression.Create('inconsistent state', param.Line, param.Col, Filename);
- (aNew as TengExpressionBinaryOperation).First := (itm as TengExpressionBinaryOperation).Second;
- (itm as TengExpressionBinaryOperation).Second := aNew;
- aStack.PushLast(aNew);
- end;
-
- //existing is binary operator, new is normal
- end else begin
- if Assigned((itm as TengExpressionBinaryOperation).Second) then
- raise EengExpression.Create('inconsistent state', param.Line, param.Col, Filename);
- (itm as TengExpressionBinaryOperation).Second := aNew;
- while (aStack.Count > 1) do
- aStack.PopLast; //remove all but first
- end;
- end else begin
-
- //existing is normal item, new is binary operation
- if (aNew is TengExpressionBinaryOperation) then begin
- aStack.PopLast;
- (aNew as TengExpressionBinaryOperation).First := itm;
- aStack.PushLast(aNew);
-
- //existing is unary operation, new is normal item or unary operation
- end else if (itm is TengExpressionUnaryOperation) then begin
- if Assigned((itm as TengExpressionUnaryOperation).Child) then
- raise EengExpression.Create('inconsistent state', param.Line, param.Col, Filename);
- (itm as TengExpressionUnaryOperation).Child := aNew;
- if not (aNew is TengExpressionUnaryOperation) then begin
- while (aStack.Count > 1) do
- aStack.PopLast; //remove all but first
- end else
- aStack.PushLast(aNew);
-
- //existing and new are both normal items
- end else begin
- raise EengExpression.Create('inconsistent state', param.Line, param.Col, Filename);
- end;
- end;
- end else
- aStack.PushLast(aNew);
- end;
-
- function BuildTree(const aDepth: Integer = 0): TengExpressionItem;
- var
- uOp: TengExpressionUnaryOperator;
- bOp: TengExpressionBinaryOperator;
- expected: TExpectedParams;
-
- stack: TExpressionItemStack;
- begin
- expected := [exVariable, exValue, exGroupBegin, exUnaryOperation];
- result := nil;
- stack := TExpressionItemStack.Create(false);
- try try
- repeat
- //GroupBegin
- if (param.Name = TOKEN_OP_GROUP_BEGIN) then begin
- if not (exGroupBegin in expected) then
- raise EengExpression.Create('unexpected ''' + TOKEN_OP_GROUP_BEGIN + '''', param.Line, param.Col, Filename);
- if not NextParam then
- raise EengExpression.Create('unexpected end', Line, Col, Filename);
- MergeItems(stack, TengExpressionGroup.Create(BuildTree(aDepth + 1), param.Line, param.Col, Filename));
- if (param.Name <> TOKEN_OP_GROUP_END) then
- raise EengExpression.Create('missing ''' + TOKEN_OP_GROUP_END + '''', param.Line, param.Col, Filename);
- expected := [exBinaryOperation, exGroupEnd];
-
- //GroupEnd
- end else if (param.Name = TOKEN_OP_GROUP_END) then begin
- if not (exGroupEnd in expected) or (aDepth = 0) then
- raise EengExpression.Create('unexpected ''' + TOKEN_OP_GROUP_END + '''', param.Line, param.Col, Filename);
- exit;
-
- //UnaryOperation
- end else if IsUnaryOperation(param.Name, uOp) then begin
- if not (exUnaryOperation in expected) then
- raise EengExpression.Create('unexpected operator: ' + param.Name, param.Line, param.Col, Filename);
- MergeItems(stack, TengExpressionUnaryOperation.Create(uOp, param.Line, param.Col, Filename));
- expected := [exVariable];
- if (uOp <> opDefined) then
- expected := expected + [exValue, exGroupBegin, exUnaryOperation]
-
- //BinaryOperation
- end else if IsBinaryOperation(param.Name, bOp) then begin
- if not (exBinaryOperation in expected) then
- raise EengExpression.Create('unexpected operator: ' + param.Name, param.Line, param.Col, Filename);
- MergeItems(stack, TengExpressionBinaryOperation.Create(bOp, param.Line, param.Col, Filename));
- expected := [exVariable, exValue, exGroupBegin, exUnaryOperation];
-
- //Value
- end else if param.Quoted and IsValidIdentifier(param.Name) then begin
- if not (exValue in expected) then
- raise EengExpression.Create('unexpected value: ' + param.Name, param.Line, param.Col, Filename);
- MergeItems(stack, TengExpressionValue.Create(param.Name, param.Line, param.Col, Filename));
- expected := [exGroupEnd, exBinaryOperation];
-
- //Variable
- end else if IsValidIdentifier(param.Name) then begin
- if not (exVariable in expected) then
- raise EengExpression.Create('unexpected variable: ' + param.Name, param.Line, param.Col, Filename);
- MergeItems(stack, TengExpressionVariable.Create(param.Name, param.Line, param.Col, Filename));
- expected := [exGroupEnd, exBinaryOperation];
-
- //Unknown
- end else
- raise EengExpression.Create('invalid parameter: ' + param.Name, param.Line, param.Col, Filename);
- until not NextParam;
-
- except
- if (stack.Count > 0) then begin
- stack[0].Free;
- stack[0] := nil;
- end;
- raise;
- end;
- finally
- if (stack.Count > 0) then
- result := stack[0];
- FreeAndNil(stack);
- end;
- end;
-
- begin
- if (aIndex >= aParameters.Count) then
- raise EengExpression.Create('invalid parameter count in expression', Line, Col, Filename);
- dec(aIndex);
- NextParam;
- result := BuildTree;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartIf.GetCount: Integer;
- begin
- result := 1;
- if Assigned(fElsePart) then
- inc(result);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartIf.GetChild(const aIndex: Integer): TengShaderPart;
- begin
- if (aIndex >= 0) and (aIndex < Count) then begin
- case aIndex of
- 0: result := fIfPart;
- 1: result := fElsePart;
- end;
- end else
- raise EOutOfRange.Create(aIndex, 0, Count-1);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartIf.GetText: String;
- begin
- result := PRECOMPILER_STATEMENT_BEGIN + GetTokenName + ' ' + fExpression.GetText + PRECOMPILER_STATEMENT_END + fIfPart.Text;
- if Assigned(fElsePart) then
- result := result + fElsePart.Text;
- result := result + PRECOMPILER_STATEMENT_BEGIN + TOKEN_END + PRECOMPILER_STATEMENT_END;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartIf.ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String;
- begin
- if (aParameters[0].Name <> GetTokenName) then
- raise EengInvalidToken.Create(ClassName, aParameters[0].Name, Line, Col, Filename);
- if (aParameters.Count < 2) then
- raise EengInvalidParamterCount.Create(GetTokenName, Line, Col, Filename);
-
- fExpression := ParseExpression(aParameters, 1);
-
- fIfPart := TengShaderPartContainer.Create(self);
- result := fIfPart.ParseText(aParseArgs);
- result := HandleToken(result, aParseArgs);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartIf.HandleToken(const aToken: String; const aParseArgs: TengParseArgs): String;
- begin
- result := aToken;
- if (result = TengShaderPartElse.GetTokenName) then begin
- fElsePart := TengShaderPartElse.Create(self);
- result := fElsePart.ParseText(aParseArgs);
- end else if (result = TengShaderPartElIf.GetTokenName) then begin
- fElsePart := TengShaderPartElIf.Create(self);
- result := fElsePart.ParseText(aParseArgs);
- end;
- result := HandleEndToken(result, aParseArgs);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartIf.HandleEndToken(const aToken: String; const aParseArgs: TengParseArgs): String;
- begin
- result := CheckEndToken(aParseArgs, self);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartIf.MapData(const aFlags: TengMapDataFlags; const aTypes: array of CengShaderPart);
- begin
- inherited MapData(aFlags, aTypes);
-
- //map all
- if (mdfIfAll in aFlags) then begin
- if Assigned(fIfPart) then
- fIfPart.MapData(aFlags, aTypes);
- if Assigned(fElsePart) then
- fElsePart.MapData(aFlags, aTypes);
-
- // evaluete and map suitable
- end else if (mdfIfEvaluate in aFlags) then begin
- if fExpression.GetValue(CheckParentScope(self), nil) then begin
- if Assigned(fIfPart) then
- fIfPart.MapData(aFlags, aTypes);
- end else begin
- if Assigned(fElsePart) then
- fElsePart.MapData(aFlags, aTypes);
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartIf.GenCodeIntern(const aGenCodeArgs: TengGenCodeArgs);
- var
- p: TengShaderPart;
- b: Boolean;
- begin
- inherited GenCodeIntern(aGenCodeArgs);
-
- b := fExpression.GetValue(CheckParentScope(self), aGenCodeArgs);
- if b then
- p := fIfPart
- else
- p := fElsePart;
-
- aGenCodeArgs.Code.AddToken(ttBegin); // IF ...
- try
- if Assigned(p) then
- p.GenCodeIntern(aGenCodeArgs);
- finally
- aGenCodeArgs.Code.AddToken(ttEnd); // ... END
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TengShaderPartIf.Destroy;
- begin
- FreeAndNil(fExpression);
- FreeAndNil(fIfPart);
- FreeAndNil(fElsePart);
- inherited Destroy;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- class function TengShaderPartIf.GetTokenName: String;
- begin
- result := TOKEN_IF;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengShaderPartElIf////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartElIf.GetText: String;
- begin
- result := PRECOMPILER_STATEMENT_BEGIN + GetTokenName + PRECOMPILER_STATEMENT_END + fIfPart.Text;
- if Assigned(fElsePart) then
- result := result + fElsePart.Text;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartElIf.HandleEndToken(const aToken: String; const aParseArgs: TengParseArgs): String;
- begin
- result := aToken;
- if (result <> TOKEN_END) then
- raise EengInvalidToken.Create(ClassName, result, aParseArgs.Line, aParseArgs.Col, Filename);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- class function TengShaderPartElIf.GetTokenName: String;
- begin
- result := TOKEN_ELIF;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengShaderPartElse////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartElse.GetText: String;
- begin
- result := PRECOMPILER_STATEMENT_BEGIN + GetTokenName + PRECOMPILER_STATEMENT_END + inherited GetText;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- class function TengShaderPartElse.GetTokenName: String;
- begin
- result := TOKEN_ELSE;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengShaderPartEcho////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartEcho.GetText: String;
- begin
- result := PRECOMPILER_STATEMENT_BEGIN + GetTokenName + ' ' + fName + PRECOMPILER_STATEMENT_END;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartEcho.ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String;
- begin
- if (aParameters[0].Name <> GetTokenName) then
- raise EengInvalidToken.Create(ClassName, aParameters[0].Name, Line, Col, Filename);
- if (aParameters.Count <> 2) then
- raise EengInvalidParamterCount.Create(GetTokenName, Line, Col, Filename);
- result := '';
- fName := aParameters[1].Name;
- if not IsValidIdentifier(fName) then
- raise EengShaderPart.Create('invalid name: ' + fName, Line, Col, GetFilename);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartEcho.GenCodeIntern(const aGenCodeArgs: TengGenCodeArgs);
- var
- p: TengShaderPart;
- begin
- CheckParentScope(self).FindMappedPart(p, fName, GEN_CODE_FIND_FLAGS);
-
- if not Assigned(p) then
- raise EengUnknownIdentifier.Create(fName, Line, Col, Filename);
- if not (p is TengShaderPartKeyValuePair) then
- raise EengInvalidParamter.Create('Expected ' + TengShaderPartDefine.GetTokenName + ' or ' + TengShaderPartProperty.GetTokenName, Line, Col, Filename);
-
- aGenCodeArgs.Code.AddText((p as TengShaderPartKeyValuePair).Value);
- inherited GenCodeIntern(aGenCodeArgs);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- class function TengShaderPartEcho.GetTokenName: String;
- begin
- result := TOKEN_ECHO;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengShaderPartMessage/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartMessage.GetText: String;
- begin
- result := PRECOMPILER_STATEMENT_BEGIN + GetTokenName + ' ''' + fMessage + '''' + PRECOMPILER_STATEMENT_END;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartMessage.ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String;
- begin
- if (aParameters[0].Name <> GetTokenName) then
- raise EengInvalidToken.Create(ClassName, aParameters[0].Name, Line, Col, Filename);
- if (aParameters.Count <> 2) then
- raise EengInvalidParamterCount.Create(GetTokenName, Line, Col, Filename);
- result := '';
- fMessage := aParameters[1].Name;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- class function TengShaderPartMessage.GetTokenName: String;
- begin
- result := TOKEN_MESSAGE;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengShaderPartWarning/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- class function TengShaderPartWarning.GetTokenName: String;
- begin
- result := TOKEN_WARNING;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengShaderPartError///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartError.GenCodeIntern(const aGenCodeArgs: TengGenCodeArgs);
- begin
- inherited GenCodeIntern(aGenCodeArgs);
- raise EengShaderPart.Create(fMessage, Line, Col, Filename);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- class function TengShaderPartError.GetTokenName: String;
- begin
- result := TOKEN_ERROR;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengShaderPartCode////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartCode.GetText: String;
- begin
- result := fCode;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartCode.ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String;
-
- function CheckToken: Boolean;
- begin
- with aParseArgs do
- result :=
- (CurrentChar = PRECOMPILER_STATEMENT_BEGIN) and
- (Col < LineLength) and
- (CurrentLine[Col + 1] in [TOKEN_IDENTIFIER, COMMENT_IDENTIFIER]);
- end;
-
- function FindToken: String;
- var
- c: Integer;
- begin
- with aParseArgs do
- if (CurrentChar = TOKEN_COMMAND_END) then
- result := TOKEN_COMMAND_END
- else if (Col < LineLength) then begin
- c := Col + 1;
- case CurrentLine[c] of
- TOKEN_IDENTIFIER: begin
- result := TOKEN_IDENTIFIER;
- inc(c);
- while (c <= LineLength) and (CurrentLine[c] in VALID_TOKEN_CHARS) do begin
- result := result + CurrentLine[c];
- inc(c);
- end;
- result := Trim(result);
- if (result = TOKEN_IDENTIFIER) then
- raise EengShaderPart.Create('empty token', Line, Col, Filename);
- end;
-
- //skip comment
- COMMENT_IDENTIFIER:
- result := COMMENT_IDENTIFIER;
- end;
- end else begin
- result := '';
- aParseArgs.IncCol;
- end;
- end;
-
- begin
- fCode := '';
- while not aParseArgs.EndOfLine do begin
- if CheckToken then begin
- result := FindToken;
- if (result <> '') then
- exit;
- end else if (aParseArgs.CurrentChar in COMMAND_END_TOKENS) then begin
- result := aParseArgs.CurrentChar;
- exit;
- end else begin
- fCode := fCode + aParseArgs.CurrentChar;
- aParseArgs.IncCol;
- end;
- end;
- result := TOKEN_LINE_BREAK;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartCode.GenCodeIntern(const aGenCodeArgs: TengGenCodeArgs);
- begin
- inherited GenCodeIntern(aGenCodeArgs);
- aGenCodeArgs.Code.AddText(fCode);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengShaderPartLineBreak///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartLineBreak.GetText: String;
- begin
- result := GetTokenName;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartLineBreak.ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String;
- begin
- if not aParseArgs.EndOfLine then
- raise EengShaderPart.Create('TengShaderPartLineBreak but not end of line', aParseArgs.Line, aParseArgs.Col, Filename);
- aParseArgs.IncLine;
- result := '';
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartLineBreak.GenCodeIntern(const aGenCodeArgs: TengGenCodeArgs);
- begin
- inherited GenCodeIntern(aGenCodeArgs);
- aGenCodeArgs.Code.AddLineEnd;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- class function TengShaderPartLineBreak.GetTokenName: String;
- begin
- result := TOKEN_LINE_BREAK;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengShaderPartCommandEnd//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartCommandEnd.GetText: String;
- begin
- result := fToken;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderPartCommandEnd.ParseTextIntern(const aParseArgs: TengParseArgs; const aParameters: TengTokenParameterList): String;
- begin
- result := '';
- fToken := aParseArgs.CurrentChar;
- aParseArgs.IncCol;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderPartCommandEnd.GenCodeIntern(const aGenCodeArgs: TengGenCodeArgs);
- begin
- inherited GenCodeIntern(aGenCodeArgs);
- aGenCodeArgs.Code.AddCommandEnd(fToken);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- class function TengShaderPartCommandEnd.CheckToken(const aToken: String): Boolean;
- var
- s: String;
- begin
- result := true;
- for s in COMMAND_END_TOKENS do
- if (s = aToken) then
- exit;
- result := false;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengShaderCode////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderCode.GetMeta(const aIndex: Integer): IengMetaData;
- begin
- result := fMetaList[aIndex];
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengShaderCode.GetMetaCount: Integer;
- begin
- result := fMetaList.Count;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TengShaderCode.Create;
- begin
- inherited Create;
- fMetaList := TMetaList.Create;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TengShaderCode.Destroy;
- begin
- FreeAndNil(fMetaList);
- inherited Destroy;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengShaderCodeIntern//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengShaderCodeIntern.AddMeta(const aMeta: IengMetaData);
- begin
- fMetaList.Add(aMeta);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengParseArgs/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengParseArgs.SetCol(const aValue: Integer);
- begin
- fCol := aValue;
- if not EndOfLine then
- fCurrentChar := fCurrentLine[fCol]
- else
- fCurrentChar := #0;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengParseArgs.SetLine(const aValue: Integer);
- begin
- fLine := aValue;
- if not EndOfFile then begin
- fCurrentLine := fCode[fLine];
- fLineLength := Length(fCurrentLine);
- end else begin
- fCurrentLine := '';
- fLineLength := -1;
- end;
- Col := 1;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengParseArgs.GetEndOfFile: Boolean;
- begin
- result := (fLine >= fLineCount);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengParseArgs.GetEndOfLine: Boolean;
- begin
- result := (fCol > fLineLength);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengParseArgs.GetCode: TStrings;
- begin
- result := fCode;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengParseArgs.IncCol;
- begin
- Col := Col + 1;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengParseArgs.IncLine;
- begin
- Line := Line + 1;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengParseArgs.ParseParameters(const aParameters: TengTokenParameterList): Boolean;
- type
- TCharType = (ctUnknown, ctValidTokenChar, ctInvalidTokenChar, ctWhiteSpace);
- var
- s: String;
- charType: TCharType;
- pLine, pCol: Integer;
- isComment: Boolean;
-
- procedure AddPart(const aTrimAndCheck: Boolean = true);
- var
- len: Integer;
- p: TengTokenParameter;
- begin
- if aTrimAndCheck then
- s := Trim(s);
- if not aTrimAndCheck or (s <> '')then begin
- len := Length(s);
- if aTrimAndCheck and ((s[1] = PRECOMPILER_QUOTE_CHAR) or (s[len] = PRECOMPILER_QUOTE_CHAR)) then begin
- if not (s[1] = PRECOMPILER_QUOTE_CHAR) then
- raise EengShaderPart.Create('missing leading quote char', Line, Col, fOwner.Filename);
- if not (s[len] = PRECOMPILER_QUOTE_CHAR) then
- raise EengShaderPart.Create('missing trailing quote char', Line, Col, fOwner.Filename);
- delete(s, len, 1);
- delete(s, 1, 1);
- p.Quoted := true;
- end else
- p.Quoted := false;
- p.Name := s;
- p.Line := pLine;
- p.Col := pCol;
- aParameters.Add(p);
- end;
- s := '';
- pLine := Line;
- pCol := Col;
- charType := ctUnknown;
- end;
-
- var
- quote, inToken, commentTokenAdded: Boolean;
- lOld, cOld: Integer;
- begin
- result := false;
- aParameters.Clear;
- if (CurrentChar <> PRECOMPILER_STATEMENT_BEGIN) or
- (Col + 1 > LineLength) or
- ( (CurrentLine[Col + 1] <> TOKEN_IDENTIFIER) and
- (CurrentLine[Col + 1] <> COMMENT_IDENTIFIER)) then
- exit;
-
- result := true;
- quote := false;
- inToken := false;
- isComment := CurrentLine[Col + 1] = COMMENT_IDENTIFIER;
- commentTokenAdded := false;
- s := '';
- charType := ctUnknown;
- lOld := Line;
- cOld := Col;
- AddPart; //initialize
-
- while not EndOfFile do begin
- while not EndOfLine do begin
- case CurrentChar of
- PRECOMPILER_STATEMENT_BEGIN: begin
- if quote then
- s := s + PRECOMPILER_STATEMENT_BEGIN
- else if not inToken then
- inToken := true
- else
- EengShaderPart.Create('invalid char in token');
- end;
-
- PRECOMPILER_STATEMENT_END: begin
- if not quote then begin
- AddPart(not isComment);
- IncCol;
- if (aParameters.Count <= 0) or (aParameters[0].Name = TOKEN_IDENTIFIER) then
- raise EengEmptyToken.Create(lOld, cOld, fOwner.Filename);
- exit;
- end else
- s := s + CurrentChar;
- end;
-
- PRECOMPILER_QUOTE_CHAR: begin
- if not quote and not isComment then
- AddPart;
- s := s + PRECOMPILER_QUOTE_CHAR;
- quote := not quote;
- if not quote and not isComment then
- AddPart;
- end;
-
- COMMENT_IDENTIFIER: begin
- s := s + COMMENT_IDENTIFIER;
- if isComment and not commentTokenAdded then begin
- commentTokenAdded := true;
- AddPart(false);
- end;
- end;
- else
- if not quote and not isComment then begin
- if (CurrentChar in TOKEN_SPLIT_CHARS) then begin
- AddPart;
- end else if (CurrentChar in VALID_TOKEN_CHARS) then begin
- if (charType <> ctValidTokenChar) then
- AddPart;
- charType := ctValidTokenChar;
- end else begin
- if (charType <> ctInvalidTokenChar) then
- AddPart;
- charType := ctInvalidTokenChar;
- end;
- end;
- s := s + CurrentChar;
- end;
- IncCol;
- end;
- s := s + sLineBreak;
- IncLine;
- end;
- raise EengShaderPart.Create('incomplete token', lOld, cOld, fOwner.Filename);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengParseArgs.LoadCode(const aStream: TStream);
- begin
- fCode.LoadFromStream(aStream);
- fLineCount := fCode.Count;
- Line := 0;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TengParseArgs.Create(const aOwner: TengShaderFile);
- begin
- inherited Create;
- fOwner := aOwner;
- fCode := TStringList.Create;
- fLineCount := fCode.Count;
- Line := 0;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TengParseArgs.Destroy;
- begin
- FreeAndNil(fCode);
- inherited Destroy;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengGenCodeArgs.TCodeItem/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengGenCodeArgs.TCodeItem.GetText: String;
- begin
- result := '';
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengGenCodeArgs.TCodeItem.IsEmpty: Boolean;
- begin
- result := (Trim(GetText) = '');
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengGenCodeArgs.TCodeItemStart////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengGenCodeArgs.TCodeItemStart.GetText: String;
- begin
- result := '';
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengGenCodeArgs.TCodeItemText/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengGenCodeArgs.TCodeItemText.GetText: String;
- begin
- result := Text;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TengGenCodeArgs.TCodeItemText.Create(const aText: String);
- begin
- inherited Create;
- Text := aText;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TCodeItemLineBreak.TCodeItemLineBreak/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengGenCodeArgs.TCodeItemLineBreak.GetText: String;
- begin
- result := sLineBreak;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengGenCodeArgs.TCodeItemCommandEnd///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengGenCodeArgs.TCodeItemCommandEnd.GetText: String;
- begin
- result := Token;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TengGenCodeArgs.TCodeItemCommandEnd.Create(const aToken: String);
- begin
- inherited Create;
- Token := aToken;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengGenCodeArgs.TCodeItemToken////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TengGenCodeArgs.TCodeItemToken.Create(const aTokenType: TTokenType; const aLevel: Integer);
- begin
- inherited Create;
- TokenType := aTokenType;
- Level := aLevel;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengGenCodeArgs.TCodeStackItem////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengGenCodeArgs.TCodeStackItem.GetEmpty: Boolean;
- begin
- result := (fItems.Count = 0) or
- ((fItems.Count = 1) and (fItems[0] is TCodeItemStart));
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- {$IFDEF DEBUG}
- function TengGenCodeArgs.TCodeStackItem.GetDebugText: String;
- var
- ci: TCodeItem;
- begin
- result := '';
- for ci in fItems do
- if (ci is TCodeItemToken) then with (ci as TCodeItemToken) do begin
- case TokenType of
- ttBegin: result := result + '$B';
- ttEnd: result := result + '$E';
- ttSingle: result := result + '$S';
- end;
- if (Level >= 0) then
- result := result + IntToStr(Level);
- end else if (ci is TCodeItemCommandEnd) then with (ci as TCodeItemCommandEnd) do begin
- result := result + '$C("' + ci.GetText + '")';
- end else
- result := result + ci.GetText;
- end;
- {$ENDIF}
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengGenCodeArgs.TCodeStackItem.GetText: String;
- type
- TGenFlag = (
- gfToken, // current line has a token in it
- gfTokenSingle, // current line has a single token in it
- gfPrevEmpty, // previouse line was empty
- gfAddToPrevLine, // trim left current line and add to prev line if not empty
- gfAddNextLine // trim left next line and add to current line if not empty
- );
- TGenFlags = set of TGenFlag;
- var
- i: Integer;
- line: String;
- sl: TStringList;
- f: TGenFlags;
-
- function GetStrOffset(const aStr: String): Integer;
- var
- len: Integer;
- begin
- result := 0;
- len := Length(aStr);
- while (result < len) and (aStr[result+1] in WHITESPACES) do
- inc(result);
- end;
-
- function GetOffset(const aItem: TCodeItemToken): Integer;
- begin
- result := aItem.Level;
- if (result < 0) then
- result := GetStrOffset(line);
- end;
-
- function GetMinOffset(aStartIndex: Integer): Integer;
- begin
- if (Trim(line) <> '') then
- result := GetStrOffset(line)
- else
- result := High(Integer);
- while (aStartIndex < sl.Count) do begin
- if (Trim(sl[aStartIndex]) <> '') then
- result := Min(result, GetStrOffset(sl[aStartIndex]));
- inc(aStartIndex);
- end;
- if (result >= High(Integer)) then
- result := -1;
- end;
-
- function TrimLeftLen(const aStr: String; aLen: Integer): String;
- var
- i, len: Integer;
- begin
- i := 1;
- len := Length(aStr);
- while (i <= len) and (aStr[i] in WHITESPACES) and (aLen > 0) do begin
- inc(i);
- dec(aLen);
- end;
- result := Copy(aStr, i, len - i + 1);
- end;
-
- function PrepareStr(const aStr: String; const aOffset: Integer): String;
- begin
- if (aOffset < 0) then
- result := StringOfChar(' ', -aOffset) + aStr
- else
- result := TrimLeftLen(aStr, aOffset);
- end;
-
- procedure IndentBlock(aStartIndex: Integer; const aOffset: Integer);
- var
- o: Integer;
- begin
- o := GetMinOffset(aStartIndex);
- if (o < 0) then
- exit;
- o := o - aOffset;
- if (o = 0) then
- exit;
- while (aStartIndex < sl.Count) do begin
- sl[aStartIndex] := PrepareStr(sl[aStartIndex], o);
- inc(aStartIndex);
- end;
- line := PrepareStr(line, o);
- end;
-
- procedure ProgressBlock(const aOffset: Integer);
- var
- item: TCodeItem;
- s: String;
- lineIndex: Integer;
- begin
- lineIndex := sl.Count; //start at next line
- while (i < fItems.Count) do begin
- item := fItems[i];
- inc(i);
-
- // LineBreak
- if (item is TCodeItemLineBreak) then begin
- if (Trim(line) = '') then begin
- if (f * [gfToken, gfPrevEmpty] = []) then begin
- sl.Add(line);
- Include(f, gfPrevEmpty);
- end;
- if not (gfTokenSingle in f) then
- Exclude(f, gfAddToPrevLine);
- end else begin
- if not (gfAddToPrevLine in f) then begin
- sl.Add(line);
- Exclude(f, gfPrevEmpty);
- end else if (sl.Count > 0) then
- sl[sl.Count-1] := sl[sl.Count-1] + TrimLeft(line)
- else
- sl.Add(line);
- Exclude(f, gfAddToPrevLine);
- end;
- Exclude(f, gfToken);
- Exclude(f, gfTokenSingle);
- if (gfAddNextLine in f) then
- f := f + [gfAddToPrevLine] - [gfAddNextLine];
- line := '';
-
- // Token
- end else if (item is TCodeItemToken) then with (item as TCodeItemToken) do begin
- Include(f, gfToken);
- case TokenType of
- ttBegin: begin
- if (Trim(line) <> '') then
- Include(f, gfAddNextLine);
- Include(f, gfPrevEmpty);
- ProgressBlock(GetOffset(item as TCodeItemToken));
- end;
-
- ttEnd: begin
- if (Trim(line) = '') then
- Include(f, gfAddToPrevLine);
- IndentBlock(lineIndex, aOffset);
- exit;
- end;
-
- ttSingle: begin
- Include(f, gfTokenSingle);
- end;
- end;
-
- // other
- end else begin
- s := item.GetText;;
- if (gfAddNextLine in f) and (Trim(s) <> '') then
- Exclude(f, gfAddNextLine);
- line := line + s;
- end;
- end;
- end;
-
- procedure TrimList;
- begin
- while (sl.Count > 0) and (Trim(sl[0]) = '') do
- sl.Delete(0);
- while (sl.Count > 0) and (Trim(sl[sl.Count-1]) = '') do
- sl.Delete(sl.Count-1);
- end;
-
- begin
- sl := TStringList.Create;
- try
- {$IFDEF DEBUG}
- sl.Text := GetDebugText;
- sl.SaveToFile('dbg');
- sl.Clear;
- {$ENDIF}
-
- i := 0;
- line := '';
- f := [gfPrevEmpty];
- ProgressBlock(0);
- TrimList;
- result := sl.Text;
- finally
- FreeAndNil(sl);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengGenCodeArgs.TCodeStackItem.SplitCurrentCommand(const aItem: TCodeStackItem);
- var
- HasCode: Boolean;
- ci: TCodeItem;
-
- function IsEndToken(const ci: TCodeItem): Boolean;
- begin
- result := (ci is TCodeItemToken) and ((ci as TCodeItemToken).TokenType = ttEnd)
- end;
-
- begin
- fItems.OwnsObjects := false;
- aItem.fItems.OwnsObjects := false;
- try
- //move all items before TCodeItemCommandEnd to aItem
- while (fItems.Count > 1) and not (fItems[fItems.Count-1] is TCodeItemCommandEnd) do begin
- ci := fItems.PopLast;
- if (trim(ci.GetText) <> '') then
- HasCode := true;
- if IsEndToken(ci) then
- HasCode := false;
- aItem.fItems.Insert(1, ci);
- end;
-
- // if ther is no code between last CommandEnd and Last End-Token, move back to last end Token
- if not HasCode then begin
- while not IsEndToken(aItem.fItems[1]) do begin
- fItems.PushLast(aItem.fItems[1]);
- aItem.fItems.Delete(1);
- end;
- fItems.PushLast(aItem.fItems[1]);
- aItem.fItems.Delete(1);
- end;
- finally
- aItem.fItems.OwnsObjects := true;
- fItems.OwnsObjects := true;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengGenCodeArgs.TCodeStackItem.Merge(const aItem: TCodeStackItem; aIndex: Integer): Integer;
- begin
- if (aIndex <= 0) then
- aIndex := 1; // do not go below start item
- result := aIndex + aItem.fItems.Count - 1;
- aItem.fItems.OwnsObjects := false;
- try
- while (aItem.fItems.Count > 1) do begin
- fItems.Insert(aIndex, aItem.fItems[aItem.fItems.Count-1]);
- aItem.fItems.Delete(aItem.fItems.Count-1);
- end;
- finally
- aItem.fItems.OwnsObjects := true;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengGenCodeArgs.TCodeStackItem.AddText(const aText: String);
- begin
- fItems.Add(TCodeItemText.Create(aText));
- if (Trim(aText) <> '') then
- Exclude(fFlags, cfIgnoreNextSemicolon);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengGenCodeArgs.TCodeStackItem.AddCommandEnd(const aToken: String);
- begin
- if (cfIgnoreNextSemicolon in fFlags) then begin
- if (aToken <> '') then
- Exclude(fFlags, cfIgnoreNextSemicolon);
- if (aToken = ';') then
- exit;
- end;
- fItems.Add(TCodeItemCommandEnd.Create(aToken));
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengGenCodeArgs.TCodeStackItem.AddToken(const aTokenType: TTokenType; const aLevel: Integer);
- begin
- fItems.Add(TCodeItemToken.Create(aTokenType, aLevel));
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengGenCodeArgs.TCodeStackItem.AddLineEnd;
- begin
- fItems.Add(TCodeItemLineBreak.Create);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengGenCodeArgs.TCodeStackItem.GetMinLineOffset: Integer;
-
- procedure CalcOffset(const aLine: String);
- var i, len: Integer;
- begin
- if (Trim(aLine) = '') then
- exit;
- len := Length(aLine);
- i := 1;
- while (i <= len) and (aLine[i] in WHITESPACES) do
- inc(i);
- if (i < result) then
- result := i-1;
- end;
-
- var
- item: TCodeItem;
- line: String;
- begin
- result := High(Integer);
- line := '';
- for item in fItems do begin
- if (item is TCodeItemLineBreak) then begin
- CalcOffset(line);
- line := '';
- end else
- line := line + item.GetText;
- end;
- CalcOffset(line);
- if (result = High(Integer)) then
- result := -1;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengGenCodeArgs.TCodeStackItem.IgnoreNextSemicolon;
- begin
- Include(fFlags, cfIgnoreNextSemicolon);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengGenCodeArgs.TCodeStackItem.ReplaceIdents(const aOld, aNew: TStrings);
- var
- rx: TRegExpr;
- i: Integer;
- itm: TCodeItem;
- begin
- if (aOld.Count <> aNew.Count) then
- raise EengInternal.Create('old and new idents must have the same size');
- rx := TRegExpr.Create;
- try
- for i := 0 to aOld.Count-1 do begin
- rx.Expression := '([^A-z0-9_]+|^)' + aOld[i] + '([^A-z0-9_]+|$)';
- for itm in fItems do
- if (itm is TCodeItemText) then
- with (itm as TCodeItemText) do
- Text := rx.Replace(Text, '$1' + aNew[i] + '$2', true);
- end;
- finally
- FreeAndNil(rx);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengGenCodeArgs.TCodeStackItem.ReplaceReturns(const aItem: TCodeStackItem; const aRetType, aFuncName: String; const aCntr: Integer);
- var
- s: String;
- i, j, retCount, first, firstOffset: Integer;
- item: TCodeItem;
- rx: TRegExpr;
- begin
- rx := TRegExpr.Create;
- try
- rx.Expression := '([^A-z0-9_]+|^)return([^A-z0-9_]+|$)';
-
- //find number of "return" in code and first item with not only whitespaces
- retCount := 0;
- first := 0;
- for i := 0 to fItems.Count-1 do begin
- item := fItems[i];
- s := item.GetText;
- if (item is TCodeItemText) and (Trim(s) <> '') and (first = 0) then begin
- first := i;
- firstOffset := Length(s) - Length(TrimLeft(s));
- end;
- if (rx.Exec(s)) then
- inc(retCount);
- end;
-
- //more than one return
- if (retCount > 1) then begin
- //TrimEnd;
- s := aFuncName + Format('_ret%.3d', [aCntr]);
- fItems.Insert(first, TCodeItemText.Create(StringOfChar(' ', firstOffset) + aRetType + ' ' + s));
- fItems.Insert(first + 1, TCodeItemCommandEnd.Create(';'));
- fItems.Insert(first + 2, TCodeItemLineBreak.Create);
-
- for item in fItems do
- if (item is TCodeItemText) then
- with (item as TCodeItemText) do
- Text := rx.Replace(Text, '$1' + s + ' =$2', true);
-
- Merge(aItem, fItems.Count);
- AddText(s);
-
- // only one return
- end else begin
- i := fItems.Count-1;
- while (i > 0) do begin
- item := fItems[i];
- if (item is TCodeItemText) then
- with (item as TCodeItemText) do begin
- if (rx.Exec(Text)) then begin
- // replace
- fItems.Insert(i, TCodeItemText.Create(rx.Match[1]));
- Text := rx.Replace(Text, '(', true);
-
- // replace last CommandEnd with ')'
- j := fItems.Count-1;
- while (j > i) and not (fItems[j] is TCodeItemCommandEnd) do
- dec(j);
- if (j > i) then begin
- fItems.Delete(j);
- fItems.Insert(j, TCodeItemText.Create(')'));
- fItems.Insert(j+1, TCodeItemToken.Create(ttEnd));
- end;
-
- // merge
- i := fItems.IndexOf(item);
- fItems.Insert(i, TCodeItemToken.Create(ttBegin));
- inc(i);
- i := Merge(aItem, i);
- exit;
- end;
- end;
- dec(i);
- end;
-
- raise EengInternal.Create('no return found in current code');
- end;
- finally
- FreeAndNil(rx);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TengGenCodeArgs.TCodeStackItem.Create;
- begin
- inherited Create;
- fItems := TCodeItemList.Create(true);
- fItems.Add(TCodeItemStart.Create);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TengGenCodeArgs.TCodeStackItem.Destroy;
- begin
- FreeAndNil(fItems);
- inherited Destroy;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengGenCodeArgs.TProcWrapper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TengGenCodeArgs.TProcWrapper.Create;
- begin
- Proc := nil;
- Code := nil;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TengGenCodeArgs.TProcWrapper.Destroy;
- begin
- FreeAndNil(Code);
- Proc := nil;
- inherited Destroy;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TengGenCodeArgs///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengGenCodeArgs.GetFlags: TengGenCodeFlags;
- begin
- if (fFlags.Count > 0) then
- result := fFlags.Last
- else
- result := [];
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengGenCodeArgs.GetText: String;
- begin
- result := fCode.Last.GetText;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengGenCodeArgs.GetCode: TCodeStackItem;
- begin
- result := fCode.Last;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengGenCodeArgs.GetProcParams: TStrings;
- begin
- result := fProcParams.Last;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengGenCodeArgs.PushCode;
- begin
- fCode.PushLast(TCodeStackItem.Create);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengGenCodeArgs.InsertCode(const aCodeStackItem: TCodeStackItem);
- begin
- fCode.PushLast(aCodeStackItem);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengGenCodeArgs.PushCurrentCommand: TCodeStackItem;
- begin
- result := TCodeStackItem.Create;
- fCommands.PushLast(result);
- Code.SplitCurrentCommand(result);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengGenCodeArgs.PushFlags(const aFlags: TengGenCodeFlags);
- begin
- fFlags.PushLast(aFlags);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengGenCodeArgs.PushProcParams(const aParams: TStrings);
- begin
- fProcParams.PushLast(aParams);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengGenCodeArgs.PopCode(const aFlags: TPopCodeFlags);
- var
- csi: TCodeStackItem;
- begin
- csi := fCode.PopLast(false);
- try
- if not csi.Empty and (aFlags * [pcfAppend, pcfPrepend] <> []) then begin
- if (pcfPrepend in aFlags) then begin
- if (pcfAddEmptyLine in aFlags) then
- csi.AddLineEnd;
- Code.Merge(csi, 1);
- end else begin
- if (pcfAddEmptyLine in aFlags) then
- Code.AddLineEnd;
- Code.Merge(csi, Code.Items.Count);
- end;
- end;
- finally
- FreeAndNil(csi);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengGenCodeArgs.ExtractCode: TCodeStackItem;
- begin
- result := fCode.PopLast(false);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengGenCodeArgs.PopCurrentCommand(const aRetType, aFuncName: String);
- var
- csi: TCodeStackItem;
- begin
- csi := fCommands.PopLast(false);
- try
- Code.ReplaceReturns(csi, aRetType, aFuncName, fInlineRetCounter);
- inc(fInlineRetCounter);
- finally
- FreeAndNil(csi);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengGenCodeArgs.PopFlags;
- begin
- fFlags.PopLast(true);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengGenCodeArgs.PopProcParams;
- begin
- fProcParams.PopLast;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengGenCodeArgs.AddProcedure(const aProc: TengShaderPartProc);
-
- function FindProc(const aName: String): TProcWrapper;
- begin
- for result in fProcedures do
- if (result.Proc.Name = aName) then
- exit;
- result := nil;
- end;
-
- var
- w: TProcWrapper;
- begin
- w := FindProc(aProc.Name);
- if Assigned(w) then begin
- if (aProc <> w.Proc) then
- raise EengDuplicateIdentifier.Create(w.Proc.Name, aProc, w.Proc);
- exit;
- end;
-
- w := TProcWrapper.Create;
- w.Proc := aProc;
- fProcedures.Add(w);
-
- PushCode; // push current code
- PushFlags(Flags + [gcfGenProcedure]);
- try
- w.Proc.GenCodeIntern(self);
- finally
- w.Code := ExtractCode; // pop procedure code and store it in wrapper
- PopFlags;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengGenCodeArgs.AddCodeProperty(const aProp: TengShaderPartCodeProperty);
- var
- p: TengShaderPartCodeProperty;
- begin
- p := fProperties[aProp.Name];
- if Assigned(p) then begin
- if not p.IsEquals(aProp) then
- raise EengDuplicateIdentifier.Create(p.Name, aProp, p);
- exit;
- end;
- fProperties.Add(aProp.Name, aProp);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengGenCodeArgs.AddMeta(const aMeta: IengMetaData);
- begin
- fShaderCode.AddMeta(aMeta);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TengGenCodeArgs.HasCodeProperty(const aName: String): Boolean;
- begin
- result := fProperties.Contains(aName);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengGenCodeArgs.GenProcedureCode(const aAppend: Boolean);
- var
- w: TProcWrapper;
- begin
- for w in fProcedures do begin
- if not Assigned(w.Code) then
- continue;
-
- InsertCode(w.Code); // push stored code ...
- w.Code := nil;
- PopCode([pcfPrepend, pcfAddEmptyLine]); // and pop it back to the code tree (this will merge the code)
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengGenCodeArgs.GenCodePropertyCode(const aTypes: array of CengShaderPart);
- var
- p: TengShaderPartCodeProperty;
- m: TCodePropertyMap;
- begin
- PushCode;
- PushFlags(Flags + [gcfGenCodeProp]);
- m := TCodePropertyMap.Create(false);
- try
- fMaxPropNameLen := 0;
- for p in fProperties do
- if CheckType(p, aTypes) then begin
- fMaxPropNameLen := Max(fMaxPropNameLen, Length(p.PropType));
- m.Add(p.PropType+p.Name, p);
- end;
- for p in m do begin
- p.GenCodeIntern(self);
- Code.AddLineEnd;
- end;
- finally
- FreeAndNil(m);
- PopCode([pcfPrepend, pcfAddEmptyLine]);
- PopFlags;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TengGenCodeArgs.GenMetaCode;
- var
- m: IengMetaData;
- s: String;
- vCompat: Boolean;
- vMax: Integer;
- layouts: TStringList;
- begin
- vCompat := false;
- vMax := 0;
- PushCode;
- layouts := TStringList.Create;
- try
- for m in fShaderCode.MetaList do begin
- case m.MetaType of
- metaVersion: begin
- if (m.Values[0] = VERSION_EXTRA_COMPAT) then
- vCompat := true
- else
- vMax := Max(vMax, StrToInt(m.Values[0]));
- if (m.Count > 1) and (m.Values[1] = VERSION_EXTRA_COMPAT) then
- vCompat := true;
- end;
-
- metaExtension: begin
- Code.AddText(format('#extension %s : %s', [m.Values[0], m.Values[1]]));
- Code.AddLineEnd;
- end;
-
- metaLayout: begin
- layouts.Add(format('layout%s;', [m.Values[0]]));
- end;
- end;
- end;
-
- if (vMax >= LAYOUT_MIN_VERSION) then
- for s in layouts do begin
- Code.AddText(s);
- Code.AddLineEnd;
- end;
-
- if (vMax > 0) then begin
- PushCode;
- try
- Code.AddText('#version ' + IntToStr(vMax));
- if vCompat then
- Code.AddText(' ' + VERSION_EXTRA_COMPAT);
- Code.AddLineEnd;
- finally
- PopCode([pcfPrepend]);
- end;
- end;
- finally
- PopCode([pcfPrepend, pcfAddEmptyLine]);
- FreeAndNil(layouts);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TengGenCodeArgs.Create(const aShaderCode: TengShaderCodeIntern; const aRoot: TengShaderPartScope);
- begin
- inherited Create;
- fRoot := aRoot;
- fProcedures := TProcedureList.Create(true);
- fProperties := TCodePropertyMap.Create(false);
- fFlags := TGenCodeFlagsStack.Create(true);
- fCode := TCodeStack.Create(true);
- fCommands := TCodeStack.Create(true);
- fProcParams := TProcParamStack.Create(false);
- fShaderCode := aShaderCode;
- PushCode;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TengGenCodeArgs.Destroy;
- begin
- fShaderCode.Text := GetText;
- FreeAndNil(fProcParams);
- FreeAndNil(fCommands);
- FreeAndNil(fCode);
- FreeAndNil(fFlags);
- FreeAndNil(fProperties);
- FreeAndNil(fProcedures);
- inherited Destroy;
- end;
-
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //DEBUG/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- {$IFDEF DEBUG}
- procedure SaveAsXMindXml(const aShaderPart: TengShaderPart; const aDirectory: String);
- var
- linkStr: String;
-
- function Escape(const aText: String): String;
- begin
- result := StringReplace(aText, '''', '' { ' }, [rfReplaceAll]);
- result := StringReplace(result, '"', '"', [rfReplaceAll]);
- result := StringReplace(result, '&', '&', [rfReplaceAll]);
- result := StringReplace(result, '<', '<', [rfReplaceAll]);
- result := StringReplace(result, '>', '>', [rfReplaceAll]);
- end;
-
- function MakeID(const aItem: TengShaderPart): String;
- begin
- result := Format('%p', [Pointer(aItem)]);
- end;
-
- function GetTitle(const aItem: TengShaderPart): String;
- var
- i: Integer;
- s: String;
- begin
- // TengShaderPartIf
- if (aItem.Parent is TengShaderPartIf) then begin
- if (aItem.Parent.Children[0] = aItem) then
- result := '- TRUE -'
- else if (aItem.Parent.Count > 1) and (aItem.Parent.Children[1] = aItem) then
- result := '- FALSE -'
- else
- result := '- UNKNOWN -';
-
- // TengShaderPartClass
- end else if (aItem is TengShaderPartClass) then
- result := aItem.GetTokenName + ' ' + (aItem as TengShaderPartClass).Name
-
- // TengShaderPartInclude
- else if (aItem is TengShaderPartInclude) then
- result := aItem.GetTokenName
-
- // TengShaderFile
- else if (aItem is TengShaderFile) then
- result := ExtractFileName((aItem as TengShaderFile).Filename)
-
- // TengShaderPartProperty
- else if (aItem is TengShaderPartProperty) then with (aItem as TengShaderPartProperty) do
- result := aItem.GetTokenName + ' ' + Name
-
- // TengShaderPartCodeProperty
- else if (aItem is TengShaderPartCodeProperty) then with (aItem as TengShaderPartCodeProperty) do
- result := aItem.GetTokenName + ' ' + fType + ' ' + fName
-
- // TengShaderPartCall
- else if (aItem is TengShaderPartCall) then with (aItem as TengShaderPartCall) do
- result := aItem.GetTokenName + ' ' + fName
-
- // TengShaderPartProc
- else if (aItem is TengShaderPartProc) then with (aItem as TengShaderPartProc) do
- result := aItem.GetTokenName + ' ' + fName
-
- // TengShaderPartMeta
- else if (aItem is TengShaderPartMeta) then with (aItem as TengShaderPartMeta) do begin
- result := aItem.GetTokenName + ' ' + fMetaData.Name;
- for i := 0 to fMetaData.Count-1 do
- result := result + ' ' + fMetaData[i];
-
- // TengShaderPartMeta
- end else if (aItem is TengShaderPartIf) then with (aItem as TengShaderPartIf) do
- result := aItem.GetTokenName + ' ' + fExpression.GetText
-
- // TengShaderPartEcho
- else if (aItem is TengShaderPartEcho) then with (aItem as TengShaderPartEcho) do
- result := aItem.GetTokenName + ' ' + fName
-
- // TengShaderPartMessage
- else if (aItem is TengShaderPartMessage) then with (aItem as TengShaderPartMessage) do
- result := aItem.GetTokenName + ' ' + fMessage
-
- else if (aItem is TengShaderPartInherited) then with (aItem as TengShaderPartInherited) do begin
- result := aItem.GetTokenName + ' ' + fInheritedName;
- for s in fParameters do
- result := ' ' + s;
-
- end else
- result := 'TODO: ' + aItem.GetTokenName;
- result := Escape(result);
- end;
-
- function GetDesc(const aItem: TengShaderPart): String;
- begin
- result := ''; //'<notes><plain>Your Description Here</plain></notes>';
- end;
-
- function MakeLinks(const aItem: TengShaderPartScope): String;
- var
- p: TengShaderPart;
- begin
- result := '';
- for p in aItem.fInherited do // red
- result := result + '<relationship end1="' + MakeID(aItem) + '" end2="' + MakeID(p) + '" style-id="1c2250lh1o9dug5bqnmfjqjj2h" timestamp="1407953246105"><control-points><control-point index="0"></control-point><control-point index="1"><position svg:x="-150" svg:y="0"/></control-point></control-points></relationship>';
- for p in aItem.fChildScopes do // green
- result := result + '<relationship end1="' + MakeID(aItem) + '" end2="' + MakeID(p) + '" style-id="kjafgighq039598z56afioh565" timestamp="1407953246105"><control-points><control-point index="0"></control-point><control-point index="1"><position svg:x="-150" svg:y="0"/></control-point></control-points></relationship>';
- for p in aItem.fMappedParts do // blue
- result := result + '<relationship end1="' + MakeID(aItem) + '" end2="' + MakeID(p) + '" style-id="akjbq3589715ljkbg09uath6pa" timestamp="1407953246105"><control-points><control-point index="0"></control-point><control-point index="1"><position svg:x="-150" svg:y="0"/></control-point></control-points></relationship>';
- end;
-
- function CreateCodeItem(var aCode: String): String;
- var
- sl: TStringList;
- begin
- sl := TStringList.Create;
- try
- sl.Text := aCode;
- while (sl.Count > 0) and (Trim(sl[0]) = '') do
- sl.Delete(0);
- while (sl.Count > 0) and (Trim(sl[sl.Count-1]) = '') do
- sl.Delete(sl.Count-1);
- if (sl.Count > 0) then
- result := '<topic timestamp="1407871141500" style-id="7dh2otp9bqp93n80sk589g5916"><title>- CODE -</title>' +
- '<notes><plain>' + Escape(sl.Text) + '</plain></notes></topic>'
- else
- result := '';
- aCode := '';
- finally
- FreeAndNil(sl);
- end;
- end;
-
- function DoItem(const aItem: TengShaderPart; const aIsRoot: Boolean = false): String;
- var
- p: TengShaderPart;
- code: String;
- begin
- code := '';
- result := '<topic id="' + MakeID(aItem) + '" style-id="7dh2otp9bqp93n80sk589g5916" timestamp="1407871141500"';
- if (aIsRoot) then
- result := result + ' structure-class="org.xmind.ui.logic.right"';
- result := result + '><title>' + GetTitle(aItem) + '</title>' + GetDesc(aItem);
-
- if (aItem is TengShaderPartScope) then
- linkStr := linkStr + MakeLinks(aItem as TengShaderPartScope);
-
- if (aItem.Count > 0) then begin
- result := result + '<children><topics type="attached">';
- for p in aItem do begin
- if (p is TengShaderPartCode) then
- code := code + (p as TengShaderPartCode).Text
- else if (p is TengShaderPartCommandEnd) then
- code := code + (p as TengShaderPartCommandEnd).fToken
- else if (p is TengShaderPartLineBreak) then
- code := code + (p as TengShaderPartLineBreak).Text
- else
- result := result + CreateCodeItem(code) + DoItem(p);
- end;
- result := result + CreateCodeItem(code) + '</topics></children>';
- end;
- result := result + '</topic>';
- end;
-
- var
- fs: TFileStream;
- s: String;
- len: Integer;
- begin
- linkStr := '';
- s := '<?xml version="1.0" encoding="UTF-8" standalone="no"?><xmap-content xmlns="urn:xmind:xmap:xmlns:content:2.0" xmlns:fo="http://www.w3.org/1999/XSL/Format" xmlns:svg="http://www.w3.org/2000/svg" xmlns:xhtml="http://www.w3.org/1999/xhtml" xmlns:xlink="http://www.w3.org/1999/xlink" timestamp="1407871228304" version="2.0"><sheet id="2e1sqd3f443tanv8s665jo6r9u" timestamp="1407871228304">' +
- DoItem(aShaderPart, true) + '<title>glslPreCompiler Code Tree</title>';
- if (linkStr <> '') then
- s := s + '<relationships>' + linkStr + '</relationships>';
- s := s + '</sheet></xmap-content>';
- len := Length(s);
- if (len > 0) then begin
- fs := TFileStream.Create(IncludeTrailingPathDelimiter(aDirectory) + 'content.xml', fmCreate);
- try
- fs.Write(s[1], len);
- finally
- FreeAndNil(fs);
- end;
-
- s := '<?xml version="1.0" encoding="UTF-8" standalone="no"?><xmap-styles xmlns="urn:xmind:xmap:xmlns:style:2.0" xmlns:fo="http://www.w3.org/1999/XSL/Format" xmlns:svg="http://www.w3.org/2000/svg" version="2.0"><styles>' +
- '<style id="7dh2otp9bqp93n80sk589g5916" type="topic"><topic-properties fo:font-family="Calibri" fo:font-size="10pt" line-class="org.xmind.branchConnection.elbow" shape-class="org.xmind.topicShape.roundedRect"/></style>' +
- '<style id="1c2250lh1o9dug5bqnmfjqjj2h" type="relationship"><relationship-properties line-color="#FF0000" /></style>' +
- '<style id="kjafgighq039598z56afioh565" type="relationship"><relationship-properties line-color="#00FF00" /></style>' +
- '<style id="akjbq3589715ljkbg09uath6pa" type="relationship"><relationship-properties line-color="#0000FF" /></style>' +
- '</styles></xmap-styles>';
- len := Length(s);
- fs := TFileStream.Create(IncludeTrailingPathDelimiter(aDirectory) + 'styles.xml', fmCreate);
- try
- fs.Write(s[1], len);
- finally
- FreeAndNil(fs);
- end;
- end;
- end;
- {$ENDIF}
-
-
- end.
|