///////////////////////////////////////////////////////////////////////
// Copyright (C) Andru 2007                                          //
// mail: dr.andru@gmail.com                                          //
// site: http://andru.2x4.ru                                         //
//                                                                   //
// OMEGA Engine is free software.                                    //
//                                                                   //
// You may 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 module 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 module.  If not, write to:                        //
// 	The Free Software Foundation, Inc.,                              //
// 	51 Franklin Street, Fifth Floor                                  //
// 	Boston, MA  02110-1301, USA.                                     //
///////////////////////////////////////////////////////////////////////
unit TEXTURE_EFFECTS;

{$I DEFINES.pas}

interface
uses
  Windows,
  OpenGL,
  minClasses,

  minFile,

  ENGINE_TYPES,
  ENGINE_VAR,
  ENGINE_CONST,

  ENGINE_UTILS,

  MATH_FAST;

procedure Tex_CalcTransparent(
                               pData            : Pointer;
                               TransparentColor : Integer;
                               Width, Height    : Integer
                             ); stdcall;
                             
procedure Tex_CalcGrayScale(
                             pData         : Pointer;
                             Width, Height : Integer ); stdcall;
                             
procedure Tex_CalcInvert(
                          pData         : Pointer;
                          Width, Height : Integer ); stdcall;

procedure Tex_CalcBGRA(
                        pData         : Pointer;
                        Width, Height : Integer ); stdcall;                          

procedure Tex_CalcMask(
                          _2x2          : Boolean;
                          pData         : Pointer;
                          Width, Height : Integer ); stdcall;

procedure Tex_LoadMaskFromFile( FileName : PChar ); stdcall;

procedure Tex_LoadMaskFromMemory( Memory : PMemory ); stdcall;

procedure Tex_FreeMask; stdcall;

procedure Tex_Calc2x2(
                       var pData     : Pointer;
                       var Width     : Integer;
                       var Height    : Integer;
                       var U, V      : Single ); stdcall;

procedure Tex_CalcQuality(
                           var pData     : Pointer;
                           var Width     : Integer;
                           var Height    : Integer;
                               Quality   : Integer ); stdcall;


procedure Get2x2( var Width, Height : Integer );

procedure CopyRGB ( p1, p2 : Integer );
procedure CopyRGBA( p1, p2 : Integer );

var
  Mask    : Pointer = nil;
  Mask2x2 : Pointer = nil;

//----------------------------------------------------------------------------//
                                 IMPLEMENTATION
//----------------------------------------------------------------------------//
uses
  TEXTURE_LOADER,
  TEXTURE_MANAGER,
  TEXTURE_FORMATS,

  ENGINE_LOG,

  UTILS;

procedure CopyRGB( p1, p2 : Integer );
Begin
Byte( Pointer( p1 + 0 )^ ) := Byte( Pointer( p2 + 0 )^ );
Byte( Pointer( p1 + 1 )^ ) := Byte( Pointer( p2 + 1 )^ );
Byte( Pointer( p1 + 2 )^ ) := Byte( Pointer( p2 + 2 )^ );
End;

procedure CopyRGBA( p1, p2 : Integer );
Begin
Byte( Pointer( p1 + 0 )^ ) := Byte( Pointer( p2 + 0 )^ );
Byte( Pointer( p1 + 1 )^ ) := Byte( Pointer( p2 + 1 )^ );
Byte( Pointer( p1 + 2 )^ ) := Byte( Pointer( p2 + 2 )^ );
Byte( Pointer( p1 + 3 )^ ) := Byte( Pointer( p2 + 3 )^ );
End;

procedure Get2x2;
  var
    W, H : Integer;
Begin
W := 1;
while W < Width do
  W := W shl 1;
Width  := W;

H := 1;
while H < Height do
  H := H shl 1;
Height := H;
End;

procedure Tex_CalcTransparent;
  var
    i, P    : Integer;
    r, g, b : Byte;
