ShaderFile/library/header/ulibShaderFile.pas

unit ulibShaderFile;

{$IFDEF fpc}
  {$mode objfpc}{$H+}
{$ENDIF}

interface

uses
  Classes, SysUtils, Variants;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
type
  {$Z4}
  TlsfLogLevel = (
    llDebug                         = 0,
    llInfo                          = 1,
    llWarning                       = 2,
    llError                         = 3
  );

  {$Z4}
  TlsfErrorCode = (
    errUnknown                      = -1,
    errNone                         = $00000000,
    errNotInit                      = $00000001,
    errInvalidHandleShaderFile      = $00000010,
    errInvalidHandleShaderGenerator = $00000011,
    errInvalidGeneratorName         = $00000020,
    errInvalidPropertyIndex         = $00000021,
    errInvalidPropertyName          = $00000022,
    errGeneratorNotAssignedToFile   = $00000023,
    errUnknownIdentfifier           = $00001000,
    errDuplicateIdentifier          = $00001001,
    errOutOfRange                   = $00001002,
    errInvalidIdentifier            = $00001003,
    errInvalidParamterCount         = $00001004,
    errInvalidParamter              = $00001005,
    errUnexpectedToken              = $00001006,
    errInvalidToken                 = $00001007,
    errExpressionInternal           = $00001008,
    errExpression                   = $00001009,
    errShaderPartInternal           = $0000100a,
    errShaderPart                   = $0000100b,
    errInvalidLibraryName           = $00002000,
    errInvalidLibraryHandle         = $00002001,
    errInvalidMethodName            = $00002002
  );

  TlsfShaderFileHandle              = Pointer;
  TlsfGeneratorHandle               = Pointer;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TlsfShaderFileLogEvent            = procedure(const aLogLevel: TlsfLogLevel; const aMsg: PAnsiChar; const aUserArgs: Pointer); stdcall;

  Tlsf_ShaderFile_create            = function: TlsfShaderFileHandle; stdcall;
  Tlsf_ShaderFile_setLogCallback    = function(const aHandle: TlsfShaderFileHandle; const aCallback: TlsfShaderFileLogEvent; const aUserArgs: Pointer): TlsfErrorCode; stdcall;
  Tlsf_ShaderFile_loadFromFile      = function(const aHandle: TlsfShaderFileHandle; const aFilename: PAnsiChar): TlsfErrorCode; stdcall;
  Tlsf_ShaderFile_saveToFile        = function(const aHandle: TlsfShaderFileHandle; const aFilename: PAnsiChar): TlsfErrorCode; stdcall;
  Tlsf_ShaderFile_getGeneratorNames = function(const aHandle: TlsfShaderFileHandle): PAnsiChar; stdcall;
  Tlsf_ShaderFile_destroy           = function(const aHandle: TlsfShaderFileHandle): TlsfErrorCode; stdcall;

  Tlsf_Generator_create             = function(const aHandle: TlsfShaderFileHandle; const aName: PAnsiChar): TlsfGeneratorHandle; stdcall;
  Tlsf_Generator_getPropertyNames   = function(const aHandle: TlsfGeneratorHandle): PAnsiChar; stdcall;
  Tlsf_Generator_getProperty        = function(const aHandle: TlsfGeneratorHandle; const aIndex: Integer): PAnsiChar; stdcall;
  Tlsf_Generator_getPropertyByName  = function(const aHandle: TlsfGeneratorHandle; const aName: PAnsiChar): PAnsiChar; stdcall;
  Tlsf_Generator_setProperty        = function(const aHandle: TlsfGeneratorHandle; const aIndex: Integer; const aValue: PAnsiChar): TlsfErrorCode; stdcall;
  Tlsf_Generator_setPropertyByName  = function(const aHandle: TlsfGeneratorHandle; const aName: PAnsiChar; const aValue: PAnsiChar): TlsfErrorCode; stdcall;
  Tlsf_Generator_generateCode       = function(const aHandle: TlsfGeneratorHandle): PAnsiChar; stdcall;
  Tlsf_Generator_destroy            = function(const aHandle: TlsfGeneratorHandle): TlsfErrorCode; stdcall;

  Tlsf_init                         = function: TlsfErrorCode; stdcall;
  Tlsf_getLastErrorCode             = function: TlsfErrorCode; stdcall;
  Tlsf_getLastErrorMsg              = function: PAnsiChar; stdcall;
  Tlsf_getLastErrorTrace            = function: PAnsiChar; stdcall;
  Tlsf_finish                       = function: TlsfErrorCode; stdcall;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TlsfShaderFile = class(TObject)
  private
    fHandle: TlsfShaderFileHandle;
  protected
    procedure LogMsg(const aLogLevel: TlsfLogLevel; const aMsg: String); virtual;
  public
    property Handle: TlsfShaderFileHandle read fHandle;

    procedure LoadFromFile(const aFilename: String);
    procedure SaveToFile(const aFilename: String);

    constructor Create;
    destructor Destroy; override;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TlsfGenerator = class(TObject)
  private
    fName: String;
    fHandle: TlsfGeneratorHandle;
    fShaderFile: TlsfShaderFile;
    fProperties: TStringList;

    function GetProperties: TStrings;
  public
    property Name:       String         read fName;
    property ShaderFile: TlsfShaderFile read fShaderFile;
    property Properties: TStrings       read GetProperties;

    function GetProperty(const aName: String): Variant; overload;
    function GetProperty(const aIndex: Integer): Variant; overload;
    procedure SetProperty(const aName: String; const aValue: Variant); overload;
    procedure SetProperty(const aIndex: Integer; const aValue: Variant); overload;

    function GenerateCode: String;

    constructor Create(const aShaderFile: TlsfShaderFile; const aName: String);
    destructor Destroy; override;
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  TlsfException = class(Exception)
  private
    fErrorCode: TlsfErrorCode;
  public
    property ErrorCode: TlsfErrorCode read fErrorCode;
    constructor Create(const aMsg: string; const aError: TlsfErrorCode = errNone);
  end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
