aboutsummaryrefslogtreecommitdiffstats
path: root/Game/Code/Classes
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--Game/Code/Classes/UCovers.pas2
-rw-r--r--Game/Code/Classes/UImage.pas234
-rw-r--r--Game/Code/Classes/UTexture.pas640
3 files changed, 375 insertions, 501 deletions
diff --git a/Game/Code/Classes/UCovers.pas b/Game/Code/Classes/UCovers.pas
index 3a5b4f50..1ff2a5c0 100644
--- a/Game/Code/Classes/UCovers.pas
+++ b/Game/Code/Classes/UCovers.pas
@@ -200,7 +200,7 @@ begin
BlockWrite(F, Name[1], NLen);
Cover[High(Cover)].Position := FilePos(F);
- BlockWrite(F, CacheMipmap[0], W*H*(Bits div 8));
+ //BlockWrite(F, CacheMipmap[0], W*H*(Bits div 8));
CloseFile(F);
end;
diff --git a/Game/Code/Classes/UImage.pas b/Game/Code/Classes/UImage.pas
index 5dd326e7..d33c0d38 100644
--- a/Game/Code/Classes/UImage.pas
+++ b/Game/Code/Classes/UImage.pas
@@ -96,6 +96,14 @@ const
Alpha: 255
);
+type
+ TImagePixelFmt = (
+ ipfRGBA, ipfRGB, ipfBGRA, ipfBGR
+ );
+
+(*******************************************************
+ * Image saving
+ *******************************************************)
{$IFDEF HavePNG}
function WritePNGImage(const FileName: string; Surface: PSDL_Surface): boolean;
@@ -107,13 +115,28 @@ function WriteBMPImage(const FileName: string; Surface: PSDL_Surface): boolean;
function WriteJPGImage(const FileName: string; Surface: PSDL_Surface; Quality: integer): boolean;
{$ENDIF}
+(*******************************************************
+ * Image loading
+ *******************************************************)
+
function LoadImage(const Identifier: string): PSDL_Surface;
+(*******************************************************
+ * Image manipulation
+ *******************************************************)
+
+function PixelFormatEquals(fmt1, fmt2: PSDL_PixelFormat): boolean;
+procedure ScaleImage(var ImgSurface: PSDL_Surface; Width, Height: Cardinal);
+procedure FitImage(var ImgSurface: PSDL_Surface; Width, Height: Cardinal);
+procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: Cardinal);
+
+
implementation
uses
SysUtils,
Classes,
+ Math,
{$IFDEF MSWINDOWS}
Windows,
{$ENDIF}
@@ -133,9 +156,11 @@ uses
{$ENDIF}
zlib,
sdl_image,
+ sdlutils,
UCommon,
ULog;
+
function IsRGBSurface(pixelFmt: PSDL_PixelFormat): boolean;
begin
Result := (pixelFmt.BitsPerPixel = 24) and
@@ -216,6 +241,11 @@ begin
end;
end;
+
+(*******************************************************
+ * Image saving
+ *******************************************************)
+
(***************************
* PNG section
*****************************)
@@ -704,6 +734,12 @@ end;
{$ENDIF}
+
+(*******************************************************
+ * Image loading
+ *******************************************************)
+
+
(*
* Loads an image from the given file or resource
*)
@@ -718,7 +754,7 @@ begin
if Identifier = '' then
exit;
-
+
//Log.LogStatus( Identifier, 'LoadImage' );
FileName := Identifier;
@@ -731,7 +767,7 @@ begin
Result := IMG_Load(PChar(FileName));
//Log.LogStatus( ' '+inttostr( integer( Result ) ), ' LoadImage' );
except
- Log.LogError('Could not load from file "'+FileName+'"', 'TTextureUnit.LoadImage');
+ Log.LogError('Could not load from file "'+FileName+'"', 'LoadImage');
Exit;
end;
end
@@ -742,14 +778,14 @@ begin
TexStream := GetResourceStream(Identifier, 'TEX');
if (not assigned(TexStream)) then
begin
- Log.LogError( 'Invalid file or resource "'+ Identifier+'"', 'TTextureUnit.LoadImage');
+ Log.LogError( 'Invalid file or resource "'+ Identifier+'"', 'LoadImage');
Exit;
end;
TexRWops := RWopsFromStream(TexStream);
if (TexRWops = nil) then
begin
- Log.LogError( 'Could not assign resource "'+Identifier+'"', 'TTextureUnit.LoadImage');
+ Log.LogError( 'Could not assign resource "'+Identifier+'"', 'LoadImage');
TexStream.Free();
Exit;
end;
@@ -758,7 +794,7 @@ begin
try
Result := IMG_Load_RW(TexRWops, 0);
except
- Log.LogError( 'Could not read resource "'+Identifier+'"', 'TTextureUnit.LoadImage');
+ Log.LogError( 'Could not read resource "'+Identifier+'"', 'LoadImage');
end;
SDL_FreeRW(TexRWops);
@@ -766,4 +802,192 @@ begin
end;
end;
+
+(*******************************************************
+ * Image manipulation
+ *******************************************************)
+
+
+function PixelFormatEquals(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 ScaleImage(var ImgSurface: PSDL_Surface; Width, Height: Cardinal);
+var
+ TempSurface: PSDL_Surface;
+begin
+ TempSurface := ImgSurface;
+ ImgSurface := SDL_ScaleSurfaceRect(TempSurface,
+ 0, 0, TempSurface^.W,TempSurface^.H,
+ Width, Height);
+ SDL_FreeSurface(TempSurface);
+end;
+
+procedure FitImage(var ImgSurface: PSDL_Surface; Width, Height: Cardinal);
+var
+ TempSurface: PSDL_Surface;
+ ImgFmt: PSDL_PixelFormat;
+begin
+ TempSurface := ImgSurface;
+
+ // create a new surface with given width and height
+ ImgFmt := TempSurface^.format;
+ ImgSurface := SDL_CreateRGBSurface(
+ SDL_SWSURFACE, Width, Height, ImgFmt^.BitsPerPixel,
+ ImgFmt^.RMask, ImgFmt^.GMask, ImgFmt^.BMask, ImgFmt^.AMask);
+
+ // copy image from temp- to new surface
+ SDL_SetAlpha(ImgSurface, 0, 255);
+ SDL_SetAlpha(TempSurface, 0, 255);
+ SDL_BlitSurface(TempSurface, nil, ImgSurface, nil);
+
+ SDL_FreeSurface(TempSurface);
+end;
+
+(*
+// Old slow floating point version of ColorizeTexture.
+// For an easier understanding of the faster fixed point version below.
+procedure ColorizeTexture(TexSurface: PSDL_Surface; Col: Cardinal);
+var
+ clr: array[0..2] of Double; // [0: R, 1: G, 2: B]
+ hsv: array[0..2] of Double; // [0: H(ue), 1: S(aturation), 2: V(alue)]
+ delta, f, p, q, t: Double;
+ max: Double;
+begin
+ 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]);
+end;
+*)
+
+procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: 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 UInt32; // [0: R, 1: G, 2: B]
+ hsv: array[0..2] of UInt32; // [0: H(ue), 1: S(aturation), 2: V(alue)]
+ dhue: UInt32;
+ h_int: Cardinal;
+ delta, f, p, q, t: Longint;
+ max: Uint32;
+begin
+ DestinationHue := col2hue(NewColor);
+
+ dhue := Trunc(DestinationHue*1024);
+
+ Pixel := ImgSurface^.Pixels;
+
+ for PixelIndex := 0 to (ImgSurface^.W * ImgSurface^.H)-1 do
+ begin
+ PixelColors := PByteArray(Pixel);
+ // inlined colorize per pixel
+
+ // uses fixed point math
+ // get color values
+ clr[0] := PixelColors[0] shl 10;
+ clr[1] := PixelColors[1] shl 10;
+ clr[2] := PixelColors[2] shl 10;
+ //calculate luminance and saturation from rgb
+
+ max := clr[0];
+ if clr[1] > max then max := clr[1];
+ if clr[2] > max then max := clr[2];
+ delta := clr[0];
+ if clr[1] < delta then delta := clr[1];
+ if clr[2] < delta then delta := clr[2];
+ delta := max-delta;
+ hsv[0] := dhue; // shl 8
+ hsv[2] := max; // shl 8
+ if (max = 0) then
+ hsv[1] := 0
+ else
+ hsv[1] := (delta shl 10) div max; // shl 8
+ h_int := hsv[0] and $fffffC00;
+ f := hsv[0]-h_int; //shl 10
+ p := (hsv[2]*(1024-hsv[1])) shr 10;
+ q := (hsv[2]*(1024-(hsv[1]*f) shr 10)) shr 10;
+ t := (hsv[2]*(1024-(hsv[1]*(1024-f)) shr 10)) shr 10;
+ h_int := h_int shr 10;
+ 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;
+
+ PixelColors[0] := clr[0] shr 10;
+ PixelColors[1] := clr[1] shr 10;
+ PixelColors[2] := clr[2] shr 10;
+
+ Inc(Pixel, ImgSurface^.format.BytesPerPixel);
+ end;
+end;
+
end.
diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas
index 0025a28c..4879760a 100644
--- a/Game/Code/Classes/UTexture.pas
+++ b/Game/Code/Classes/UTexture.pas
@@ -12,13 +12,10 @@ uses
gl,
glu,
glext,
- Math,
Classes,
SysUtils,
UCommon,
- UImage,
SDL,
- sdlutils,
SDL_Image;
type
@@ -64,6 +61,8 @@ const
function TextureTypeToStr(TexType: TTextureType): string;
function ParseTextureType(const TypeStr: string; Default: TTextureType): TTextureType;
+procedure AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: TTextureType);
+
type
PTextureEntry = ^TTextureEntry;
TTextureEntry = record
@@ -76,95 +75,55 @@ type
TextureCache: TTexture; // Thumbnail texture
end;
- TTextureDatabase = record
- Texture: array of TTextureEntry;
+ TTextureDatabase = class
+ private
+ Texture: array of TTextureEntry;
+ public
+ procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Color: Cardinal; Cache: boolean);
+ function FindTexture(const Name: string; Typ: TTextureType; Color: Cardinal): integer;
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);
+ TextureDatabase: TTextureDatabase;
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;
+ procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Cache: boolean = false); overload;
+ procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Color: Cardinal; Cache: boolean = false); overload;
+ function GetTexture(const Name: string; Typ: TTextureType; FromCache: boolean = false): TTexture; overload;
+ function GetTexture(const Name: string; Typ: TTextureType; Col: LongWord; FromCache: boolean = false): TTexture; overload;
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;
+ function CreateTexture(Data: PChar; const Name: string; Width, Height: word; BitsPerPixel: 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(width, height: Integer);
-
- Constructor Create;
- Destructor Destroy; override;
+ constructor Create;
+ destructor Destroy; override;
end;
var
- Texture: TTextureUnit;
- TextureDatabase: TTextureDatabase;
-
- Mipmapping: boolean;
-
- CacheMipmap: array[0..256*256*3-1] of byte; // 3KB
- CacheMipmapSurface: PSDL_Surface;
-
+ Texture: TTextureUnit;
implementation
-uses ULog,
- DateUtils,
- UCovers,
- UThemes,
- 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;
+uses
+ DateUtils,
+ StrUtils,
+ Math,
+ ULog,
+ UCovers,
+ UThemes,
+ UImage;
-procedure TTextureUnit.AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: TTextureType);
+procedure 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
@@ -173,179 +132,98 @@ begin
else
NeededPixFmt := @PixelFmt_RGB;
-
- if not pixfmt_eq(TexSurface^.format, NeededPixFmt) then
+ if not PixelformatEquals(TexSurface^.format, NeededPixFmt) then
begin
TempSurface := TexSurface;
TexSurface := SDL_ConvertSurface(TempSurface, NeededPixFmt, SDL_SWSURFACE);
SDL_FreeSurface(TempSurface);
end;
end;
+
+{ TTextureDatabase }
-function TTextureUnit.GetScaledTexture(TexSurface: PSDL_Surface; W,H: Cardinal): PSDL_Surface;
+procedure TTextureDatabase.AddTexture(var Tex: TTexture; Typ: TTextureType; Color: Cardinal; Cache: boolean);
var
- TempSurface: PSDL_Surface;
+ TextureIndex: integer;
begin
- TempSurface := TexSurface;
- Result := SDL_ScaleSurfaceRect(TempSurface,
- 0, 0, TempSurface^.W,TempSurface^.H,
- W, H);
- SDL_FreeSurface(TempSurface);
+ TextureIndex := FindTexture(Tex.Name, Typ, Color);
+ if (TextureIndex = -1) then
+ begin
+ TextureIndex := Length(Texture);
+ SetLength(Texture, TextureIndex+1);
+
+ Texture[TextureIndex].Name := Tex.Name;
+ Texture[TextureIndex].Typ := Typ;
+ Texture[TextureIndex].Color := Color;
+ end;
+
+ if (Cache) then
+ Texture[TextureIndex].TextureCache := Tex
+ else
+ Texture[TextureIndex].Texture := Tex;
end;
-procedure TTextureUnit.ScaleTexture(var TexSurface: PSDL_Surface; W,H: Cardinal);
+function TTextureDatabase.FindTexture(const Name: string; Typ: TTextureType; Color: Cardinal): integer;
var
- TempSurface: PSDL_Surface;
+ TextureIndex: integer;
+ CurrentTexture: PTextureEntry;
begin
- TempSurface := TexSurface;
- TexSurface := SDL_ScaleSurfaceRect(TempSurface,
- 0, 0, TempSurface^.W,TempSurface^.H,
- W, H);
- SDL_FreeSurface(TempSurface);
+ Result := -1;
+ for TextureIndex := 0 to High(Texture) do
+ begin
+ CurrentTexture := @Texture[TextureIndex];
+ if (CurrentTexture.Name = Name) and
+ (CurrentTexture.Typ = Typ) then
+ begin
+ // colorized textures must match in their color too
+ if (CurrentTexture.Typ <> TEXTURE_TYPE_COLORIZED) or
+ (CurrentTexture.Color = Color) then
+ begin
+ Result := TextureIndex;
+ Break;
+ end;
+ end;
+ end;
end;
-procedure TTextureUnit.FitTexture(var TexSurface: PSDL_Surface; W,H: Cardinal);
-var
- TempSurface: PSDL_Surface;
+
+{ TTextureUnit }
+
+constructor TTextureUnit.Create;
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);
+ inherited Create;
+ TextureDatabase := TTextureDatabase.Create;
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;
+destructor TTextureUnit.Destroy;
begin
- DestinationHue := col2hue(Col);
+ TextureDatabase.Free;
+ inherited Destroy;
+end;
- dhue := Trunc(DestinationHue*1024);
- Pixel := TexSurface^.Pixels;
+procedure TTextureUnit.AddTexture(var Tex: TTexture; Typ: TTextureType; Cache: boolean);
+begin
+ TextureDatabase.AddTexture(Tex, Typ, 0, Cache);
+end;
- 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;
+procedure TTextureUnit.AddTexture(var Tex: TTexture; Typ: TTextureType; Color: Cardinal; Cache: boolean);
+begin
+ TextureDatabase.AddTexture(Tex, Typ, Color, Cache);
+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;
+function TTextureUnit.LoadTexture(FromRegistry: boolean; const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture;
+begin
+ // FIXME: what is the FromRegistry parameter supposed to do?
+ Result := LoadTexture(Identifier, Typ, Col);
+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;
+function TTextureUnit.LoadTexture(const Identifier: string): TTexture;
+begin
+ Result := LoadTexture(Identifier, TEXTURE_TYPE_PLAIN, 0);
end;
-function TTextureUnit.LoadTexture(FromRegistry: boolean; const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture;
+function TTextureUnit.LoadTexture(const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture;
var
TexSurface: PSDL_Surface;
MipmapSurface: PSDL_Surface;
@@ -353,21 +231,11 @@ var
oldWidth, oldHeight: Cardinal;
ActTex: GLuint;
begin
- Log.BenchmarkStart(4);
- Mipmapping := true;
-
// zero texture data
FillChar(Result, SizeOf(Result), 0);
// 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) +'"',
@@ -376,13 +244,8 @@ begin
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;
@@ -394,100 +257,32 @@ begin
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}
-
+ ScaleImage(TexSurface, newWidth, newHeight);
- (*
-
- // 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
+ // now we might colorize the whole thing
if (Typ = TEXTURE_TYPE_COLORIZED) then
- ColorizeTexture(TexSurface, Col);
+ ColorizeImage(TexSurface, Col);
- // save actual dimensions of our texture
+ // save actual dimensions of our texture
oldWidth := newWidth;
oldHeight := newHeight;
- // make texture dimensions be powers of 2
+
+ // 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);
+ FitImage(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
+ // prepare OpenGL texture
glGenTextures(1, @ActTex);
glBindTexture(GL_TEXTURE_2D, ActTex);
@@ -506,11 +301,6 @@ 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}
-
-
// setup texture struct
with Result do
begin
@@ -541,26 +331,7 @@ begin
Name := Identifier;
end;
- {$ifdef blindydebug}
- Log.LogStatus('',' JB-6');
- {$endif}
-
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;
@@ -570,207 +341,87 @@ end;
function TTextureUnit.GetTexture(const Name: string; Typ: TTextureType; Col: LongWord; FromCache: boolean): TTexture;
var
- texture: integer;
- cover: integer;
+ TextureIndex: integer;
+ CoverIndex: integer;
begin
-
- if Name = '' then
- exit;
-
- // find texture entry
- texture := FindTexture(Name, Typ, Col);
-
- if texture = -1 then
- begin
- // create texture entry
- texture := Length(TextureDatabase.Texture);
- SetLength(TextureDatabase.Texture, texture+1);
-
- TextureDatabase.Texture[texture].Name := Name;
- TextureDatabase.Texture[texture].Typ := Typ;
- TextureDatabase.Texture[texture].Color := Col;
-
- // inform database that no textures have been loaded into memory
- TextureDatabase.Texture[texture].Texture.TexNum := 0;
- TextureDatabase.Texture[texture].TextureCache.TexNum := 0;
- end;
-
- // use preloaded texture
- if (not FromCache) or (FromCache{ and (Covers.CoverExists(Name) < 0)}) then
+ if (Name = '') then
begin
- // use full texture
- if TextureDatabase.Texture[texture].Texture.TexNum = 0 then
- begin
- // load texture
- {$ifdef blindydebug}
- Log.LogStatus('...', 'GetTexture('''+Name+''','''+Typ+''')');
- {$endif}
- TextureDatabase.Texture[texture].Texture := LoadTexture(false, Name, Typ, Col);
- {$ifdef blindydebug}
- Log.LogStatus('done',' ');
- {$endif}
- end;
-
- // use texture
- Result := TextureDatabase.Texture[texture].Texture;
+ // zero texture data
+ FillChar(Result, SizeOf(Result), 0);
+ Exit;
end;
- if FromCache and Covers.CoverExists(Name) then
+ if (FromCache) then
begin
+ (*
// use cache texture
- cover := Covers.CoverNumber(Name);
+ CoverIndex := Covers.FindCover(Name);
- if TextureDatabase.Texture[texture].TextureCache.TexNum = 0 then
+ if TextureDatabase.Texture[TextureIndex].TextureCache.TexNum = 0 then
begin
// load texture
Covers.PrepareData(Name);
- TextureDatabase.Texture[texture].TextureCache := CreateTexture(Covers.Data, Name, Covers.Cover[cover].W, Covers.Cover[cover].H, 24);
+ TextureDatabase.Texture[TextureIndex].TextureCache := CreateTexture(Covers.Data, Name, Covers.Cover[CoverIndex].Width, Covers.Cover[CoverIndex].Height, 24);
end;
+ *)
// use texture
- Result := TextureDatabase.Texture[texture].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;
-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);
+ TextureIndex := TextureDatabase.FindTexture(Name, Typ, Col);
+ if (TextureIndex > -1) then
+ Result := TextureDatabase.Texture[TextureIndex].TextureCache;
+ Exit;
end;
-end;
-//--------
-// sets textures thumbnail size vars and sets length of databuffer and create coversurface
-//--------
-procedure TTextureUnit.SetCoverSize(width, height: integer);
-begin
- if (width > 0) and (height > 0) then
+ // find texture entry in database
+ TextureIndex := TextureDatabase.FindTexture(Name, Typ, Col);
+ if (TextureIndex = -1) then
begin
- TnWidth := width;
- TnHeight := height;
-
- SetLength(TnBuffer, TnWidth * TnHeight * 3);
+ // create texture entry in database
+ TextureIndex := Length(TextureDatabase.Texture);
+ SetLength(TextureDatabase.Texture, TextureIndex+1);
- //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;
+ TextureDatabase.Texture[TextureIndex].Name := Name;
+ TextureDatabase.Texture[TextureIndex].Typ := Typ;
+ TextureDatabase.Texture[TextureIndex].Color := Col;
-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
- begin
- 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;
+ // inform database that no textures have been loaded into memory
+ TextureDatabase.Texture[TextureIndex].Texture.TexNum := 0;
+ TextureDatabase.Texture[TextureIndex].TextureCache.TexNum := 0;
end;
-end;
-function TTextureUnit.LoadTexture(const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture;
-begin
- Result := LoadTexture(false, Identifier, Typ, Col);
-end;
+ // load full texture
+ if (TextureDatabase.Texture[TextureIndex].Texture.TexNum = 0) then
+ TextureDatabase.Texture[TextureIndex].Texture := LoadTexture(false, Name, Typ, Col);
-function TTextureUnit.LoadTexture(const Identifier: string): TTexture;
-begin
- Result := LoadTexture(false, Identifier, TEXTURE_TYPE_PLAIN, 0);
+ // use texture
+ Result := TextureDatabase.Texture[TextureIndex].Texture;
end;
-function TTextureUnit.CreateTexture(var Data: array of byte; const Name: string; W, H: word; Bits: byte): TTexture;
+function TTextureUnit.CreateTexture(Data: PChar; const Name: string; Width, Height: word; BitsPerPixel: byte): TTexture;
var
Error: integer;
ActTex: GLuint;
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]);
+ glTexImage2D(GL_TEXTURE_2D, 0, 3, Width, Height, 0, GL_RGB, GL_UNSIGNED_BYTE, Data);
+
+ {
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.Z := 0;
Result.W := 0;
Result.H := 0;
Result.ScaleW := 1;
@@ -786,13 +437,12 @@ begin
Result.ColB := 1;
Result.Alpha := 1;
- // 0.4.2 new test - default use whole texure, taking TexW and TexH as const and changing these
+ // 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;
@@ -806,7 +456,7 @@ var
T: integer;
TexNum: GLuint;
begin
- T := FindTexture(Name, Typ, Col);
+ T := TextureDatabase.FindTexture(Name, Typ, Col);
if not FromCache then
begin
@@ -815,7 +465,7 @@ begin
begin
glDeleteTextures(1, PGLuint(@TexNum));
TextureDatabase.Texture[T].Texture.TexNum := 0;
-// Log.LogError('Unload texture no '+IntToStr(TexNum));
+ //Log.LogError('Unload texture no '+IntToStr(TexNum));
end;
end
else
@@ -825,7 +475,7 @@ begin
begin
glDeleteTextures(1, @TexNum);
TextureDatabase.Texture[T].TextureCache.TexNum := 0;
-// Log.LogError('Unload texture cache no '+IntToStr(TexNum));
+ //Log.LogError('Unload texture cache no '+IntToStr(TexNum));
end;
end;
end;
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-07 19:10:29 +0000