unit DDrawShader;
//
//  Implements shaders as resources.
//
//  All you need is the TShader object.
//

{$MODE FPC}
{$MODESWITCH OUT}
{$MODESWITCH RESULT}
{$I deng_defines.inc}

interface

uses
  strings,
  dansiview,
  dansibuffer,
  dansibuffer_ansiview,
  dstream,
  dstreammem,
  dfilereader,
  {$IFDEF DENG_USE_DRAW_OPENGL}{$IFDEF ANDROID}GLES,{$ELSE}GL, GLext,{$ENDIF}{$ENDIF}
  {$IFDEF DENG_USE_DRAW_OPENGL}DEng_glsl,{$ENDIF}
  {$IFDEF MSWINDOWS}windows,{$ENDIF}
  dcolors,
  dvector2i,
  dvector2f,
  dvector3f,
  dvector4f,
  dmatrix4f,
  deng,
  dresourcemanager;

type
TShaderParameters = object
private const
  FLAG_DEFAULT          = 1 shl 0;
  FLAG_SEPARATED        = 1 shl 1; // vertex and fragment are from separated
                                   // sources
private
  FFlags: Cardinal;
  FVertexFileName: AnsiString;
  FFragmentFileName: AnsiString;
public
  procedure InitDefault;
  procedure InitFile(const V, F: AnsiString);
  function MakeId: AnsiString;
end;

PShaderLoader = ^TShaderLoader;
TShaderLoader = object(TResourceType)
public
  function GetSingleton: PShaderLoader; static; inline;
  function OnAllocHolder(ResourceRecord: PResourceRecord;
                         Parameters: Pointer;
                         out Holder: Pointer): Boolean; virtual;
  function OnAllocDefaultHolder(ResourceRecord: PResourceRecord;
                         out Holder: Pointer): Boolean; virtual;
  function OnAllocHotSwapingHolder(ResourceRecord: PResourceRecord;
                                   Original: Pointer;
                                   out Holder: Pointer): Boolean; virtual;
  function OnThreadedLoad(Holder: Pointer): Boolean; virtual;
  function OnLoad(Holder: Pointer): Boolean; virtual;
  function OnUnload(Holder: Pointer): Boolean; virtual;
  function OnThreadedUnload(Holder: Pointer): Boolean; virtual;
  function OnDeallocHolder(Holder: Pointer): Boolean; virtual;
  function OnHotSwap(Old, New: PResourceRecord): Boolean; virtual;
end;

TShaderUniform = GLint;
TShaderAttribute = GLuint;

PShaderHolder = ^TShaderHolder;
TShaderHolder = object
private type
  TUniform = record
  {$IFDEF DENG_USE_DRAW_OPENGL}
    FLocation: GLint;
    FName: TAnsiBuffer;
  {$ENDIF}
  end;
  TAttribute = record
  {$IFDEF DENG_USE_DRAW_OPENGL}
    FLocation: GLint;
    FName: TAnsiBuffer;
  {$ENDIF}
  end;
private
  {$IFDEF DENG_USE_DRAW_OPENGL}
  FProgram: GLuint;
  FVertexShader: GLuint;
  FFragmentShader: GLuint;
  {$ENDIF}
  FParameters: TShaderParameters;
  FRecord: PResourceRecord;
  FVertexSource: AnsiString;
  FFragmentSource: AnsiString;
  FUniforms: array of TUniform;
  FAttributes: array of TAttribute;
public
  function GetUniform(Name: PAnsiChar): TShaderUniform;
  function GetAttribute(Name: PAnsiChar): TShaderAttribute;
  procedure LogVerboseInfo;
  property GetRecord: PResourceRecord read FRecord;
end;

TShader = object(specialize TResource<TShaderLoader, TShaderHolder>)
      //  Shader object for using in client code. Please take a look at the
      //  dresourcemanager.TResource definition to see all supported methods.
