{
    This file is part of Chentrah,
    Copyright (C) 2004-2014 Anton Rzheshevski (chebmaster@mail.ru).

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see http://www.gnu.org/licenses/

 **********************************************************************}


unit mo_glsl;

{$include mo_globaldefs.h}

interface

uses
  sysutils, Classes, math, md5,  chepersy, mo_hub, typinfo, mo_classes,
    mo_gmathbase, mo_resources;

procedure CheckGLSLError(Handle: GLhandleARB; Param: GLenum; Explanation: WideString; source: AnsiString = '');

procedure RegClasses;

type

  {
    There are things man was not meant to keep between module instances.
    For example, GLSL shaders are guaranteed to crash (does the driver
      link them to our DLL somehow?)

    So these classes are not inherited from TGenericDynamicResource anymore

    The class instances get saved and loaded, but the shaders are deleted
      at each module unload and recreated at each session load
      (because you *cannot* load the session without reloading the module DLL)
  }

  TAbstractShader = class(TManagedObject) //TGenericDynamicResource)
  private
    _handle: ptruint;
    f_source: AnsiString;
    function MyType: GLenum; virtual; abstract;
  public
    constructor Create(source: AnsiString);
    destructor Destroy; override;
    procedure GenResource;
    function Which(): WideString; virtual; abstract;
    procedure RegisterFields; override;
    property Handle: ptruint read _handle;
  end;

  TVertexShader = class(TAbstractShader)
  private
    function MyType: GLenum; override;
  public
    function Which(): WideString; override;
  end;

  TFragmentShader = class(TAbstractShader)
  private
    function MyType: GLenum; override;
  public
    function Which(): WideString; override;
  end;

  TGlslProgram = class(TManagedObject) //TGenericDynamicResource)
    //does NOT free shaders on destruction
  protected
    _handle: ptruint;
    f_vsh: TVertexShader;
    f_fsh: TFragmentShader;
    f_free_shaders_on_destroy: boolean;
  public
    constructor Create(_vsh: TVertexShader; _fsh: TFragmentShader;
      FreeShadersOnDestroy: boolean = true);
    procedure RegisterFields; override;
    destructor Destroy; override;
    procedure GenResource; virtual;
    procedure DeleteShaders;
    property VertexShader: TVertexShader read f_vsh;
    property FragmentShader: TFragmentShader read f_fsh;
    procedure Use;
    property Handle: ptruint read _handle;
  end;

implementation //**************************************************************
  uses mo_module;

  constructor TAbstractShader.Create(source: AnsiString);
  begin
    inherited Create;
    f_source:= source + #0;
    GenResource;
    Module.AddPerishable(Self);
  end;

  procedure TAbstractShader.RegisterFields;
  begin
    inherited;
    ListFields([
      '-_handle', @_handle, typeinfo(ptruint),
      'f_source', @f_source, typeinfo(AnsiString)
    ]);
  end;

  destructor TAbstractShader.Destroy;
  begin
    if _handle <> 0 then  glDeleteShader(_handle);
    CheckGlError;
    Module.RemovePerishable(Self);
    inherited;
  end;

  procedure TAbstractShader.GenResource;
  var
    len: GLuint;
  begin
    try
      _handle:= glCreateShader(MyType());
      CheckGlError;
      len:= Length(f_source);
      glShaderSource(_handle,  1, @(pointer(f_source)), NIL);//@len);
      CheckGlError;
      glCompileShader(_handle);
      CheckGLSLError(_handle, GL_OBJECT_COMPILE_STATUS_ARB,
        PervertedFormat(RuEn(
          'компиляции %0 шейдера',
          'compiling %0 shader'), [Which()]
        ),
        f_source
      );
    except
      if _handle <> 0 then glDeleteShader(_handle);
      CheckGlError;
      _handle:= 0;
      Die(RuEn('Не удалось создать шейдер','Failed to create shader'));
    end;
  end;

  function TVertexShader.Which(): WideString;
  begin
    Result:= RuEn('вершинного', 'vertex');
  end;


  function TFragmentShader.Which(): WideString;
  begin
    Result:= RuEn('фрагментного', 'fragment');
  end;


  function TVertexShader.MyType: GLenum;
  begin
    Result:= GL_VERTEX_SHADER_ARB;
  end;

  function TFragmentShader.MyType: GLenum;
  begin
    Result:= GL_FRAGMENT_SHADER_ARB;
  end;



