From 6aeb93d3d4f49deb1f9705f276497864c408b723 Mon Sep 17 00:00:00 2001 From: Bergmann89 Date: Sun, 13 Sep 2015 11:48:00 +0200 Subject: [PATCH] * removed old shader file --- uengShaderFile.old.pas | 5641 ---------------------------------------- 1 file changed, 5641 deletions(-) delete mode 100644 uengShaderFile.old.pas diff --git a/uengShaderFile.old.pas b/uengShaderFile.old.pas deleted file mode 100644 index a198ccb..0000000 --- a/uengShaderFile.old.pas +++ /dev/null @@ -1,5641 +0,0 @@ -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; - - 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; - -//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// - 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; - TengShaderPartMap = specialize TutlMap; - 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; - 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; - 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; - 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; - 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; - TProcParamStack = specialize TutlList; - TGenCodeFlagsStack = specialize TutlList; - TProcedureList = specialize TutlList; - TCodePropertyMap = specialize TutlMap; - 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; - -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 := ''; //'Your Description Here'; - end; - - function MakeLinks(const aItem: TengShaderPartScope): String; - var - p: TengShaderPart; - begin - result := ''; - for p in aItem.fInherited do // red - result := result + ''; - for p in aItem.fChildScopes do // green - result := result + ''; - for p in aItem.fMappedParts do // blue - result := result + ''; - 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 := '- CODE -' + - '' + Escape(sl.Text) + '' - 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 := '' + GetTitle(aItem) + '' + GetDesc(aItem); - - if (aItem is TengShaderPartScope) then - linkStr := linkStr + MakeLinks(aItem as TengShaderPartScope); - - if (aItem.Count > 0) then begin - result := result + ''; - 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) + ''; - end; - result := result + ''; - end; - -var - fs: TFileStream; - s: String; - len: Integer; -begin - linkStr := ''; - s := '' + - DoItem(aShaderPart, true) + 'glslPreCompiler Code Tree'; - if (linkStr <> '') then - s := s + '' + linkStr + ''; - s := s + ''; - 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 := '' + - '' + - '' + - '' + - '' + - ''; - 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. -