public
  procedure Init(const V, F: AnsiString);
  function GetAttribute(const Name: PAnsiChar): TShaderAttribute; inline;
      // Returns attrib array Id for the attribute Name
  function GetUniform(const Name: PAnsiChar): TShaderUniform; inline;
  procedure SetUniform1f(const Name: PAnsiChar; V: Single); inline; overload;
  procedure SetUniform2f(const Name: PAnsiChar; const V: TVec2f); inline; overload;
  procedure SetUniform4f(const Name: PAnsiChar; const V: TVec4f); inline; overload;
      //  Sets the uniform variable Name to the value V.
  procedure SetUniform1i(const Name: PAnsiChar; V: GLint); inline; overload;
  procedure SetUniformMatrix4f(const Name: PAnsiChar; const Matrix: TMat4f); inline; overload;
      //  Sets the uniform variable Name to the value Matrix.
  procedure SetUniform1f(Location: TShaderUniform; V: Single); inline; overload;
  procedure SetUniform2f(Location: TShaderUniform; const V: TVec2f); inline; overload;
  procedure SetUniform4f(Location: TShaderUniform; const V: TVec4f); inline; overload;
  procedure SetUniform1i(Location: TShaderUniform; V: GLint); inline; overload;
  procedure SetUniformMatrix4f(Location: TShaderUniform; const Matrix: TMat4f); inline; overload;
  procedure Use; inline;
  procedure Unuse; inline;
  procedure LogVerboseInfo;
end;

implementation

var
  ShaderLoader: TShaderLoader;

procedure TShaderParameters.InitDefault;
begin
  FFlags := FLAG_DEFAULT;
  FVertexFileName := '';
  FFragmentFileName := '';
end;

procedure TShaderParameters.InitFile(const V, F: AnsiString);
begin
  FFlags := FLAG_SEPARATED;
  FVertexFileName := V;
  FFragmentFileName := F;
end;

function TShaderParameters.MakeId: AnsiString;
begin
  Result := FVertexFileName + '+' + FFragmentFileName;
  if FFlags <> 0 then begin
    Result := Result + ' +';
    if FFlags and FLAG_SEPARATED <> 0 then
      Result := Result + 's';
  end;
end;

function TShaderLoader.GetSingleton: PShaderLoader;
begin
  Result := @ShaderLoader;
end;

function TShaderLoader.OnAllocHolder(ResourceRecord: PResourceRecord;
                       Parameters: Pointer;
                       out Holder: Pointer): Boolean;
begin
  New(PShaderHolder(Holder));
  PShaderHolder(Holder)^.FParameters := TShaderParameters(Parameters^);
  PShaderHolder(Holder)^.FRecord := ResourceRecord;
  // TODO Defaults
  Exit(True);
end;

function TShaderLoader.OnAllocDefaultHolder(ResourceRecord: PResourceRecord;
                       out Holder: Pointer): Boolean;
begin
  New(PShaderHolder(Holder));
  PShaderHolder(Holder)^.FParameters.InitDefault;
  PShaderHolder(Holder)^.FRecord := ResourceRecord;
  PShaderHolder(Holder)^.FProgram := 0;
  PShaderHolder(Holder)^.FVertexShader := 0;
  PShaderHolder(Holder)^.FFragmentShader := 0;
  Exit(True);
end;

function TShaderLoader.OnAllocHotSwapingHolder(ResourceRecord: PResourceRecord;
                                 Original: Pointer;
                                 out Holder: Pointer): Boolean;
begin
  Exit(False);
end;

function TShaderLoader.OnThreadedLoad(Holder: Pointer): Boolean;
begin
  with PShaderHolder(Holder)^ do begin
    if FParameters.FFlags and TShaderParameters.FLAG_SEPARATED <> 0 then begin
      if not ReadFileContent(FParameters.FVertexFileName, FVertexSource) then begin
        LogTagged('DD', 'FAILED ' + FParameters.FVertexFileName + ': not readable');
        Exit(False);
      end;
      if not ReadFileContent(FParameters.FFragmentFileName, FFragmentSource) then begin
        LogTagged('DD', 'FAILED ' + FParameters.FFragmentFileName + ': not readable');
        Exit(False);
      end;
    end;
  end;
  Exit(True); // pass-through
end;

function TShaderLoader.OnLoad(Holder: Pointer): Boolean;
var
  ActiveUniforms, ActiveAttributes: GLint;
  Len: GLsizei;
  Size: GLint;
  Typ: GLenum;
  Buf: array[0 .. 256 - 1] of AnsiChar;
  I: LongInt;