var
  lsf_ShaderFile_create:            Tlsf_ShaderFile_create;
  lsf_ShaderFile_setLogCallback:    Tlsf_ShaderFile_setLogCallback;
  lsf_ShaderFile_loadFromFile:      Tlsf_ShaderFile_loadFromFile;
  lsf_ShaderFile_saveToFile:        Tlsf_ShaderFile_saveToFile;
  lsf_ShaderFile_getGeneratorNames: Tlsf_ShaderFile_getGeneratorNames;
  lsf_ShaderFile_destroy:           Tlsf_ShaderFile_destroy;

  lsf_Generator_create:             Tlsf_Generator_create;
  lsf_Generator_getPropertyNames:   Tlsf_Generator_getPropertyNames;
  lsf_Generator_getProperty:        Tlsf_Generator_getProperty;
  lsf_Generator_getPropertyByName:  Tlsf_Generator_getPropertyByName;
  lsf_Generator_setProperty:        Tlsf_Generator_setProperty;
  lsf_Generator_setPropertyByName:  Tlsf_Generator_setPropertyByName;
  lsf_Generator_generateCode:       Tlsf_Generator_generateCode;
  lsf_Generator_destroy:            Tlsf_Generator_destroy;

  lsf_getLastErrorCode:             Tlsf_getLastErrorCode;
  lsf_getLastErrorMsg:              Tlsf_getLastErrorMsg;
  lsf_getLastErrorTrace:            Tlsf_getLastErrorTrace;

procedure lsf_init(const aLibName: String);
procedure lsf_finish;

implementation

{$IF DEFINED(WIN32) OR DEFINED(WIN64)}
uses
  windows;

type
  TLibHandle = HMODULE;

const
  InvalidLibHandle: TLibHandle = 0;

function LibOpen(const aLibName: String; out aError: String): TLibHandle;
begin
  result := LoadLibraryA(PAnsiChar(AnsiString(aLibName)));
  if (result = 0)
    then aError := SysErrorMessage(GetLastError())
    else aError := '';
end;

function GetAddr(const aLibHandle: TLibHandle; const aName: String): Pointer;
begin
  result := GetProcAddress(aLibHandle, PAnsiChar(AnsiString(aName)));
end;

procedure LibClose(const aLibHandle: TLibHandle);
begin
  FreeLibrary(aLibHandle);
end;

{$ELSEIF DEFINED(LINUX)}
uses
  dl;

type
  TLibHandle = Pointer;

const
  InvalidLibHandle: TLibHandle = nil;

function LibOpen(const aLibName: String; out aError: String): TLibHandle;
begin
  dlerror();
  result := dlopen(PChar(aLibName), RTLD_LAZY);
  if (result = InvalidLibHandle)
    then aError := dlerror()
    else aError := '';
end;

function GetAddr(const aLibHandle: TLibHandle; const aName: String): Pointer;
begin
  result := dlsym(aLibHandle, PChar(aName));
end;

procedure LibClose(const aLibHandle: TLibHandle);
begin
  dlclose(aLibHandle);
end;

{$ELSE}
  {$ERROR 'unknown operation system'}
{$IFEND}