Begin
r := ( TransparentColor and $FF     );
g := ( TransparentColor and $FF00   ) shr 8;
b := ( TransparentColor and $FF0000 ) shr 16;
for i := 0 to Width * Height - 1 do
  begin
    P := Integer( pData ) + i * 4;

    if ( Byte( Pointer( P + 0 )^ ) = b ) and
       ( Byte( Pointer( P + 1 )^ ) = g ) and
       ( Byte( Pointer( P + 2 )^ ) = r ) Then
      begin
        Byte( Pointer( P + 0 )^ ) := 0;
        Byte( Pointer( P + 1 )^ ) := 0;
        Byte( Pointer( P + 2 )^ ) := 0;
        Byte( Pointer( P + 3 )^ ) := 0;

        if i + Width <= Width * Height - 1 Then
          if Byte( Pointer( Integer( pData ) + ( i + Width ) * 4 + 3 )^ ) > 0 Then
            CopyRGB( P, Integer( pData ) + ( i + Width ) * 4 );

        if i + 1 <= Width * Height - 1 Then
          if Byte( Pointer( Integer( pData ) + ( i + 1 ) * 4 + 3 )^ ) > 0 Then
            CopyRGB( P, Integer( pData ) + ( i + 1 ) * 4 );

        if i - 1 > 0 Then
          if Byte( Pointer( Integer( pData ) + ( i - 1 ) * 4 + 3 )^ ) > 0 Then
            CopyRGB( P, Integer( pData ) + ( i - 1 ) * 4 );

        if i - Width > 0 Then
          if Byte( Pointer( Integer( pData ) + ( i - Width ) * 4 + 3 )^ ) > 0 Then
            CopyRGB( P, Integer( pData ) + ( i - Width ) * 4 );

      end;{ else
        Byte( Pointer( P + 3 )^ ) := 255;}
  end;
End;

procedure Tex_CalcGrayScale;
  var
    i, P, Gray : Integer;
Begin
for i := 0 to Width * Height - 1 do
  begin
    P := Integer( pData ) + i * 4;
    Gray := M_Round(
                     Byte( Pointer( P + 0 )^ ) * 0.3  +
                     Byte( Pointer( P + 1 )^ ) * 0.59 +
                     Byte( Pointer( P + 2 )^ ) * 0.11
                   );

    Byte( Pointer( P + 0 )^ ) := Gray;
    Byte( Pointer( P + 1 )^ ) := Gray;
    Byte( Pointer( P + 2 )^ ) := Gray;
  end;
End;

procedure Tex_CalcInvert;
  var
    i, P : Integer;
Begin
for i := 0 to Width * Height - 1 do
  begin
    P := Integer( pData ) + i * 4;

    Byte( Pointer( P + 0 )^ ) := 255 - Byte( Pointer( P + 0 )^ );
    Byte( Pointer( P + 1 )^ ) := 255 - Byte( Pointer( P + 1 )^ );
    Byte( Pointer( P + 2 )^ ) := 255 - Byte( Pointer( P + 2 )^ );
  end;
End;

procedure Tex_CalcBGRA;
  var
    i, P, t : Integer;
Begin
for i := 0 to Width * Height - 1 do
  begin
    P := Integer( pData ) + i * 4;
    t := Byte( Pointer( P + 0 )^ );

    Byte( Pointer( P + 0 )^ ) := Byte( Pointer( P + 2 )^ );
    Byte( Pointer( P + 2 )^ ) := t;
  end;
End;

procedure Tex_LoadMaskFromFile;
  var
    Info   : TTexture;
    Stream : TMemoryStream;
Begin
FileName := PChar( String( app_Dir ) + String( FileName ) );
if assigned( Mask2x2 ) or assigned( Mask ) Then Tex_FreeMask;
if not FileExists( FileName ) Then
  begin
    E_Error( ERR_CANT_FIND_FILE + '"' + FileName + '"!' );
    app_Work := FALSE;
    Exit;
  end;

Stream := TMemoryStream.Create;
Stream.LoadFromFile( FileName );
Tex_LoadData( Stream.Memory, Stream.Size, Info, Mask );
Mem_Get( Mask2x2, Info.Width * Info.Height * 4 );
Move( Mask^, Mask2x2^, Info.Width * Info.Height * 4 );
Stream.Free;

if ( not assigned( Mask2x2 ) ) or ( not assigned( Mask ) ) Then
  begin
    E_Error( ERR_CANT_LOAD_MASK + FileName + '!' );
    app_Work := FALSE;
    Exit;
  end;

Tex_Calc2x2( Mask2x2, Info.Width, Info.Height, Info.U, Info.V );