begin
  with PShaderHolder(Holder)^ do begin
    //LogTagged('DD', 'LODING SHADERS ');

    FVertexShader := glCreateShader(GL_VERTEX_SHADER);
    if not deng_glCompileShader(FVertexShader, FParameters.FVertexFileName, FVertexSource) then begin
      glDeleteShader(FVertexShader);
      Exit(False);
    end;
    LogTagged('DD', 'LOADED ' + FParameters.FVertexFileName);

    FFragmentShader := glCreateShader(GL_FRAGMENT_SHADER);
    if not deng_glCompileShader(FFragmentShader, FParameters.FFragmentFileName, FFragmentSource) then begin
      glDeleteShader(FFragmentShader);
      glDeleteShader(FVertexShader);
      Exit(False);
    end;
    LogTagged('DD', 'LOADED ' + FParameters.FFragmentFileName);

    FProgram := glCreateProgram();
    if not deng_glLinkShaders('Linking ' + FParameters.FVertexFileName + '+' + FParameters.FFragmentFileName, FProgram, FVertexShader, FFragmentShader) then begin
      glDeleteProgram(FProgram);
      glDeleteShader(FFragmentShader);
      glDeleteShader(FVertexShader);
      Exit(False);
    end;

    glGetProgramiv(FProgram, GL_ACTIVE_UNIFORMS, @ActiveUniforms);
    SetLength(FUniforms, ActiveUniforms);
    for I := 0 to ActiveUniforms - 1 do begin
      glGetActiveUniform(FProgram, I, High(Buf), @Len, @Size, @Typ, @Buf[0]);
      Buf[Len] := #0;
      FUniforms[I].FName.Init(@Buf[0], Len);
      FUniforms[I].FLocation := glGetUniformLocation(FProgram, @Buf[0]);
    end;
    glGetProgramiv(FProgram, GL_ACTIVE_ATTRIBUTES, @ActiveAttributes);
    SetLength(FAttributes, ActiveAttributes);
    for I := 0 to ActiveAttributes - 1 do begin
      glGetActiveAttrib(FProgram, I, High(Buf), @Len, @Size, @Typ, @Buf[0]);
      Buf[Len] := #0;
      FAttributes[I].FName.Init(@Buf[0], Len);
      FAttributes[I].FLocation := glGetAttribLocation(FProgram, @Buf[0]);
    end;
  end;
  Exit(True);
end;

function TShaderLoader.OnUnload(Holder: Pointer): Boolean;
var
  I: LongInt;
begin
  with PShaderHolder(Holder)^ do begin
    for I := 0 to High(FUniforms) do
      FUniforms[I].FName.Done;
    SetLength(FUniforms, 0);
    for I := 0 to High(FAttributes) do
      FAttributes[I].FName.Done;
    SetLength(FAttributes, 0);
    deng_glDeleteShaderProgram(FProgram, FVertexShader, FFragmentShader);
    FVertexSource := '';
    FFragmentSource := '';
    if FParameters.FFlags and TShaderParameters.FLAG_DEFAULT = 0 then begin
      if FParameters.FFlags and TShaderParameters.FLAG_SEPARATED <> 0 then begin
        LogTagged('DD', 'UNLOADED ' + FParameters.FVertexFileName);
        LogTagged('DD', 'UNLOADED ' + FParameters.FFragmentFileName);
      end else begin
        LogTagged('DD', 'UNLOADED ' + GetRecord^.GetHumanReadableId);
      end;
    end;
    Exit(True);
  end;
end;

function TShaderLoader.OnThreadedUnload(Holder: Pointer): Boolean;
begin
  Exit(True); // pass-through
end;

function TShaderLoader.OnDeallocHolder(Holder: Pointer): Boolean;
begin
  Dispose(PShaderHolder(Holder));
  Exit(True);
end;

function TShaderLoader.OnHotSwap(Old, New: PResourceRecord): Boolean;
begin
  Exit(False);
end;

{$IFDEF DENG_USE_NODRAW}
procedure TShader.Init(const V, F: PAnsiChar);
begin
end;

procedure TShader.Done;
begin
end;

procedure TShader.SetUniformMatrix4f(const Name: PAnsiChar; const Matrix: TMat4f);
begin
end;
{$ENDIF}

{$IFDEF DENG_USE_DRAW_OPENGL}
function TShaderHolder.GetUniform(Name: PAnsiChar): TShaderUniform;
var
  I: LongInt;