var
  libHandle: TLibHandle;
  lsf_init_intern: Tlsf_init;
  lsf_finish_intern: Tlsf_finish;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure lsf_init(const aLibName: String);

  function LoadProc(const aName: String): Pointer;
  begin
    result := GetAddr(libHandle, aName);
    if not Assigned(result) then
      raise Exception.CreateFmt('unable to load ''%s'' from ''%s''', [aName, aLibName]);
  end;

var
  eMsg: String;
  err: TlsfErrorCode;
begin
  libHandle := LibOpen(aLibName, eMsg);
  if (libHandle = InvalidLibHandle) then
    raise Exception.Create('unable to load library: ' + eMsg);

  lsf_ShaderFile_create             := Tlsf_ShaderFile_create(            LoadProc('lsf_ShaderFile_create'));
  lsf_ShaderFile_setLogCallback     := Tlsf_ShaderFile_setLogCallback(    LoadProc('lsf_ShaderFile_setLogCallback'));
  lsf_ShaderFile_loadFromFile       := Tlsf_ShaderFile_loadFromFile(      LoadProc('lsf_ShaderFile_loadFromFile'));
  lsf_ShaderFile_saveToFile         := Tlsf_ShaderFile_saveToFile(        LoadProc('lsf_ShaderFile_saveToFile'));
  lsf_ShaderFile_getGeneratorNames  := Tlsf_ShaderFile_getGeneratorNames( LoadProc('lsf_ShaderFile_getGeneratorNames'));
  lsf_ShaderFile_destroy            := Tlsf_ShaderFile_destroy(           LoadProc('lsf_ShaderFile_destroy'));

  lsf_Generator_create              := Tlsf_Generator_create(             LoadProc('lsf_Generator_create'));
  lsf_Generator_getPropertyNames    := Tlsf_Generator_getPropertyNames(   LoadProc('lsf_Generator_getPropertyNames'));
  lsf_Generator_getProperty         := Tlsf_Generator_getProperty(        LoadProc('lsf_Generator_getProperty'));
  lsf_Generator_getPropertyByName   := Tlsf_Generator_getPropertyByName(  LoadProc('lsf_Generator_getPropertyByName'));
  lsf_Generator_setProperty         := Tlsf_Generator_setProperty(        LoadProc('lsf_Generator_setProperty'));
  lsf_Generator_setPropertyByName   := Tlsf_Generator_setPropertyByName(  LoadProc('lsf_Generator_setPropertyByName'));
  lsf_Generator_generateCode        := Tlsf_Generator_generateCode(       LoadProc('lsf_Generator_generateCode'));
  lsf_Generator_destroy             := Tlsf_Generator_destroy(            LoadProc('lsf_Generator_destroy'));

  lsf_init_intern                   := Tlsf_init(                         LoadProc('lsf_init'));
  lsf_getLastErrorCode              := Tlsf_getLastErrorCode(             LoadProc('lsf_getLastErrorCode'));
  lsf_getLastErrorMsg               := Tlsf_getLastErrorMsg(              LoadProc('lsf_getLastErrorMsg'));
  lsf_getLastErrorTrace             := Tlsf_getLastErrorTrace(            LoadProc('lsf_getLastErrorTrace'));
  lsf_finish_intern                 := Tlsf_finish(                       LoadProc('lsf_finish'));

  err := lsf_init_intern();
  if (err <> errNone) then
    raise TlsfException.Create('error while initializing library: ' + lsf_getLastErrorMsg(), err);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure lsf_finish;
begin
  lsf_finish_intern();
  lsf_ShaderFile_create            := nil;
  lsf_ShaderFile_setLogCallback    := nil;
  lsf_ShaderFile_loadFromFile      := nil;
  lsf_ShaderFile_saveToFile        := nil;
  lsf_ShaderFile_getGeneratorNames := nil;
  lsf_ShaderFile_destroy           := nil;
  lsf_getLastErrorCode             := nil;
  lsf_getLastErrorMsg              := nil;
  lsf_getLastErrorTrace            := nil;
  if (libHandle <> InvalidLibHandle) then begin
    LibClose(libHandle);
    libHandle := InvalidLibHandle;
  end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure LogCallback(const aLogLevel: TlsfLogLevel; const aMsg: PAnsiChar; const aUserArgs: Pointer); stdcall;
begin
  TlsfShaderFile(aUserArgs).LogMsg(aLogLevel, String(aMsg));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TlsfShaderFile////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TlsfShaderFile.LogMsg(const aLogLevel: TlsfLogLevel; const aMsg: String);
begin
  // DUMMY
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TlsfShaderFile.LoadFromFile(const aFilename: String);
var
  err: TlsfErrorCode;
