|
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854 |
- library libShaderFile;
-
- {$mode objfpc}{$H+}
-
- uses
- SysUtils, variants, Classes,
- uengShaderFile, uengShaderGeneratorEx, uengShaderPart,
- uengShaderFileGenerics, uengShaderFileTypes;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //external types and contstants/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- const
- {%H-}LSF_LOGLEVEL_DEBUG = llDebug;
- {%H-}LSF_LOGLEVEL_INFO = llInfo;
- {%H-}LSF_LOGLEVEL_WARNING = llWarning;
- {%H-}LSF_LOGLEVEL_ERROR = llError;
-
- LSF_ERR_NONE = $00000000;
- LSF_ERR_NOT_INIT = $00000001;
- LSF_ERR_INVALID_HANDLE_SHADER_FILE = $00000010;
- LSF_ERR_INVALID_HANDLE_SHADER_GENERATOR = $00000011;
- LSF_ERR_INVALID_HANDLE_STREAM = $00000012;
- LSF_ERR_INVALID_GENERATOR_NAME = $00000020;
- LSF_ERR_INVALID_PROPERTY_INDEX = $00000021;
- LSF_ERR_INVALID_PROPERTY_NAME = $00000022;
- LSF_ERR_GENERATOR_NOT_ASSIGNED_TO_FILE = $00000023;
- LSF_ERR_UNKNOWN_IDENTFIFIER = $00001000;
- LSF_ERR_DUPLICATE_IDENTIFIER = $00001001;
- LSF_ERR_OUT_OF_RANGE = $00001002;
- LSF_ERR_INVALID_IDENTIFIER = $00001003;
- LSF_ERR_INVALID_PARAMTER_COUNT = $00001004;
- LSF_ERR_INVALID_PARAMTER = $00001005;
- LSF_ERR_UNEXPECTED_TOKEN = $00001006;
- LSF_ERR_INVALID_TOKEN = $00001007;
- LSF_ERR_EXPRESSION_INTERNAL = $00001008;
- LSF_ERR_EXPRESSION = $00001009;
- LSF_ERR_SHADER_PART_INTERNAL = $0000100A;
- LSF_ERR_SHADER_PART = $0000100B;
- LSF_ERR_UNKNOWN = $FFFFFFFF;
-
- {%H-}LSF_SEEK_BEG = soBeginning;
- {%H-}LSF_SEEK_CUR = soCurrent;
- {%H-}LSF_SEEK_END = soEnd;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- type
- TlsfErrorCode = Cardinal;
- TlsfLogLevel = Cardinal;
- TlsfSeekOrigin = Cardinal;
- TlsfShaderFileHandle = Pointer;
- TlsfShaderGeneratorHandle = Pointer;
- TlsfStreamHandle = Pointer;
-
- TlsfShaderFileLogEvent = procedure(const aLogLevel: TlsfLogLevel; const aMsg: PAnsiChar; const aUserArgs: Pointer); stdcall;
- TlsfSaveDataCallback = procedure(const aFilename: PAnsiChar; const aHandle: TlsfStreamHandle; const aUserArgs: Pointer); stdcall;
- TlsfLoadDataCallback = function(const aFilename: PAnsiChar; const aHandle: TlsfStreamHandle; const aUserArgs: Pointer): Boolean; stdcall;
-
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //internal types and contstants/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- type
- TShaderFile = class;
- TShaderGenerator = class;
-
- TShaderGeneratorHandleHashSet = specialize TutlHashSet<TlsfShaderGeneratorHandle>;
- TShaderGeneratorHashSet = specialize TutlHashSet<TShaderGenerator>;
- TStreamHashSet = specialize TutlHashSet<TStream>;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TShaderGenerator = class(TengShaderGeneratorEx)
- private
- fOwner: TShaderFile;
- fPropertyNames: String;
- fPropertyValue: String;
- fGeneratedCode: String;
- public
- property Owner: TShaderFile read fOwner;
- property PropertyNames: String read fPropertyNames;
-
- function GetProperty(const aIndex: Integer): PAnsiChar;
- function GetProperty(const aName: String): PAnsiChar;
- function SetProperty(const aIndex: Integer; const aValue: PAnsiChar): TlsfErrorCode;
- function SetProperty(const aName: String; const aValue: PAnsiChar): TlsfErrorCode;
- function GenerateCode: PAnsiChar;
-
- constructor Create(const aOwner: TShaderFile; const aName: String);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TShaderFile = class(TengShaderFile)
- private
- fLogUserArgs: Pointer;
- fLogCallback: TlsfShaderFileLogEvent;
- fGenerators: TShaderGeneratorHashSet;
- fGeneratorNames: String;
- protected
- procedure LogMsgIntern(const aSender: TengShaderPart; const aLogLevel: TengShaderPartLogLevel; const aMsg: String); override;
- public
- property LogCallback: TlsfShaderFileLogEvent read fLogCallback write fLogCallback;
- property LogUserArgs: Pointer read fLogUserArgs write fLogUserArgs;
- property GeneratorNames: String read fGeneratorNames;
-
- procedure LoadFromFile(const aFilename: String; const aFileReader: IengShaderFileReader = nil); reintroduce;
-
- function CreateGenerator(const aName: String): TShaderGenerator;
- function DestroyGenerator(const aGenerator: TShaderGenerator): TlsfErrorCode;
-
- constructor Create; overload;
- destructor Destroy; override;
- end;
- TShaderFileHashSet = specialize TutlHashSet<TShaderFile>;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TFileWriterProxy = class(TInterfacedObject, IengShaderFileWriter)
- private
- fUserArgs: Pointer;
- fCallback: TlsfSaveDataCallback;
- public
- procedure SaveStream(const aFilename: String; const aStream: TStream);
- constructor Create(const aCallback: TlsfSaveDataCallback; const aUserArgs: Pointer);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TFileReaderProxy = class(TInterfacedObject, IengShaderFileReader)
- private
- fUserArgs: Pointer;
- fCallback: TlsfLoadDataCallback;
- public
- function LoadStream(const aFilename: String; const aStream: TStream): Boolean;
- constructor Create(const aCallback: TlsfLoadDataCallback; const aUserArgs: Pointer);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- var
- ShaderFiles: TShaderFileHashSet = nil;
- ShaderGenerators: TShaderGeneratorHandleHashSet = nil;
- Streams: TStreamHashSet = nil;
- LastErrorCode: TlsfErrorCode = LSF_ERR_NONE;
- LastErrorMsg: String = '';
- LastErrorTrace: String = '';
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //Misc (not exportet)///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure SetLastError(const aErrorCode: TlsfErrorCode; const aMsg: String);
- begin
- LastErrorCode := aErrorCode;
- LastErrorMsg := aMsg;
- LastErrorTrace := '';
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure SetLastError(const aException: Exception);
- begin
- if (aException is EengUnknownIdentifier) then
- LastErrorCode := LSF_ERR_UNKNOWN_IDENTFIFIER
- else if (aException is EengDuplicateIdentifier) then
- LastErrorCode := LSF_ERR_DUPLICATE_IDENTIFIER
- else if (aException is EengOutOfRange) then
- LastErrorCode := LSF_ERR_OUT_OF_RANGE
- else if (aException is EengInvalidIdentifier) then
- LastErrorCode := LSF_ERR_INVALID_IDENTIFIER
- else if (aException is EengInvalidParamterCount) then
- LastErrorCode := LSF_ERR_INVALID_PARAMTER_COUNT
- else if (aException is EengInvalidParamter) then
- LastErrorCode := LSF_ERR_INVALID_PARAMTER
- else if (aException is EengUnexpectedToken) then
- LastErrorCode := LSF_ERR_UNEXPECTED_TOKEN
- else if (aException is EengInvalidToken) then
- LastErrorCode := LSF_ERR_INVALID_TOKEN
- else if (aException is EengExpressionInternal) then
- LastErrorCode := LSF_ERR_EXPRESSION_INTERNAL
- else if (aException is EengExpression) then
- LastErrorCode := LSF_ERR_EXPRESSION
- else if (aException is EengShaderPartInternal) then
- LastErrorCode := LSF_ERR_SHADER_PART_INTERNAL
- else if (aException is EengShaderPart ) then
- LastErrorCode := LSF_ERR_SHADER_PART
- else
- LastErrorCode := LSF_ERR_UNKNOWN;
- if (aException is EengShaderPart)
- then LastErrorTrace := (aException as EengShaderPart).PrintTrace
- else LastErrorTrace := '';
- LastErrorMsg := aException.Message;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function CheckIfInitialized: Boolean;
- begin
- result := Assigned(ShaderFiles);
- if not result then
- SetLastError(LSf_ERR_NOT_INIT, 'libShaderFile has not been initialized. call lsf_init before using any other methods.');
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function CheckShaderFileHandle(const aHandle: TlsfShaderFileHandle): Boolean;
- begin
- result := CheckIfInitialized;
- if result then begin
- result := ShaderFiles.Contains(TShaderFile(aHandle));
- if not result then
- SetLastError(LSF_ERR_INVALID_HANDLE_SHADER_FILE, Format('0x%x is not a valid shader file handle', [{%H-}PtrUInt(aHandle)]));
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function CheckShaderGeneratorHandle(const aHandle: TlsfShaderGeneratorHandle): Boolean;
- begin
- result := CheckIfInitialized;
- if result then begin
- result := ShaderGenerators.Contains(TShaderGenerator(aHandle));
- if not result then
- SetLastError(LSF_ERR_INVALID_HANDLE_SHADER_GENERATOR, Format('0x%x is not a valid shader generator handle', [{%H-}PtrUInt(aHandle)]));
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function CheckStreamHandle(const aHandle: TlsfStreamHandle): Boolean;
- begin
- result := CheckIfInitialized;
- if result then begin
- result := Streams.Contains(TStream(aHandle));
- if not result then
- SetLastError(LSF_ERR_INVALID_HANDLE_STREAM, Format('0x%x is not a valid stream handle', [{%H-}PtrUInt(aHandle)]));
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //ShaderFile////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function lsf_ShaderFile_create: TlsfShaderFileHandle; stdcall;
- var
- sf: TShaderFile;
- begin
- try
- result := nil;
- if not CheckIfInitialized then
- exit;
- sf := TShaderFile.Create;
- ShaderFiles.Add(sf);
- result := sf;
- except
- on e: Exception do begin
- SetLastError(e);
- result := nil;
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function lsf_ShaderFile_setLogCallback(const aHandle: TlsfShaderFileHandle; const aCallback: TlsfShaderFileLogEvent; const aUserArgs: Pointer): TlsfErrorCode; stdcall;
- begin
- try
- result := LSF_ERR_NONE;
- if CheckShaderFileHandle(aHandle) then with TShaderFile(aHandle) do begin
- LogCallback := aCallback;
- LogUserArgs := aUserArgs;
- end else
- result := LastErrorCode;
- except
- on e: Exception do begin
- SetLastError(e);
- result := LastErrorCode;
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function lsf_ShaderFile_loadFromFile(const aHandle: TlsfShaderFileHandle; const aFilename: PAnsiChar): TlsfErrorCode; stdcall;
- begin
- try
- result := LSF_ERR_NONE;
- if not CheckShaderFileHandle(aHandle)
- then result := LastErrorCode
- else TShaderFile(aHandle).LoadFromFile(aFilename);
- except
- on e: Exception do begin
- SetLastError(e);
- result := LastErrorCode;
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function lsf_ShaderFile_loadFromFunc(const aHandle: TlsfShaderFileHandle; const aFilename: PAnsiChar;
- const aCallback: TlsfLoadDataCallback; const aUserArgs: Pointer): TlsfErrorCode; stdcall;
- begin
- try
- result := LSF_ERR_NONE;
- if not CheckShaderFileHandle(aHandle)
- then result := LastErrorCode
- else TShaderFile(aHandle).LoadFromFile(aFilename, TFileReaderProxy.Create(aCallback, aUserArgs));
- except
- on e: Exception do begin
- SetLastError(e);
- result := LastErrorCode;
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function lsf_ShaderFile_saveToFile(const aHandle: TlsfShaderFileHandle; const aFilename: PAnsiChar): TlsfErrorCode; stdcall;
- begin
- try
- result := LSF_ERR_NONE;
- if not CheckShaderFileHandle(aHandle)
- then result := LastErrorCode
- else TShaderFile(aHandle).SaveToFile(aFilename);
- except
- on e: Exception do begin
- SetLastError(e);
- result := LastErrorCode;
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function lsf_ShaderFile_saveToFunc(const aHandle: TlsfShaderFileHandle; const aFilename: PAnsiChar;
- const aCallback: TlsfSaveDataCallback; const aUserArgs: Pointer): TlsfErrorCode; stdcall;
- begin
- try
- result := LSF_ERR_NONE;
- if not CheckShaderFileHandle(aHandle)
- then result := LastErrorCode
- else TShaderFile(aHandle).SaveToFile(aFilename, TFileWriterProxy.Create(aCallback, aUserArgs));
- except
- on e: Exception do begin
- SetLastError(e);
- result := LastErrorCode;
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function lsf_ShaderFile_getGeneratorNames(const aHandle: TlsfShaderFileHandle): PAnsiChar; stdcall;
- begin
- try
- if not CheckShaderFileHandle(aHandle)
- then result := nil
- else result := PAnsiChar(TShaderFile(aHandle).GeneratorNames);
- except
- on e: Exception do begin
- SetLastError(e);
- result := nil;
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function lsf_ShaderFile_destroy(const aHandle: TlsfShaderFileHandle): TlsfErrorCode; stdcall;
- begin
- try
- result := LSF_ERR_NONE;
- if not CheckShaderFileHandle(aHandle)
- then result := LastErrorCode
- else ShaderFiles.Remove(TShaderFile(aHandle));
- except
- on e: Exception do begin
- SetLastError(e);
- result := LastErrorCode;
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //Generator/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function lsf_Generator_create(const aHandle: TlsfShaderFileHandle; const aName: PAnsiChar): TlsfShaderGeneratorHandle; stdcall;
- begin
- try
- if not CheckShaderFileHandle(aHandle)
- then result := nil
- else result := TShaderFile(aHandle).CreateGenerator(string(aName));
- except
- on e: Exception do begin
- SetLastError(e);
- result := nil;
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function lsf_Generator_getPropertyNames(const aHandle: TlsfShaderGeneratorHandle): PAnsiChar; stdcall;
- begin
- try
- if not CheckShaderGeneratorHandle(aHandle)
- then result := nil
- else result := PAnsiChar(TShaderGenerator(aHandle).PropertyNames);
- except
- on e: Exception do begin
- SetLastError(e);
- result := nil;
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function lsf_Generator_getProperty(const aHandle: TlsfShaderGeneratorHandle; const aIndex: Integer): PAnsiChar; stdcall;
- begin
- try
- if not CheckShaderGeneratorHandle(aHandle)
- then result := nil
- else result := TShaderGenerator(aHandle).GetProperty(aIndex);
- except
- on e: Exception do begin
- SetLastError(e);
- result := nil;
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function lsf_Generator_getPropertyByName(const aHandle: TlsfShaderGeneratorHandle; const aName: PAnsiChar): PAnsiChar; stdcall;
- begin
- try
- if not CheckShaderGeneratorHandle(aHandle)
- then result := nil
- else result := TShaderGenerator(aHandle).GetProperty(aName);
- except
- on e: Exception do begin
- SetLastError(e);
- result := nil;
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function lsf_Generator_setProperty(const aHandle: TlsfShaderGeneratorHandle; const aIndex: Integer; const aValue: PAnsiChar): TlsfErrorCode; stdcall;
- begin
- try
- if not CheckShaderGeneratorHandle(aHandle)
- then result := LastErrorCode
- else result := TShaderGenerator(aHandle).SetProperty(aIndex, aValue);
- except
- on e: Exception do begin
- SetLastError(e);
- result := LastErrorCode;
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function lsf_Generator_setPropertyByName(const aHandle: TlsfShaderGeneratorHandle; const aName, aValue: PAnsiChar): TlsfErrorCode; stdcall;
- begin
- try
- if not CheckShaderGeneratorHandle(aHandle)
- then result := LastErrorCode
- else result := TShaderGenerator(aHandle).SetProperty(aName, aValue);
- except
- on e: Exception do begin
- SetLastError(e);
- result := LastErrorCode;
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function lsf_Generator_generateCode(const aHandle: TlsfShaderGeneratorHandle): PAnsiChar; stdcall;
- begin
- try
- if not CheckShaderGeneratorHandle(aHandle)
- then result := nil
- else result := TShaderGenerator(aHandle).GenerateCode;
- except
- on e: Exception do begin
- SetLastError(e);
- result := nil;
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function lsf_Generator_destroy(const aHandle: TlsfShaderGeneratorHandle): TlsfErrorCode; stdcall;
- var
- sg: TShaderGenerator;
- sf: TShaderFile;
- begin
- try
- result := LSF_ERR_NONE;
- if CheckShaderGeneratorHandle(aHandle) then begin
- sg := TShaderGenerator(aHandle);
- sf := sg.Owner;
- sf.DestroyGenerator(sg);
- end else
- result := LastErrorCode;
- except
- on e: Exception do begin
- SetLastError(e);
- result := LastErrorCode;
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //Stream////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function lsf_Stream_getSize(const aHandle: TlsfStreamHandle): Integer; stdcall;
- begin
- try
- if CheckStreamHandle(aHandle)
- then result := TStream(aHandle).Size
- else result := -1;
- except
- on e: Exception do begin
- SetLastError(e);
- result := LastErrorCode;
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function lsf_Stream_setSize(const aHandle: TlsfStreamHandle; const aSize: Integer): TlsfErrorCode; stdcall;
- begin
- try
- if CheckStreamHandle(aHandle)
- then TStream(aHandle).Size := aSize
- else result := LastErrorCode;
- except
- on e: Exception do begin
- SetLastError(e);
- result := LastErrorCode;
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function lsf_Stream_seek(const aHandle: TlsfStreamHandle; const aOffset: Integer; const aOrigin: TlsfSeekOrigin): Integer; stdcall;
- begin
- try
- if CheckStreamHandle(aHandle)
- then result := TStream(aHandle).Seek(aOrigin, aOrigin)
- else result := -1;
- except
- on e: Exception do begin
- SetLastError(e);
- result := LastErrorCode;
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function lsf_Stream_read(const aHandle: TlsfStreamHandle; const aBuffer: Pointer; const aSize: Integer): Integer; stdcall;
- begin
- try
- if CheckStreamHandle(aHandle)
- then result := TStream(aHandle).Read(aBuffer^, aSize)
- else result := -1;
- except
- on e: Exception do begin
- SetLastError(e);
- result := LastErrorCode;
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function lsf_Stream_write(const aHandle: TlsfStreamHandle; const aBuffer: Pointer; const aSize: Integer): Integer; stdcall;
- begin
- try
- if CheckStreamHandle(aHandle)
- then result := TStream(aHandle).Write(aBuffer^, aSize)
- else result := -1;
- except
- on e: Exception do begin
- SetLastError(e);
- result := LastErrorCode;
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //Global////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function lsf_init: TlsfErrorCode; stdcall;
- begin
- try
- result := LSF_ERR_NONE;
- ShaderFiles := TShaderFileHashSet.Create(true);
- ShaderGenerators := TShaderGeneratorHandleHashSet.Create(true);
- Streams := TStreamHashSet.Create(false);
- except
- on e: Exception do begin
- SetLastError(e);
- result := LastErrorCode;
- end;
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function lsf_getLastErrorCode: TlsfErrorCode; stdcall;
- begin
- result := LastErrorCode;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function lsf_getLastErrorMsg: PAnsiChar; stdcall;
- begin
- result := PAnsiChar(LastErrorMsg);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function lsf_getLastErrorTrace: PAnsiChar; stdcall;
- begin
- result := PAnsiChar(LastErrorTrace);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function lsf_finish: TlsfErrorCode; stdcall;
- begin
- try
- result := LSF_ERR_NONE;
- FreeAndNil(Streams);
- FreeAndNil(ShaderGenerators);
- FreeAndNil(ShaderFiles);
- except
- on e: Exception do begin
- SetLastError(e);
- result := LastErrorCode;
- end;
- end;
- end;
-
- exports
- lsf_ShaderFile_create,
- lsf_ShaderFile_setLogCallback,
- lsf_ShaderFile_loadFromFile,
- lsf_ShaderFile_loadFromFunc,
- lsf_ShaderFile_saveToFile,
- lsf_ShaderFile_saveToFunc,
- lsf_ShaderFile_getGeneratorNames,
- lsf_ShaderFile_destroy,
-
- lsf_Generator_create,
- lsf_Generator_getPropertyNames,
- lsf_Generator_getProperty,
- lsf_Generator_getPropertyByName,
- lsf_Generator_setProperty,
- lsf_Generator_setPropertyByName,
- lsf_Generator_generateCode,
- lsf_Generator_destroy,
-
- lsf_Stream_getSize,
- lsf_Stream_setSize,
- lsf_Stream_seek,
- lsf_Stream_read,
- lsf_Stream_write,
-
- lsf_init,
- lsf_getLastErrorCode,
- lsf_getLastErrorMsg,
- lsf_getLastErrorTrace,
- lsf_finish;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TShaderGenerator//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TShaderGenerator.GetProperty(const aIndex: Integer): PAnsiChar;
- begin
- result := nil;
- if (aIndex < 0) or (aIndex >= fProperties.Count) then begin
- SetLastError(LSF_ERR_INVALID_PROPERTY_INDEX, Format('index (%d) out of range (%d:%d)', [aIndex, 0, fProperties.Count-1]));
- exit;
- end;
- fPropertyValue := fProperties.ValueAt[aIndex];
- result := PAnsiChar(fPropertyValue);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TShaderGenerator.GetProperty(const aName: String): PAnsiChar;
- var
- i: Integer;
- begin
- result := nil;
- i := fProperties.IndexOf(aName);
- if (i >= 0)
- then result := GetProperty(i)
- else SetLastError(LSF_ERR_INVALID_PROPERTY_NAME, Format('%s is not a valid/known property name', [aName]));
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TShaderGenerator.SetProperty(const aIndex: Integer; const aValue: PAnsiChar): TlsfErrorCode;
- begin
- result := LSF_ERR_NONE;
- if (aIndex < 0) or (aIndex >= fProperties.Count) then begin
- SetLastError(LSF_ERR_INVALID_PROPERTY_INDEX, Format('index (%d) out of range (%d:%d)', [aIndex, 0, fProperties.Count-1]));
- result := LastErrorCode;
- end;
- fProperties.ValueAt[aIndex] := string(aValue);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TShaderGenerator.SetProperty(const aName: String; const aValue: PAnsiChar): TlsfErrorCode;
- var
- i: Integer;
- begin
- i := fProperties.IndexOf(aName);
- if (i < 0) then begin
- SetLastError(LSF_ERR_INVALID_PROPERTY_NAME, Format('%s is not a valid/known property name', [aName]));
- result := LastErrorCode;
- end else
- result := SetProperty(i, aValue)
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TShaderGenerator.GenerateCode: PAnsiChar;
- var
- kvp: TStringVariantMap.TKeyValuePair;
- c: TengShaderCode;
- begin
- for kvp in fProperties.KeyValuePairs do
- PropertyByName[kvp.Key] := kvp.Value;
- c := TengShaderCode.Create;
- try
- inherited GenerateCode(c);
- fGeneratedCode := c.Text;
- result := PAnsiChar(fGeneratedCode);
- finally
- FreeAndNil(c);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TShaderGenerator.Create(const aOwner: TShaderFile; const aName: String);
- var
- s: String;
- begin
- inherited Create(aOwner, aName);
- fOwner := aOwner;
- fPropertyNames := '';
- for s in fProperties.Keys do
- fPropertyNames := fPropertyNames + s + sLineBreak;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TShaderFile///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TShaderFile.LogMsgIntern(const aSender: TengShaderPart; const aLogLevel: TengShaderPartLogLevel; const aMsg: String);
- var
- tmp: TlsfShaderFileLogEvent;
- begin
- inherited LogMsgIntern(aSender, aLogLevel, aMsg);
- tmp := fLogCallback;
- if Assigned(tmp) then
- tmp(Cardinal(aLogLevel), PAnsiChar(aMsg), fLogUserArgs);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TShaderFile.LoadFromFile(const aFilename: String; const aFileReader: IengShaderFileReader);
- var
- i: Integer;
- begin
- inherited LoadFromFile(aFilename, aFileReader);
- fGeneratorNames := '';
- for i := 0 to GeneratorCount-1 do
- fGeneratorNames := fGeneratorNames + inherited GeneratorNames[i] + sLineBreak;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TShaderFile.CreateGenerator(const aName: String): TShaderGenerator;
-
- function CheckName: Boolean;
- var
- i: Integer;
- begin
- result := true;
- for i := 0 to GeneratorCount-1 do
- if (inherited GeneratorNames[i] = aName) then
- exit;
- result := false;
- end;
-
- begin
- result := nil;
- if not CheckName then begin
- SetLastError(LSF_ERR_INVALID_GENERATOR_NAME, 'a generator with the name ''' + aName + ''' does not exist');
- exit;
- end;
- result := TShaderGenerator.Create(self, aName);
- fGenerators.Add(result);
- ShaderGenerators.Add(result);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TShaderFile.DestroyGenerator(const aGenerator: TShaderGenerator): TlsfErrorCode;
- begin
- if Assigned(ShaderGenerators) then
- ShaderGenerators.Remove(aGenerator);
- if not fGenerators.Remove(aGenerator) then begin
- SetLastError(LSF_ERR_GENERATOR_NOT_ASSIGNED_TO_FILE, 'the passed generator handle is not owned by any file');
- result := LastErrorCode;
- end else
- result := LSF_ERR_NONE;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TShaderFile.Create;
- begin
- inherited Create;
- fGenerators := TShaderGeneratorHashSet.Create(true);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TShaderFile.Destroy;
- begin
- FreeAndNil(fGenerators);
- inherited Destroy;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TFileWriterProxy//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TFileWriterProxy.SaveStream(const aFilename: String; const aStream: TStream);
- begin
- Streams.Add(aStream);
- try
- fCallback(PAnsiChar(aFilename), TlsfStreamHandle(aStream), fUserArgs);
- finally
- Streams.Remove(aStream);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TFileWriterProxy.Create(const aCallback: TlsfSaveDataCallback; const aUserArgs: Pointer);
- begin
- inherited Create;
- fCallback := aCallback;
- fUserArgs := aUserArgs;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TFileReaderProxy//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TFileReaderProxy.LoadStream(const aFilename: String; const aStream: TStream): Boolean;
- begin
- Streams.Add(aStream);
- try
- result := fCallback(PAnsiChar(aFilename), TlsfStreamHandle(aStream), fUserArgs);
- finally
- Streams.Remove(aStream);
- end;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TFileReaderProxy.Create(const aCallback: TlsfLoadDataCallback; const aUserArgs: Pointer);
- begin
- inherited Create;
- fCallback := aCallback;
- fUserArgs := aUserArgs;
- end;
-
-
- end.
|