- title-bar icon working again in windowed mode

- moved LoadImage to UImage.pas
- added RWopsFromStream() to get an SDL RWops handle from a TStream
- removed some German comments

git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1041 b956fd51-792f-4845-bead-9b4dfca2ff2c

4 files changed, 1051 insertions, 1088 deletions

diff --git a/Game/Code/Classes/UCommon.pas b/Game/Code/Classes/UCommon.pas
index f37322f4..ff88c4b6 100644
--- a/Game/Code/Classes/UCommon.pas
+++ b/Game/Code/Classes/UCommon.pas
@@ -15,6 +15,7 @@ uses
   Windows,

   Messages,

   {$ENDIF}

+  sdl,

   ULog;

 

 {$IFNDEF DARWIN}

@@ -34,6 +35,7 @@ procedure ShowMessage( const msg : String; msgType: TMessageType = mtInfo );
 procedure ConsoleWriteLn(const msg: string);

 

 function GetResourceStream(const aName, aType : string): TStream;

+function RWopsFromStream(Stream: TStream): PSDL_RWops;

 

 {$IFDEF FPC}

 function RandomRange(aMin: Integer; aMax: Integer) : Integer;

@@ -81,9 +83,6 @@ uses
   {$IFDEF LINUX}

   libc,

   {$ENDIF}

-  {$IFDEF FPC}

-  sdl,

-  {$ENDIF}

   UMain,

   UConfig;

 

@@ -334,6 +333,76 @@ begin
   {$ENDIF}

 end;

 

+// +++++++++++++++++++++ helpers for RWOpsFromStream() +++++++++++++++

+  function SdlStreamSeek( context : PSDL_RWops; offset : Integer; whence : Integer ) : integer; cdecl;

+  var

+    stream : TStream;

+    origin : Word;

+  begin

+    stream := TStream( context.unknown );

+    if ( stream = nil ) then

+      raise EInvalidContainer.Create( 'SDLStreamSeek on nil' );

+    case whence of

+      0 : origin := soFromBeginning; //	Offset is from the beginning of the resource. Seek moves to the position Offset. Offset must be >= 0.

+      1 : origin := soFromCurrent; //	Offset is from the current position in the resource. Seek moves to Position + Offset.

+      2 : origin := soFromEnd;

+    else

+      origin := soFromBeginning; // just in case

+    end;

+    Result := stream.Seek( offset, origin );

+  end;

+  

+  function SdlStreamRead( context : PSDL_RWops; Ptr : Pointer; size : Integer; maxnum: Integer ) : Integer; cdecl;

+  var

+    stream : TStream;

+  begin

+    stream := TStream( context.unknown );

+    if ( stream = nil ) then

+      raise EInvalidContainer.Create( 'SDLStreamRead on nil' );

+    try

+      Result := stream.read( Ptr^, Size * maxnum ) div size;

+    except

+      Result := -1;

+    end;

+  end;

+  

+  function SDLStreamClose( context : PSDL_RWops ) : Integer; cdecl;

+  var

+    stream : TStream;

+  begin

+    stream := TStream( context.unknown );

+    if ( stream = nil ) then

+      raise EInvalidContainer.Create( 'SDLStreamClose on nil' );

+    stream.Free;

+    Result := 1;

+  end;

+// -----------------------------------------------

+

+(*

+ * Creates an SDL_RWops handle from a TStream.

+ * The stream and RWops must be freed by the user after usage.

+ * Use SDL_FreeRW(...) to free the RWops data-struct. 

+ *)

+function RWopsFromStream(Stream: TStream): PSDL_RWops;

+begin

+  Result := SDL_AllocRW();

+  if (Result = nil) then

+    Exit;

+

+  // set RW-callbacks

+  with Result^ do

+  begin

+    unknown := TUnknown(Stream);

+    seek    := SDLStreamSeek;

+    read    := SDLStreamRead;

+    write   := nil;

+    close   := SDLStreamClose;

+    type_   := 2;

+  end;

+end;

+

+

+

 {$IFDEF FPC}

 function RandomRange(aMin: Integer; aMax: Integer) : Integer;

 begin

diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas
index afb986e1..cc34b18d 100644
--- a/Game/Code/Classes/UGraphic.pas
+++ b/Game/Code/Classes/UGraphic.pas
@@ -16,6 +16,7 @@ uses
   ULog,
   SysUtils,
   ULyrics,
+  UImage,
   UScreenLoading,
   UScreenWelcome,
   UScreenMain,
@@ -249,17 +250,12 @@ function LoadingThreadFunction: integer;
 
 implementation
 
-uses  UMain,
-      UIni,
-      UDisplay,
-      UCommandLine,
-      {$IFNDEF FPC}
-      Graphics,
-      {$ENDIF}
-      {$IFDEF win32}
-      windows,
-      {$ENDIF}
-      Classes;
+uses
+  UMain,
+  UIni,
+  UDisplay,
+  UCommandLine,
+  Classes;
 
 procedure LoadFontTextures;
 begin
@@ -402,79 +398,59 @@ begin
 end;
 
 procedure Initialize3D (Title: string);
-//var
-//  Icon: TIcon;
-//  Res:  TResourceStream;
-// ISurface: PSDL_Surface; // Auto Removed, Unused Variable
-// Pixel: PByteArray; // Auto Removed, Unused Variable
-// I: Integer; // Auto Removed, Unused Variable
+var
+  Icon: PSDL_Surface;
 begin
   Log.LogStatus('LoadOpenGL', 'UGraphic.Initialize3D');
-//  Log.BenchmarkStart(2);
+  //Log.BenchmarkStart(2);
 
   LoadOpenGL;
 
   Log.LogStatus('SDL_Init', 'UGraphic.Initialize3D');
-  if ( SDL_Init(SDL_INIT_VIDEO)= -1 ) then
+  if ( SDL_InitSubSystem(SDL_INIT_VIDEO) = -1 ) then
   begin
     Log.LogError('SDL_Init Failed', 'UGraphic.Initialize3D');
     exit;
   end;
 