while ( Info.Width > ogl_MaxTextureSize ) or ( Info.Height > ogl_MaxTextureSize ) do
  Tex_CalcQuality( Mask, Info.Width, Info.Height, 2 );
while ( Info.Width > ogl_MaxTextureSize ) or ( Info.Height > ogl_MaxTextureSize ) do
  Tex_CalcQuality( Mask2x2, Info.Width, Info.Height, 2 );

if app_Log Then
  LOG_AddMessage( LOGT_APP, PChar( LOG_LOADING_MASK + FileName ) );
End;

procedure Tex_LoadMaskFromMemory;
  var
    Info   : TTexture;
    Stream : TMemoryStream;
Begin
if assigned( Mask2x2 ) or assigned( Mask ) Then Tex_FreeMask;
if Memory^.Ptr = nil Then
  begin
    E_Error( MSKLOAD + ERR_CANT_LOAD_MASK + ERR_CANT_FIND_MEMORY );
    app_Work := FALSE;
    Exit;
  end;

Stream := TMemoryStream.Create;
Stream.Write( Memory^.Ptr^, Memory^.Size );
Tex_LoadData( Stream.Memory, Stream.Size, Info, Mask );
Mem_Get( Mask2x2, Info.Width * Info.Height * 4 );
Move( Mask^, Mask2x2^, Info.Width * Info.Height * 4 );
Stream.Free;

if ( not assigned( Mask2x2 ) ) or ( not assigned( Mask ) ) Then
  begin
    E_Error( MSKLOAD + ERR_CANT_LOAD_MASK + FROM_MEMORY );
    app_Work := FALSE;
    Exit;
  end;

Tex_Calc2x2( Mask2x2, Info.Width, Info.Height, Info.U, Info.V );

while ( Info.Width > ogl_MaxTextureSize ) or ( Info.Height > ogl_MaxTextureSize ) do
  Tex_CalcQuality( Mask, Info.Width, Info.Height, 2 );
while ( Info.Width > ogl_MaxTextureSize ) or ( Info.Height > ogl_MaxTextureSize ) do
  Tex_CalcQuality( Mask2x2, Info.Width, Info.Height, 2 );

if app_Log Then
  LOG_AddMessage( LOGT_APP, PChar( LOG_LOADING_MASK + FROM_MEMORY ) );
End;

procedure Tex_CalcMask;
  var
    i, P, PM : Integer;
    M        : Pointer;
Begin
if _2x2 Then
  M := Mask2x2
else
  M := Mask;

for i := 0 to Width * Height - 1 do
  begin
    P  := Integer( pData ) + i * 4;
    PM := Integer( M ) + i * 4;

    Byte( Pointer( P + 3 )^ ) := Byte( Pointer( PM + 1 )^ );
  end;
End;

procedure Tex_FreeMask;
Begin
Mem_Free( Mask );
Mem_Free( Mask2x2 );
Mask    := nil;
Mask2x2 := nil;
if app_Log Then
  LOG_AddMessage( LOGT_APP, LOG_FREE_MASK );
End;

procedure Tex_Calc2x2;
  var
    i    : Integer;
    w, h : Integer;
    Data : Pointer;
Begin
w := Width;
h := Height;
Get2x2( w, h );
if ( w = Width ) and ( h = Height ) Then exit;
U := Width / w;
V := Height / h;

Mem_Get( Data, w * h * 4 );
FillChar( Data^, w * h * 4, 0 );
for i := 0 to Height - 1 do
  Move( Pointer( Integer( pData ) + i * Width * 4 )^,
        Pointer( Integer( Data ) + i * w * 4 )^,
        Width * 4 );

Width  := w;
Height := h;
Mem_Free( pData );
pData := Data;
End;

procedure Tex_CalcQuality;
  var
    i, j   : Integer;
    w, h   : Integer;
    Data   : Pointer;
    p1, p2 : Integer;
Begin
w := Width  div Quality;
h := Height div Quality;

Mem_Get( Data, w * h * 4 );
for i := 0 to Width - 1 do
  for j := 0 to Height - 1 do
    begin
      p1 := Integer( Data ) + ( i div Quality ) * 4 + ( j div Quality ) * w * 4;
      p2 := Integer( pData ) + i * 4 + j * Width * 4;

      CopyRGBA( p1, p2 );
    end;

Width  := w;
Height := h;
Mem_Free( pData );
pData := Data;
End;

end.
