ShaderFile/library/libShaderFile.lpr

library libShaderFile;

{$mode objfpc}{$H+}

uses
  SysUtils,
  uengShaderFile, uengShaderPart, uengShaderFileGenerics, uengShaderFileTypes;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//external types and contstants/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
const
  LSF_LOGLEVEL_DEBUG                      = llDebug;
  LSF_LOGLEVEL_INFO                       = llInfo;
  LSF_LOGLEVEL_WARNING                    = llWarning;
  LSF_LOGLEVEL_ERROR                      = llError;

  LSF_ERR_NONE                            = $00000000;
  LSF_ERR_NOT_INIT                        = $00000001;
  LSF_ERR_INVALID_HANDLE_SHADER_FILE      = $00000002;
  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;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
type
  TlsfErrorCode = Cardinal;
  TlsfLogLevel = Cardinal;
  TlsfShaderFileHandle = Pointer;
  TlsfShaderFileLogEvent = procedure(const aLogLevel: TlsfLogLevel; const aMsg: PAnsiChar);

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//internal types and contstants/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
type
  TShaderFile = class(TengShaderFile)
  private
    fLogCallback: TlsfShaderFileLogEvent;
  protected
    procedure LogMsgIntern(const aSender: TengShaderPart; const aLogLevel: TengShaderPartLogLevel; const aMsg: String); override;
  public
    property LogCallback: TlsfShaderFileLogEvent read fLogCallback write fLogCallback;
  end;
  TengShaderFiles = specialize TutlHashSet<TShaderFile>;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
var
  ShaderFiles: TengShaderFiles = 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
  try
    result := Assigned(ShaderFiles);
    if not result then
      SetLastError(LSf_ERR_NOT_INIT, 'libShaderFile has not been initialized. call esf_init before using any other methods.');
  except
    on e: Exception do begin
      SetLastError(e);
      result := false;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function CheckShaderFileHandle(const aHandle: TlsfShaderFileHandle): Boolean;
begin
  try
    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', [PtrUInt(aHandle)]));
    end;
  except
    on e: Exception do begin
      SetLastError(e);
      result := false;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//ShaderFile////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function lsf_ShaderFile_create: TlsfShaderFileHandle; stdcall;
begin
  try
    result := nil;
    if not CheckIfInitialized then
      exit;
    result := TengShaderFile.Create;
    ShaderFiles.Add(TShaderFile(result));
  except
    on e: Exception do begin
      SetLastError(e);
      result := nil;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function lsf_ShaderFile_setLogCallback(const aHandle: TlsfShaderFileHandle; const aCallback: TlsfShaderFileLogEvent): TlsfErrorCode; stdcall;
begin
  try
    result := LSF_ERR_NONE;
    if not CheckShaderFileHandle(aHandle)
      then result := LastErrorCode
      else TShaderFile(aHandle).LogCallback := aCallback;
  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_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_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;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//Global////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function lsf_init: TlsfErrorCode; stdcall;
begin
  try
    result := LSF_ERR_NONE;
    ShaderFiles := TengShaderFiles.Create(true);
  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(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_saveToFile,
  lsf_ShaderFile_destroy,

  lsf_init,
  lsf_getLastErrorCode,
  lsf_getLastErrorMsg,
  lsf_getLastErrorTrace,
  lsf_finish;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//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));
end;

end.