//    f_vsh: TVertexShader;
//    f_fsh: TFragmentShader;

  constructor TGlslProgram.Create(_vsh: TVertexShader; _fsh: TFragmentShader;
      FreeShadersOnDestroy: boolean = true);
  begin
    f_vsh:= _vsh;
    f_fsh:= _fsh;
    f_free_shaders_on_destroy:= FreeShadersOnDestroy;
    GenResource;
    Module.AddPerishable(Self);
  end;

  procedure TGlslProgram.RegisterFields;
  begin
    inherited;
    ListFields([
      '-_handle', @_handle, typeinfo(ptruint),
      'f_vsh', @f_vsh, typeinfo(TVertexShader),
      'f_fsh', @f_fsh, typeinfo(TFragmentShader),
      'f_free_shaders_on_destroy', @f_free_shaders_on_destroy, typeinfo(boolean)
    ])
  end;

  destructor TGlslProgram.Destroy;
  begin
    if _handle = 0 then Exit;
    if Assigned(f_vsh) and (f_vsh.Handle <> 0) then begin
      glDetachShader(_handle, f_vsh.Handle);
      CheckGlError;
    end;
    if Assigned(f_fsh) and (f_fsh.Handle <> 0) then begin
      glDetachShader(_handle, f_fsh.Handle);
      CheckGlError;
    end;
    if f_free_shaders_on_destroy then DeleteShaders;
    glDeleteProgram(_handle);
    CheckGlError;
    Module.RemovePerishable(Self);
  end;

  procedure TGlslProgram.GenResource;
  var
    sta: GLint;
  begin
    try
      _handle:= glCreateProgram(); { see un_gl.inc : this var could be either
        glCreateProgram or glCreateProgramObjectARB, whichever is found first.
        This system was made when OpenGL 2.0 was a cutting edge technology,
        with limited support. It creates a transparent abstraction layer
        on top of various extensions of OpenGL 1.4+

        The downside is, the abstraction layer follows the OpenGL 1.4 syntax
      }
      CheckGlError;

      if not Assigned(f_vsh) then Die(RuEn(
        'TGlslProgram.GenResource: не хватает экземпляра класса вершинного шейдера',
        'TGlslProgram.GenResource: missing vertex shader class instance.'));
      if not Assigned(f_fsh) then Die(RuEn(
        'TGlslProgram.GenResource: не хватает экземпляра класса фрагментного шейдера',
        'TGlslProgram.GenResource: missing fragment shader class instance.'));

      if f_vsh.Handle = 0 then f_vsh.GenResource;
      if f_fsh.Handle = 0 then f_fsh.GenResource;

      glAttachShader(_handle, f_vsh.Handle); //alias for glAttachObjectARB
      CheckGlError;

      glAttachShader(_handle, f_fsh.Handle);
      CheckGlError;

      glLinkProgram(_handle);

      CheckGLSLError(_handle, GL_OBJECT_LINK_STATUS_ARB, RuEn(
        'сборки шейдеров в программу GLSL',
        'linking GLSL program'
      ));

    except
      if _handle <> 0 then begin
        glDeleteProgram(_handle);
        CheckGlError;
      end;
      _handle:= 0;
      Die(RuEn('Не удалось создать программу','Failed to create program'));
    end;
  end;

  procedure TGlslProgram.DeleteShaders;
  begin
    if Assigned(f_vsh) then begin
      f_vsh.Free;
      pointer(f_vsh):= NIL;
    end;
    if Assigned(f_fsh) then begin
      f_fsh.Free;
      pointer(f_fsh):= NIL;
    end;
  end;


  procedure TGlslProgram.Use;
  begin
    if _handle = 0 then GenResource;
    glUseProgram(_handle);
  end;


  procedure CheckGLSLError(Handle: GLhandleARB; Param: GLenum; Explanation: WideString; source: AnsiString);
  var
    slen, res: GLint;
    s: AnsiString;
  begin
    glGetObjectParameteriv(Handle, Param, @res);

    if (res <> GL_TRUE) or true then begin //MotherState^.VerboseLog then begin
      SetLength(s, 100000);
      glGetInfoLog(Handle, Length(s), @slen, PGLcharARB(@s[1]));
      SetLength(s, slen);
    end;

    if res <> GL_TRUE then begin
      MotherState^.Fatality:= Yes; //cuz opengl just hangs if we try to continue!
      if source <> ''
        then Die(RuEn(
          'Ошибка %0: %1'#10#13'Исходный код шейдера: %2',
          'Failed %0: %1'#10#13'Shader source: %2'), [Explanation, s, source])
        else Die(RuEn(
          'Ошибка %0: %1',
          'Failed %0: %1'), [Explanation, s]);
    end;

    if MotherState^.VerboseLog then
      if source <> ''
        then AddLog('Log of %0 : %1 ; Shader source: %2',[Explanation, s, source])
        else AddLog('Log of %0 : %1',[Explanation, s]);
  end;

  procedure RegClasses;
  begin
    RegClass(TVertexShader);
    RegClass(TFragmentShader);
    RegClass(TGlslProgram);
  end;

end.

