unit uengShaderPartClass; {$mode objfpc}{$H+} {$I uengShaderFile.inc} interface uses Classes, SysUtils, uengShaderPart, uengShaderGenerator, uengShaderGeneratorArgs, uengShaderFileParser {$IFDEF SHADER_FILE_USE_BITSPACE_UTILS} , uutlGenerics {$ELSE} , uengShaderFileGenerics {$ENDIF} ; type //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// TengShaderPartClass = class; TengShaderPartClassList = specialize TutlSimpleList; TengShaderPartClass = class(TengShaderGenerator) { Code Loading & Storage } private { member } fName: String; fExtends: TStringList; fInherited: TengShaderPartClassList; private { getter } function GetExtends: TStrings; procedure UpdateInherited; protected { virtual getter } function GetText: String; override; function ParseIntern(const aArgs: TengParseArgs; const aParams: TengTokenParameterList): String; override; procedure UpdateProperties; override; { Code Generation } public procedure GenerateCodeIntern(const aArgs: TengShaderGeneratorArgs); override; { General } public property Name: String read fName; property Extends: TStrings read GetExtends; property InheritedClasses: TengShaderPartClassList read fInherited; constructor Create(const aParent: TengShaderPart); override; destructor Destroy; override; { Class Methods } public class function GetTokenName: String; override; class procedure Validate(const aArgs: TengParseArgs; const aParent: TengShaderPart); override; end; TengShaderPartClassMap = specialize TutlMap; implementation uses uengShaderFileConstants, uengShaderFileTypes, uengShaderFileHelper, uengShaderPartKeyValuePair, uengShaderPartScope, uengShaderFile; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TengShaderPartClass/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TengShaderPartClass.GetExtends: TStrings; begin result := fExtends; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TengShaderPartClass.UpdateInherited; procedure FilterResults(const aName: String; const aResults, aNewResults: TengShaderPartList); var p: TengShaderPart; begin aNewResults.Clear; for p in aResults do if ((p as TengShaderPartClass).Name = aName) then aNewResults.Add(p); end; var sr, res: TengSearchResults; walker: TengSearchWalker; s: String; begin if (fExtends.Count <= 0) then exit; sr := TengSearchResults.Create; res := TengSearchResults.Create; walker := TengSearchWalker.Create(sr); try walker.Owner := self; walker.ResultTypes := CengShaderPartArr.Create(TengShaderPartClass); walker.ChildrenDoNotLeave := CengShaderPartArr.Create(TengShaderPartScope); walker.ChildrenForceLeave := CengShaderPartArr.Create(TengShaderFile); walker.ParentsDoNotLeave := CengShaderPartArr.Create(TengShaderFile); walker.SearchFlags := [ sfIgnoreOwner, sfSearchChildrenLazy, sfSearchChildren, sfSearchParents ]; fInherited.Clear; walker.Run(self); for s in fExtends do begin FilterResults(s, sr, res); fInherited.Add(ExtractSearchResult(self, s, res) as TengShaderPartClass); end; finally FreeAndNil(walker); FreeAndNil(res); FreeAndNil(sr); end; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TengShaderPartClass.GetText: String; var s: String; begin result := TOKEN_CHAR_BEGIN + GetTokenName + ' ' + fName; if (fExtends.Count > 0) then begin result := result + ' ' + TOKEN_EXTENDS; for s in fExtends do result := result + ' ' + s; end; result := result + TOKEN_CHAR_END + inherited GetText + TOKEN_CHAR_BEGIN + TOKEN_END + TOKEN_CHAR_END; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TengShaderPartClass.ParseIntern(const aArgs: TengParseArgs; const aParams: TengTokenParameterList): String; var i: Integer; begin if (aParams[0].Name <> GetTokenName) then with aParams[0] do raise EengInvalidToken.Create(ClassName, Name, Line, Col, Filename, self); if (aParams.Count < 2) then raise EengInvalidParamterCount.Create(GetTokenName, 2, -1, self); with aParams[1] do begin if not IsValidIdentifier(Name) then raise EengInvalidIdentifier.Create(Name, self); fName := Name; end; if (aParams.Count > 2) then begin if (aParams.Count < 4) then raise EengInvalidParamterCount.Create(GetTokenName, 4, -1, self); if (aParams[2].Name <> TOKEN_EXTENDS) then with aParams[2] do raise EengInvalidParamter.Create(aParams[2].Name, TOKEN_EXTENDS, Line, Col, Filename, self); fExtends.Clear; for i := 3 to aParams.Count-1 do fExtends.Add(aParams[i].Name); end; UpdateInherited; result := inherited ParseIntern(aArgs, aParams); result := CheckEndToken(result, aArgs, self); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TengShaderPartClass.UpdateProperties; var sr: TengSearchResults; walker: TengSearchWalker; p: TengShaderPart; c: TengShaderPartClass; begin inherited UpdateProperties; for c in fInherited do c.CopyProperties(self); sr := TengSearchResults.Create; walker := TengSearchWalker.Create(sr); try walker.SearchFlags := [sfSearchChildren]; walker.ResultTypes := CengShaderPartArr.Create(TengShaderPartProperty); walker.ChildrenDoNotLeave := CengShaderPartArr.Create(TengShaderPartClass); walker.Run(self); for p in sr.GetReverseEnumerator do AddProperty(p as TengShaderPartProperty); finally FreeAndNil(walker); FreeAndNil(sr); end; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TengShaderPartClass.GenerateCodeIntern(const aArgs: TengShaderGeneratorArgs); var c: TengShaderPartClass; begin for c in fInherited do c.GenerateCodeIntern(aArgs); aArgs.BeginBlock; try inherited GenerateCodeIntern(aArgs); finally aArgs.EndBlock; end; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TengShaderPartClass.Create(const aParent: TengShaderPart); begin inherited Create(aParent); fExtends := TStringList.Create; fInherited := TengShaderPartClassList.Create(false); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// destructor TengShaderPartClass.Destroy; begin FreeAndNil(fInherited); FreeAndNil(fExtends); inherited Destroy; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// class function TengShaderPartClass.GetTokenName: String; begin result := TOKEN_CLASS; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// class procedure TengShaderPartClass.Validate(const aArgs: TengParseArgs; const aParent: TengShaderPart); procedure RaiseEx(const aToken: String); begin with aArgs do raise EengShaderPart.Create('token ' + GetTokenName + ' is not allowed in ' + aToken, Line, Col, Filename, aParent); end; begin inherited Validate(aArgs, aParent); if aParent.HasParent(TengShaderPartClass, true) then RaiseEx(TengShaderPartClass.GetTokenName); end; end.