- { //Load Icon
-  Res := TResourceStream.CreateFromID(HInstance, 3, RT_ICON);
-  Icon := TIcon.Create;
-  Icon.LoadFromStream(Res);
-  Res.Free;
-  Icon.
-  //Create icon Surface
-  SDL_CreateRGBSurfaceFrom (
-  SDL_SWSURFACE,
-  Icon.Width,
-  Icon.Height,
-  32,
-  128 or 64,
-  32 or 16,
-  8 or 4,
-  2 or 1);
-  //SDL_BlitSurface(
-
-
-  SDL_WM_SetIcon(SDL_LoadBMP('DEFAULT_WINDOW_ICON'), 0); //}
+  // load icon image (must be 32x32 for win32)
+  Icon := LoadImage('WINDOWICON');
+  if (Icon <> nil) then
+    SDL_WM_SetIcon(Icon, 0);
 
   SDL_WM_SetCaption(PChar(Title), nil);
 
   InitializeScreen;
 
-//  Log.BenchmarkEnd(2);
-//  Log.LogBenchmark('--> Setting Screen', 2);
+  //Log.BenchmarkEnd(2);
+  //Log.LogBenchmark('--> Setting Screen', 2);
 
-  // ladowanie tekstur
-//  Log.BenchmarkStart(2);
+  //Log.BenchmarkStart(2);
   Texture := TTextureUnit.Create;
   Texture.Limit := 1024*1024;
 
-//  LoadTextures;
-//  Log.BenchmarkEnd(2);
-//  Log.LogBenchmark('--> Loading Textures', 2);
+  //LoadTextures;
+  //Log.BenchmarkEnd(2);
+  //Log.LogBenchmark('--> Loading Textures', 2);
 
-{  Log.BenchmarkStart(2);
+  {
+  Log.BenchmarkStart(2);
   Lyric:= TLyric.Create;
   Log.BenchmarkEnd(2);
   Log.LogBenchmark('--> Loading Fonts', 2);
-}
+  }
 
-//  Log.BenchmarkStart(2);
+  //Log.BenchmarkStart(2);
 
   Log.LogStatus('TDisplay.Create', 'UGraphic.Initialize3D');
   Display := TDisplay.Create;
-  
+
   Log.LogStatus('SDL_EnableUnicode', 'UGraphic.Initialize3D');
   SDL_EnableUnicode(1);
-//  Log.BenchmarkEnd(2); Log.LogBenchmark('====> Creating Display', 2);
+  //Log.BenchmarkEnd(2); Log.LogBenchmark('====> Creating Display', 2);
 
-//  Log.LogStatus('Loading Screens', 'Initialize3D');
-//  Log.BenchmarkStart(3);
+  //Log.LogStatus('Loading Screens', 'Initialize3D');
+  //Log.BenchmarkStart(3);
 
   Log.LogStatus('Loading Font Textures', 'UGraphic.Initialize3D');
   LoadFontTextures();
@@ -488,18 +464,14 @@ begin
   LoadTextures; // jb
 
 
-  
+
   // now that we have something to display while loading,
   // start thread that loads the rest of ultrastar
-//  Mutex   := SDL_CreateMutex;
-//  SDL_UnLockMutex(Mutex);
-
-  // funktioniert so noch nicht, da der ladethread unverändert auf opengl zugreifen will
-  // siehe dazu kommentar unten
-  // Englisch Translation:
-  // is currently not working because the loading thread trys to accses opengl unchanged
-  // look comment below
+  //Mutex   := SDL_CreateMutex;
+  //SDL_UnLockMutex(Mutex);
 
+  // does not work this way because the loading thread tries to access opengl.
+  // See comment below
   //LoadingThread  := SDL_CreateThread(@LoadingThread, nil);
 
   // this would be run in the loadingthread
@@ -507,24 +479,8 @@ begin
   LoadScreens;
 
 
-  // TODO!!!!!!1
-  // hier käme jetzt eine schleife, die
-  // * den ladescreen malt (ab und zu)
-  // * den "fortschritt" des ladescreens steuert
-  // * zwischendrin schaut, ob der ladethread texturen geladen hat (mutex prüfen) und
-  //   * die texturen in die opengl lädt, sowie
-  //   * dem ladethread signalisiert, dass der speicher für die textur
-  //     zum laden der nächsten textur weiterverwendet werden kann (über weiteren mutex)
-  // * über einen 3. mutex so lange läuft, bis der ladethread signalisiert,
-  //   dass er alles geladen hat fertig ist
-  //
-  // dafür muss loadtexture so umgeschrieben werden, dass es, statt selbst irgendwelche
-  // opengl funktionen aufzurufen, entsprechend mutexe verändert
-  // der hauptthread muss auch irgendwoher erfahren, was an opengl funktionen auszuführen ist,
-  // mit welchen parametern (texturtyp, entspr. texturobjekt, textur-zwischenspeicher-adresse, ...
-  //
-  // English Translation:
-  // here should be a loop witch
+  // TODO:
+  // here should be a loop which
   // * draws the loading screen (form time to time)
   // * controlls the "process of the loading screen
   // * checks if the loadingthread has loaded textures (check mutex) and
@@ -538,10 +494,8 @@ begin
   // the mainthread have to know somehow what opengl function have to be called with which parameters like
   // texturetype, textureobjekt, textur-buffer-adress, ...
 
-
-
   // wait for loading thread to finish
-  // funktioniert so auch noch nicht - currently dos not work this way
+  // currently does not work this way
   // SDL_WaitThread(LoadingThread, I);
   // SDL_DestroyMutex(Mutex);
 
@@ -611,16 +565,9 @@ begin
   else
     Depth := Ini.Depth;
 
-
-  Log.LogStatus('SDL_SetVideoMode', 'Set Window Icon');
-
-// Okay it's possible to set the title bar / taskbar icon here
-// it's working this way, but just if the bmp is in your exe folder
-  SDL_WM_SetIcon(SDL_LoadBMP('ustar-icon.bmp'), 0);
-
   Log.LogStatus('SDL_SetVideoMode', 'Initialize3D');
-//  SDL_SetRefreshrate(85);
-//  SDL_GL_SetAttribute( SDL_GL_DOUBLEBUFFER, 1 );
+  //SDL_SetRefreshrate(85);
+  //SDL_GL_SetAttribute( SDL_GL_DOUBLEBUFFER, 1 );
 
   {$IFDEF DARWIN}
     // Todo : eddie: remove before realease
diff --git a/Game/Code/Classes/UImage.pas b/Game/Code/Classes/UImage.pas
index 640e5202..d0a9d0d8 100644
--- a/Game/Code/Classes/UImage.pas
+++ b/Game/Code/Classes/UImage.pas
@@ -107,6 +107,8 @@ function WriteBMPImage(const FileName: string; Surface: PSDL_Surface): boolean;
 function WriteJPGImage(const FileName: string; Surface: PSDL_Surface; Quality: integer): boolean;

 {$ENDIF}

 

+function LoadImage(const Identifier: string): PSDL_Surface;

+

 implementation

 

 uses

@@ -130,6 +132,8 @@ uses
   png,

   {$ENDIF}

   zlib,

+  sdl_image,

+  UCommon,

   ULog;

 

 function IsRGBSurface(pixelFmt: PSDL_PixelFormat): boolean;

@@ -700,4 +704,66 @@ end;
 

 {$ENDIF}

 

+(*

+ * Loads an image from the given file or resource

+ *)

+function LoadImage(const Identifier: string): PSDL_Surface;

+var
+  TexRWops:  PSDL_RWops;
+  TexStream: TStream;
+  FileName: string;
+begin
+  Result   := nil;
+  TexRWops := nil;
+
+  if Identifier = '' then
+    exit;
+    
+  //Log.LogStatus( Identifier, 'LoadImage' );
+
+  FileName := Identifier;
+
+  if (FileExistsInsensitive(FileName)) then
+  begin
+    // load from file
+    //Log.LogStatus( 'Is File ( Loading : '+FileName+')', '  LoadImage' );
+    try
+      Result := IMG_Load(PChar(FileName));
+      //Log.LogStatus( '       '+inttostr( integer( Result ) ), '  LoadImage' );
+    except
+      Log.LogError('Could not load from file "'+FileName+'"', 'TTextureUnit.LoadImage');
+      Exit;
+    end;
+  end
+  else
+  begin
+    //Log.LogStatus( 'IS Resource, because file does not exist.('+Identifier+')', '  LoadImage' );
+
+    TexStream := GetResourceStream(Identifier, 'TEX');
+    if (not assigned(TexStream)) then
+    begin
+      Log.LogError( 'Invalid file or resource "'+ Identifier+'"', 'TTextureUnit.LoadImage');
+      Exit;
+    end;
+
+    TexRWops := RWopsFromStream(TexStream);
+    if (TexRWops = nil) then
+    begin
+      Log.LogError( 'Could not assign resource "'+Identifier+'"', 'TTextureUnit.LoadImage');
+      TexStream.Free();
+      Exit;
+    end;
+
+    //Log.LogStatus( 'resource Assigned....' , Identifier);
+    try
+      Result := IMG_Load_RW(TexRWops, 0);
+    except
+      Log.LogError( 'Could not read resource "'+Identifier+'"', 'TTextureUnit.LoadImage');
+    end;
+
+    SDL_FreeRW(TexRWops);
+    TexStream.Free();
+  end;
+end;
+

 end.

diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas
index 8502c3e4..b88300d4 100644
--- a/Game/Code/Classes/UTexture.pas
+++ b/Game/Code/Classes/UTexture.pas
@@ -1,993 +1,874 @@
-unit UTexture;

-// added for easier debug disabling

-{$undef blindydebug}

-

-interface

-

-{$IFDEF FPC}

-  {$MODE Delphi}

-{$ENDIF}

-

-{$I switches.inc}

-

-uses OpenGL12,

-     {$IFDEF win32}

-     windows,

-     {$ENDIF}

-     Math,

-     Classes,

-     SysUtils,

-     UCommon,

-     UImage,

-     SDL,

-     sdlutils,

-     SDL_Image;

-

-type

-  TTexture = record

-    TexNum:   GLuint;

-    X:        real;

-    Y:        real;

-    Z:        real; // new

-    W:        real;

-    H:        real;

-    ScaleW:   real; // for dynamic scalling while leaving width constant

-    ScaleH:   real; // for dynamic scalling while leaving height constant

-    Rot:      real; // 0 - 2*pi

-    Int:      real; // intensity

-    ColR:     real;

-    ColG:     real;

-    ColB:     real;

-    TexW:     real; // used?

-    TexH:     real; // used?

-    TexX1:    real;

-    TexY1:    real;

-    TexX2:    real;

-    TexY2:    real;

-    Alpha:    real;

-    Name:     string; // 0.5.0: experimental for handling cache images. maybe it's useful for dynamic skins

-  end;

-

-type

-  TTextureType = (

-    TEXTURE_TYPE_PLAIN,        // Plain (alpha = 1)

-    TEXTURE_TYPE_TRANSPARENT,  // Alpha is used

-    TEXTURE_TYPE_COLORIZED     // Alpha is used; Hue of the HSV color-model will be replaced by a new value

-  );

-const

-  TextureTypeStr: array[TTextureType] of string = (

-    'Plain',

-    'Transparent',

-    'Colorized'

-  );

-

-function TextureTypeToStr(TexType: TTextureType): string;

-function ParseTextureType(const TypeStr: string; Default: TTextureType): TTextureType;

-

-type

-  TTextureEntry = record

-    Name:       string;

-    Typ:        TTextureType;

-    Color:      Cardinal;

-

-    // we use normal TTexture, it's easier to implement and if needed - we copy ready data

-    Texture:        TTexture;

-    TextureCache:   TTexture;

-  end;

-

-  TTextureDatabase = record

-    Texture:    array of TTextureEntry;

-  end;

-

-  TTextureUnit = class

-    private

-      TnWidth, TnHeight: Cardinal; //Width and Height of the Cover Thumbnails

-

-      TnBuffer:  array of byte;

-      TnSurface: PSDL_Surface;

-

-      function LoadImage(const Identifier: string): PSDL_Surface;

-      function pixfmt_eq(fmt1,fmt2: PSDL_Pixelformat): boolean;

-      procedure AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: TTextureType);

-      function GetScaledTexture(TexSurface: PSDL_Surface; W,H: Cardinal): PSDL_Surface;

-      procedure ScaleTexture(var TexSurface: PSDL_Surface; W,H: Cardinal);

-      procedure FitTexture(var TexSurface: PSDL_Surface; W,H: Cardinal);

-      procedure ColorizeTexture(TexSurface: PSDL_Surface; Col: Cardinal);

-    public

-    Limit:      integer;

-    CreateCacheMipmap:  boolean;

-

-//    function GetNumberFor

-    function GetTexture(const Name: string; Typ: TTextureType; FromCache: boolean = true): TTexture; overload;

-    function GetTexture(const Name: string; Typ: TTextureType; Col: LongWord; FromCache: boolean = true): TTexture; overload;

-    function FindTexture(const Name: string; Typ: TTextureType; Col: Cardinal): integer;