begin
  for I := 0 to High(FUniforms) do begin
    if FUniforms[I].FName = Name then
      Exit(FUniforms[I].FLocation);
  end;
  Exit(0);
end;

function TShaderHolder.GetAttribute(Name: PAnsiChar): TShaderAttribute;
var
  I: LongInt;
begin
  for I := 0 to High(FAttributes) do begin
    if FAttributes[I].FName = Name then
      Exit(FAttributes[I].FLocation);
  end;
  Exit(0);
end;

procedure TShaderHolder.LogVerboseInfo;
var
  I: LongInt;
  S: AnsiString;
begin
  S := GetRecord^.GetHumanReadableId + ': UNIFORMS: ';
  for I := 0 to High(FUniforms) do begin
    S := S + FUniforms[I].FName.ToString;
    if I < High(FUniforms) then
      S := S + ',';
  end;
  S := S + '; ATTRIBUTES: ';
  for I := 0 to High(FAttributes) do begin
    S := S + FAttributes[I].FName.ToString;
    if I < High(FAttributes) then
      S := S + ',';
  end;
  S := S + ';';
  LogTagged('DD', S);
end;

procedure TShader.Init(const V, F: AnsiString);
var
  Parameters: TShaderParameters;
begin
  Parameters.InitFile(V, F);
  LoadInternal(nil, @Parameters, Parameters.MakeId);
end;

function TShader.GetAttribute(const Name: PAnsiChar): TShaderAttribute;
begin
  //Result := glGetAttribLocation(FHolder^.FProgram, Name);
  Result := FHolder^.GetAttribute(Name);
end;

function TShader.GetUniform(const Name: PAnsiChar): TShaderUniform; inline;
begin
  Result := FHolder^.GetUniform(Name);
end;

procedure TShader.SetUniform1f(const Name: PAnsiChar; V: Single);
var
  Location: GLuint;
begin
  Location := FHolder^.GetUniform(Name);
  glUniform1f(Location, V);
end;

procedure TShader.SetUniform2f(const Name: PAnsiChar; const V: TVec2f);
var
  Location: GLuint;
begin
  Location := FHolder^.GetUniform(Name);
  glUniform2fv(Location, 1, @V);
end;

procedure TShader.SetUniform4f(const Name: PAnsiChar; const V: TVec4f);
var
  Location: GLuint;
begin
  Location := FHolder^.GetUniform(Name);
  glUniform4fv(Location, 1, @V);
end;

procedure TShader.SetUniform1i(const Name: PAnsiChar; V: GLint); inline;
var
  Location: GLuint;
begin
  Location := FHolder^.GetUniform(Name);
  glUniform1i(Location, V);
end;

procedure TShader.SetUniformMatrix4f(const Name: PAnsiChar; const Matrix: TMat4f);
var
  Location: GLuint;
begin
  Location := FHolder^.GetUniform(Name);
  glUniformMatrix4fv(Location, 1, GL_FALSE, @Matrix[0]);
end;

procedure TShader.SetUniform1f(Location: TShaderUniform; V: Single);
begin
  glUniform1f(Location, V);
end;

procedure TShader.SetUniform2f(Location: TShaderUniform; const V: TVec2f);
begin
  glUniform2fv(Location, 1, @V);
end;

procedure TShader.SetUniform4f(Location: TShaderUniform; const V: TVec4f);
begin
  glUniform4fv(Location, 1, @V);
end;

procedure TShader.SetUniform1i(Location: TShaderUniform; V: GLint);
begin
  glUniform1i(Location, V);
end;

procedure TShader.SetUniformMatrix4f(Location: TShaderUniform; const Matrix: TMat4f);
begin
  glUniformMatrix4fv(Location, 1, GL_FALSE, @Matrix[0]);
end;

procedure TShader.Use;
begin
  glUseProgram(FHolder^.FProgram);
end;

procedure TShader.Unuse;
begin
  glUseProgram(0);
end;

procedure TShader.LogVerboseInfo;
begin
  FHolder^.LogVerboseInfo;
end;
{$ENDIF}

initialization
  ShaderLoader.Init(TResourceType.FLAG_THREADED_LOAD);
finalization
  ShaderLoader.Done;
end.
