diff --git a/uengShaderCodePart.pas b/uengShaderCodePart.pas index 45d06f2..0a4e527 100644 --- a/uengShaderCodePart.pas +++ b/uengShaderCodePart.pas @@ -11,6 +11,8 @@ uses {$IFDEF SHADER_FILE_USE_BITSPACE_UTILS} , uutlGenerics +{$ELSE} + , uengShaderFileGenerics {$ENDIF} ; diff --git a/uengShaderFile.inc b/uengShaderFile.inc index 780ae75..bf59ff6 100644 --- a/uengShaderFile.inc +++ b/uengShaderFile.inc @@ -1,3 +1,3 @@ {.$DEFINE DEBUGEXPRESSION_ADD_BRACKET} // add brackets to expressions -{$DEFINE SHADER_FILE_USE_BITSPACE_UTILS} // use bitSpace Utils +{.$DEFINE SHADER_FILE_USE_BITSPACE_UTILS} // use bitSpace Utils {.$DEFINE SHADER_FILE_DEBUG} // enable debug output diff --git a/uengShaderFile.pas b/uengShaderFile.pas index 97c4e8e..ed90caf 100644 --- a/uengShaderFile.pas +++ b/uengShaderFile.pas @@ -27,8 +27,8 @@ type { Code Loading & Storage } private fFilename: String; - fFileReader: IutlFileReader; - fFileWriter: IutlFileWriter; + fFileReader: IengShaderFileReader; + fFileWriter: IengShaderFileWriter; fClasses: TengShaderPartClassMap; private function GetGenerator(const aName: String): TengShaderGenerator; diff --git a/uengShaderFileGenerics.pas b/uengShaderFileGenerics.pas new file mode 100644 index 0000000..89a3883 --- /dev/null +++ b/uengShaderFileGenerics.pas @@ -0,0 +1,1226 @@ +unit uengShaderFileGenerics; + +{$mode objfpc}{$H+} +{$modeswitch nestedprocvars} + +interface + +uses + Classes, SysUtils, typinfo; + +type +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + generic IutlEqualityComparer = interface + function EqualityCompare(const i1, i2: T): Boolean; + end; + + generic TutlEqualityComparer = class(TInterfacedObject, specialize IutlEqualityComparer) + public + function EqualityCompare(const i1, i2: T): Boolean; + end; + + generic TutlEventEqualityComparer = class(TInterfacedObject, specialize IutlEqualityComparer) + public type + TEqualityEvent = function(const i1, i2: T): Boolean; + TEqualityEventO = function(const i1, i2: T): Boolean of object; + TEqualityEventN = function(const i1, i2: T): Boolean is nested; + private type + TEqualityEventType = (eetNormal, eetObject, eetNested); + private + fEvent: TEqualityEvent; + fEventO: TEqualityEventO; + fEventN: TEqualityEventN; + fEventType: TEqualityEventType; + public + function EqualityCompare(const i1, i2: T): Boolean; + constructor Create(const aEvent: TEqualityEvent); overload; + constructor Create(const aEvent: TEqualityEventO); overload; + constructor Create(const aEvent: TEqualityEventN); overload; + { HINT: you need to activate "$modeswitch nestedprocvars" when you want to use nested callbacks } + end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + generic IutlComparer = interface + function Compare(const i1, i2: T): Integer; + end; + + generic TutlComparer = class(TInterfacedObject, specialize IutlComparer) + public + function Compare(const i1, i2: T): Integer; + end; + + generic TutlEventComparer = class(TInterfacedObject, specialize IutlComparer) + public type + TEvent = function(const i1, i2: T): Integer; + TEventO = function(const i1, i2: T): Integer of object; + TEventN = function(const i1, i2: T): Integer is nested; + private type + TEventType = (etNormal, etObject, etNested); + private + fEvent: TEvent; + fEventO: TEventO; + fEventN: TEventN; + fEventType: TEventType; + public + function Compare(const i1, i2: T): Integer; + constructor Create(const aEvent: TEvent); overload; + constructor Create(const aEvent: TEventO); overload; + constructor Create(const aEvent: TEventN); overload; + { HINT: you need to activate "$modeswitch nestedprocvars" when you want to use nested callbacks } + end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + generic TutlListBase = class(TObject) + private type + TListItem = packed record + data: T; + end; + PListItem = ^TListItem; + + public type + TEnumerator = class(TObject) + private + fReverse: Boolean; + fList: TFPList; + fPosition: Integer; + function GetCurrent: T; + public + property Current: T read GetCurrent; + function GetEnumerator: TEnumerator; + function MoveNext: Boolean; + constructor Create(const aList: TFPList; const aReverse: Boolean = false); + end; + + private + fList: TFPList; + fOwnsObjects: Boolean; + + protected + property List: TFPList read fList; + + function GetCount: Integer; + function GetItem(const aIndex: Integer): T; + procedure SetCount(const aValue: Integer); + procedure SetItem(const aIndex: Integer; const aItem: T); + + function CreateItem: PListItem; virtual; + procedure DestroyItem(const aItem: PListItem; const aFreeItem: Boolean = true); virtual; + procedure InsertIntern(const aIndex: Integer; const aItem: T); virtual; + procedure DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean = true); + + public + property OwnsObjects: Boolean read fOwnsObjects write fOwnsObjects; + + function GetEnumerator: TEnumerator; + function GetReverseEnumerator: TEnumerator; + procedure Clear; + + constructor Create(const aOwnsObjects: Boolean = true); + destructor Destroy; override; + end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + { a simple list without the ability to compare objects (e.g. for IndexOf, Remove, Extract) } + generic TutlSimpleList = class(specialize TutlListBase) + public type + IComparer = specialize IutlComparer; + TSortDirection = (sdAscending, sdDescending); + private + function Split(aComparer: IComparer; const aDirection: TSortDirection; const aLeft, aRight: Integer): Integer; + procedure QuickSort(aComparer: IComparer; const aDirection: TSortDirection; const aLeft, aRight: Integer); + public + property Items[const aIndex: Integer]: T read GetItem write SetItem; default; + property Count: Integer read GetCount write SetCount; + + function Add(const aItem: T): Integer; + procedure Insert(const aIndex: Integer; const aItem: T); + + procedure Exchange(const aIndex1, aIndex2: Integer); + procedure Move(const aCurIndex, aNewIndex: Integer); + procedure Sort(aComparer: IComparer; const aDirection: TSortDirection = sdAscending); + + procedure Delete(const aIndex: Integer); + + function First: T; + procedure PushFirst(const aItem: T); + function PopFirst(const aFreeItem: Boolean = false): T; + + function Last: T; + procedure PushLast(const aItem: T); + function PopLast(const aFreeItem: Boolean = false): T; + end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + generic TutlCustomList = class(specialize TutlSimpleList) + public type + IEqualityComparer = specialize IutlEqualityComparer; + private + fEqualityComparer: IEqualityComparer; + public + function IndexOf(const aItem: T): Integer; + function Extract(const aItem: T; const aDefault: T): T; + function Remove(const aItem: T): Integer; + + constructor Create(aEqualityComparer: IEqualityComparer; const aOwnsObjects: Boolean = true); + destructor Destroy; override; + end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + generic TutlList = class(specialize TutlCustomList) + public type + TEqualityComparer = specialize TutlEqualityComparer; + public + constructor Create(const aOwnsObjects: Boolean = true); + end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + generic TutlCustomHashSet = class(specialize TutlListBase) + public type + IComparer = specialize IutlComparer; + private + fComparer: IComparer; + function SearchItem(const aMin, aMax: Integer; const aItem: T; out aIndex: Integer): Integer; + public + property Items[const aIndex: Integer]: T read GetItem; default; + property Count: Integer read GetCount; + + function Add(const aItem: T): Boolean; + function Contains(const aItem: T): Boolean; + function IndexOf(const aItem: T): Integer; + function Remove(const aItem: T): Boolean; + procedure Delete(const aIndex: Integer); + + constructor Create(aComparer: IComparer; const aOwnsObjects: Boolean = true); + destructor Destroy; override; + end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + generic TutlHashSet = class(specialize TutlCustomHashSet) + public type + TComparer = specialize TutlComparer; + public + constructor Create(const aOwnsObjects: Boolean = true); + end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + EutlMap = class(Exception); + EutlMapKeyNotFound = class(EutlMap) + public + constructor Create; + end; + EutlMapKeyAlreadyExists = class(EutlMap) + public + constructor Create; + end; + generic TutlCustomMap = class(TObject) + public type + IComparer = specialize IutlComparer; + TKeyValuePair = packed record + Key: TKey; + Value: TValue; + end; + private type + THashSetBase = specialize TutlCustomHashSet; + THashSet = class(THashSetBase) + protected + procedure DestroyItem(const aItem: PListItem; const aFreeItem: Boolean = true); override; + public + property Items[const aIndex: Integer]: TKeyValuePair read GetItem write SetItem; default; + end; + + TKVPComparer = class(TInterfacedObject, THashSet.IComparer) + private + fComparer: IComparer; + public + function Compare(const i1, i2: TKeyValuePair): Integer; + constructor Create(aComparer: IComparer); + destructor Destroy; override; + end; + + TValueEnumerator = class(TObject) + private + fHashSet: THashSet; + fPos: Integer; + function GetCurrent: TValue; + public + property Current: TValue read GetCurrent; + function MoveNext: Boolean; + constructor Create(const aHashSet: THashSet); + end; + + TKeyEnumerator = class(TObject) + private + fHashSet: THashSet; + fPos: Integer; + function GetCurrent: TKey; + public + property Current: TKey read GetCurrent; + function MoveNext: Boolean; + constructor Create(const aHashSet: THashSet); + end; + + TKeyValuePairEnumerator = class(TObject) + private + fHashSet: THashSet; + fPos: Integer; + function GetCurrent: TKeyValuePair; + public + property Current: TKeyValuePair read GetCurrent; + function MoveNext: Boolean; + constructor Create(const aHashSet: THashSet); + end; + + TKeyWrapper = class(TObject) + private + fHashSet: THashSet; + function GetItem(const aIndex: Integer): TKey; + function GetCount: Integer; + public + property Items[const aIndex: Integer]: TKey read GetItem; default; + property Count: Integer read GetCount; + function GetEnumerator: TKeyEnumerator; + constructor Create(const aHashSet: THashSet); + end; + + TKeyValuePairWrapper = class(TObject) + private + fHashSet: THashSet; + function GetItem(const aIndex: Integer): TKeyValuePair; + function GetCount: Integer; + public + property Items[const aIndex: Integer]: TKeyValuePair read GetItem; default; + property Count: Integer read GetCount; + function GetEnumerator: TKeyValuePairEnumerator; + constructor Create(const aHashSet: THashSet); + end; + + private + fComparer: IComparer; + fHashSet: THashSet; + fKeyWrapper: TKeyWrapper; + fKeyValuePairWrapper: TKeyValuePairWrapper; + + function GetValues(const aKey: TKey): TValue; + function GetValueAt(const aIndex: Integer): TValue; + function GetCount: Integer; + + procedure SetValueAt(const aIndex: Integer; aValue: TValue); + procedure SetValues(const aKey: TKey; aValue: TValue); + public + property Values [const aKey: TKey]: TValue read GetValues write SetValues; default; + property ValueAt[const aIndex: Integer]: TValue read GetValueAt write SetValueAt; + property Keys: TKeyWrapper read fKeyWrapper; + property KeyValuePairs: TKeyValuePairWrapper read fKeyValuePairWrapper; + property Count: Integer read GetCount; + + procedure Add(const aKey: TKey; const aValue: TValue); + function IndexOf(const aKey: TKey): Integer; + function Contains(const aKey: TKey): Boolean; + procedure Delete(const aKey: TKey); + procedure DeleteAt(const aIndex: Integer); + procedure Clear; + + function GetEnumerator: TValueEnumerator; + + constructor Create(aComparer: IComparer; const aOwnsObjects: Boolean = true); + destructor Destroy; override; + end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + generic TutlMap = class(specialize TutlCustomMap) + public type + TComparer = specialize TutlComparer; + public + constructor Create(const aOwnsObjects: Boolean = true); + end; + + function utlFreeOrFinalize(var obj; const aTypeInfo: PTypeInfo; const aFreeObj: Boolean = true): Boolean; + +implementation + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//Helper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +operator < (const i1, i2: TObject): Boolean; inline; +begin + result := PtrUInt(i1) < PtrUInt(i2); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +operator > (const i1, i2: TObject): Boolean; inline; +begin + result := PtrUInt(i1) > PtrUInt(i2); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function utlFreeOrFinalize(var obj; const aTypeInfo: PTypeInfo; const aFreeObj: Boolean = true): Boolean; +var + o: TObject; +begin + result := true; + case aTypeInfo^.Kind of + tkClass: begin + if (aFreeObj) then begin + o := TObject(obj); + Pointer(obj) := nil; + o.Free; + end; + end; + + tkInterface: begin + IUnknown(obj) := nil; + end; + + tkAString: begin + AnsiString(Obj) := ''; + end; + + tkUString: begin + UnicodeString(Obj) := ''; + end; + + tkString: begin + String(Obj) := ''; + end; + else + result := false; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//EutlMapKeyNotFound//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor EutlMapKeyNotFound.Create; +begin + inherited Create('key not found'); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//EutlMapKeyAlreadyExists/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor EutlMapKeyAlreadyExists.Create; +begin + inherited Create('key already exists'); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlEqualityComparer////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlEqualityComparer.EqualityCompare(const i1, i2: T): Boolean; +begin + result := (i1 = i2); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlEventEqualityComparer.EqualityCompare(const i1, i2: T): Boolean; +begin + case fEventType of + eetNormal: result := fEvent(i1, i2); + eetObject: result := fEventO(i1, i2); + eetNested: result := fEventN(i1, i2); + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlEventEqualityComparer.Create(const aEvent: TEqualityEvent); +begin + inherited Create; + fEvent := aEvent; + fEventType := eetNormal; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlEventEqualityComparer.Create(const aEvent: TEqualityEventO); +begin + inherited Create; + fEventO := aEvent; + fEventType := eetObject; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlEventEqualityComparer.Create(const aEvent: TEqualityEventN); +begin + inherited Create; + fEventN := aEvent; + fEventType := eetNested; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlComparer////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlComparer.Compare(const i1, i2: T): Integer; +begin + if (i1 < i2) then + result := -1 + else if (i1 > i2) then + result := 1 + else + result := 0; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlEventComparer.Compare(const i1, i2: T): Integer; +begin + case fEventType of + etNormal: result := fEvent(i1, i2); + etObject: result := fEventO(i1, i2); + etNested: result := fEventN(i1, i2); + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlEventComparer.Create(const aEvent: TEvent); +begin + inherited Create; + fEvent := aEvent; + fEventType := etNormal; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlEventComparer.Create(const aEvent: TEventO); +begin + inherited Create; + fEventO := aEvent; + fEventType := etObject; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlEventComparer.Create(const aEvent: TEventN); +begin + inherited Create; + fEventN := aEvent; + fEventType := etNested; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlListBase////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlListBase.TEnumerator.GetCurrent: T; +begin + result := PListItem(fList[fPosition])^.data; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlListBase.TEnumerator.GetEnumerator: TEnumerator; +begin + result := self; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlListBase.TEnumerator.MoveNext: Boolean; +begin + if fReverse then begin + dec(fPosition); + result := (fPosition >= 0); + end else begin + inc(fPosition); + result := (fPosition < fList.Count) + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlListBase.TEnumerator.Create(const aList: TFPList; const aReverse: Boolean); +begin + inherited Create; + fList := aList; + fReverse := aReverse; + if fReverse then + fPosition := fList.Count + else + fPosition := -1; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlListBase////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlListBase.GetCount: Integer; +begin + result := fList.Count; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlListBase.GetItem(const aIndex: Integer): T; +begin + if (aIndex >= 0) and (aIndex < fList.Count) then + result := PListItem(fList[aIndex])^.data + else + raise Exception.CreateFmt('index (%d) out of range [%d:%d]', [aIndex, 0, fList.Count-1]); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlListBase.SetCount(const aValue: Integer); +var + item: PListItem; +begin + if (aValue < 0) then + raise Exception.Create('new value for count must be positiv'); + while (aValue > fList.Count) do begin + item := CreateItem; + FillByte(item^, SizeOf(item^), 0); + fList.Add(item); + end; + while (aValue < fList.Count) do + DeleteIntern(fList.Count-1); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlListBase.SetItem(const aIndex: Integer; const aItem: T); +var + item: PListItem; +begin + if (aIndex >= 0) and (aIndex < fList.Count) then begin + item := PListItem(fList[aIndex]); + utlFreeOrFinalize(item^, TypeInfo(item^), fOwnsObjects); + item^.data := aItem; + end else + raise Exception.CreateFmt('index (%d) out of range [%d:%d]', [aIndex, 0, fList.Count-1]); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlListBase.CreateItem: PListItem; +begin + new(result); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlListBase.DestroyItem(const aItem: PListItem; const aFreeItem: Boolean); +begin + utlFreeOrFinalize(aItem^.data, TypeInfo(aItem^.data), fOwnsObjects and aFreeItem); + Dispose(aItem); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlListBase.InsertIntern(const aIndex: Integer; const aItem: T); +var + item: PListItem; +begin + item := CreateItem; + try + item^.data := aItem; + fList.Insert(aIndex, item); + except + DestroyItem(item, false); + raise; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlListBase.DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean); +var + item: PListItem; +begin + if (aIndex >= 0) and (aIndex < fList.Count) then begin + item := PListItem(fList[aIndex]); + fList.Delete(aIndex); + DestroyItem(item, aFreeItem); + end else + raise Exception.CreateFmt('index (%d) out of range [%d:%d]', [aIndex, 0, fList.Count-1]); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlListBase.GetEnumerator: TEnumerator; +begin + result := TEnumerator.Create(fList, false); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlListBase.GetReverseEnumerator: TEnumerator; +begin + result := TEnumerator.Create(fList, true); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlListBase.Clear; +begin + while (fList.Count > 0) do + DeleteIntern(fList.Count-1); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlListBase.Create(const aOwnsObjects: Boolean); +begin + inherited Create; + fOwnsObjects := aOwnsObjects; + fList := TFPList.Create; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +destructor TutlListBase.Destroy; +begin + Clear; + FreeAndNil(fList); + inherited Destroy; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlSimpleList//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlSimpleList.Split(aComparer: IComparer; const aDirection: TSortDirection; const aLeft, aRight: Integer): Integer; +var + i, j: Integer; + pivot: T; +begin + i := aLeft; + j := aRight - 1; + pivot := GetItem(aRight); + repeat + while ((aDirection = sdAscending) and (aComparer.Compare(GetItem(i), pivot) <= 0) or + (aDirection = sdDescending) and (aComparer.Compare(GetItem(i), pivot) >= 0)) and + (i < aRight) do inc(i); + + while ((aDirection = sdAscending) and (aComparer.Compare(GetItem(j), pivot) >= 0) or + (aDirection = sdDescending) and (aComparer.Compare(GetItem(j), pivot) <= 0)) and + (j > aLeft) do dec(j); + + if (i < j) then + Exchange(i, j); + until (i >= j); + + if ((aDirection = sdAscending) and (aComparer.Compare(GetItem(i), pivot) > 0)) or + ((aDirection = sdDescending) and (aComparer.Compare(GetItem(i), pivot) < 0)) then + Exchange(i, aRight); + + result := i; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlSimpleList.QuickSort(aComparer: IComparer; const aDirection: TSortDirection; const aLeft, aRight: Integer); +var + s: Integer; +begin + if (aLeft < aRight) then begin + s := Split(aComparer, aDirection, aLeft, aRight); + QuickSort(aComparer, aDirection, aLeft, s - 1); + QuickSort(aComparer, aDirection, s + 1, aRight); + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlSimpleList.Add(const aItem: T): Integer; +begin + result := Count; + InsertIntern(result, aItem); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlSimpleList.Insert(const aIndex: Integer; const aItem: T); +begin + InsertIntern(aIndex, aItem); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlSimpleList.Exchange(const aIndex1, aIndex2: Integer); +begin + if (aIndex1 < 0) or (aIndex1 >= Count) then + raise Exception.CreateFmt('index (%d) out of range [%d:%d]', [aIndex1, 0, fList.Count-1]); + if (aIndex2 < 0) or (aIndex2 >= Count) then + raise Exception.CreateFmt('index (%d) out of range [%d:%d]', [aIndex2, 0, fList.Count-1]); + fList.Exchange(aIndex1, aIndex2); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlSimpleList.Move(const aCurIndex, aNewIndex: Integer); +begin + if (aCurIndex < 0) or (aCurIndex >= Count) then + raise Exception.CreateFmt('index (%d) out of range [%d:%d]', [aCurIndex, 0, fList.Count-1]); + if (aNewIndex < 0) or (aNewIndex >= Count) then + raise Exception.CreateFmt('index (%d) out of range [%d:%d]', [aNewIndex, 0, fList.Count-1]); + fList.Move(aCurIndex, aNewIndex); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlSimpleList.Sort(aComparer: IComparer; const aDirection: TSortDirection); +begin + QuickSort(aComparer, aDirection, 0, fList.Count-1); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlSimpleList.Delete(const aIndex: Integer); +begin + DeleteIntern(aIndex); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlSimpleList.First: T; +begin + result := Items[0]; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlSimpleList.PushFirst(const aItem: T); +begin + InsertIntern(0, aItem); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlSimpleList.PopFirst(const aFreeItem: Boolean): T; +begin + if aFreeItem then + FillByte(result{%H-}, SizeOf(result), 0) + else + result := First; + DeleteIntern(0, aFreeItem); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlSimpleList.Last: T; +begin + result := Items[Count-1]; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlSimpleList.PushLast(const aItem: T); +begin + InsertIntern(Count, aItem); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlSimpleList.PopLast(const aFreeItem: Boolean): T; +begin + if aFreeItem then + FillByte(result{%H-}, SizeOf(result), 0) + else + result := Last; + DeleteIntern(Count-1, aFreeItem); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlCustomList//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlCustomList.IndexOf(const aItem: T): Integer; +var + c: Integer; +begin + c := List.Count; + result := 0; + while (result < c) and + not fEqualityComparer.EqualityCompare(PListItem(List[result])^.data, aItem) do + inc(result); + if (result >= c) then + result := -1; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlCustomList.Extract(const aItem: T; const aDefault: T): T; +var + i: Integer; +begin + i := IndexOf(aItem); + if (i >= 0) then begin + result := Items[i]; + DeleteIntern(i, false); + end else + result := aDefault; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlCustomList.Remove(const aItem: T): Integer; +begin + result := IndexOf(aItem); + if (result >= 0) then + DeleteIntern(result); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlCustomList.Create(aEqualityComparer: IEqualityComparer; const aOwnsObjects: Boolean); +begin + inherited Create(aOwnsObjects); + fEqualityComparer := aEqualityComparer; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +destructor TutlCustomList.Destroy; +begin + fEqualityComparer := nil; + inherited Destroy; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlList////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlList.Create(const aOwnsObjects: Boolean); +begin + inherited Create(TEqualityComparer.Create, aOwnsObjects); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlCustomHashSet///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlCustomHashSet.SearchItem(const aMin, aMax: Integer; const aItem: T; out aIndex: Integer): Integer; +var + i, cmp: Integer; +begin + if (aMin <= aMax) then begin + i := aMin + Trunc((aMax - aMin) / 2); + cmp := fComparer.Compare(aItem, GetItem(i)); + if (cmp = 0) then + result := i + else if (cmp < 0) then + result := SearchItem(aMin, i-1, aItem, aIndex) + else if (cmp > 0) then + result := SearchItem(i+1, aMax, aItem, aIndex); + end else begin + result := -1; + aIndex := aMin; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlCustomHashSet.Add(const aItem: T): Boolean; +var + i: Integer; +begin + result := (SearchItem(0, List.Count-1, aItem, i) < 0); + if result then + InsertIntern(i, aItem); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlCustomHashSet.Contains(const aItem: T): Boolean; +var + tmp: Integer; +begin + result := (SearchItem(0, List.Count-1, aItem, tmp) >= 0); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlCustomHashSet.IndexOf(const aItem: T): Integer; +var + tmp: Integer; +begin + result := SearchItem(0, List.Count-1, aItem, tmp); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlCustomHashSet.Remove(const aItem: T): Boolean; +var + i, tmp: Integer; +begin + i := SearchItem(0, List.Count-1, aItem, tmp); + result := (i >= 0); + if result then + DeleteIntern(i); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlCustomHashSet.Delete(const aIndex: Integer); +begin + DeleteIntern(aIndex); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlCustomHashSet.Create(aComparer: IComparer; const aOwnsObjects: Boolean); +begin + inherited Create(aOwnsObjects); + fComparer := aComparer; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +destructor TutlCustomHashSet.Destroy; +begin + fComparer := nil; + inherited Destroy; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlHashSet/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlHashSet.Create(const aOwnsObjects: Boolean); +begin + inherited Create(TComparer.Create, aOwnsObjects); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlCustomMap.THashSet//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlCustomMap.THashSet.DestroyItem(const aItem: PListItem; const aFreeItem: Boolean); +begin + // never free objects used as keys, but do finalize strings, interfaces etc. + utlFreeOrFinalize(aItem^.data.key, TypeInfo(aItem^.data.key), false); + utlFreeOrFinalize(aItem^.data.value, TypeInfo(aItem^.data.value), aFreeItem and OwnsObjects); + inherited DestroyItem(aItem, aFreeItem); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlCustomMap.TKVPComparer//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlCustomMap.TKVPComparer.Compare(const i1, i2: TKeyValuePair): Integer; +begin + result := fComparer.Compare(i1.Key, i2.Key); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlCustomMap.TKVPComparer.Create(aComparer: IComparer); +begin + inherited Create; + fComparer := aComparer; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +destructor TutlCustomMap.TKVPComparer.Destroy; +begin + fComparer := nil; + inherited Destroy; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlCustomMap.TValueEnumerator//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlCustomMap.TValueEnumerator.GetCurrent: TValue; +begin + result := fHashSet[fPos].Value; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlCustomMap.TValueEnumerator.MoveNext: Boolean; +begin + inc(fPos); + result := (fPos < fHashSet.Count); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlCustomMap.TValueEnumerator.Create(const aHashSet: THashSet); +begin + inherited Create; + fHashSet := aHashSet; + fPos := -1; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlCustomMap.TKeyEnumerator////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlCustomMap.TKeyEnumerator.GetCurrent: TKey; +begin + result := fHashSet[fPos].Key; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlCustomMap.TKeyEnumerator.MoveNext: Boolean; +begin + inc(fPos); + result := (fPos < fHashSet.Count); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlCustomMap.TKeyEnumerator.Create(const aHashSet: THashSet); +begin + inherited Create; + fHashSet := aHashSet; + fPos := -1; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlCustomMap.TKeyValuePairEnumerator///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlCustomMap.TKeyValuePairEnumerator.GetCurrent: TKeyValuePair; +begin + result := fHashSet[fPos]; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlCustomMap.TKeyValuePairEnumerator.MoveNext: Boolean; +begin + inc(fPos); + result := (fPos < fHashSet.Count); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlCustomMap.TKeyValuePairEnumerator.Create(const aHashSet: THashSet); +begin + inherited Create; + fHashSet := aHashSet; + fPos := -1; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlCustomMap.TKeyWrapper///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlCustomMap.TKeyWrapper.GetItem(const aIndex: Integer): TKey; +begin + result := fHashSet[aIndex].Key; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlCustomMap.TKeyWrapper.GetCount: Integer; +begin + result := fHashSet.Count; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlCustomMap.TKeyWrapper.GetEnumerator: TKeyEnumerator; +begin + result := TKeyEnumerator.Create(fHashSet); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlCustomMap.TKeyWrapper.Create(const aHashSet: THashSet); +begin + inherited Create; + fHashSet := aHashSet; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlCustomMap.TKeyValuePairWrapper//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlCustomMap.TKeyValuePairWrapper.GetItem(const aIndex: Integer): TKeyValuePair; +begin + result := fHashSet[aIndex]; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlCustomMap.TKeyValuePairWrapper.GetCount: Integer; +begin + result := fHashSet.Count; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlCustomMap.TKeyValuePairWrapper.GetEnumerator: TKeyValuePairEnumerator; +begin + result := TKeyValuePairEnumerator.Create(fHashSet); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlCustomMap.TKeyValuePairWrapper.Create(const aHashSet: THashSet); +begin + inherited Create; + fHashSet := aHashSet; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlCustomMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlCustomMap.GetValues(const aKey: TKey): TValue; +var + i: Integer; + kvp: TKeyValuePair; +begin + kvp.Key := aKey; + i := fHashSet.IndexOf(kvp); + if (i < 0) then + FillByte(result{%H-}, SizeOf(result), 0) + else + result := fHashSet[i].Value; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlCustomMap.GetValueAt(const aIndex: Integer): TValue; +begin + result := fHashSet[aIndex].Value; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlCustomMap.GetCount: Integer; +begin + result := fHashSet.Count; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlCustomMap.SetValues(const aKey: TKey; aValue: TValue); +var + i: Integer; + kvp: TKeyValuePair; +begin + kvp.Key := aKey; + kvp.Value := aValue; + i := fHashSet.IndexOf(kvp); + if (i < 0) then + raise EutlMap.Create('key not found'); + fHashSet[i] := kvp; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlCustomMap.SetValueAt(const aIndex: Integer; aValue: TValue); +var + kvp: TKeyValuePair; +begin + kvp := fHashSet[aIndex]; + kvp.Value := aValue; + fHashSet[aIndex] := kvp; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlCustomMap.Add(const aKey: TKey; const aValue: TValue); +var + kvp: TKeyValuePair; +begin + kvp.Key := aKey; + kvp.Value := aValue; + if not fHashSet.Add(kvp) then + raise EutlMapKeyAlreadyExists.Create(); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlCustomMap.IndexOf(const aKey: TKey): Integer; +var + kvp: TKeyValuePair; +begin + kvp.Key := aKey; + result := fHashSet.IndexOf(kvp); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlCustomMap.Contains(const aKey: TKey): Boolean; +var + kvp: TKeyValuePair; +begin + kvp.Key := aKey; + result := (fHashSet.IndexOf(kvp) >= 0); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlCustomMap.Delete(const aKey: TKey); +var + kvp: TKeyValuePair; +begin + kvp.Key := aKey; + if not fHashSet.Remove(kvp) then + raise EutlMapKeyNotFound.Create; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlCustomMap.DeleteAt(const aIndex: Integer); +begin + fHashSet.Delete(aIndex); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TutlCustomMap.Clear; +begin + fHashSet.Clear; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TutlCustomMap.GetEnumerator: TValueEnumerator; +begin + result := TValueEnumerator.Create(fHashSet); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlCustomMap.Create(aComparer: IComparer; const aOwnsObjects: Boolean); +begin + inherited Create; + fComparer := aComparer; + fHashSet := THashSet.Create(TKVPComparer.Create(fComparer), aOwnsObjects); + fKeyWrapper := TKeyWrapper.Create(fHashSet); + fKeyValuePairWrapper := TKeyValuePairWrapper.Create(fHashSet); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +destructor TutlCustomMap.Destroy; +begin + FreeAndNil(fKeyValuePairWrapper); + FreeAndNil(fKeyWrapper); + FreeAndNil(fHashSet); + fComparer := nil; + inherited Destroy; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TutlMap/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +constructor TutlMap.Create(const aOwnsObjects: Boolean); +begin + inherited Create(TComparer.Create, aOwnsObjects); +end; + +end. diff --git a/uengShaderFileParser.pas b/uengShaderFileParser.pas index 0429080..b52964e 100644 --- a/uengShaderFileParser.pas +++ b/uengShaderFileParser.pas @@ -12,7 +12,7 @@ uses {$IFDEF SHADER_FILE_USE_BITSPACE_UTILS} , uutlGenerics {$ELSE} - , fgl + , uengShaderFileGenerics {$ENDIF} ; diff --git a/uengShaderFileTypes.pas b/uengShaderFileTypes.pas index f8f3db4..83a9305 100644 --- a/uengShaderFileTypes.pas +++ b/uengShaderFileTypes.pas @@ -10,6 +10,8 @@ uses {$IFDEF SHADER_FILE_USE_BITSPACE_UTILS} , uutlSerialization, uutlCommon, uutlGenerics +{$ELSE} + , uengShaderFileGenerics {$ENDIF} ; @@ -21,6 +23,40 @@ type TengShaderFileReader = uutlSerialization.TutlSimpleFileReader; TengShaderFileWriter = uutlSerialization.TutlSimpleFileWriter; TIntfObjNoRefCount = uutlCommon.TutlInterfaceNoRefCount; +{$ELSE} +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + TIntfObjNoRefCount = class(TObject, IUnknown) + protected + fRefCount : longint; + { implement methods of IUnknown } + function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; + function _AddRef : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; virtual; + function _Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF}; virtual; + public + property RefCount: LongInt read fRefCount; + end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + IengShaderFileReader = interface + ['{3A9C3AE3-CAEE-44C9-85BE-0BCAA5C1BE7A}'] + function LoadStream(const aFilename: String; const aStream: TStream): Boolean; + end; + + IengShaderFileWriter = interface + ['{3DF84644-9FC4-4A8A-88C2-73F13E72B1ED}'] + procedure SaveStream(const aFilename: String; const aStream: TStream); + end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// + TengShaderFileReader = class(TInterfacedObject, IengShaderFileReader) + public + function LoadStream(const aFilename: String; const aStream: TStream): Boolean; + end; + + TengShaderFileWriter = class(TInterfacedObject, IengShaderFileWriter) + public + procedure SaveStream(const aFilename: String; const aStream: TStream); + end; {$ENDIF} TengShaderPartLogLevel = ( @@ -186,6 +222,59 @@ implementation uses uengShaderPart; +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TIntfObjNoRefCount////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TIntfObjNoRefCount.QueryInterface(constref iid: tguid; out obj): longint; stdcall; +begin + if getinterface(iid,obj) + then result := S_OK + else result := longint(E_NOINTERFACE); +end; + +function TIntfObjNoRefCount._AddRef: longint; stdcall; +begin + result := InterLockedIncrement(fRefCount); +end; + +function TIntfObjNoRefCount._Release: longint; stdcall; +begin + result := InterLockedDecrement(fRefCount); +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TengShaderFileReader////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +function TengShaderFileReader.LoadStream(const aFilename: String; const aStream: TStream): Boolean; +var + fs: TFileStream; +begin + result := FileExists(aFilename); + if result then begin + fs := TFileStream.Create(aFilename, fmOpenRead); + try + aStream.CopyFrom(fs, fs.Size - fs.Position); + finally + FreeAndNil(fs); + end; + end; +end; + +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//TengShaderFileWriter////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// +procedure TengShaderFileWriter.SaveStream(const aFilename: String; const aStream: TStream); +var + fs: TFileStream; +begin + fs := TFileStream.Create(aFilename, fmCreate); + try + fs.CopyFrom(aStream, aStream.Size - aStream.Position); + finally + FreeAndNil(fs); + end; +end; + //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TengMetaData////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// diff --git a/uengShaderGeneratorArgs.pas b/uengShaderGeneratorArgs.pas index 22f862f..a5de1e5 100644 --- a/uengShaderGeneratorArgs.pas +++ b/uengShaderGeneratorArgs.pas @@ -11,6 +11,8 @@ uses {$IFDEF SHADER_FILE_USE_BITSPACE_UTILS} , uutlGenerics +{$ELSE} + , uengShaderFileGenerics {$ENDIF} ; diff --git a/uengShaderPart.pas b/uengShaderPart.pas index f1ce70c..127da5b 100644 --- a/uengShaderPart.pas +++ b/uengShaderPart.pas @@ -13,7 +13,7 @@ uses {$IFDEF SHADER_FILE_USE_BITSPACE_UTILS} , uutlGenerics {$ELSE} - , fgl + , uengShaderFileGenerics {$ENDIF} ; diff --git a/uengShaderPartClass.pas b/uengShaderPartClass.pas index 8d7158b..6bfd877 100644 --- a/uengShaderPartClass.pas +++ b/uengShaderPartClass.pas @@ -11,6 +11,8 @@ uses {$IFDEF SHADER_FILE_USE_BITSPACE_UTILS} , uutlGenerics +{$ELSE} + , uengShaderFileGenerics {$ENDIF} ; diff --git a/uengShaderPartKeyValuePair.pas b/uengShaderPartKeyValuePair.pas index af9e4ee..dd969c9 100644 --- a/uengShaderPartKeyValuePair.pas +++ b/uengShaderPartKeyValuePair.pas @@ -11,6 +11,8 @@ uses {$IFDEF SHADER_FILE_USE_BITSPACE_UTILS} , uutlGenerics +{$ELSE} + , uengShaderFileGenerics {$ENDIF} ; diff --git a/uengShaderPartProc.pas b/uengShaderPartProc.pas index ac130db..cbc33de 100644 --- a/uengShaderPartProc.pas +++ b/uengShaderPartProc.pas @@ -12,8 +12,9 @@ uses {$IFDEF SHADER_FILE_USE_BITSPACE_UTILS} , uutlGenerics; {$ELSE} - , fgl; + , uengShaderFileGenerics {$ENDIF} + ; type ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////