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.