begin
  err := lsf_ShaderFile_loadFromFile(fHandle, PAnsiChar(AnsiString(aFilename)));
  if (err <> errNone) then
    raise TlsfException.Create('error while loading from file: ' + lsf_getLastErrorMsg(), lsf_getLastErrorCode());
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TlsfShaderFile.SaveToFile(const aFilename: String);
var
  err: TlsfErrorCode;
begin
  err := lsf_ShaderFile_saveToFile(fHandle, PAnsiChar(AnsiString(aFilename)));
  if (err <> errNone) then
    raise TlsfException.Create('error while saving to file: ' + lsf_getLastErrorMsg(), lsf_getLastErrorCode());
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TlsfShaderFile.Create;
var
  err: TlsfErrorCode;
begin
  inherited Create;

  fHandle := lsf_ShaderFile_create();
  if not Assigned(fHandle) then
    raise TlsfException.Create('error while creating shader file: ' + lsf_getLastErrorMsg(), lsf_getLastErrorCode());

  err := lsf_ShaderFile_setLogCallback(fHandle, @LogCallback, self);
  if (err <> errNone) then
    raise TlsfException.Create('error while settings log callback: ' + lsf_getLastErrorMsg(), lsf_getLastErrorCode());
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TlsfShaderFile.Destroy;
begin
  if Assigned(fHandle) then begin
    lsf_ShaderFile_destroy(fHandle);
    fHandle := nil;
  end;
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TlsfGenerator/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TlsfGenerator.GetProperties: TStrings;
begin
  result := fProperties;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TlsfGenerator.GetProperty(const aName: String): Variant;
var
  s: PAnsiChar;
begin
  s := lsf_Generator_getPropertyByName(fHandle, PAnsiChar(AnsiString(aName)));
  if not Assigned(s) then
    raise TlsfException.Create('error while getting property by name: ' + lsf_getLastErrorMsg(), lsf_getLastErrorCode());
  result := String(s);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TlsfGenerator.GetProperty(const aIndex: Integer): Variant;
var
  s: PAnsiChar;
begin
  s := lsf_Generator_getProperty(fHandle, aIndex);
  if not Assigned(s) then
    raise TlsfException.Create('error while getting property by index: ' + lsf_getLastErrorMsg(), lsf_getLastErrorCode());
  result := String(s);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TlsfGenerator.SetProperty(const aName: String; const aValue: Variant);
var
  err: TlsfErrorCode;
  s: AnsiString;
begin
  s := AnsiString(aValue);
  err := lsf_Generator_setPropertyByName(fHandle, PAnsiChar(AnsiString(aName)), PAnsiChar(s));
  if (err <> errNone) then
    raise TlsfException.Create('error while settings property by name: ' + lsf_getLastErrorMsg(), err);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TlsfGenerator.SetProperty(const aIndex: Integer; const aValue: Variant);
var
  err: TlsfErrorCode;
  s: AnsiString;
begin
  s := AnsiString(aValue);
  err := lsf_Generator_setProperty(fHandle, aIndex, PAnsiChar(s));
  if (err <> errNone) then
    raise TlsfException.Create('error while settings property by name: ' + lsf_getLastErrorMsg(), err);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TlsfGenerator.GenerateCode: String;
var
  s: PAnsiChar;
begin
  s := lsf_Generator_generateCode(fHandle);
  if not Assigned(s) then
    raise TlsfException.Create('error while generating code: ' + lsf_getLastErrorMsg(), lsf_getLastErrorCode());
  result := String(s);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TlsfGenerator.Create(const aShaderFile: TlsfShaderFile; const aName: String);
var
  s: PAnsiChar;
begin
  inherited Create;
  fProperties := TStringList.Create;
  fShaderFile := aShaderFile;
  fName       := aName;
  fHandle     := lsf_Generator_create(fShaderFile.Handle, PAnsiChar(AnsiString(aName)));
  if not Assigned(fHandle) then
    raise TlsfException.Create('error while opening generator: ' + lsf_getLastErrorMsg(), lsf_getLastErrorCode());

  s := lsf_Generator_getPropertyNames(fHandle);
  if not Assigned(s) then
    raise TlsfException.Create('error while generating code: ' + lsf_getLastErrorMsg(), lsf_getLastErrorCode());
  fProperties.Text := string(s);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TlsfGenerator.Destroy;
begin
  if Assigned(fHandle) then begin
    lsf_Generator_destroy(fHandle);
    fHandle := nil;
  end;
  FreeAndNil(fProperties);
  inherited Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TlsfException/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TlsfException.Create(const aMsg: string; const aError: TlsfErrorCode);
begin
  inherited Create(aMsg);
  fErrorCode := aError;
end;

end.