From 217cd16e10ff809e7382e5447f1ccde60f3e8564 Mon Sep 17 00:00:00 2001 From: b1indy Date: Fri, 21 Sep 2007 22:15:36 +0000 Subject: first try to load textures with SDL_Image supported texture types are: Plain, Transparent and Colorized (textures in the resource file must be typed TEX) everything else (Font Black, ...) is not implemented. So beware - it looks really broken. There seems to be a problem with The covers - I just didn't understand, what's going on there. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@428 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 942 +++++++++++++++++------------------------ 1 file changed, 381 insertions(+), 561 deletions(-) (limited to 'Game/Code/Classes') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 1c436f04..78a2573f 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -2,6 +2,9 @@ unit UTexture; // Plain (alpha = 1) // Transparent +// Colorized + +// obsolete? // Transparent Range // Font (white is drawn, black is transparent) // Font Outline (Font with darker outline) @@ -25,15 +28,12 @@ uses OpenGL12, Math, Classes, SysUtils, - {$IFDEF FPC} - ulazjpeg, - {$ELSE} - JPEG, - PNGImage, - {$ENDIF} Graphics, UCommon, - UThemes; + UThemes, + SDL, + sdlutils, + SDL_Image; {$IFDEF Win32} @@ -45,7 +45,7 @@ uses OpenGL12, {$ELSE} const opengl32 = 'libGL.so' ; // YES Capital GL {$ENDIF} - + procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32; {$ENDIF} @@ -88,10 +88,16 @@ type end; TTextureUnit = class - + private - function LoadBitmap( const aSourceStream : TStream; const aIMG : TBitMap ): boolean; - function LoadJpeg( const aSourceStream : TStream; const aIMG : TBitMap ): boolean; + function LoadImage(Identifier: PChar): PSDL_Surface; + function pixfmt_eq(fmt1,fmt2: PSDL_Pixelformat): boolean; + procedure AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: PChar); + 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; @@ -108,27 +114,19 @@ type end; var - lasthue: double; Texture: TTextureUnit; TextureDatabase: TTextureDatabase; + // this should be in UDisplay?! PrintScreenData: array[0..1024*768-1] of longword; ActTex: GLuint;//integer; - TexOrigW: integer; - TexOrigH: integer; - TexNewW: integer; - TexNewH: integer; - - TexFitW: integer; - TexFitH: integer; // new for limit - - TextureD8: array[1..1024*1024] of byte; // 1MB +// TextureD8: array[1..1024*1024] of byte; // 1MB TextureD16: array[1..1024*1024, 1..2] of byte; // luminance/alpha tex (2MB) - TextureD24: array[1..1024*1024, 1..3] of byte; // normal 24-bit tex (3MB) - TextureD242: array[1..512*512, 1..3] of byte; // normal 24-bit tex (0,75MB) - TextureD32: array[1..1024*1024, 1..4] of byte; // transparent 32-bit tex (4MB) +// TextureD24: array[1..1024*1024, 1..3] of byte; // normal 24-bit tex (3MB) +// TextureD242: array[1..512*512, 1..3] of byte; // normal 24-bit tex (0,75MB) +// TextureD32: array[1..1024*1024, 1..4] of byte; // transparent 32-bit tex (4MB) // total 40MB at 2048*2048 // total 10MB at 1024*1024 @@ -140,141 +138,244 @@ var implementation uses ULog, DateUtils, UCovers, StrUtils; -function TTextureUnit.GetTexture(Name, Typ: string): TTexture; -begin - Result := GetTexture(Name, Typ, true); +const + fmt_rgba: TSDL_Pixelformat=(palette: nil; + BitsPerPixel: 32; + BytesPerPixel: 4; + Rloss: 0; + Gloss: 0; + Bloss: 0; + Aloss: 0; + Rshift: 0; + Gshift: 8; + Bshift: 16; + Ashift: 24; + Rmask: $000000ff; + Gmask: $0000ff00; + Bmask: $00ff0000; + Amask: $ff000000; + ColorKey: 0; + Alpha: 255); + fmt_rgb: TSDL_Pixelformat=( palette: nil; + BitsPerPixel: 24; + BytesPerPixel: 3; + Rloss: 0; + Gloss: 0; + Bloss: 0; + Aloss: 0; + Rshift: 0; + Gshift: 8; + Bshift: 16; + Ashift: 0; + Rmask: $000000ff; + Gmask: $0000ff00; + Bmask: $00ff0000; + Amask: $00000000; + ColorKey: 0; + Alpha: 255); + + +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; -function TTextureUnit.GetTexture(Name, Typ: string; FromCache: boolean): TTexture; -var - T: integer; // texture - C: integer; // cover - Data: array of byte; -begin - // find texture entry - T := FindTexture(Name); - - if T = -1 then +// +++++++++++++++++++++ helpers for loadimage +++++++++++++++ + function SdlStreamSeek( context : PSDL_RWops; offset : Integer; whence : Integer ) : integer; cdecl; + var + stream : TStream; + origin : Word; begin - // create texture entry - T := Length(TextureDatabase.Texture); - SetLength(TextureDatabase.Texture, T+1); - - TextureDatabase.Texture[T].Name := Name; - TextureDatabase.Texture[T].Typ := Typ; - - // inform database that no textures have been loaded into memory - TextureDatabase.Texture[T].Texture.TexNum := -1; - TextureDatabase.Texture[T].TextureCache.TexNum := -1; + 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; - - // use preloaded texture - if (not FromCache) or (FromCache and not Covers.CoverExists(Name)) then + function SdlStreamRead( context : PSDL_RWops; Ptr : Pointer; size : Integer; maxnum: Integer ) : Integer; cdecl; + var + stream : TStream; begin - // use full texture - if TextureDatabase.Texture[T].Texture.TexNum = -1 then - begin - // load texture - TextureDatabase.Texture[T].Texture := LoadTexture(false, pchar(Name), 'JPG', pchar(Typ), $0); + 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; - - // use texture - Result := TextureDatabase.Texture[T].Texture; end; - - if FromCache and Covers.CoverExists(Name) then + function SDLStreamClose( context : PSDL_RWops ) : Integer; cdecl; + var + stream : TStream; begin - // use cache texture - C := Covers.CoverNumber(Name); + stream := TStream( context.unknown ); + if ( stream = nil ) then + raise EInvalidContainer.Create( 'SDLStreamClose on nil' ); + stream.Free; + Result := 1; + end; +// ----------------------------------------------- - if TextureDatabase.Texture[T].TextureCache.TexNum = -1 then begin - // load texture - Covers.PrepareData(Name); - TextureDatabase.Texture[T].TextureCache := CreateTexture(Covers.Data, Name, Covers.Cover[C].W, Covers.Cover[C].H, 24); +function TTextureUnit.LoadImage(Identifier: PChar): PSDL_Surface; +var + TexStream: TStream; + TexRWops: PSDL_RWops; + dHandle: THandle; + +begin + Result:=nil; + TexRWops:=nil; + Log.LogStatus( ' start' , Identifier); + if ( FileExists(Identifier) ) then + begin + Log.LogStatus( ' found file' , ' '+ Identifier); + // load from file + Result:=IMG_Load(Identifier); + end + else + begin + Log.LogStatus( ' trying resource' , ' '+ Identifier); + // load from resource stream + dHandle:=FindResource(hInstance,Identifier,'TEX'); + if dHandle=0 then begin + Log.LogStatus( 'ERROR Could not find resource' , Identifier); + beep; + Exit; end; + + try + TexStream := TResourceStream.Create(HInstance, Identifier, 'TEX'); + TexRWops:=SDL_AllocRW; + TexRWops.unknown:=TUnknown(TexStream); + TexRWops.seek:=SDLStreamSeek; + TexRWops.read:=SDLStreamRead; + TexRWops.write:=nil; + TexRWops.close:=SDLStreamClose; + TexRWops.type_:=2; + except + Log.LogStatus( 'ERROR Could not load from resource' , Identifier); + beep; + Exit; + end; + Result:=IMG_Load_RW(TexRWops,0); + SDL_FreeRW(TexRWops); + TexStream.Free; + end; + Log.LogStatus( ' DONE' , '---'+ Identifier); +end; - // use texture - Result := TextureDatabase.Texture[T].TextureCache; +procedure TTextureUnit.AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: PChar); +var + TempSurface: PSDL_Surface; + NeededPixFmt: PSDL_Pixelformat; +begin + NeededPixFmt:=@fmt_rgba; + if Typ= 'Plain' then NeededPixFmt:=@fmt_rgb; + if (Typ='Transparent') or + (Typ='Colorized') + then NeededPixFmt:=@fmt_rgba; + + 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.FindTexture(Name: string): integer; +function TTextureUnit.GetScaledTexture(TexSurface: PSDL_Surface; W,H: Cardinal): PSDL_Surface; var - T: integer; // texture + TempSurface: PSDL_Surface; begin - Result := -1; - for T := 0 to high(TextureDatabase.Texture) do - if TextureDatabase.Texture[T].Name = Name then - Result := T; + TempSurface:=TexSurface; + Result:=SDL_ScaleSurfaceRect(TempSurface, + 0,0,TempSurface^.W,TempSurface^.H, + W,H); +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; -// expects: src, dst: pointers to r,g,b,a -// hue: new hue within range [0.0-6.0) -procedure ColorizeCopy(Src, Dst: PByteArray; hue: Double); overload; +procedure TTextureUnit.FitTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); var - i,j,k: Cardinal; - clr, hls: array[0..2] of Double; - delta, f, p, q, t: Double; + TempSurface: PSDL_Surface; begin - hls[0]:=hue; + 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 col2h(Color:Cardinal):double; + var + clr,hls: array[0..2] of double; + delta: double; + begin + clr[0]:=((Color and $ff0000) shr 16)/255; + clr[1]:=((Color and $ff00) shr 8)/255; + clr[2]:=(Color and $ff)/255; + hls[1]:=maxvalue(clr); + delta:=hls[1]-minvalue(clr); + if clr[0]=hls[1] then hls[0]:=(clr[1]-clr[2])/delta + else if clr[1]=hls[1] then hls[0]:=2.0+(clr[2]-clr[0])/delta + else if clr[2]=hls[1] then hls[0]:=4.0+(clr[0]-clr[1])/delta; + if hls[0]<0.0 then hls[0]:=hls[0]+6.0; + if hls[0]=6.0 then hls[0]:=0.0; + col2h:=hls[0]; + end; + procedure ColorizePixel(Pix: PByteArray; hue: Double); + var + i,j,k: Cardinal; + clr, hls: array[0..2] of Double; + delta, f, p, q, t: Double; + begin + hls[0]:=hue; + + clr[0] := Pix[0]/255; + clr[1] := Pix[1]/255; + clr[2] := Pix[2]/255; - clr[0] := src[0]/255; - clr[1] := src[1]/255; - clr[2] := src[2]/255; - //calculate luminance and saturation from rgb hls[1] := maxvalue(clr); //l:=... delta := hls[1] - minvalue(clr); - + if hls[1] = 0.0 then hls[2] := 0.0 else hls[2] := delta/hls[1]; //v:=... - - // calc new rgb from our hls (h from color, l ans s from pixel) -// if (hls[1]<>0.0) and (hls[2]<>0.0) then // only if colorizing makes sense - begin - k:=trunc(hls[0]); - f:=hls[0]-k; - p:=hls[1]*(1.0-hls[2]); - q:=hls[1]*(1.0-(hls[2]*f)); - t:=hls[1]*(1.0-(hls[2]*(1.0-f))); - case k of - 0: begin clr[0]:=hls[1]; clr[1]:=t; clr[2]:=p; end; - 1: begin clr[0]:=q; clr[1]:=hls[1]; clr[2]:=p; end; - 2: begin clr[0]:=p; clr[1]:=hls[1]; clr[2]:=t; end; - 3: begin clr[0]:=p; clr[1]:=q; clr[2]:=hls[1]; end; - 4: begin clr[0]:=t; clr[1]:=p; clr[2]:=hls[1]; end; - 5: begin clr[0]:=hls[1]; clr[1]:=p; clr[2]:=q; end; - end; - // and store new rgb back into the image - dst[0]:=floor(255*clr[0]); - dst[1]:=floor(255*clr[1]); - dst[2]:=floor(255*clr[2]); - dst[3]:=src[3]; - end; -end; -// expects: src: $rrggbb -// dst: pointer to r,g,b,a -// hue: new hue within range [0.0-6.0) -procedure ColorizeCopy(Src: Cardinal; Dst: PByteArray; hue: Double); overload; -var - i,j,k: Cardinal; - clr, hls: array[0..2] of Double; - delta, f, p, q, t: Double; -begin - hls[0]:=hue; - - clr[0]:=((src shr 16) and $ff)/255; - clr[1]:=((src shr 8) and $ff)/255; - clr[2]:=(src and $ff)/255; - //calculate luminance and saturation from rgb - hls[1]:=maxvalue(clr); //l:=... - delta:=hls[1]-minvalue(clr); - if hls[1]=0.0 then hls[2]:=0.0 else hls[2]:=delta/hls[1]; //v:=... // calc new rgb from our hls (h from color, l ans s from pixel) -// if (hls[1]<>0.0) and (hls[2]<>0.0) then // only if colorizing makes sense + // if (hls[1]<>0.0) and (hls[2]<>0.0) then // only if colorizing makes sense begin k:=trunc(hls[0]); f:=hls[0]-k; @@ -290,428 +391,135 @@ begin 5: begin clr[0]:=hls[1]; clr[1]:=p; clr[2]:=q; end; end; // and store new rgb back into the image - dst[0]:=floor(255*clr[0]); - dst[1]:=floor(255*clr[1]); - dst[2]:=floor(255*clr[2]); - dst[3]:=255; + Pix[0]:=floor(255*clr[0]); + Pix[1]:=floor(255*clr[1]); + Pix[2]:=floor(255*clr[2]); end; -end; -//returns hue within range [0.0-6.0) -function col2h(Color:Cardinal):double; -var - clr,hls: array[0..2] of double; - delta: double; -begin - clr[0]:=((Color and $ff0000) shr 16)/255; - clr[1]:=((Color and $ff00) shr 8)/255; - clr[2]:=(Color and $ff)/255; - hls[1]:=maxvalue(clr); - delta:=hls[1]-minvalue(clr); - if clr[0]=hls[1] then hls[0]:=(clr[1]-clr[2])/delta - else if clr[1]=hls[1] then hls[0]:=2.0+(clr[2]-clr[0])/delta - else if clr[2]=hls[1] then hls[0]:=4.0+(clr[0]-clr[1])/delta; - if hls[0]<0.0 then hls[0]:=hls[0]+6.0; - if hls[0]=6.0 then hls[0]:=0.0; - col2h:=hls[0]; -end; - - -function TTextureUnit.LoadBitmap( const aSourceStream : TStream; const aIMG : TBitMap ): boolean; -begin - result := false; - try - Log.LogStatus( ' TTextureUnit.LoadBitmap' , '' ); - - aSourceStream.position := 0; - aIMG.LoadFromStream( aSourceStream ); - finally - result := aSourceStream.position > 0; end; -end; -function TTextureUnit.LoadJpeg( const aSourceStream : TStream; const aIMG : TBitMap ): boolean; var - TextureJ: TJPEGImage; + DestinationHue: Double; + PixelIndex: Cardinal; begin - result := false; - try - Log.LogStatus( ' TTextureUnit.LoadJpeg' , ''); - - aSourceStream.position := 0; - - TextureJ := TJPEGImage.Create; - try - TextureJ.LoadFromStream( aSourceStream ); - aIMG.Assign(TextureJ); - finally - TextureJ.Free; - end; - finally - result := aSourceStream.position > 0; - end; + DestinationHue:=col2h(Col); + for PixelIndex:=0 to (TexSurface^.W*TexSurface^.H -1) do + ColorizePixel(@(PByteArray(TexSurface^.Pixels)[PixelIndex*TexSurface^.format.BytesPerPixel]),DestinationHue); end; - - - function TTextureUnit.LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; var - Res: TResourceStream; - TextureB: TBitmap; - TextureJ: TJPEGImage; - {$IFNDEF FPC} - TexturePNG: TPNGObject; - {$ENDIF} - - TextureAlpha: array of byte; - AlphaPtr: PByte; - TransparentColor: TColor; - PixelColor: TColor; + TexSurface: PSDL_Surface; + MipmapSurface: PSDL_Surface; + newWidth, newHeight: Cardinal; + oldWidth, oldHeight: Cardinal; - Position: integer; - Position2: integer; - Pix: integer; - ColInt: real; - PPix: PByteArray; - TempA: integer; - Error: integer; - SkipX: integer; - myAlpha: Real; - myRGBABitmap: array of byte; - RGBPtr: PByte; - myHue: Double; - - lTextureStream : TStream; begin - lTextureStream := nil; - - Log.LogStatus( 'From Resource - ' + inttostr( integer( FromRegistry ) ) , Identifier +' '+ Format +' '+ Typ ); - -// {$IFNDEF FPC} - // TODO : JB_lazarus eeeew this is a nasty one... - // but lazarus implementation scanlines is different :( - // need to implement as per - // http://www.lazarus.freepascal.org/index.php?name=PNphpBB2&file=viewtopic&p=18512 - // http://www.lazarus.freepascal.org/index.php?name=PNphpBB2&file=viewtopic&p=10797 - // http://wiki.lazarus.freepascal.org/Developing_with_Graphics Log.BenchmarkStart(4); Mipmapping := true; - if FromRegistry then - begin - try - {$IFNDEF FPC} - lTextureStream := TResourceStream.Create(HInstance, Identifier, Format); - - // TEmp, untill all code is moved to refactord way.. - Res := TResourceStream( lTextureStream ); - {$ENDIF} - except - Log.LogStatus( 'ERROR Could not load from resource' , Identifier +' '+ Format +' '+ Typ ); - beep; - Exit; - end; - end + if Identifier = nil then + Log.LogStatus(' ERROR unknown Identifier', 'Id:'''+Identifier+''' Fmt:'''+Format+''' Typ:'''+Typ+'''') else - begin - if ( FileExists(Identifier) ) then - begin - // Get the File Extension... - Format := PAnsichar(UpperCase(RightStr(ExtractFileExt(Identifier),3))); + Log.LogStatus(' should be ok - trying to load', 'Id:'''+Identifier+''' Fmt:'''+Format+''' Typ:'''+Typ+''''); - lTextureStream := TMemoryStream.create(); - TMemoryStream(lTextureStream).loadfromfile( Identifier ); - end; - end; - - if assigned( lTextureStream ) then + // load texture data into memory + TexSurface:=LoadImage(Identifier); + if not assigned(TexSurface) then begin - TextureB := TBitmap.Create; + Log.LogStatus( 'ERROR Could not load texture' , Identifier +' '+ Format +' '+ Typ ); + beep; + Exit; + end; - if Format = 'BMP' then - LoadBitmap( lTextureStream , TextureB ) - else - if Format = 'JPG' then - LoadJpeg( lTextureStream , TextureB ) - else if Format = 'PNG' then + // convert pixel format as needed + AdjustPixelFormat(TexSurface, Typ); + + // 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 + ScaleTexture(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='Plain') then begin - {$IFNDEF FPC} - // TODO : JB_lazarus - fix this for lazarus.. - TexturePNG := TPNGObject.Create; - if FromRegistry then - TexturePNG.LoadFromStream(Res) - else + if (Covers.W <= 256) and (Covers.H <= 256) then begin - if FileExists(Identifier) then - TexturePNG.LoadFromFile(Identifier) - else - Exit; + MipmapSurface:=GetScaledTexture(TexSurface,Covers.W, Covers.H); + System.Move(MipmapSurface^.pixels,CacheMipmap,Covers.W*Covers.H*3-1); + SDL_FreeSurface(MipmapSurface); end; - - TextureB.Assign(TexturePNG); - // transparent png hack start (part 1 of 2) - if ((Typ = 'Transparent') or (Typ = 'Colorized')) and (TexturePNG.TransparencyMode = ptmPartial) then - begin - setlength(TextureAlpha, TextureB.Width*TextureB.Height); - setlength(MyRGBABitmap,TextureB.Width*TextureB.Height*4); - if (TexturePNG.Header.ColorType = COLOR_GRAYSCALEALPHA) or - (TexturePNG.Header.ColorType = COLOR_RGBALPHA) then - begin - // i would have preferred english variables here but i use Position because i'm lazy - for Position := 0 to TextureB.Height - 1 do - begin - AlphaPtr := PByte(TexturePNG.AlphaScanline[Position]); - RGBPtr:=PByte(TexturePNG.Scanline[Position]); - for Position2 := 0 to TextureB.Width - 1 do - begin - TextureAlpha[Position*TextureB.Width+Position2]:= AlphaPtr^; - MyRGBABitmap[(Position*TextureB.Width+Position2)*4]:= RGBPtr^; - Inc(RGBPtr); - MyRGBABitmap[(Position*TextureB.Width+Position2)*4+1]:= RGBPtr^; - Inc(RGBPtr); - MyRGBABitmap[(Position*TextureB.Width+Position2)*4+2]:= RGBPtr^; - Inc(RGBPtr); - MyRGBABitmap[(Position*TextureB.Width+Position2)*4+3]:= AlphaPtr^; -// Inc(RGBPtr); - Inc(AlphaPtr); - end; - end; - end; - end else - setlength(TextureAlpha,0); // just no special transparency for unimplemented transparency types (ptmBit) - // transparent png hack end - TexturePNG.Free; - {$ENDIF} + // should i create a cache texture, if Covers.W/H are larger? end; - if FromRegistry then Res.Free; - if (TextureB.Width > 1024) or (TextureB.Height > 1024) then begin // will be fixed in 0.5.1 and dynamically extended to 8192x8192 depending on the driver - Log.LogError('Image ' + Identifier + ' is too big (' + IntToStr(TextureB.Width) + 'x' + IntToStr(TextureB.Height) + ')'); - Result.TexNum := -1; - end else begin + // now we might colorize the whole thing + if Typ='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 + + // 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 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 = 'Plain' then begin - {$IFNDEF FPC} - // dimensions - TexOrigW := TextureB.Width; - TexOrigH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); - - // copy and process pixeldata - TextureB.PixelFormat := pf24bit; -{ if (TextureB.PixelFormat = pf8bit) then begin - for Position := 0 to TexOrigH-1 do begin - for Position2 := 0 to TexOrigW-1 do begin - Pix := TextureB.Canvas.Pixels[Position2, Position]; - TextureD24[Position*TexNewW + Position2+1, 1] := Pix; - TextureD24[Position*TexNewW + Position2+1, 2] := Pix div 256; - TextureD24[Position*TexNewW + Position2+1, 3] := Pix div (256*256); - end; - end; - end;} - if (TexOrigW <= Limit) and (TexOrigW <= Limit) then begin - if (TextureB.PixelFormat = pf24bit) then begin - for Position := 0 to TexOrigH-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TexOrigW-1 do begin - TextureD24[Position*TexNewW + Position2+1, 1] := PPix[Position2*3+2]; - TextureD24[Position*TexNewW + Position2+1, 2] := PPix[Position2*3+1]; - TextureD24[Position*TexNewW + Position2+1, 3] := PPix[Position2*3]; - end; - end; - end; - end else begin - // limit - TexFitW := 4 * (TexOrigW div 4); // fix for bug in gluScaleImage - TexFitH := TexOrigH; - if (TextureB.PixelFormat = pf24bit) then begin - for Position := 0 to TexOrigH-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TexOrigW-1 do begin - TextureD24[Position*TexFitW + Position2+1, 1] := PPix[Position2*3+2]; - TextureD24[Position*TexFitW + Position2+1, 2] := PPix[Position2*3+1]; - TextureD24[Position*TexFitW + Position2+1, 3] := PPix[Position2*3]; - end; - end; - end; - gluScaleImage(GL_RGB, TexFitW, TexFitH, GL_UNSIGNED_BYTE, @TextureD24, - Limit, Limit, GL_UNSIGNED_BYTE, @TextureD24); // takes some time - - TexNewW := Limit; - TexNewH := Limit; - TexOrigW := Limit; - TexOrigH := Limit; - end; - - // creating cache mipmap - if CreateCacheMipmap then begin - if (TexOrigW <> TexNewW) or (TexOrigH <> TexNewH) then begin - // texture only uses some of it's space. there's a need for resize to fit full size - // and get best quality - TexFitW := 4 * (TexOrigW div 4); // 0.5.0: fix for bug in gluScaleImage - SkipX := (TexOrigW div 2) mod 2; // 0.5.0: try to center image - - TexFitH := TexOrigH; - for Position := 0 to TexOrigH-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TexOrigW-1 do begin - TextureD242[Position*TexFitW + Position2+1, 1] := PPix[(Position2+SkipX)*3+2]; - TextureD242[Position*TexFitW + Position2+1, 2] := PPix[(Position2+SkipX)*3+1]; - TextureD242[Position*TexFitW + Position2+1, 3] := PPix[(Position2+SkipX)*3]; - end; - end; - gluScaleImage(GL_RGB, TexFitW, TexFitH, GL_UNSIGNED_BYTE, @TextureD242, - Covers.W, Covers.H, GL_UNSIGNED_BYTE, @CacheMipmap[0]); // takes some time - - end else begin - // texture fits perfectly - gluScaleImage(GL_RGB, TexOrigW, TexOrigH, GL_UNSIGNED_BYTE, @TextureD24, - Covers.W, Covers.H, GL_UNSIGNED_BYTE, @CacheMipmap[0]); // takes some time - end; - end; - - glTexImage2D(GL_TEXTURE_2D, 0, 3, TexNewW, TexNewH, 0, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); - if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 3, TexNewW, TexNewH, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); - if Error > 0 then beep; - end - {$ENDIF} + glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, TexSurface^.pixels); end; - if Typ = 'Transparent' then begin - // dimensions - TexOrigW := TextureB.Width; - TexOrigH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); - TextureB.Width := TexNewW; - TextureB.Height := TexNewH; - - // copy and process pixeldata - for Position := 0 to TexOrigH-1 do begin - for Position2 := 0 to TexOrigW-1 do begin - Pix := TextureB.Canvas.Pixels[Position2, Position]; - // ,- part of transparent png hack - if ((Pix = $fefefe) or (Pix = Col)) and (length(TextureAlpha)=0) then begin //Small fix, that caused artefacts to be drawn (#fe == dec254) - TextureD32[Position*TexNewW + Position2 + 1, 1] := 0; - TextureD32[Position*TexNewW + Position2 + 1, 2] := 0; - TextureD32[Position*TexNewW + Position2 + 1, 3] := 0; - TextureD32[Position*TexNewW + Position2 + 1, 4] := 0; - end else if (Format = 'PNG') and (length(TextureAlpha) <> 0) then begin - myAlpha:=TextureAlpha[Position*TexOrigW+Position2]; - TextureD32[Position*TexNewW + Position2+1, 1] := MyRGBABitmap[(Position*TexOrigW+Position2)*4+2]; - TextureD32[Position*TexNewW + Position2+1, 2] := MyRGBABitmap[(Position*TexOrigW+Position2)*4+1]; - TextureD32[Position*TexNewW + Position2+1, 3] := MyRGBABitmap[(Position*TexOrigW+Position2)*4]; - TextureD32[Position*TexNewW+Position2+1,4]:=MyRGBABitmap[(Position*TexOrigW+Position2)*4+3]; - end else begin - TextureD32[Position*TexNewW + Position2+1, 1] := (Pix and $ff); - TextureD32[Position*TexNewW + Position2+1, 2] := ((Pix shr 8) and $ff); - TextureD32[Position*TexNewW + Position2+1, 3] := ((Pix shr 16) and $ff); - TextureD32[Position*TexNewW + Position2+1, 4] := 255; - end; - end; - end; - setlength(TextureAlpha,0); - setlength(MyRGBABitmap,0); - glTexImage2D(GL_TEXTURE_2D, 0, 4, TexNewW, TexNewH, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); -{ if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 4, TextureB.Width, TextureB.Height, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - if Error > 0 then beep; - end;} + if (Typ = 'Transparent') or (Typ='Colorized') then begin + glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TexSurface^.pixels); end; - -// The new awesomeness of colorized pngs starts here -// We're the first who had this feature, so give credit when you copy+paste :P - if Typ = 'Colorized' then begin - // dimensions - TexOrigW := TextureB.Width; - TexOrigH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); - TextureB.Width := TexNewW; - TextureB.Height := TexNewH; - - myHue:=col2h(Col); - // copy and process pixeldata - for Position := 0 to TexOrigH-1 do begin - for Position2 := 0 to TexOrigW-1 do begin - Pix := TextureB.Canvas.Pixels[Position2, Position]; - if (Format = 'PNG') and (length(MyRGBABitmap) <> 0) then - ColorizeCopy(@MyRGBABitmap[(Position*TexOrigW+Position2)*4], - @TextureD32[Position*TexNewW + Position2+1, 1], - myHue) - else - ColorizeCopy(Pix, - @TextureD32[Position*TexNewW + Position2+1, 1], - myHue); - end; - end; - - setlength(TextureAlpha,0); - setlength(MyRGBABitmap,0); - glTexImage2D(GL_TEXTURE_2D, 0, 4, TexNewW, TexNewH, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; -// eoa COLORIZE - - if Typ = 'Transparent Range' then begin - // dimensions - TexOrigW := TextureB.Width; - TexOrigH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); - TextureB.Width := TexNewW; - TextureB.Height := TexNewH; - // copy and process pixeldata - for Position := 0 to TexOrigH-1 do begin - for Position2 := 0 to TexOrigW-1 do begin +{ + if Typ = 'Transparent Range' then + // set alpha to 256-green-component (not sure) Pix := TextureB.Canvas.Pixels[Position2, Position]; TextureD32[Position*TexNewW + Position2+1, 1] := Pix; TextureD32[Position*TexNewW + Position2+1, 2] := Pix div 256; TextureD32[Position*TexNewW + Position2+1, 3] := Pix div (256*256); TextureD32[Position*TexNewW + Position2+1, 4] := 256 - Pix div 256; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TexNewW, TexNewH, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); -{ if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 4, TextureB.Width, TextureB.Height, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - if Error > 0 then beep; - end;} - end; - +} +{ if Typ = 'Font' then - begin - {$IFNDEF FPC} - TextureB.PixelFormat := pf24bit; - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin + // either create luminance-alpha texture + // or use transparency from differently saved file + // or do something totally different (text engine with ttf) Pix := PPix[Position2 * 3]; TextureD16[Position*TextureB.Width + Position2 + 1, 1] := 255; TextureD16[Position*TextureB.Width + Position2 + 1, 2] := Pix; - end; - end; glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - - if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); - if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 2, TextureB.Width, TextureB.Height, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - if Error > 0 then beep; - end; - {$ENDIF} - end; - +} +{ if Typ = 'Font Outline' then + // no idea... begin - {$IFNDEF FPC} TextureB.PixelFormat := pf24bit; for Position := 0 to TextureB.Height-1 do begin PPix := TextureB.ScanLine[Position]; @@ -732,18 +540,12 @@ begin end; end; glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - - if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); - if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 2, TextureB.Width, TextureB.Height, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - if Error > 0 then beep; - end; - {$ENDIF} end; - +} +{ if Typ = 'Font Outline 2' then + // same as above begin - {$IFNDEF FPC} TextureB.PixelFormat := pf24bit; for Position := 0 to TextureB.Height-1 do begin PPix := TextureB.ScanLine[Position]; @@ -762,18 +564,16 @@ begin end; end; glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); if Mipmapping then begin Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 2, TextureB.Width, TextureB.Height, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); if Error > 0 then beep; end; - {$ENDIF} end; if Typ = 'Font Black' then + // and so on begin - {$IFNDEF FPC} // normalnie 0,125s bez niczego 0,015s - 0,030s z pix 0,125s <-- ??? // dimensions TextureB.PixelFormat := pf24bit; @@ -795,12 +595,11 @@ begin end; end; glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - {$ENDIF} end; if Typ = 'Alpha Black Colored' then + // ... hope, noone needs this begin - {$IFNDEF FPC} TextureB.PixelFormat := pf24bit; TexOrigW := TextureB.Width; TexOrigH := TextureB.Height; @@ -820,12 +619,10 @@ begin end; end; glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - {$ENDIF} end; if Typ = 'Font Gray' then begin - {$IFNDEF FPC} // dimensions TexOrigW := TextureB.Width; TexOrigH := TextureB.Height; @@ -844,16 +641,10 @@ begin end; end; glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); -{ if Mipmapping then begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 4, TextureB.Width, TextureB.Height, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - if Error > 0 then beep; - end;} - {$ENDIF} end; if Typ = 'Arrow' then begin - {$IFNDEF FPC} TextureB.PixelFormat := pf24bit; for Position := 0 to TextureB.Height-1 do begin PPix := TextureB.ScanLine[Position]; @@ -882,12 +673,10 @@ begin Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 4, TextureB.Width, TextureB.Height, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); if Error > 0 then beep; end; - {$ENDIF} end; if Typ = 'Note Plain' then begin - {$IFNDEF FPC} for Position := 0 to TextureB.Height-1 do begin PPix := TextureB.ScanLine[Position]; @@ -921,12 +710,10 @@ begin end; end; glTexImage2D(GL_TEXTURE_2D, 0, 3, TextureB.Width, TextureB.Height, 0, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); - {$ENDIF} end; if Typ = 'Note Transparent' then begin - {$IFNDEF FPC} for Position := 0 to TextureB.Height-1 do begin PPix := TextureB.ScanLine[Position]; for Position2 := 0 to TextureB.Width-1 do begin @@ -961,10 +748,9 @@ begin end; end; glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - {$ENDIF} end; +} - TextureB.Free; Result.X := 0; Result.Y := 0; Result.W := 0; @@ -973,8 +759,8 @@ begin Result.ScaleH := 1; Result.Rot := 0; Result.TexNum := ActTex; - Result.TexW := TexOrigW / TexNewW; - Result.TexH := TexOrigH / TexNewH; + Result.TexW := oldWidth / newWidth; + Result.TexH := oldHeight / newHeight; Result.Int := 1; Result.ColR := 1; @@ -991,52 +777,86 @@ begin // 0.5.0 Result.Name := Identifier; - end; + SDL_FreeSurface(TexSurface); + Log.BenchmarkEnd(4); if Log.BenchmarkTimeLength[4] >= 1 then Log.LogBenchmark('**********> Texture Load Time Warning - ' + Format + '/' + Identifier + '/' + Typ, 4); +end; - end; // logerror -// freeandnil( lTextureStream ); // TODO - jb - free this.. but we cant at the moment :( -// {$ENDIF} +function TTextureUnit.GetTexture(Name, Typ: string): TTexture; +begin + Result := GetTexture(Name, Typ, true); end; -{procedure ResizeTexture(s: pbytearray; d: pbytearray); +function TTextureUnit.GetTexture(Name, Typ: string; FromCache: boolean): TTexture; var - Position: integer; - Position2: integer; + T: integer; // texture + C: integer; // cover + Data: array of byte; begin - for Position := 0 to TexNewH*4-1 do - for Position2 := 0 to TexNewW-1 do - d[Position*TexNewW + Position2] := 0; - - for Position := 0 to TexOrigH-1 do begin - for Position2 := 0 to TexOrigW-1 do begin - d[(Position*TexNewW + Position2)*4] := Paleta[s[Position*TexOrigW + Position2], 1]; - d[(Position*TexNewW + Position2)*4+1] := Paleta[s[Position*TexOrigW + Position2], 2]; - d[(Position*TexNewW + Position2)*4+2] := Paleta[s[Position*TexOrigW + Position2], 3]; - d[(Position*TexNewW + Position2)*4+3] := Paleta[s[Position*TexOrigW + Position2], 4]; + // find texture entry + T := FindTexture(Name); + + 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; + + // inform database that no textures have been loaded into memory + TextureDatabase.Texture[T].Texture.TexNum := -1; + TextureDatabase.Texture[T].TextureCache.TexNum := -1; + end; + + // use preloaded texture + if (not FromCache) or (FromCache and not Covers.CoverExists(Name)) then + begin + // use full texture + if TextureDatabase.Texture[T].Texture.TexNum = -1 then + begin + // load texture + TextureDatabase.Texture[T].Texture := LoadTexture(false, pchar(Name), 'JPG', pchar(Typ), $0); + 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 = -1 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;} +end; -{procedure SetTexture(p: pointer); +function TTextureUnit.FindTexture(Name: string): integer; +var + T: integer; // texture begin - glGenTextures(1, Tekstur); - glBindTexture(GL_TEXTURE_2D, Tekstur); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP); - glTexImage2D(GL_TEXTURE_2D, 0, 4, TexNewW, TexNewH, 0, GL_RGBA, GL_UNSIGNED_BYTE, p); -end;} + Result := -1; + for T := 0 to high(TextureDatabase.Texture) do + if TextureDatabase.Texture[T].Name = Name then + Result := T; +end; function TTextureUnit.LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; begin Result := LoadTexture(false, Identifier, Format, Typ, Col); -// Result := LoadTexture(SkinReg, Identifier, Format, Typ, Col); // default to SkinReg - end; function TTextureUnit.LoadTexture(Identifier: string): TTexture; -- cgit v1.2.3