diff options
author | tobigun <tobigun@b956fd51-792f-4845-bead-9b4dfca2ff2c> | 2008-04-30 13:24:28 +0000 |
---|---|---|
committer | tobigun <tobigun@b956fd51-792f-4845-bead-9b4dfca2ff2c> | 2008-04-30 13:24:28 +0000 |
commit | 85094b44de1f7a1a9bd710b162670fdb0a02a9a8 (patch) | |
tree | 3369951e5093a987b0fd98f9ea3119de22676f24 | |
parent | 731dec0d29e29a5d30e728616bcb5aa35c7c75ea (diff) | |
download | usdx-85094b44de1f7a1a9bd710b162670fdb0a02a9a8.tar.gz usdx-85094b44de1f7a1a9bd710b162670fdb0a02a9a8.tar.xz usdx-85094b44de1f7a1a9bd710b162670fdb0a02a9a8.zip |
- 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
Diffstat (limited to '')
-rw-r--r-- | Game/Code/Classes/UCommon.pas | 75 | ||||
-rw-r--r-- | Game/Code/Classes/UGraphic.pas | 131 | ||||
-rw-r--r-- | Game/Code/Classes/UImage.pas | 66 | ||||
-rw-r--r-- | Game/Code/Classes/UTexture.pas | 1867 | ||||
-rw-r--r-- | Game/Code/UltraStar.rc | 2 | ||||
-rw-r--r-- | Resources/Graphics/ustar-icon.png | bin | 0 -> 666 bytes |
6 files changed, 1052 insertions, 1089 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. diff --git a/Game/Code/UltraStar.rc b/Game/Code/UltraStar.rc index eae06f54..55036ebd 100644 --- a/Game/Code/UltraStar.rc +++ b/Game/Code/UltraStar.rc @@ -11,7 +11,7 @@ FontO2 TEX "../../Resources/Fonts/Outline 2/Outline 2.png" FontO2 FNT "../../Resources/Fonts/Outline 2/Outline 2.dat"
MAINICON ICON "../../Resources/Graphics/ustar-icon_v01.ico"
-//MAINICON ICON "../../Resources/Graphics/us.ico"
+WINDOWICON TEX "../../Resources/Graphics/ustar-icon.png"
CRDTS_BG TEX "../../Resources/Graphics/credits_v5_bg.png"
CRDTS_OVL TEX "../../Resources/Graphics/credits_v5_overlay.png"
diff --git a/Resources/Graphics/ustar-icon.png b/Resources/Graphics/ustar-icon.png Binary files differnew file mode 100644 index 00000000..1b13a6ee --- /dev/null +++ b/Resources/Graphics/ustar-icon.png |