-    function LoadTexture(FromRegistry: boolean; const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture; overload;

-    function LoadTexture(const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture; overload;

-    function LoadTexture(const Identifier: string): TTexture; overload;

-    function CreateTexture(var Data: array of byte; const Name: string; W, H: word; Bits: byte): TTexture;

-    procedure UnloadTexture(const Name: string; Typ: TTextureType; FromCache: boolean); overload;

-    procedure UnloadTexture(const Name: string; Typ: TTextureType; Col: Cardinal; FromCache: boolean); overload;

-    //procedure FlushTextureDatabase();

-

-    Function GetCoverThumbnail(const Name: string): Pointer;

-    Procedure SetCoverSize(W, H: Integer);

-    

-    Constructor Create;

-    Destructor Destroy; override;

-  end;

-

-var

-  Texture:          TTextureUnit;

-  TextureDatabase:  TTextureDatabase;

-

-  ActTex:     GLuint;

-

-  Mipmapping: Boolean;

-

-  CacheMipmap:  array[0..256*256*3-1] of byte; // 3KB

-  CacheMipmapSurface: PSDL_Surface;

-

-

-implementation

-

-uses ULog,

-     DateUtils,

-     UCovers,

-     UThemes,

-     {$IFDEF DARWIN}

-     MacResources,

-     {$ENDIF}

-     StrUtils;

-

-Constructor TTextureUnit.Create;

-begin

-  inherited Create;

-end;

-

-Destructor TTextureUnit.Destroy;

-begin

-  inherited Destroy;

-end;

-

-function TTextureUnit.pixfmt_eq(fmt1,fmt2: PSDL_Pixelformat): boolean;

-begin

-  if (fmt1^.BitsPerPixel = fmt2^.BitsPerPixel) and

-     (fmt1^.BytesPerPixel = fmt2^.BytesPerPixel) and

-     (fmt1^.Rloss = fmt2^.Rloss) and (fmt1^.Gloss = fmt2^.Gloss) and

-     (fmt1^.Bloss = fmt2^.Bloss) and (fmt1^.Rmask = fmt2^.Rmask) and

-     (fmt1^.Gmask = fmt2^.Gmask) and (fmt1^.Bmask = fmt2^.Bmask) and

-     (fmt1^.Rshift = fmt2^.Rshift) and (fmt1^.Gshift = fmt2^.Gshift) and

-     (fmt1^.Bshift = fmt2^.Bshift)

-   then

-    Result:=True

-  else

-    Result:=False;

-end;

-

-// +++++++++++++++++++++ helpers for loadimage +++++++++++++++

-  function SdlStreamSeek( context : PSDL_RWops; offset : Integer; whence : Integer ) : integer; cdecl;

-  var

-    stream : TStream;

-    origin : Word;

-  begin

-    stream := TStream( context.unknown );

-    if ( stream = nil ) then

-      raise EInvalidContainer.Create( 'SDLStreamSeek on nil' );

-    case whence of

-      0 : origin := soFromBeginning; //	Offset is from the beginning of the resource. Seek moves to the position Offset. Offset must be >= 0.

-      1 : origin := soFromCurrent; //	Offset is from the current position in the resource. Seek moves to Position + Offset.

-      2 : origin := soFromEnd;

-    else

-      origin := soFromBeginning; // just in case

-    end;

-    Result := stream.Seek( offset, origin );

-  end;

-  

-  function SdlStreamRead( context : PSDL_RWops; Ptr : Pointer; size : Integer; maxnum: Integer ) : Integer; cdecl;

-  var

-    stream : TStream;

-  begin

-    stream := TStream( context.unknown );

-    if ( stream = nil ) then

-      raise EInvalidContainer.Create( 'SDLStreamRead on nil' );

-    try

-      Result := stream.read( Ptr^, Size * maxnum ) div size;

-    except

-      Result := -1;

-    end;

-  end;

-  

-  function SDLStreamClose( context : PSDL_RWops ) : Integer; cdecl;

-  var

-    stream : TStream;

-  begin

-    stream := TStream( context.unknown );

-    if ( stream = nil ) then

-      raise EInvalidContainer.Create( 'SDLStreamClose on nil' );

-    stream.Free;

-    Result := 1;

-  end;

-// -----------------------------------------------

-

-function TTextureUnit.LoadImage(const Identifier: string): PSDL_Surface;

-var

-  TexRWops:  PSDL_RWops;

-  TexStream: TStream;

-  FileName: string;

-begin

-  Result   := nil;

-  TexRWops := nil;

-

-  if Identifier = '' then

-    exit;

-    

-  //Log.LogStatus( Identifier, 'LoadImage' );

-

-  FileName := Identifier;

-

-  if (FileExistsInsensitive(FileName)) then

-  begin

-    // load from file

-    //Log.LogStatus( 'Is File ( Loading : '+FileName+')', '  LoadImage' );

-    try

-      Result := IMG_Load(PChar(FileName));

-      //Log.LogStatus( '       '+inttostr( integer( Result ) ), '  LoadImage' );

-    except

-      Log.LogError('Could not load from file "'+FileName+'"', 'TTextureUnit.LoadImage');

-      Exit;

-    end;

-  end

-  else

-  begin

-    //Log.LogStatus( 'IS Resource, because file does not exist.('+Identifier+')', '  LoadImage' );

-

-    TexStream := GetResourceStream(Identifier, 'TEX');

-    if (not assigned(TexStream)) then

-    begin

-      Log.LogError( 'Invalid file or resource "'+ Identifier+'"', 'TTextureUnit.LoadImage');

-      Exit;

-    end;

-

-    TexRWops := SDL_AllocRW();

-    if (TexRWops = nil) then

-    begin

-      Log.LogError( 'Could not assign resource "'+Identifier+'"', 'TTextureUnit.LoadImage');

-      TexStream.Free();

-      Exit;

-    end;

-

-    // user defined RW-callbacks

-    with TexRWops^ do

-    begin

-      unknown := TUnknown(TexStream);

-      seek    := SDLStreamSeek;

-      read    := SDLStreamRead;

-      write   := nil;

-      close   := SDLStreamClose;

-      type_   := 2;

-    end;

-

-    //Log.LogStatus( 'resource Assigned....' , Identifier);

-    try

-      Result := IMG_Load_RW(TexRWops, 0);

-    except

-      Log.LogError( 'Could not read resource "'+Identifier+'"', 'TTextureUnit.LoadImage');

-    end;

-

-    SDL_FreeRW(TexRWops);

-    TexStream.Free();

-  end;

-end;

-

-procedure TTextureUnit.AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: TTextureType);

-var

-  TempSurface: PSDL_Surface;

-  NeededPixFmt: PSDL_Pixelformat;

-begin

-  NeededPixFmt:=@PixelFmt_RGBA;

-  if      (Typ = TEXTURE_TYPE_PLAIN) then

-    NeededPixFmt:=@PixelFmt_RGB

-  else if (Typ = TEXTURE_TYPE_TRANSPARENT) or

-          (Typ = TEXTURE_TYPE_COLORIZED) then

-    NeededPixFmt:=@PixelFmt_RGBA

-  else

-    NeededPixFmt:=@PixelFmt_RGB;

-

-

-  if not pixfmt_eq(TexSurface^.format, NeededPixFmt) then

-  begin

-    TempSurface:=TexSurface;

-    TexSurface:=SDL_ConvertSurface(TempSurface,NeededPixFmt,SDL_SWSURFACE);

-    SDL_FreeSurface(TempSurface);

-  end;

-end;

-

-function TTextureUnit.GetScaledTexture(TexSurface: PSDL_Surface; W,H: Cardinal): PSDL_Surface;

-var

-  TempSurface: PSDL_Surface;

-begin

-  TempSurface:=TexSurface;

-  Result:=SDL_ScaleSurfaceRect(TempSurface,

-                  0,0,TempSurface^.W,TempSurface^.H,

-                  W,H);

-  SDL_FreeSurface(TempSurface);

-end;

-

-procedure TTextureUnit.ScaleTexture(var TexSurface: PSDL_Surface; W,H: Cardinal);

-var

-  TempSurface: PSDL_Surface;

-begin

-  TempSurface:=TexSurface;

-  TexSurface:=SDL_ScaleSurfaceRect(TempSurface,

-                  0,0,TempSurface^.W,TempSurface^.H,

-                  W,H);

-  SDL_FreeSurface(TempSurface);

-end;

-

-procedure TTextureUnit.FitTexture(var TexSurface: PSDL_Surface; W,H: Cardinal);

-var

-  TempSurface: PSDL_Surface;

-begin

-  TempSurface:=TexSurface;

-  with TempSurface^.format^ do

-    TexSurface:=SDL_CreateRGBSurface(SDL_SWSURFACE,W,H,BitsPerPixel,RMask, GMask, BMask, AMask);

-  SDL_SetAlpha(TexSurface, 0, 255);

-  SDL_SetAlpha(TempSurface, 0, 255);

-  SDL_BlitSurface(TempSurface,nil,TexSurface,nil);

-  SDL_FreeSurface(TempSurface);

-end;

-

-procedure TTextureUnit.ColorizeTexture(TexSurface: PSDL_Surface; Col: Cardinal);

-  //returns hue within range [0.0-6.0)

-  function col2hue(Color:Cardinal): double;

-  var

-    clr: array[0..2] of double;

-    hue, max, delta: double;

-  begin

-    clr[0] := ((Color and $ff0000) shr 16)/255; // R

-    clr[1] := ((Color and   $ff00) shr  8)/255; // G

-    clr[2] :=  (Color and     $ff)        /255; // B

-    max := maxvalue(clr);

-    delta := max - minvalue(clr);

-    // calc hue

-    if (delta = 0.0) then       hue := 0

-    else if (clr[0] = max) then hue :=     (clr[1]-clr[2])/delta

-    else if (clr[1] = max) then hue := 2.0+(clr[2]-clr[0])/delta

-    else if (clr[2] = max) then hue := 4.0+(clr[0]-clr[1])/delta;

-    if (hue < 0.0) then

-      hue := hue + 6.0;

-    Result := hue;

-  end;

-

-var

-  DestinationHue: Double;

-  PixelIndex: Cardinal;

-  Pixel: PByte;

-    PixelColors: PByteArray;

-//    clr: array[0..2] of Double; // [0: R, 1: G, 2: B]

-    clr2: array[0..2] of Uint32;

-//    hsv: array[0..2] of Double; // [0: H(ue), 1: S(aturation), 2: V(alue)]

-    hsv2: array[0..2] of UInt32;//LongInt;

-    dhue: UInt32;//LongInt;

-    h_int: Cardinal;

-//    delta, f, p, q, t: Double;

-    delta2,f2,p2,q2,t2: Longint;//LongInt;

-//    max: Double;

-    max2: Uint32;

-begin

-  DestinationHue := col2hue(Col);

-

-  dhue:=Trunc(DestinationHue*1024);

-

-  Pixel := TexSurface^.Pixels;

-

-  for PixelIndex := 0 to (TexSurface^.W * TexSurface^.H)-1 do

-  begin

-    PixelColors:=PByteArray(Pixel);

-  // inlined colorize per pixel

-

-  // uses fixed point math

-    // get color values

-    clr2[0]:=PixelColors[0] shl 10;

-    clr2[1]:=PixelColors[1] shl 10;

-    clr2[2]:=PixelColors[2] shl 10;

-    //calculate luminance and saturation from rgb

-

-    max2:=clr2[0];

-    if clr2[1]>max2 then max2:=clr2[1];

-    if clr2[2]>max2 then max2:=clr2[2];

-    delta2:=clr2[0];

-    if clr2[1]<delta2 then delta2:=clr2[1];

-    if clr2[2]<delta2 then delta2:=clr2[2];

-    delta2:=max2-delta2;

-    hsv2[0]:=dhue;  // shl 8

-    hsv2[2]:=max2;  // shl 8

-    if (max2=0) then hsv2[1] := 0

-    else             hsv2[1] := (delta2 shl 10) div max2; // shl 8

-      h_int:= hsv2[0] and $fffffC00;

-      f2:= hsv2[0]-h_int; //shl 10

-      p2:= (hsv2[2]*(1024-hsv2[1])) shr 10;

-      q2:= (hsv2[2]*(1024-(hsv2[1]*f2) shr 10)) shr 10;

-      t2:= (hsv2[2]*(1024-(hsv2[1]*(1024-f2)) shr 10)) shr 10;

-      h_int:=h_int shr 10;

-      case h_int of

-        0: begin clr2[0]:=hsv2[2]; clr2[1]:=t2;      clr2[2]:=p2;      end; // (v,t,p)

-        1: begin clr2[0]:=q2;      clr2[1]:=hsv2[2]; clr2[2]:=p2;      end; // (q,v,p)

-        2: begin clr2[0]:=p2;      clr2[1]:=hsv2[2]; clr2[2]:=t2;      end; // (p,v,t)

-        3: begin clr2[0]:=p2;      clr2[1]:=q2;      clr2[2]:=hsv2[2]; end; // (p,q,v)

-        4: begin clr2[0]:=t2;      clr2[1]:=p2;      clr2[2]:=hsv2[2]; end; // (t,p,v)

-        5: begin clr2[0]:=hsv2[2]; clr2[1]:=p2;      clr2[2]:=q2;      end; // (v,p,q)

-      end;

-

-    PixelColors[0]:=clr2[0] shr 10;

-    PixelColors[1]:=clr2[1] shr 10;

-    PixelColors[2]:=clr2[2] shr 10;

-

-    // old floating point version

-(*    clr[0] := PixelColors[0]/255;

-    clr[1] := PixelColors[1]/255;

-    clr[2] := PixelColors[2]/255;

-    max := maxvalue(clr);

-    delta := max - minvalue(clr);

-

-    hsv[0] := DestinationHue; // set H(ue)

-    hsv[2] := max; // set V(alue)

-    // calc S(aturation)

-    if (max = 0.0) then hsv[1] := 0.0

-    else                hsv[1] := delta/max;

-

-//    ColorizePixel(PByteArray(Pixel), DestinationHue);

-      h_int := trunc(hsv[0]);             // h_int = |_h_|

-      f := hsv[0]-h_int;                  // f = h-h_int

-      p := hsv[2]*(1.0-hsv[1]);           // p = v*(1-s)

-      q := hsv[2]*(1.0-(hsv[1]*f));       // q = v*(1-s*f)

-      t := hsv[2]*(1.0-(hsv[1]*(1.0-f))); // t = v*(1-s*(1-f))

-      case h_int of

-        0: begin clr[0]:=hsv[2]; clr[1]:=t;      clr[2]:=p;      end; // (v,t,p)

-        1: begin clr[0]:=q;      clr[1]:=hsv[2]; clr[2]:=p;      end; // (q,v,p)

-        2: begin clr[0]:=p;      clr[1]:=hsv[2]; clr[2]:=t;      end; // (p,v,t)

-        3: begin clr[0]:=p;      clr[1]:=q;      clr[2]:=hsv[2]; end; // (p,q,v)

-        4: begin clr[0]:=t;      clr[1]:=p;      clr[2]:=hsv[2]; end; // (t,p,v)

-        5: begin clr[0]:=hsv[2]; clr[1]:=p;      clr[2]:=q;      end; // (v,p,q)

-      end;

-

-    // and store new rgb back into the image

-    PixelColors[0] := trunc(255*clr[0]);

-    PixelColors[1] := trunc(255*clr[1]);

-    PixelColors[2] := trunc(255*clr[2]);

-*)

-    Inc(Pixel, TexSurface^.format.BytesPerPixel);

-  end;

-end;

-

-function TTextureUnit.LoadTexture(FromRegistry: boolean; const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture;

-var

-  TexSurface: PSDL_Surface;

-  MipmapSurface: PSDL_Surface;

-  newWidth, newHeight: Cardinal;

-  oldWidth, oldHeight: Cardinal;

-begin

-  Log.BenchmarkStart(4);

-  Mipmapping := true;

-(*

-  Log.LogStatus( '', '' );

-

-  if Identifier = nil then

-    Log.LogStatus(' ERROR unknown Identifier', 'Id:'''+Identifier+''' Fmt:'''+Format+''' Typ:'''+Typ+'''')

-  else

-    Log.LogStatus(' should be ok - trying to load', 'Id:'''+Identifier+''' Fmt:'''+Format+''' Typ:'''+Typ+'''');

-*)

-

- // load texture data into memory

-  {$ifdef blindydebug}

-  Log.LogStatus('',' ----------------------------------------------------');

-  Log.LogStatus('',' LoadImage('''+Identifier+''') (called by '+Format+')');

-  {$endif}

-  TexSurface := LoadImage(Identifier);

-  {$ifdef blindydebug}

-  Log.LogStatus('',' ok');

-  {$endif}

-  if not assigned(TexSurface) then

-  begin

-    Log.LogError('Could not load texture: "' + Identifier +' '+ TextureTypeToStr(Typ) +'"',

-                 'TTextureUnit.LoadTexture');

-    Exit;

-  end;

-

-  // convert pixel format as needed

-  {$ifdef blindydebug}

-  Log.LogStatus('',' AdjustPixelFormat');

-  {$endif}

-  AdjustPixelFormat(TexSurface, Typ);

-  {$ifdef blindydebug}

-  Log.LogStatus('',' ok');

-  {$endif}

-  // adjust texture size (scale down, if necessary)

-  newWidth   := TexSurface.W;

-  newHeight  := TexSurface.H;

-

-  if (newWidth > Limit) then

-    newWidth := Limit;

-

-  if (newHeight > Limit) then

-    newHeight := Limit;

-

-  if (TexSurface.W > newWidth) or (TexSurface.H > newHeight) then

-  begin

-    {$ifdef blindydebug}

-    Log.LogStatus('',' ScaleTexture');

-    {$endif}

-    ScaleTexture(TexSurface,newWidth,newHeight);

-    {$ifdef blindydebug}

-    Log.LogStatus('',' ok');

-    {$endif}

-  end;

-

-  {$ifdef blindydebug}

-  Log.LogStatus('',' JB-1 : typ='+Typ);

-  {$endif}

-

-

-

-  // don't actually understand, if this is needed...

-  // this should definately be changed... together with all this

-  // cover cache stuff

-  {if (CreateCacheMipmap) and (Typ = TEXTURE_TYPE_PLAIN) then

-  begin

-    {$ifdef blindydebug}{

-    Log.LogStatus('',' JB-1 : Minimap');

-    {$endif}

-

-    {if (TnWidth <= 256) and (TnHeight <= 256) then

-    begin

-      {$ifdef blindydebug}{

-      Log.LogStatus('',' GetScaledTexture('''+inttostr(Covers.W)+''','''+inttostr(Covers.H)+''') (for CacheMipmap)');

-      {$endif}{

-      MipmapSurface:=GetScaledTexture(TexSurface, TnWidth, TnHeight);

-      if assigned(MipmapSurface) then

-      begin

-        {$ifdef blindydebug}{

-        Log.LogStatus('',' ok');

-        Log.LogStatus('',' BlitSurface Stuff');

-        {$endif}{

-        // creating and freeing the surface could be done once, if Cover.W and Cover.H don't change

-        TnSurface:=SDL_CreateRGBSurfaceFrom(@TnBuffer[0], TnWidth, TnHeight, 24, TnWidth*3, $000000ff, $0000ff00, $00ff0000, 0);

-        SDL_BlitSurface(TnSurface, nil, TnSurface, nil);

-        SDL_FreeSurface(TnSurface);

-        {$ifdef blindydebug}{

-        Log.LogStatus('',' ok');

-        Log.LogStatus('',' SDL_FreeSurface (CacheMipmap)');

-        {$endif}{

-        SDL_FreeSurface(TnSurface);

-        {$ifdef blindydebug}{

-        Log.LogStatus('',' ok');

-        {$endif}{

-      end

-      else

-      begin

-        Log.LogStatus(' Error creating CacheMipmap',' LoadTexture('''+Identifier+''')');

-      end;

-    end;

-    // should i create a cache texture, if Covers.W/H are larger?

-  end; }

-

-  {$ifdef blindydebug}

-  Log.LogStatus('',' JB-2');

-  {$endif}

-

-

- // now we might colorize the whole thing

-  if (Typ = TEXTURE_TYPE_COLORIZED) then

-    ColorizeTexture(TexSurface, Col);

-

- // save actual dimensions of our texture

-  oldWidth  := newWidth;

-  oldHeight := newHeight;

- // make texture dimensions be powers of 2

-  newWidth  := Round(Power(2, Ceil(Log2(newWidth))));

-  newHeight := Round(Power(2, Ceil(Log2(newHeight))));

-  if (newHeight <> oldHeight) or (newWidth <> oldWidth) then

-    FitTexture(TexSurface, newWidth, newHeight);

-

-  // at this point we have the image in memory...

-  // scaled to be at most 1024x1024 pixels large

-  // scaled so that dimensions are powers of 2

-  // and converted to either RGB or RGBA

-

-  {$ifdef blindydebug}

-  Log.LogStatus('',' JB-3');

-  {$endif}

-

-

-  // if we got a Texture of Type Plain, Transparent or Colorized,

-  // then we're done manipulating it

-  // and could now create our openGL texture from it

-

- // prepare OpenGL texture

-

-  // JB_linux : this is causing AV's on linux... ActText seems to be nil !

-//  {$IFnDEF win32}

-//  if pointer(ActTex) = nil then

-//    exit;

-//  {$endif}

-

-  glGenTextures(1, @ActTex);

-

-  glBindTexture(GL_TEXTURE_2D, ActTex);

-  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);

-  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);

-  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);

-

-  // load data into gl texture

-  if (Typ = TEXTURE_TYPE_TRANSPARENT) or

-     (Typ = TEXTURE_TYPE_COLORIZED) then

-  begin

-    glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TexSurface.pixels);

-  end

-  else //if Typ = TEXTURE_TYPE_PLAIN then

-  begin

-    glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, TexSurface.pixels);

-  end;

-

-  {$ifdef blindydebug}

-  Log.LogStatus('',' JB-5');

-  {$endif}

-

-

-  Result.X := 0;

-  Result.Y := 0;

-  Result.Z := 0;

-  Result.W := 0;

-  Result.H := 0;

-  Result.ScaleW := 1;

-  Result.ScaleH := 1;

-  Result.Rot := 0;

-  Result.TexNum := ActTex;

-  Result.TexW := oldWidth / newWidth;

-  Result.TexH := oldHeight / newHeight;

-

-  Result.Int   := 1;

-  Result.ColR  := 1;

-  Result.ColG  := 1;

-  Result.ColB  := 1;

-  Result.Alpha := 1;

-

-  // new test - default use whole texure, taking TexW and TexH as const and changing these

-  Result.TexX1 := 0;

-  Result.TexY1 := 0;

-  Result.TexX2 := 1;

-  Result.TexY2 := 1;

-

-  {$ifdef blindydebug}

-  Log.LogStatus('',' JB-6');

-  {$endif}

-

-  Result.Name := Identifier;

-

-  SDL_FreeSurface(TexSurface);

-

-  {$ifdef blindydebug}

-  Log.LogStatus('',' JB-7');

-  {$endif}

-

-

-  Log.BenchmarkEnd(4);

-  if Log.BenchmarkTimeLength[4] >= 1 then

-    Log.LogBenchmark('**********> Texture Load Time Warning - ' + Identifier + '/' + TextureTypeToStr(Typ), 4)

-  else Log.LogBenchmark('**********> Texture Load Time ' + ExtractFileName(Identifier) + '/' + TextureTypeToStr(Typ), 4);

-  {$ifdef blindydebug}

-  Log.LogStatus('',' JB-8');

-  {$endif}

-

-end;

-

-

-function TTextureUnit.GetTexture(const Name: string; Typ: TTextureType; FromCache: boolean): TTexture;

-begin

-  Result := GetTexture(Name, Typ, 0, FromCache);

-end;

-

-function TTextureUnit.GetTexture(const Name: string; Typ: TTextureType; Col: LongWord; FromCache: boolean): TTexture;

-var

-  T:    integer; // texture

-  C:    integer; // cover

-  Data: array of byte;

-begin

-

-  if Name = '' then

-    exit;

-

-  // find texture entry

-  T := FindTexture(Name, Typ, Col);

-

-  if T = -1 then

-  begin

-    // create texture entry

-    T := Length(TextureDatabase.Texture);

-    SetLength(TextureDatabase.Texture, T+1);

-

-    TextureDatabase.Texture[T].Name  := Name;

-    TextureDatabase.Texture[T].Typ   := Typ;

-    TextureDatabase.Texture[T].Color := Col;

-

-    // inform database that no textures have been loaded into memory

-    TextureDatabase.Texture[T].Texture.TexNum      := 0;

-    TextureDatabase.Texture[T].TextureCache.TexNum := 0;

-  end;

-

-  // use preloaded texture

-  if (not FromCache) or (FromCache{ and (Covers.CoverExists(Name) < 0)}) then

-  begin

-    // use full texture

-    if TextureDatabase.Texture[T].Texture.TexNum = 0 then

-    begin

-      // load texture

-      {$ifdef blindydebug}

-      Log.LogStatus('...', 'GetTexture('''+Name+''','''+Typ+''')');

-      {$endif}

-      TextureDatabase.Texture[T].Texture := LoadTexture(false, Name, Typ, Col);

-      {$ifdef blindydebug}

-      Log.LogStatus('done',' ');

-      {$endif}

-    end;

-

-    // use texture

-    Result := TextureDatabase.Texture[T].Texture;

-  end;

-

-  if FromCache and Covers.CoverExists(Name) then

-  begin

-    // use cache texture

-    C := Covers.CoverNumber(Name);

-

-    if TextureDatabase.Texture[T].TextureCache.TexNum = 0 then

-    begin

-      // load texture

-      Covers.PrepareData(Name);

-      TextureDatabase.Texture[T].TextureCache := CreateTexture(Covers.Data, Name, Covers.Cover[C].W, Covers.Cover[C].H, 24);

-    end;

-

-    // use texture

-    Result := TextureDatabase.Texture[T].TextureCache;

-  end;

-end;

-

-//--------

-// Returns Pointer to an Array of Byte containing the Texture Data in the

-// requested Size

-//--------

-Function TTextureUnit.GetCoverThumbnail(const Name: string): Pointer;

-var

-  TexSurface: PSDL_Surface;

-  newHeight, newWidth: Cardinal;

-const

-  Typ = TEXTURE_TYPE_PLAIN;

-begin

-  Result := nil;

-  If (FileExists(Name)) then

-  begin

-    {$ifdef blindydebug}

-    Log.LogStatus('',' ----------------------------------------------------');

-    Log.LogStatus('',' GetCoverThumbnail('''+Name+''')');

-    {$endif}

-    TexSurface := LoadImage(Name);

-    {$ifdef blindydebug}

-    Log.LogStatus('',' ok');

-    {$endif}

-    if assigned(TexSurface) then

-    begin

-      // convert pixel format as needed

-      {$ifdef blindydebug}

-      Log.LogStatus('',' AdjustPixelFormat');

-      {$endif}

-      AdjustPixelFormat(TexSurface, Typ);

-

-      {$ifdef blindydebug}

-      Log.LogStatus('',' ok');

-      {$endif}

-

-      // Scale Texture to Covers Dimensions

-      {$ifdef blindydebug}

-      Log.LogStatus('',' ScaleTexture('''+inttostr(tnWidth)+''','''+inttostr(TnHeight)+''') (for CacheMipmap)');

-      {$endif}

-      ScaleTexture(TexSurface, TnWidth, TnHeight);

-

-      if assigned(TexSurface) AND assigned(TnSurface) then

-      begin

-        {$ifdef blindydebug}

-        Log.LogStatus('',' ok');

-        Log.LogStatus('',' BlitSurface Stuff');

-        {$endif}

-

-        SDL_BlitSurface(TexSurface, nil, TnSurface, nil);

-

-        Result := @TnBuffer[0];

-

-        {$ifdef blindydebug}

-        Log.LogStatus('',' ok');

-        {$endif}

-      end

-      else

-        Log.LogStatus(' Error creating Cover Thumbnail',' LoadTexture('''+Name+''')');

-    end

-    else

-      Log.LogError('Could not load texture for Cover Thumbnail: "' + name+' '+ TextureTypeToStr(Typ) +'"',

-                   'TTextureUnit.GetCoverThumbnail');

-

-    SDL_FreeSurface(TexSurface);

-  end;

-end;

-

-//--------

-// Sets Textures Thumbnail Size Vars and Sets LEngth of DataBuffer and Create CoverSurface

-//--------

-Procedure TTextureUnit.SetCoverSize(W, H: Integer);

-begin

-  If (H > 0) AND (W > 0) then

-  begin

-    TnWidth := W;

-    TnHeight := H;

-

-    SetLength(TnBuffer, TnWidth * TnHeight * 3);

-

-    //Free if necesary and Create new Surface at Data

-    If (Assigned(TnSurface)) then

-      SDL_FreeSurface(TnSurface);

-      

-    TnSurface := SDL_CreateRGBSurfaceFrom(@TnBuffer[0], TnWidth, TnHeight, 24, TnWidth*3, $000000ff, $0000ff00, $00ff0000, 0);

-  end;

-end;

-

-function TTextureUnit.FindTexture(const Name: string; Typ: TTextureType; Col: Cardinal): integer;

-var

-  T:    integer; // texture

-begin

-  Result := -1;

-  for T := 0 to high(TextureDatabase.Texture) do

-    if (TextureDatabase.Texture[T].Name = Name) and

-       (TextureDatabase.Texture[T].Typ = Typ) then

-    begin

-      // colorized textures must match in their color too

-      if (TextureDatabase.Texture[T].Typ <> TEXTURE_TYPE_COLORIZED) or

-         (TextureDatabase.Texture[T].Color = Col) then

-      begin

-        Result := T;

-        break;

-      end;

-    end;

-end;

-

-function TTextureUnit.LoadTexture(const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture;

-begin

-  Result := LoadTexture(false, Identifier, Typ, Col);

-end;

-

-function TTextureUnit.LoadTexture(const Identifier: string): TTexture;

-begin

-  Result := LoadTexture(false, Identifier, TEXTURE_TYPE_PLAIN, 0);

-end;

-

-function TTextureUnit.CreateTexture(var Data: array of byte; const Name: string; W, H: word; Bits: byte): TTexture;

-var

-  Position:        integer;

-  Position2:       integer;

-  Pix:        integer;

-  ColInt:     real;

-  PPix:       PByteArray;

-  TempA:      integer;

-  Error:      integer;

-begin

-  Mipmapping := false;

-

-  glGenTextures(1, @ActTex); // ActText = new texture number

-  glBindTexture(GL_TEXTURE_2D, ActTex);

-  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);

-  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);

-  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);

-

-  glTexImage2D(GL_TEXTURE_2D, 0, 3, W, H, 0, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]);

-  if Mipmapping then begin

-    Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 3, W, H, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]);

-    if Error > 0 then

-      Log.LogError('gluBuild2DMipmaps() failed', 'TTextureUnit.CreateTexture');

-  end;

-

-  Result.X := 0;

-  Result.Y := 0;

-  Result.W := 0;

-  Result.H := 0;

-  Result.ScaleW := 1;

-  Result.ScaleH := 1;

-  Result.Rot := 0;

-  Result.TexNum := ActTex;

-  Result.TexW := 1;

-  Result.TexH := 1;

-

-  Result.Int := 1;

-  Result.ColR := 1;

-  Result.ColG := 1;

-  Result.ColB := 1;

-  Result.Alpha := 1;

-

-  // 0.4.2 new test - default use whole texure, taking TexW and TexH as const and changing these

-  Result.TexX1 := 0;

-  Result.TexY1 := 0;

-  Result.TexX2 := 1;

-  Result.TexY2 := 1;

-

-  // 0.5.0

-  Result.Name := Name;

-end;

-

-procedure TTextureUnit.UnloadTexture(const Name: string; Typ: TTextureType; FromCache: boolean);

-begin

-  UnloadTexture(Name, Typ, 0, FromCache);

-end;

-

-procedure TTextureUnit.UnloadTexture(const Name: string; Typ: TTextureType; Col: Cardinal; FromCache: boolean);

-var

-  T:      integer;

-  TexNum: GLuint;

-begin

-  T := FindTexture(Name, Typ, Col);

-

-  if not FromCache then begin

-    TexNum := TextureDatabase.Texture[T].Texture.TexNum;

-    if TexNum > 0 then begin

-      glDeleteTextures(1, PGLuint(@TexNum));

-      TextureDatabase.Texture[T].Texture.TexNum := 0;

-//      Log.LogError('Unload texture no '+IntToStr(TexNum));

-    end;

-  end else begin

-    TexNum := TextureDatabase.Texture[T].TextureCache.TexNum;

-    if TexNum > 0 then begin

-      glDeleteTextures(1, @TexNum);

-      TextureDatabase.Texture[T].TextureCache.TexNum := 0;

-//      Log.LogError('Unload texture cache no '+IntToStr(TexNum));

-    end;

-  end;

-end;

-

-(* This needs some work

-procedure TTextureUnit.FlushTextureDatabase();

-var

-  i: integer;

-  Tex: ^TTexture;

-begin

-  for i := 0 to High(TextureDatabase.Texture) do

-  begin

-    // only delete non-cached entries

-    if (TextureDatabase.Texture[i].Texture.TexNum > 0) then

-    begin

-      Tex := @TextureDatabase.Texture[i].Texture;

-      glDeleteTextures(1, PGLuint(Tex^.TexNum));

-      Tex^.TexNum := 0;

-    end;

-  end;

-end;

-*)

-

-function TextureTypeToStr(TexType: TTextureType): string;

-begin

-  Result := TextureTypeStr[TexType];

-end;

-

-function ParseTextureType(const TypeStr: string; Default: TTextureType): TTextureType;

-var

-  TexType: TTextureType;

-  UpCaseStr: string;

-begin

-  UpCaseStr := UpperCase(TypeStr);

-  for TexType := Low(TextureTypeStr) to High(TextureTypeStr) do

-  begin

-    if (UpCaseStr = UpperCase(TextureTypeStr[TexType])) then

-    begin

-      Result := TexType;

-      Exit;

-    end;

-  end;

-  Log.LogWarn('Unknown texture-type: "' + TypeStr + '"', 'ParseTextureType');

-  Result := TEXTURE_TYPE_PLAIN;

-end;

-

-end.

+unit UTexture;
+// added for easier debug disabling
+{$undef blindydebug}
+
+interface
+
+{$IFDEF FPC}
+  {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses OpenGL12,
+     Math,
+     Classes,
+     SysUtils,
+     UCommon,
+     UImage,
+     SDL,
+     sdlutils,
+     SDL_Image;
+
+type
+  TTexture = record
+    TexNum:   GLuint;
+    X:        real;
+    Y:        real;
+    Z:        real; // new
+    W:        real;
+    H:        real;
+    ScaleW:   real; // for dynamic scalling while leaving width constant
+    ScaleH:   real; // for dynamic scalling while leaving height constant
+    Rot:      real; // 0 - 2*pi
+    Int:      real; // intensity
+    ColR:     real;
+    ColG:     real;
+    ColB:     real;
+    TexW:     real; // used?
+    TexH:     real; // used?
+    TexX1:    real;
+    TexY1:    real;
+    TexX2:    real;
+    TexY2:    real;
+    Alpha:    real;
+    Name:     string; // 0.5.0: experimental for handling cache images. maybe it's useful for dynamic skins
+  end;
+
+type
+  TTextureType = (
+    TEXTURE_TYPE_PLAIN,        // Plain (alpha = 1)
+    TEXTURE_TYPE_TRANSPARENT,  // Alpha is used
+    TEXTURE_TYPE_COLORIZED     // Alpha is used; Hue of the HSV color-model will be replaced by a new value
+  );
+const
+  TextureTypeStr: array[TTextureType] of string = (
+    'Plain',
+    'Transparent',
+    'Colorized'
+  );
+
+function TextureTypeToStr(TexType: TTextureType): string;
+function ParseTextureType(const TypeStr: string; Default: TTextureType): TTextureType;
+
+type
+  TTextureEntry = record
+    Name:       string;
+    Typ:        TTextureType;
+    Color:      Cardinal;
+
+    // we use normal TTexture, it's easier to implement and if needed - we copy ready data
+    Texture:        TTexture;
+    TextureCache:   TTexture;
+  end;
+
+  TTextureDatabase = record
+    Texture:    array of TTextureEntry;
+  end;
+
+  TTextureUnit = class
+    private
+      TnWidth, TnHeight: Cardinal; //Width and Height of the Cover Thumbnails
+
+      TnBuffer:  array of byte;
+      TnSurface: PSDL_Surface;
+
+      function pixfmt_eq(fmt1,fmt2: PSDL_Pixelformat): boolean;
+      procedure AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: TTextureType);
+      function GetScaledTexture(TexSurface: PSDL_Surface; W,H: Cardinal): PSDL_Surface;
+      procedure ScaleTexture(var TexSurface: PSDL_Surface; W,H: Cardinal);
+      procedure FitTexture(var TexSurface: PSDL_Surface; W,H: Cardinal);
+      procedure ColorizeTexture(TexSurface: PSDL_Surface; Col: Cardinal);
+    public
+    Limit:      integer;
+    CreateCacheMipmap:  boolean;
+
+//    function GetNumberFor
+    function GetTexture(const Name: string; Typ: TTextureType; FromCache: boolean = true): TTexture; overload;
+    function GetTexture(const Name: string; Typ: TTextureType; Col: LongWord; FromCache: boolean = true): TTexture; overload;
+    function FindTexture(const Name: string; Typ: TTextureType; Col: Cardinal): integer;
+    function LoadTexture(FromRegistry: boolean; const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture; overload;
+    function LoadTexture(const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture; overload;
+    function LoadTexture(const Identifier: string): TTexture; overload;
+    function CreateTexture(var Data: array of byte; const Name: string; W, H: word; Bits: byte): TTexture;
+    procedure UnloadTexture(const Name: string; Typ: TTextureType; FromCache: boolean); overload;
+    procedure UnloadTexture(const Name: string; Typ: TTextureType; Col: Cardinal; FromCache: boolean); overload;
+    //procedure FlushTextureDatabase();
+
+    Function GetCoverThumbnail(const Name: string): Pointer;
+    Procedure SetCoverSize(W, H: Integer);
+    
+    Constructor Create;
+    Destructor Destroy; override;
+  end;
+
+var
+  Texture:          TTextureUnit;
+  TextureDatabase:  TTextureDatabase;
+
+  ActTex:     GLuint;
+
+  Mipmapping: Boolean;
+
+  CacheMipmap:  array[0..256*256*3-1] of byte; // 3KB
+  CacheMipmapSurface: PSDL_Surface;
+
+
+implementation
+
+uses ULog,
+     DateUtils,
+     UCovers,
+     UThemes,
+     {$IFDEF DARWIN}
+     MacResources,
+     {$ENDIF}
+     StrUtils;
+
+Constructor TTextureUnit.Create;
+begin
+  inherited Create;
+end;
+
+Destructor TTextureUnit.Destroy;
+begin
+  inherited Destroy;
+end;
+
+function TTextureUnit.pixfmt_eq(fmt1,fmt2: PSDL_Pixelformat): boolean;
+begin
+  if (fmt1^.BitsPerPixel = fmt2^.BitsPerPixel) and
+     (fmt1^.BytesPerPixel = fmt2^.BytesPerPixel) and
+     (fmt1^.Rloss = fmt2^.Rloss) and (fmt1^.Gloss = fmt2^.Gloss) and
+     (fmt1^.Bloss = fmt2^.Bloss) and (fmt1^.Rmask = fmt2^.Rmask) and
+     (fmt1^.Gmask = fmt2^.Gmask) and (fmt1^.Bmask = fmt2^.Bmask) and
+     (fmt1^.Rshift = fmt2^.Rshift) and (fmt1^.Gshift = fmt2^.Gshift) and
+     (fmt1^.Bshift = fmt2^.Bshift)
+   then
+    Result:=True
+  else
+    Result:=False;
+end;
+
+procedure TTextureUnit.AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: TTextureType);
+var
+  TempSurface: PSDL_Surface;
+  NeededPixFmt: PSDL_Pixelformat;
+begin
+  NeededPixFmt:=@PixelFmt_RGBA;
+  if      (Typ = TEXTURE_TYPE_PLAIN) then
+    NeededPixFmt:=@PixelFmt_RGB
+  else if (Typ = TEXTURE_TYPE_TRANSPARENT) or
+          (Typ = TEXTURE_TYPE_COLORIZED) then
+    NeededPixFmt:=@PixelFmt_RGBA
+  else
+    NeededPixFmt:=@PixelFmt_RGB;
+
+
+  if not pixfmt_eq(TexSurface^.format, NeededPixFmt) then
+  begin
+    TempSurface:=TexSurface;
+    TexSurface:=SDL_ConvertSurface(TempSurface,NeededPixFmt,SDL_SWSURFACE);
+    SDL_FreeSurface(TempSurface);
+  end;
+end;
+
+function TTextureUnit.GetScaledTexture(TexSurface: PSDL_Surface; W,H: Cardinal): PSDL_Surface;
+var
+  TempSurface: PSDL_Surface;
+begin
+  TempSurface:=TexSurface;
+  Result:=SDL_ScaleSurfaceRect(TempSurface,
+                  0,0,TempSurface^.W,TempSurface^.H,
+                  W,H);
+  SDL_FreeSurface(TempSurface);
+end;
+
+procedure TTextureUnit.ScaleTexture(var TexSurface: PSDL_Surface; W,H: Cardinal);
+var
+  TempSurface: PSDL_Surface;
+begin
+  TempSurface:=TexSurface;
+  TexSurface:=SDL_ScaleSurfaceRect(TempSurface,
+                  0,0,TempSurface^.W,TempSurface^.H,
+                  W,H);
+  SDL_FreeSurface(TempSurface);
+end;
+
+procedure TTextureUnit.FitTexture(var TexSurface: PSDL_Surface; W,H: Cardinal);
+var
+  TempSurface: PSDL_Surface;
+begin
+  TempSurface:=TexSurface;
+  with TempSurface^.format^ do
+    TexSurface:=SDL_CreateRGBSurface(SDL_SWSURFACE,W,H,BitsPerPixel,RMask, GMask, BMask, AMask);
+  SDL_SetAlpha(TexSurface, 0, 255);
+  SDL_SetAlpha(TempSurface, 0, 255);
+  SDL_BlitSurface(TempSurface,nil,TexSurface,nil);
+  SDL_FreeSurface(TempSurface);
+end;
+
+procedure TTextureUnit.ColorizeTexture(TexSurface: PSDL_Surface; Col: Cardinal);
+  //returns hue within range [0.0-6.0)
+  function col2hue(Color:Cardinal): double;
+  var
+    clr: array[0..2] of double;
+    hue, max, delta: double;
+  begin
+    clr[0] := ((Color and $ff0000) shr 16)/255; // R
+    clr[1] := ((Color and   $ff00) shr  8)/255; // G
+    clr[2] :=  (Color and     $ff)        /255; // B
+    max := maxvalue(clr);
+    delta := max - minvalue(clr);
+    // calc hue
+    if (delta = 0.0) then       hue := 0
+    else if (clr[0] = max) then hue :=     (clr[1]-clr[2])/delta
+    else if (clr[1] = max) then hue := 2.0+(clr[2]-clr[0])/delta
+    else if (clr[2] = max) then hue := 4.0+(clr[0]-clr[1])/delta;
+    if (hue < 0.0) then
+      hue := hue + 6.0;
+    Result := hue;
+  end;
+
+var
+  DestinationHue: Double;
+  PixelIndex: Cardinal;
+  Pixel: PByte;
+    PixelColors: PByteArray;
+//    clr: array[0..2] of Double; // [0: R, 1: G, 2: B]
+    clr2: array[0..2] of Uint32;
+//    hsv: array[0..2] of Double; // [0: H(ue), 1: S(aturation), 2: V(alue)]
+    hsv2: array[0..2] of UInt32;//LongInt;
+    dhue: UInt32;//LongInt;
+    h_int: Cardinal;
+//    delta, f, p, q, t: Double;
+    delta2,f2,p2,q2,t2: Longint;//LongInt;
+//    max: Double;
+    max2: Uint32;
+begin
+  DestinationHue := col2hue(Col);
+
+  dhue:=Trunc(DestinationHue*1024);
+
+  Pixel := TexSurface^.Pixels;
+
+  for PixelIndex := 0 to (TexSurface^.W * TexSurface^.H)-1 do
+  begin
+    PixelColors:=PByteArray(Pixel);
+  // inlined colorize per pixel
+
+  // uses fixed point math
+    // get color values
+    clr2[0]:=PixelColors[0] shl 10;
+    clr2[1]:=PixelColors[1] shl 10;
+    clr2[2]:=PixelColors[2] shl 10;
+    //calculate luminance and saturation from rgb
+
+    max2:=clr2[0];
+    if clr2[1]>max2 then max2:=clr2[1];
+    if clr2[2]>max2 then max2:=clr2[2];
+    delta2:=clr2[0];
+    if clr2[1]<delta2 then delta2:=clr2[1];
+    if clr2[2]<delta2 then delta2:=clr2[2];
+    delta2:=max2-delta2;
+    hsv2[0]:=dhue;  // shl 8
+    hsv2[2]:=max2;  // shl 8
+    if (max2=0) then hsv2[1] := 0
+    else             hsv2[1] := (delta2 shl 10) div max2; // shl 8
+      h_int:= hsv2[0] and $fffffC00;
+      f2:= hsv2[0]-h_int; //shl 10
+      p2:= (hsv2[2]*(1024-hsv2[1])) shr 10;
+      q2:= (hsv2[2]*(1024-(hsv2[1]*f2) shr 10)) shr 10;
+      t2:= (hsv2[2]*(1024-(hsv2[1]*(1024-f2)) shr 10)) shr 10;
+      h_int:=h_int shr 10;
+      case h_int of
+        0: begin clr2[0]:=hsv2[2]; clr2[1]:=t2;      clr2[2]:=p2;      end; // (v,t,p)
+        1: begin clr2[0]:=q2;      clr2[1]:=hsv2[2]; clr2[2]:=p2;      end; // (q,v,p)
+        2: begin clr2[0]:=p2;      clr2[1]:=hsv2[2]; clr2[2]:=t2;      end; // (p,v,t)
+        3: begin clr2[0]:=p2;      clr2[1]:=q2;      clr2[2]:=hsv2[2]; end; // (p,q,v)
+        4: begin clr2[0]:=t2;      clr2[1]:=p2;      clr2[2]:=hsv2[2]; end; // (t,p,v)
+        5: begin clr2[0]:=hsv2[2]; clr2[1]:=p2;      clr2[2]:=q2;      end; // (v,p,q)
+      end;
+
+    PixelColors[0]:=clr2[0] shr 10;
+    PixelColors[1]:=clr2[1] shr 10;
+    PixelColors[2]:=clr2[2] shr 10;
+
+    // old floating point version
+(*    clr[0] := PixelColors[0]/255;
+    clr[1] := PixelColors[1]/255;
+    clr[2] := PixelColors[2]/255;
+    max := maxvalue(clr);
+    delta := max - minvalue(clr);
+
+    hsv[0] := DestinationHue; // set H(ue)
+    hsv[2] := max; // set V(alue)
+    // calc S(aturation)
+    if (max = 0.0) then hsv[1] := 0.0
+    else                hsv[1] := delta/max;
+
+//    ColorizePixel(PByteArray(Pixel), DestinationHue);
+      h_int := trunc(hsv[0]);             // h_int = |_h_|
+      f := hsv[0]-h_int;                  // f = h-h_int
+      p := hsv[2]*(1.0-hsv[1]);           // p = v*(1-s)
+      q := hsv[2]*(1.0-(hsv[1]*f));       // q = v*(1-s*f)
+      t := hsv[2]*(1.0-(hsv[1]*(1.0-f))); // t = v*(1-s*(1-f))
+      case h_int of
+        0: begin clr[0]:=hsv[2]; clr[1]:=t;      clr[2]:=p;      end; // (v,t,p)
+        1: begin clr[0]:=q;      clr[1]:=hsv[2]; clr[2]:=p;      end; // (q,v,p)
+        2: begin clr[0]:=p;      clr[1]:=hsv[2]; clr[2]:=t;      end; // (p,v,t)
+        3: begin clr[0]:=p;      clr[1]:=q;      clr[2]:=hsv[2]; end; // (p,q,v)
+        4: begin clr[0]:=t;      clr[1]:=p;      clr[2]:=hsv[2]; end; // (t,p,v)
+        5: begin clr[0]:=hsv[2]; clr[1]:=p;      clr[2]:=q;      end; // (v,p,q)
+      end;
+
+    // and store new rgb back into the image
+    PixelColors[0] := trunc(255*clr[0]);
+    PixelColors[1] := trunc(255*clr[1]);
+    PixelColors[2] := trunc(255*clr[2]);
+*)
+    Inc(Pixel, TexSurface^.format.BytesPerPixel);
+  end;
+end;
+
+function TTextureUnit.LoadTexture(FromRegistry: boolean; const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture;
+var
+  TexSurface: PSDL_Surface;
+  MipmapSurface: PSDL_Surface;
+  newWidth, newHeight: Cardinal;
+  oldWidth, oldHeight: Cardinal;
+begin
+  Log.BenchmarkStart(4);
+  Mipmapping := true;
+(*
+  Log.LogStatus( '', '' );
+
+  if Identifier = nil then
+    Log.LogStatus(' ERROR unknown Identifier', 'Id:'''+Identifier+''' Fmt:'''+Format+''' Typ:'''+Typ+'''')
+  else
+    Log.LogStatus(' should be ok - trying to load', 'Id:'''+Identifier+''' Fmt:'''+Format+''' Typ:'''+Typ+'''');
+*)
+
+ // load texture data into memory
+  {$ifdef blindydebug}
+  Log.LogStatus('',' ----------------------------------------------------');
+  Log.LogStatus('',' LoadImage('''+Identifier+''') (called by '+Format+')');
+  {$endif}
+  TexSurface := LoadImage(Identifier);
+  {$ifdef blindydebug}
+  Log.LogStatus('',' ok');
+  {$endif}
+  if not assigned(TexSurface) then
+  begin
+    Log.LogError('Could not load texture: "' + Identifier +' '+ TextureTypeToStr(Typ) +'"',
+                 'TTextureUnit.LoadTexture');
+    Exit;
+  end;
+
+  // convert pixel format as needed
+  {$ifdef blindydebug}
+  Log.LogStatus('',' AdjustPixelFormat');
+  {$endif}
+  AdjustPixelFormat(TexSurface, Typ);
+  {$ifdef blindydebug}
+  Log.LogStatus('',' ok');
+  {$endif}
+  // adjust texture size (scale down, if necessary)
+  newWidth   := TexSurface.W;
+  newHeight  := TexSurface.H;
+
+  if (newWidth > Limit) then
+    newWidth := Limit;
+
+  if (newHeight > Limit) then
+    newHeight := Limit;
+
+  if (TexSurface.W > newWidth) or (TexSurface.H > newHeight) then
+  begin
+    {$ifdef blindydebug}
+    Log.LogStatus('',' ScaleTexture');
+    {$endif}
+    ScaleTexture(TexSurface,newWidth,newHeight);
+    {$ifdef blindydebug}
+    Log.LogStatus('',' ok');
+    {$endif}
+  end;
+
+  {$ifdef blindydebug}
+  Log.LogStatus('',' JB-1 : typ='+Typ);
+  {$endif}
+
+
+
+  // don't actually understand, if this is needed...
+  // this should definately be changed... together with all this
+  // cover cache stuff
+  {if (CreateCacheMipmap) and (Typ = TEXTURE_TYPE_PLAIN) then
+  begin
+    {$ifdef blindydebug}{
+    Log.LogStatus('',' JB-1 : Minimap');
+    {$endif}
+
+    {if (TnWidth <= 256) and (TnHeight <= 256) then
+    begin
+      {$ifdef blindydebug}{
+      Log.LogStatus('',' GetScaledTexture('''+inttostr(Covers.W)+''','''+inttostr(Covers.H)+''') (for CacheMipmap)');
+      {$endif}{
+      MipmapSurface:=GetScaledTexture(TexSurface, TnWidth, TnHeight);
+      if assigned(MipmapSurface) then
+      begin
+        {$ifdef blindydebug}{
+        Log.LogStatus('',' ok');
+        Log.LogStatus('',' BlitSurface Stuff');
+        {$endif}{
+        // creating and freeing the surface could be done once, if Cover.W and Cover.H don't change
+        TnSurface:=SDL_CreateRGBSurfaceFrom(@TnBuffer[0], TnWidth, TnHeight, 24, TnWidth*3, $000000ff, $0000ff00, $00ff0000, 0);
+        SDL_BlitSurface(TnSurface, nil, TnSurface, nil);
+        SDL_FreeSurface(TnSurface);
+        {$ifdef blindydebug}{
+        Log.LogStatus('',' ok');
+        Log.LogStatus('',' SDL_FreeSurface (CacheMipmap)');
+        {$endif}{
+        SDL_FreeSurface(TnSurface);
+        {$ifdef blindydebug}{
+        Log.LogStatus('',' ok');
+        {$endif}{
+      end
+      else
+      begin
+        Log.LogStatus(' Error creating CacheMipmap',' LoadTexture('''+Identifier+''')');
+      end;
+    end;
+    // should i create a cache texture, if Covers.W/H are larger?
+  end; }
+
+  {$ifdef blindydebug}
+  Log.LogStatus('',' JB-2');
+  {$endif}
+
+
+ // now we might colorize the whole thing
+  if (Typ = TEXTURE_TYPE_COLORIZED) then
+    ColorizeTexture(TexSurface, Col);
+
+ // save actual dimensions of our texture
+  oldWidth  := newWidth;
+  oldHeight := newHeight;
+ // make texture dimensions be powers of 2
+  newWidth  := Round(Power(2, Ceil(Log2(newWidth))));
+  newHeight := Round(Power(2, Ceil(Log2(newHeight))));
+  if (newHeight <> oldHeight) or (newWidth <> oldWidth) then
+    FitTexture(TexSurface, newWidth, newHeight);
+
+  // at this point we have the image in memory...
+  // scaled to be at most 1024x1024 pixels large
+  // scaled so that dimensions are powers of 2
+  // and converted to either RGB or RGBA
+
+  {$ifdef blindydebug}
+  Log.LogStatus('',' JB-3');
+  {$endif}
+
+
+  // if we got a Texture of Type Plain, Transparent or Colorized,
+  // then we're done manipulating it
+  // and could now create our openGL texture from it
+
+ // prepare OpenGL texture
+
+  // JB_linux : this is causing AV's on linux... ActText seems to be nil !
+//  {$IFnDEF win32}
+//  if pointer(ActTex) = nil then
+//    exit;
+//  {$endif}
+
+  glGenTextures(1, @ActTex);
+
+  glBindTexture(GL_TEXTURE_2D, ActTex);
+  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
+  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);
+  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);
+
+  // load data into gl texture
+  if (Typ = TEXTURE_TYPE_TRANSPARENT) or
+     (Typ = TEXTURE_TYPE_COLORIZED) then
+  begin
+    glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TexSurface.pixels);
+  end
+  else //if Typ = TEXTURE_TYPE_PLAIN then
+  begin
+    glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, TexSurface.pixels);
+  end;
+
+  {$ifdef blindydebug}
+  Log.LogStatus('',' JB-5');
+  {$endif}
+
+
+  Result.X := 0;
+  Result.Y := 0;
+  Result.Z := 0;
+  Result.W := 0;
+  Result.H := 0;
+  Result.ScaleW := 1;
+  Result.ScaleH := 1;
+  Result.Rot := 0;
+  Result.TexNum := ActTex;
+  Result.TexW := oldWidth / newWidth;
+  Result.TexH := oldHeight / newHeight;
+
+  Result.Int   := 1;
+  Result.ColR  := 1;
+  Result.ColG  := 1;
+  Result.ColB  := 1;
+  Result.Alpha := 1;
+
+  // new test - default use whole texure, taking TexW and TexH as const and changing these
+  Result.TexX1 := 0;
+  Result.TexY1 := 0;
+  Result.TexX2 := 1;
+  Result.TexY2 := 1;
+
+  {$ifdef blindydebug}
+  Log.LogStatus('',' JB-6');
+  {$endif}
+
+  Result.Name := Identifier;
+
+  SDL_FreeSurface(TexSurface);
+
+  {$ifdef blindydebug}
+  Log.LogStatus('',' JB-7');
+  {$endif}
+
+
+  Log.BenchmarkEnd(4);
+  if Log.BenchmarkTimeLength[4] >= 1 then
+    Log.LogBenchmark('**********> Texture Load Time Warning - ' + Identifier + '/' + TextureTypeToStr(Typ), 4)
+  else Log.LogBenchmark('**********> Texture Load Time ' + ExtractFileName(Identifier) + '/' + TextureTypeToStr(Typ), 4);
+  {$ifdef blindydebug}
+  Log.LogStatus('',' JB-8');
+  {$endif}
+
+end;
+
+
+function TTextureUnit.GetTexture(const Name: string; Typ: TTextureType; FromCache: boolean): TTexture;
+begin
+  Result := GetTexture(Name, Typ, 0, FromCache);
+end;
+
+function TTextureUnit.GetTexture(const Name: string; Typ: TTextureType; Col: LongWord; FromCache: boolean): TTexture;
+var
+  T:    integer; // texture
+  C:    integer; // cover
+  Data: array of byte;
+begin
+
+  if Name = '' then
+    exit;
+
+  // find texture entry
+  T := FindTexture(Name, Typ, Col);
+
+  if T = -1 then
+  begin
+    // create texture entry
+    T := Length(TextureDatabase.Texture);
+    SetLength(TextureDatabase.Texture, T+1);
+
+    TextureDatabase.Texture[T].Name  := Name;
+    TextureDatabase.Texture[T].Typ   := Typ;
+    TextureDatabase.Texture[T].Color := Col;
+
+    // inform database that no textures have been loaded into memory
+    TextureDatabase.Texture[T].Texture.TexNum      := 0;
+    TextureDatabase.Texture[T].TextureCache.TexNum := 0;
+  end;
+
+  // use preloaded texture
+  if (not FromCache) or (FromCache{ and (Covers.CoverExists(Name) < 0)}) then
+  begin
+    // use full texture
+    if TextureDatabase.Texture[T].Texture.TexNum = 0 then
+    begin
+      // load texture
+      {$ifdef blindydebug}
+      Log.LogStatus('...', 'GetTexture('''+Name+''','''+Typ+''')');
+      {$endif}
+      TextureDatabase.Texture[T].Texture := LoadTexture(false, Name, Typ, Col);
+      {$ifdef blindydebug}
+      Log.LogStatus('done',' ');
+      {$endif}
+    end;
+
+    // use texture
+    Result := TextureDatabase.Texture[T].Texture;
+  end;
+
+  if FromCache and Covers.CoverExists(Name) then
+  begin
+    // use cache texture
+    C := Covers.CoverNumber(Name);
+
+    if TextureDatabase.Texture[T].TextureCache.TexNum = 0 then
+    begin
+      // load texture
+      Covers.PrepareData(Name);
+      TextureDatabase.Texture[T].TextureCache := CreateTexture(Covers.Data, Name, Covers.Cover[C].W, Covers.Cover[C].H, 24);
+    end;
+
+    // use texture
+    Result := TextureDatabase.Texture[T].TextureCache;
+  end;
+end;
+
+//--------
+// Returns Pointer to an Array of Byte containing the Texture Data in the
+// requested Size
+//--------
+Function TTextureUnit.GetCoverThumbnail(const Name: string): Pointer;
+var
+  TexSurface: PSDL_Surface;
+  newHeight, newWidth: Cardinal;
+const
+  Typ = TEXTURE_TYPE_PLAIN;
+begin
+  Result := nil;
+  If (FileExists(Name)) then
+  begin
+    {$ifdef blindydebug}
+    Log.LogStatus('',' ----------------------------------------------------');
+    Log.LogStatus('',' GetCoverThumbnail('''+Name+''')');
+    {$endif}
+    TexSurface := LoadImage(Name);
+    {$ifdef blindydebug}
+    Log.LogStatus('',' ok');
+    {$endif}
+    if assigned(TexSurface) then
+    begin
+      // convert pixel format as needed
+      {$ifdef blindydebug}
+      Log.LogStatus('',' AdjustPixelFormat');
+      {$endif}
+      AdjustPixelFormat(TexSurface, Typ);
+
+      {$ifdef blindydebug}
+      Log.LogStatus('',' ok');
+      {$endif}
+
+      // Scale Texture to Covers Dimensions
+      {$ifdef blindydebug}
+      Log.LogStatus('',' ScaleTexture('''+inttostr(tnWidth)+''','''+inttostr(TnHeight)+''') (for CacheMipmap)');
+      {$endif}
+      ScaleTexture(TexSurface, TnWidth, TnHeight);
+
+      if assigned(TexSurface) AND assigned(TnSurface) then
+      begin
+        {$ifdef blindydebug}
+        Log.LogStatus('',' ok');
+        Log.LogStatus('',' BlitSurface Stuff');
+        {$endif}
+
+        SDL_BlitSurface(TexSurface, nil, TnSurface, nil);
+
+        Result := @TnBuffer[0];
+
+        {$ifdef blindydebug}
+        Log.LogStatus('',' ok');
+        {$endif}
+      end
+      else
+        Log.LogStatus(' Error creating Cover Thumbnail',' LoadTexture('''+Name+''')');
+    end
+    else
+      Log.LogError('Could not load texture for Cover Thumbnail: "' + name+' '+ TextureTypeToStr(Typ) +'"',
+                   'TTextureUnit.GetCoverThumbnail');
+
+    SDL_FreeSurface(TexSurface);
+  end;
+end;
+
+//--------
+// Sets Textures Thumbnail Size Vars and Sets LEngth of DataBuffer and Create CoverSurface
+//--------
+Procedure TTextureUnit.SetCoverSize(W, H: Integer);
+begin
+  If (H > 0) AND (W > 0) then
+  begin
+    TnWidth := W;
+    TnHeight := H;
+
+    SetLength(TnBuffer, TnWidth * TnHeight * 3);
+
+    //Free if necesary and Create new Surface at Data
+    If (Assigned(TnSurface)) then
+      SDL_FreeSurface(TnSurface);
+      
+    TnSurface := SDL_CreateRGBSurfaceFrom(@TnBuffer[0], TnWidth, TnHeight, 24, TnWidth*3, $000000ff, $0000ff00, $00ff0000, 0);
+  end;
+end;
+
+function TTextureUnit.FindTexture(const Name: string; Typ: TTextureType; Col: Cardinal): integer;
+var
+  T:    integer; // texture
+begin
+  Result := -1;
+  for T := 0 to high(TextureDatabase.Texture) do
+    if (TextureDatabase.Texture[T].Name = Name) and
+       (TextureDatabase.Texture[T].Typ = Typ) then
+    begin
+      // colorized textures must match in their color too
+      if (TextureDatabase.Texture[T].Typ <> TEXTURE_TYPE_COLORIZED) or
+         (TextureDatabase.Texture[T].Color = Col) then
+      begin
+        Result := T;
+        break;
+      end;
+    end;
+end;
+
+function TTextureUnit.LoadTexture(const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture;
+begin
+  Result := LoadTexture(false, Identifier, Typ, Col);
+end;
+
+function TTextureUnit.LoadTexture(const Identifier: string): TTexture;
+begin
+  Result := LoadTexture(false, Identifier, TEXTURE_TYPE_PLAIN, 0);
+end;
+
+function TTextureUnit.CreateTexture(var Data: array of byte; const Name: string; W, H: word; Bits: byte): TTexture;
+var
+  Position:        integer;
+  Position2:       integer;
+  Pix:        integer;
+  ColInt:     real;
+  PPix:       PByteArray;
+  TempA:      integer;
+  Error:      integer;
+begin
+  Mipmapping := false;
+
+  glGenTextures(1, @ActTex); // ActText = new texture number
+  glBindTexture(GL_TEXTURE_2D, ActTex);
+  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
+  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);
+  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);
+
+  glTexImage2D(GL_TEXTURE_2D, 0, 3, W, H, 0, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]);
+  if Mipmapping then begin
+    Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 3, W, H, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]);
+    if Error > 0 then
+      Log.LogError('gluBuild2DMipmaps() failed', 'TTextureUnit.CreateTexture');
+  end;
+
+  Result.X := 0;
+  Result.Y := 0;
+  Result.W := 0;
+  Result.H := 0;
+  Result.ScaleW := 1;
+  Result.ScaleH := 1;
+  Result.Rot := 0;
+  Result.TexNum := ActTex;
+  Result.TexW := 1;
+  Result.TexH := 1;
+
+  Result.Int := 1;
+  Result.ColR := 1;
+  Result.ColG := 1;
+  Result.ColB := 1;
+  Result.Alpha := 1;
+
+  // 0.4.2 new test - default use whole texure, taking TexW and TexH as const and changing these
+  Result.TexX1 := 0;
+  Result.TexY1 := 0;
+  Result.TexX2 := 1;
+  Result.TexY2 := 1;
+
+  // 0.5.0
+  Result.Name := Name;
+end;
+
+procedure TTextureUnit.UnloadTexture(const Name: string; Typ: TTextureType; FromCache: boolean);
+begin
+  UnloadTexture(Name, Typ, 0, FromCache);
+end;
+
+procedure TTextureUnit.UnloadTexture(const Name: string; Typ: TTextureType; Col: Cardinal; FromCache: boolean);
+var
+  T:      integer;
+  TexNum: GLuint;
+begin
+  T := FindTexture(Name, Typ, Col);
+
+  if not FromCache then begin
+    TexNum := TextureDatabase.Texture[T].Texture.TexNum;
+    if TexNum > 0 then begin
+      glDeleteTextures(1, PGLuint(@TexNum));
+      TextureDatabase.Texture[T].Texture.TexNum := 0;
+//      Log.LogError('Unload texture no '+IntToStr(TexNum));
+    end;
+  end else begin
+    TexNum := TextureDatabase.Texture[T].TextureCache.TexNum;
+    if TexNum > 0 then begin
+      glDeleteTextures(1, @TexNum);
+      TextureDatabase.Texture[T].TextureCache.TexNum := 0;
+//      Log.LogError('Unload texture cache no '+IntToStr(TexNum));
+    end;
+  end;
+end;
+
+(* This needs some work
+procedure TTextureUnit.FlushTextureDatabase();
+var
+  i: integer;
+  Tex: ^TTexture;
+begin
+  for i := 0 to High(TextureDatabase.Texture) do
+  begin
+    // only delete non-cached entries
+    if (TextureDatabase.Texture[i].Texture.TexNum > 0) then
+    begin
+      Tex := @TextureDatabase.Texture[i].Texture;
+      glDeleteTextures(1, PGLuint(Tex^.TexNum));
+      Tex^.TexNum := 0;
+    end;
+  end;
+end;
+*)
+
+function TextureTypeToStr(TexType: TTextureType): string;
+begin
+  Result := TextureTypeStr[TexType];
+end;
+
+function ParseTextureType(const TypeStr: string; Default: TTextureType): TTextureType;
+var
+  TexType: TTextureType;
+  UpCaseStr: string;
+begin
+  UpCaseStr := UpperCase(TypeStr);
+  for TexType := Low(TextureTypeStr) to High(TextureTypeStr) do
+  begin
+    if (UpCaseStr = UpperCase(TextureTypeStr[TexType])) then
+    begin
+      Result := TexType;
+      Exit;
+    end;
+  end;
+  Log.LogWarn('Unknown texture-type: "' + TypeStr + '"', 'ParseTextureType');
+  Result := TEXTURE_TYPE_PLAIN;
+end;
+
+end.