From 5ed6620bad808381fce94f2cd67ee911b4d45bff Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Wed, 21 Mar 2007 19:19:04 +0000 Subject: git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 811 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 811 insertions(+) create mode 100644 Game/Code/Classes/UTexture.pas (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas new file mode 100644 index 00000000..767d53ec --- /dev/null +++ b/Game/Code/Classes/UTexture.pas @@ -0,0 +1,811 @@ +unit UTexture; + +// Plain (alpha = 1) +// Transparent +// Transparent Range +// Font (white is drawn, black is transparent) +// Font Outline (Font with darker outline) +// Font Outline 2 (Font with darker outline) +// Font Black (black is drawn, white is transparent) +// Font Gray (gray is drawn, white is transparent) +// Arrow (for arrows, white is white, gray has color, black is transparent); + +interface +uses OpenGL12, Windows, Math, Classes, SysUtils, Graphics, JPEG, UThemes; + +procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32; +//procedure glBindTexture(target: GLenum; texture: GLuint); stdcall; external opengl32; +//function gluBuild2DMipmaps (target: GLenum; components, width, height: GLint; +// format, atype: GLenum; data: Pointer): Integer; stdcall; external glu32; +//procedure glCopyTexImage2D(target: GLenum; level: GLint; internalFormat: GLenum; x, y: GLint; width, height: GLsizei; border: GLint); stdcall; external opengl32; + + +type + TTexture = record + TexNum: integer; + 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; + + TTextureEntry = record + Name: string; + Typ: string; + + // we use normal TTexture, it's easier to implement and if needed - we copy ready data + Texture: TTexture; + TextureCache: TTexture; // 0.5.0 + end; + + TTextureDatabase = record + Texture: array of TTextureEntry; + end; + + TTextureUnit = class + Limit: integer; + CreateCacheMipmap: boolean; + +// function GetNumberFor + function GetTexture(Name, Typ: string): TTexture; overload; + function GetTexture(Name, Typ: string; FromCache: boolean): TTexture; overload; + function FindTexture(Name: string): integer; + function LoadTexture(FromRegistry: boolean; Nazwa, Format, Typ: PChar; Col: LongWord): TTexture; overload; + function LoadTexture(Nazwa, Format, Typ: PChar; Col: LongWord): TTexture; overload; + function LoadTexture(Nazwa: string): TTexture; overload; + function CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; + procedure UnloadTexture(Name: string; FromCache: boolean); + end; + +var + Texture: TTextureUnit; + TextureDatabase: TTextureDatabase; + + + // for print screens +// PrintScreenTex: GLuint; +// PrintScreenData: array[0..480-1, 0..640-1] of longword; + PrintScreenData: array[0..1024*768-1] of longword; + +// Tekstur: Gluint; + ActTex: GLuint;//integer; + +{ Tekstura: array[1..32] of TTekstura; + Mipmapping: boolean = true;} + + TexOrygW: integer; + TexOrygH: integer; + TexNewW: integer; + TexNewH: integer; +{ RLE: array[1..128*128] of byte; + RLE2: array[1..128*128] of byte;} + + TexFitW: integer; + TexFitH: integer; // new for limit + + 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) + // total 40MB at 2048*2048 + // total 10MB at 1024*1024 + +{ Paleta: array[0..255, 1..4] of byte; + Len: integer;} + Mipmapping: Boolean; + + CacheMipmap: array[0..256*256*3-1] of byte; // 3KB + + +implementation +uses ULog, DateUtils, UCovers; + +function TTextureUnit.GetTexture(Name, Typ: string): TTexture; +begin + Result := GetTexture(Name, Typ, true); +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 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 not textures has 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); +{ Covers.Data[0] := 0; + Covers.Data[1] := 0; + Covers.Data[2] := 0; + Covers.Data[3] := 255; + Covers.Data[4] := 255; + Covers.Data[5] := 255;} + 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; + +function TTextureUnit.FindTexture(Name: string): integer; +var + T: integer; // texture +begin + Result := -1; + for T := 0 to high(TextureDatabase.Texture) do + if TextureDatabase.Texture[T].Name = Name then + Result := T; +end; + +function TTextureUnit.LoadTexture(FromRegistry: boolean; Nazwa, Format, Typ: PChar; Col: LongWord): TTexture; +var + Res: TResourceStream; + TextureB: TBitmap; + TextureJ: TJPEGImage; + + Pet: integer; + Pet2: integer; + Pix: integer; + ColInt: real; + PPix: PByteArray; + TempA: integer; + Error: integer; + SkipX: integer; +begin + Log.BenchmarkStart(4); + Mipmapping := true; + + if FromRegistry then begin + try + Res := TResourceStream.Create(HInstance, Nazwa, Format); + except + beep; + Exit; + end; + end; + + if FromRegistry or ((not FromRegistry) and FileExists(Nazwa)) then begin + + TextureB := TBitmap.Create; + + if Format = 'JPG' then begin + TextureJ := TJPEGImage.Create; + if FromRegistry then TextureJ.LoadFromStream(Res) + else begin + if FileExists(Nazwa) then + TextureJ.LoadFromFile(Nazwa) + else + Exit; + end; + TextureB.Assign(TextureJ); + TextureJ.Free; + end; + if Format = 'BMP' then begin + if FromRegistry then TextureB.LoadFromStream(Res) + else TextureB.LoadFromFile(Nazwa); + 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 ' + Nazwa + ' is too big (' + IntToStr(TextureB.Width) + 'x' + IntToStr(TextureB.Height) + ')'); + Result.TexNum := -1; + end else begin + + 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); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP); + + if Typ = 'Plain' then begin + // wymiary + TexOrygW := TextureB.Width; + TexOrygH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrygW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrygH)))); + + // kopiowanie + TextureB.PixelFormat := pf24bit; +{ if (TextureB.PixelFormat = pf8bit) then begin + for Pet := 0 to TexOrygH-1 do begin + for Pet2 := 0 to TexOrygW-1 do begin + Pix := TextureB.Canvas.Pixels[Pet2, Pet]; + TextureD24[Pet*TexNewW + Pet2+1, 1] := Pix; + TextureD24[Pet*TexNewW + Pet2+1, 2] := Pix div 256; + TextureD24[Pet*TexNewW + Pet2+1, 3] := Pix div (256*256); + end; + end; + end;} + if (TexOrygW <= Limit) and (TexOrygW <= Limit) then begin + if (TextureB.PixelFormat = pf24bit) then begin + for Pet := 0 to TexOrygH-1 do begin + PPix := TextureB.ScanLine[Pet]; + for Pet2 := 0 to TexOrygW-1 do begin + TextureD24[Pet*TexNewW + Pet2+1, 1] := PPix[Pet2*3+2]; + TextureD24[Pet*TexNewW + Pet2+1, 2] := PPix[Pet2*3+1]; + TextureD24[Pet*TexNewW + Pet2+1, 3] := PPix[Pet2*3]; + end; + end; + end; + end else begin + // limit + TexFitW := 4 * (TexOrygW div 4); // fix for bug in gluScaleImage + TexFitH := TexOrygH; + if (TextureB.PixelFormat = pf24bit) then begin + for Pet := 0 to TexOrygH-1 do begin + PPix := TextureB.ScanLine[Pet]; + for Pet2 := 0 to TexOrygW-1 do begin + TextureD24[Pet*TexFitW + Pet2+1, 1] := PPix[Pet2*3+2]; + TextureD24[Pet*TexFitW + Pet2+1, 2] := PPix[Pet2*3+1]; + TextureD24[Pet*TexFitW + Pet2+1, 3] := PPix[Pet2*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; + TexOrygW := Limit; + TexOrygH := Limit; + end; + + // creating cache mipmap + if CreateCacheMipmap then begin + if (TexOrygW <> TexNewW) or (TexOrygH <> 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 * (TexOrygW div 4); // 0.5.0: fix for bug in gluScaleImage + SkipX := (TexOrygW div 2) mod 2; // 0.5.0: try to center image + + TexFitH := TexOrygH; + for Pet := 0 to TexOrygH-1 do begin + PPix := TextureB.ScanLine[Pet]; + for Pet2 := 0 to TexOrygW-1 do begin + TextureD242[Pet*TexFitW + Pet2+1, 1] := PPix[(Pet2+SkipX)*3+2]; + TextureD242[Pet*TexFitW + Pet2+1, 2] := PPix[(Pet2+SkipX)*3+1]; + TextureD242[Pet*TexFitW + Pet2+1, 3] := PPix[(Pet2+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, TexOrygW, TexOrygH, 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 + end; + + if Typ = 'Transparent' then begin + // wymiary + TexOrygW := TextureB.Width; + TexOrygH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrygW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrygH)))); + TextureB.Width := TexNewW; + TextureB.Height := TexNewH; + // kopiowanie + for Pet := 0 to TexOrygH-1 do begin + for Pet2 := 0 to TexOrygW-1 do begin + Pix := TextureB.Canvas.Pixels[Pet2, Pet]; + if Pix = Col then begin + TextureD32[Pet*TexNewW + Pet2 + 1, 1] := 0; + TextureD32[Pet*TexNewW + Pet2 + 1, 2] := 0; + TextureD32[Pet*TexNewW + Pet2 + 1, 3] := 0; + TextureD32[Pet*TexNewW + Pet2 + 1, 4] := 0; + end else begin + TextureD32[Pet*TexNewW + Pet2+1, 1] := Pix; + TextureD32[Pet*TexNewW + Pet2+1, 2] := Pix div 256; + TextureD32[Pet*TexNewW + Pet2+1, 3] := Pix div (256*256); + TextureD32[Pet*TexNewW + Pet2+1, 4] := 255; + end; + 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 = 'Transparent Range' then begin + // wymiary + TexOrygW := TextureB.Width; + TexOrygH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrygW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrygH)))); + TextureB.Width := TexNewW; + TextureB.Height := TexNewH; + // kopiowanie + for Pet := 0 to TexOrygH-1 do begin + for Pet2 := 0 to TexOrygW-1 do begin + Pix := TextureB.Canvas.Pixels[Pet2, Pet]; + TextureD32[Pet*TexNewW + Pet2+1, 1] := Pix; + TextureD32[Pet*TexNewW + Pet2+1, 2] := Pix div 256; + TextureD32[Pet*TexNewW + Pet2+1, 3] := Pix div (256*256); + TextureD32[Pet*TexNewW + Pet2+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 + TextureB.PixelFormat := pf24bit; + for Pet := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Pet]; + for Pet2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Pet2 * 3]; + TextureD16[Pet*TextureB.Width + Pet2 + 1, 1] := 255; + TextureD16[Pet*TextureB.Width + Pet2 + 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; + end; + + if Typ = 'Font Outline' then begin + TextureB.PixelFormat := pf24bit; + for Pet := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Pet]; + for Pet2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Pet2 * 3]; + + Col := Pix; + if Col < 127 then Col := 127; + + TempA := Pix; + if TempA >= 95 then TempA := 255; + if TempA >= 31 then TempA := 255; + if Pix < 95 then TempA := (Pix * 256) div 96; + + + TextureD16[Pet*TextureB.Width + Pet2 + 1, 1] := Col; + TextureD16[Pet*TextureB.Width + Pet2 + 1, 2] := TempA; + 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; + end; + + if Typ = 'Font Outline 2' then begin + TextureB.PixelFormat := pf24bit; + for Pet := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Pet]; + for Pet2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Pet2 * 3]; + + Col := Pix; + if Col < 31 then Col := 31; + + TempA := Pix; + if TempA >= 31 then TempA := 255; + if Pix < 31 then TempA := Pix * (256 div 32); + + TextureD16[Pet*TextureB.Width + Pet2 + 1, 1] := Col; + TextureD16[Pet*TextureB.Width + Pet2 + 1, 2] := TempA; + 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; + end; + + if Typ = 'Font Black' then begin + // normalnie 0,125s bez niczego 0,015s - 0,030s z pix 0,125s + // wymiary + TextureB.PixelFormat := pf24bit; + TexOrygW := TextureB.Width; + TexOrygH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrygW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrygH)))); + TextureB.Width := TexNewW; + TextureB.Height := TexNewH; + // kopiowanie + for Pet := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Pet]; + for Pet2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Pet2*3]; + TextureD32[Pet*TextureB.Width + Pet2 + 1, 1] := 255; + TextureD32[Pet*TextureB.Width + Pet2 + 1, 2] := 255; + TextureD32[Pet*TextureB.Width + Pet2 + 1, 3] := 255; + TextureD32[Pet*TextureB.Width + Pet2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + if Typ = 'Alpha Black Colored' then begin + TextureB.PixelFormat := pf24bit; + TexOrygW := TextureB.Width; + TexOrygH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrygW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrygH)))); + TextureB.Width := TexNewW; + TextureB.Height := TexNewH; + // kopiowanie + for Pet := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Pet]; + for Pet2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Pet2*3]; + TextureD32[Pet*TextureB.Width + Pet2 + 1, 1] := (Col div $10000) and $FF; + TextureD32[Pet*TextureB.Width + Pet2 + 1, 2] := (Col div $100) and $FF; + TextureD32[Pet*TextureB.Width + Pet2 + 1, 3] := Col and $FF; + TextureD32[Pet*TextureB.Width + Pet2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + if Typ = 'Font Gray' then begin + // wymiary + TexOrygW := TextureB.Width; + TexOrygH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrygW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrygH)))); + TextureB.Width := TexNewW; + TextureB.Height := TexNewH; + // kopiowanie + for Pet := 0 to TextureB.Height-1 do begin + for Pet2 := 0 to TextureB.Width-1 do begin + Pix := TextureB.Canvas.Pixels[Pet2, Pet]; + TextureD32[Pet*TextureB.Width + Pet2 + 1, 1] := 127; + TextureD32[Pet*TextureB.Width + Pet2 + 1, 2] := 127; + TextureD32[Pet*TextureB.Width + Pet2 + 1, 3] := 127; + TextureD32[Pet*TextureB.Width + Pet2 + 1, 4] := 255 - (Pix mod 256); + 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;} + end; + + if Typ = 'Arrow' then begin + TextureB.PixelFormat := pf24bit; + for Pet := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Pet]; + for Pet2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Pet2 * 3]; + + // transparency + if Pix >= 127 then TempA := 255; + if Pix < 127 then TempA := Pix * 2; + + // ColInt = color intensity + if Pix < 127 then ColInt := 1; + if Pix >= 127 then ColInt := 2 - Pix / 128; + //0.75, 0.6, 0.25 + + TextureD32[Pet*TextureB.Width + Pet2 + 1, 1] := Round(ColInt * 0.75 * 255 + (1 - ColInt) * 255); + TextureD32[Pet*TextureB.Width + Pet2 + 1, 2] := Round(ColInt * 0.6 * 255 + (1 - ColInt) * 255); + TextureD32[Pet*TextureB.Width + Pet2 + 1, 3] := Round(ColInt * 0.25 * 255 + (1 - ColInt) * 255); + TextureD32[Pet*TextureB.Width + Pet2 + 1, 4] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + + if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); + 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 = 'Note Plain' then begin + for Pet := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Pet]; + for Pet2 := 0 to TextureB.Width-1 do begin + + + + // Skin Patch + // 0-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White + case PPix[Pet2*3] of + 0..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Pet2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Pet2*3]) div $Bf) + (((Col and $FF) * PPix[Pet2*3]) div $Bf); + 192: Pix := Col; + 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Pet2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Pet2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Pet2*3] - $C0) * 4)) div $FF)); + 255: Pix := $FFFFFF; + end; +// 0.5.0. Original +// case PPix[Pet2*3] of +// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; +// 192: Pix := Col; +// 255: Pix := $FFFFFF; +// end; + + + + + + TextureD24[Pet*TextureB.Width + Pet2 + 1, 1] := Pix div $10000; + TextureD24[Pet*TextureB.Width + Pet2 + 1, 2] := (Pix div $100) and $FF; + TextureD24[Pet*TextureB.Width + Pet2 + 1, 3] := Pix and $FF; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 3, TextureB.Width, TextureB.Height, 0, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); + end; + + if Typ = 'Note Transparent' then begin + for Pet := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Pet]; + for Pet2 := 0 to TextureB.Width-1 do begin + TempA := 255; + + + + //Skin Patch + // 0= Transparent, 1-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White + case PPix[Pet2*3] of + 0: TempA := 0; + 1..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Pet2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Pet2*3]) div $Bf) + (((Col and $FF) * PPix[Pet2*3]) div $Bf); + 192: Pix := Col; + 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Pet2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Pet2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Pet2*3] - $C0) * 4)) div $FF)); + 255: Pix := $FFFFFF; + end; +// 0.5.0 Original +// case PPix[Pet2*3] of +// 0: TempA := 0; +// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; +// 192: Pix := Col; +// 255: Pix := $FFFFFF; +// end; + + + + + TextureD32[Pet*TextureB.Width + Pet2 + 1, 1] := Pix div $10000; + TextureD32[Pet*TextureB.Width + Pet2 + 1, 2] := (Pix div $100) and $FF; + TextureD32[Pet*TextureB.Width + Pet2 + 1, 3] := Pix and $FF; + TextureD32[Pet*TextureB.Width + Pet2 + 1, 4] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + + + + TextureB.Free; +// Inc(ActTex); +{ Tekst.Tekstura := ActTex; + Tekst.W := TexOrygW; + Tekst.H := TexOrygH; + Tekst.X2 := TexOrygW/TexNewW; + Tekst.Y2 := TexOrygH/TexNewH;} + 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 := TexOrygW / TexNewW; + Result.TexH := TexOrygH / TexNewH; + + 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 := Nazwa; + + end; + + Log.BenchmarkEnd(4); + if Log.BenchmarkTimeLength[4] >= 1 then + Log.LogBenchmark('**********> Texture Load Time Warning - ' + Format + '/' + Nazwa + '/' + Typ, 4); + + end; // logerror +end; + +{procedure ResizeTexture(s: pbytearray; d: pbytearray); +var + Pet: integer; + Pet2: integer; +begin + for Pet := 0 to TexNewH*4-1 do + for Pet2 := 0 to TexNewW-1 do + d[Pet*TexNewW + Pet2] := 0; + + for Pet := 0 to TexOrygH-1 do begin + for Pet2 := 0 to TexOrygW-1 do begin + d[(Pet*TexNewW + Pet2)*4] := Paleta[s[Pet*TexOrygW + Pet2], 1]; + d[(Pet*TexNewW + Pet2)*4+1] := Paleta[s[Pet*TexOrygW + Pet2], 2]; + d[(Pet*TexNewW + Pet2)*4+2] := Paleta[s[Pet*TexOrygW + Pet2], 3]; + d[(Pet*TexNewW + Pet2)*4+3] := Paleta[s[Pet*TexOrygW + Pet2], 4]; + end; + end; +end;} + +{procedure SetTexture(p: pointer); +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;} + +function TTextureUnit.LoadTexture(Nazwa, Format, Typ: PChar; Col: LongWord): TTexture; +begin + Result := LoadTexture(false, Nazwa, Format, Typ, Col); +// Result := LoadTexture(SkinReg, Nazwa, Format, Typ, Col); // default to SkinReg + +end; + +function TTextureUnit.LoadTexture(Nazwa: string): TTexture; +begin + Result := LoadTexture(false, pchar(Nazwa), 'JPG', 'Plain', 0); +end; + +function TTextureUnit.CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; +var + Pet: integer; + Pet2: 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); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP); + + 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 beep; + end; + + +// Inc(ActTex); +{ Tekst.Tekstura := ActTex; + Tekst.W := TexOrygW; + Tekst.H := TexOrygH; + Tekst.X2 := TexOrygW/TexNewW; + Tekst.Y2 := TexOrygH/TexNewH;} + 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(Name: string; FromCache: boolean); +var + T: integer; + TexNum: GLuint; +begin + T := FindTexture(Name); + + if not FromCache then begin + TexNum := TextureDatabase.Texture[T].Texture.TexNum; + if TexNum >= 0 then begin + glDeleteTextures(1, @TexNum); + TextureDatabase.Texture[T].Texture.TexNum := -1; +// 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 := -1; +// Log.LogError('Unload texture cache no '+IntToStr(TexNum)); + end; + end; +end; + +end. \ No newline at end of file -- cgit v1.2.3 From 5ce375d1b7493e41a3ac14b979932d6cf7d73285 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sat, 24 Mar 2007 13:37:12 +0000 Subject: Copyed PNG Texture Support from UltraStar 0.5.3 git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@23 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 28 +++++++++++++++++++++------- 1 file changed, 21 insertions(+), 7 deletions(-) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 767d53ec..b50ab6bf 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -11,7 +11,7 @@ unit UTexture; // Arrow (for arrows, white is white, gray has color, black is transparent); interface -uses OpenGL12, Windows, Math, Classes, SysUtils, Graphics, JPEG, UThemes; +uses OpenGL12, Windows, Math, Classes, SysUtils, Graphics, JPEG, UThemes, PNGImage; procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32; //procedure glBindTexture(target: GLenum; texture: GLuint); stdcall; external opengl32; @@ -192,6 +192,7 @@ var Res: TResourceStream; TextureB: TBitmap; TextureJ: TJPEGImage; + TexturePNG: TPNGObject; Pet: integer; Pet2: integer; @@ -215,10 +216,14 @@ begin end; if FromRegistry or ((not FromRegistry) and FileExists(Nazwa)) then begin - TextureB := TBitmap.Create; - if Format = 'JPG' then begin + if Format = 'BMP' then begin + if FromRegistry then TextureB.LoadFromStream(Res) + else TextureB.LoadFromFile(Nazwa); + end + + else if Format = 'JPG' then begin TextureJ := TJPEGImage.Create; if FromRegistry then TextureJ.LoadFromStream(Res) else begin @@ -229,10 +234,19 @@ begin end; TextureB.Assign(TextureJ); TextureJ.Free; - end; - if Format = 'BMP' then begin - if FromRegistry then TextureB.LoadFromStream(Res) - else TextureB.LoadFromFile(Nazwa); + end + + else if Format = 'PNG' then begin + TexturePNG := TPNGObject.Create; + if FromRegistry then TexturePNG.LoadFromStream(Res) + else begin + if FileExists(Nazwa) then + TexturePNG.LoadFromFile(Nazwa) + else + Exit; + end; + TextureB.Assign(TexturePNG); + TexturePNG.Free; end; if FromRegistry then Res.Free; -- cgit v1.2.3 From 033bd987a8d704aa7eb62e1cdd572694d3cd728d Mon Sep 17 00:00:00 2001 From: mogguh Date: Tue, 17 Apr 2007 16:09:34 +0000 Subject: Bugfix: Fixed minor problem that caused artefacts to be drawn - 'transparent' now works with #ffffff and #fefefe (UTexture.pas) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@104 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index b50ab6bf..4a8fa786 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -361,7 +361,7 @@ begin for Pet := 0 to TexOrygH-1 do begin for Pet2 := 0 to TexOrygW-1 do begin Pix := TextureB.Canvas.Pixels[Pet2, Pet]; - if Pix = Col then begin + if ((Pix = $fefefe) or (Pix = Col)) then begin //Small fix, that caused artefacts to be drawn (#fe == dec254) TextureD32[Pet*TexNewW + Pet2 + 1, 1] := 0; TextureD32[Pet*TexNewW + Pet2 + 1, 2] := 0; TextureD32[Pet*TexNewW + Pet2 + 1, 3] := 0; -- cgit v1.2.3 From 6c530e99b8a5314bb1e988a00680ba4332ac4abc Mon Sep 17 00:00:00 2001 From: b1indy Date: Tue, 24 Apr 2007 13:23:53 +0000 Subject: UTexture.pas: texture-wrap-mode changed to GL_CLAMP_TO_EDGE - solves some problems where edges of textures were drawn incorrectly UDisplay.pas: simplified generation of fade texture (a little) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@134 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 4a8fa786..0eae68a2 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -259,8 +259,8 @@ begin 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); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); if Typ = 'Plain' then begin // wymiary @@ -755,8 +755,8 @@ begin 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); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP); + 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 -- cgit v1.2.3 From 1d20a6ed1de519a7167c3b53fee7f2484f2f22b1 Mon Sep 17 00:00:00 2001 From: b1indy Date: Tue, 26 Jun 2007 14:11:20 +0000 Subject: Added support for transparency in PNG images - if a PNG with transparency is loaded as 'Transparent' texture type, then the alpha-channel is set according to the transparency information in the file git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@270 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 36 ++++++++++++++++++++++++++++++++++-- 1 file changed, 34 insertions(+), 2 deletions(-) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 0eae68a2..da603ec9 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -193,6 +193,10 @@ var TextureB: TBitmap; TextureJ: TJPEGImage; TexturePNG: TPNGObject; + TextureAlpha: array of byte; + AlphaPtr: PByte; + TransparentColor: TColor; + PixelColor: TColor; Pet: integer; Pet2: integer; @@ -246,6 +250,27 @@ begin Exit; end; TextureB.Assign(TexturePNG); + // transparent png hack start (part 1 of 2) + if (Typ = 'Transparent') and (TexturePNG.TransparencyMode = ptmPartial) then + begin + setlength(TextureAlpha, TextureB.Width*TextureB.Height); + if (TexturePNG.Header.ColorType = COLOR_GRAYSCALEALPHA) or + (TexturePNG.Header.ColorType = COLOR_RGBALPHA) then + begin + // i would have preferred english variables here but i use Pet because i'm lazy + for Pet := 0 to TextureB.Height - 1 do + begin + AlphaPtr := PByte(TexturePNG.AlphaScanline[Pet]); + for Pet2 := 0 to TextureB.Width - 1 do + begin + TextureAlpha[Pet*TextureB.Width+Pet2]:= AlphaPtr^; + 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; end; @@ -357,11 +382,13 @@ begin TexNewH := Round(Power(2, Ceil(Log2(TexOrygH)))); TextureB.Width := TexNewW; TextureB.Height := TexNewH; + // kopiowanie for Pet := 0 to TexOrygH-1 do begin for Pet2 := 0 to TexOrygW-1 do begin Pix := TextureB.Canvas.Pixels[Pet2, Pet]; - if ((Pix = $fefefe) or (Pix = Col)) then begin //Small fix, that caused artefacts to be drawn (#fe == dec254) + // ,- 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[Pet*TexNewW + Pet2 + 1, 1] := 0; TextureD32[Pet*TexNewW + Pet2 + 1, 2] := 0; TextureD32[Pet*TexNewW + Pet2 + 1, 3] := 0; @@ -370,7 +397,12 @@ begin TextureD32[Pet*TexNewW + Pet2+1, 1] := Pix; TextureD32[Pet*TexNewW + Pet2+1, 2] := Pix div 256; TextureD32[Pet*TexNewW + Pet2+1, 3] := Pix div (256*256); - TextureD32[Pet*TexNewW + Pet2+1, 4] := 255; + // transparent png hack start (part 2 of 2) + if (Format = 'PNG') and (length(TextureAlpha) <> 0) then begin + TextureD32[Pet*TexNewW+Pet2+1,4]:=TextureAlpha[Pet*TexOrygW+Pet2]; + end else + // transparent png hack end + TextureD32[Pet*TexNewW + Pet2+1, 4] := 255; end; end; end; -- cgit v1.2.3 From 7050f9d54fc4603a952c12efbab2e3331413865f Mon Sep 17 00:00:00 2001 From: b1indy Date: Tue, 3 Jul 2007 08:37:09 +0000 Subject: some tweaking of transparency handling for PNGs to make it look more as expected git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@272 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index da603ec9..275f0748 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -206,6 +206,7 @@ var TempA: integer; Error: integer; SkipX: integer; + myAlpha: Real; begin Log.BenchmarkStart(4); Mipmapping := true; @@ -399,7 +400,16 @@ begin TextureD32[Pet*TexNewW + Pet2+1, 3] := Pix div (256*256); // transparent png hack start (part 2 of 2) if (Format = 'PNG') and (length(TextureAlpha) <> 0) then begin - TextureD32[Pet*TexNewW+Pet2+1,4]:=TextureAlpha[Pet*TexOrygW+Pet2]; + myAlpha:=TextureAlpha[Pet*TexOrygW+Pet2]; + + // the following calculations tweak transparency so that it really looks transparent + myAlpha:=myAlpha-75; + if myAlpha < 0 then myAlpha:=0; + myAlpha:=myAlpha/180; + myAlpha:=myAlpha*myAlpha*myAlpha; + myAlpha:=myAlpha*255; + + TextureD32[Pet*TexNewW+Pet2+1,4]:=floor(myAlpha); end else // transparent png hack end TextureD32[Pet*TexNewW + Pet2+1, 4] := 255; -- cgit v1.2.3 From 4ddd757d3ee4fa079d8601e03dec0522940070cf Mon Sep 17 00:00:00 2001 From: b1indy Date: Sat, 21 Jul 2007 20:48:07 +0000 Subject: Modified LoadTexture so that it ignores the Format parameter (for texture files, if supplied) but detects the file format by looking at the file's extension. Now any supported filetype can be used to skin USDX (not only JPG or BMP, which was hardcoded default everywhere) The remains of this former misguided policy are still in many places of the code and have to be removed over time. Also tried to remove most of the non-english comments and variable names git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@314 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 461 +++++++++++++++++++---------------------- 1 file changed, 215 insertions(+), 246 deletions(-) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 275f0748..43a8737e 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -14,11 +14,6 @@ interface uses OpenGL12, Windows, Math, Classes, SysUtils, Graphics, JPEG, UThemes, PNGImage; procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32; -//procedure glBindTexture(target: GLenum; texture: GLuint); stdcall; external opengl32; -//function gluBuild2DMipmaps (target: GLenum; components, width, height: GLint; -// format, atype: GLenum; data: Pointer): Integer; stdcall; external glu32; -//procedure glCopyTexImage2D(target: GLenum; level: GLint; internalFormat: GLenum; x, y: GLint; width, height: GLsizei; border: GLint); stdcall; external opengl32; - type TTexture = record @@ -66,9 +61,9 @@ type function GetTexture(Name, Typ: string): TTexture; overload; function GetTexture(Name, Typ: string; FromCache: boolean): TTexture; overload; function FindTexture(Name: string): integer; - function LoadTexture(FromRegistry: boolean; Nazwa, Format, Typ: PChar; Col: LongWord): TTexture; overload; - function LoadTexture(Nazwa, Format, Typ: PChar; Col: LongWord): TTexture; overload; - function LoadTexture(Nazwa: string): TTexture; overload; + function LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; + function LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; + function LoadTexture(Identifier: string): TTexture; overload; function CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; procedure UnloadTexture(Name: string; FromCache: boolean); end; @@ -77,24 +72,14 @@ var Texture: TTextureUnit; TextureDatabase: TTextureDatabase; - - // for print screens -// PrintScreenTex: GLuint; -// PrintScreenData: array[0..480-1, 0..640-1] of longword; PrintScreenData: array[0..1024*768-1] of longword; -// Tekstur: Gluint; ActTex: GLuint;//integer; -{ Tekstura: array[1..32] of TTekstura; - Mipmapping: boolean = true;} - - TexOrygW: integer; - TexOrygH: integer; + TexOrigW: integer; + TexOrigH: integer; TexNewW: integer; TexNewH: integer; -{ RLE: array[1..128*128] of byte; - RLE2: array[1..128*128] of byte;} TexFitW: integer; TexFitH: integer; // new for limit @@ -107,15 +92,13 @@ var // total 40MB at 2048*2048 // total 10MB at 1024*1024 -{ Paleta: array[0..255, 1..4] of byte; - Len: integer;} Mipmapping: Boolean; CacheMipmap: array[0..256*256*3-1] of byte; // 3KB implementation -uses ULog, DateUtils, UCovers; +uses ULog, DateUtils, UCovers, StrUtils; function TTextureUnit.GetTexture(Name, Typ: string): TTexture; begin @@ -138,7 +121,7 @@ begin TextureDatabase.Texture[T].Name := Name; TextureDatabase.Texture[T].Typ := Typ; - // inform database that not textures has been loaded into memory + // inform database that no textures have been loaded into memory TextureDatabase.Texture[T].Texture.TexNum := -1; TextureDatabase.Texture[T].TextureCache.TexNum := -1; end; @@ -163,12 +146,6 @@ begin if TextureDatabase.Texture[T].TextureCache.TexNum = -1 then begin // load texture Covers.PrepareData(Name); -{ Covers.Data[0] := 0; - Covers.Data[1] := 0; - Covers.Data[2] := 0; - Covers.Data[3] := 255; - Covers.Data[4] := 255; - Covers.Data[5] := 255;} TextureDatabase.Texture[T].TextureCache := CreateTexture(Covers.Data, Name, Covers.Cover[C].W, Covers.Cover[C].H, 24); end; @@ -187,7 +164,7 @@ begin Result := T; end; -function TTextureUnit.LoadTexture(FromRegistry: boolean; Nazwa, Format, Typ: PChar; Col: LongWord): TTexture; +function TTextureUnit.LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; var Res: TResourceStream; TextureB: TBitmap; @@ -198,8 +175,8 @@ var TransparentColor: TColor; PixelColor: TColor; - Pet: integer; - Pet2: integer; + Position: integer; + Position2: integer; Pix: integer; ColInt: real; PPix: PByteArray; @@ -213,27 +190,35 @@ begin if FromRegistry then begin try - Res := TResourceStream.Create(HInstance, Nazwa, Format); + Res := TResourceStream.Create(HInstance, Identifier, Format); except beep; Exit; end; end; - if FromRegistry or ((not FromRegistry) and FileExists(Nazwa)) then begin + // filetype "detection" + if (not FromRegistry) and (FileExists(Identifier)) then begin + Format:=''; + Format := PAnsichar(UpperCase(RightStr(ExtractFileExt(Identifier),3))); + end; +// else Format:='JPG'; +// if not ((Format='BMP')or(Format='JPG')or(Format='PNG')) then Format:='JPG'; + + if FromRegistry or ((not FromRegistry) and FileExists(Identifier)) then begin TextureB := TBitmap.Create; if Format = 'BMP' then begin if FromRegistry then TextureB.LoadFromStream(Res) - else TextureB.LoadFromFile(Nazwa); + else TextureB.LoadFromFile(Identifier); end else if Format = 'JPG' then begin TextureJ := TJPEGImage.Create; if FromRegistry then TextureJ.LoadFromStream(Res) else begin - if FileExists(Nazwa) then - TextureJ.LoadFromFile(Nazwa) + if FileExists(Identifier) then + TextureJ.LoadFromFile(Identifier) else Exit; end; @@ -245,8 +230,8 @@ begin TexturePNG := TPNGObject.Create; if FromRegistry then TexturePNG.LoadFromStream(Res) else begin - if FileExists(Nazwa) then - TexturePNG.LoadFromFile(Nazwa) + if FileExists(Identifier) then + TexturePNG.LoadFromFile(Identifier) else Exit; end; @@ -258,13 +243,13 @@ begin if (TexturePNG.Header.ColorType = COLOR_GRAYSCALEALPHA) or (TexturePNG.Header.ColorType = COLOR_RGBALPHA) then begin - // i would have preferred english variables here but i use Pet because i'm lazy - for Pet := 0 to TextureB.Height - 1 do + // 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[Pet]); - for Pet2 := 0 to TextureB.Width - 1 do + AlphaPtr := PByte(TexturePNG.AlphaScanline[Position]); + for Position2 := 0 to TextureB.Width - 1 do begin - TextureAlpha[Pet*TextureB.Width+Pet2]:= AlphaPtr^; + TextureAlpha[Position*TextureB.Width+Position2]:= AlphaPtr^; Inc(AlphaPtr); end; end; @@ -278,7 +263,7 @@ begin 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 ' + Nazwa + ' is too big (' + IntToStr(TextureB.Width) + 'x' + IntToStr(TextureB.Height) + ')'); + Log.LogError('Image ' + Identifier + ' is too big (' + IntToStr(TextureB.Width) + 'x' + IntToStr(TextureB.Height) + ')'); Result.TexNum := -1; end else begin @@ -289,46 +274,46 @@ begin glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); if Typ = 'Plain' then begin - // wymiary - TexOrygW := TextureB.Width; - TexOrygH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrygW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrygH)))); + // dimensions + TexOrigW := TextureB.Width; + TexOrigH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); - // kopiowanie + // copy and process pixeldata TextureB.PixelFormat := pf24bit; { if (TextureB.PixelFormat = pf8bit) then begin - for Pet := 0 to TexOrygH-1 do begin - for Pet2 := 0 to TexOrygW-1 do begin - Pix := TextureB.Canvas.Pixels[Pet2, Pet]; - TextureD24[Pet*TexNewW + Pet2+1, 1] := Pix; - TextureD24[Pet*TexNewW + Pet2+1, 2] := Pix div 256; - TextureD24[Pet*TexNewW + Pet2+1, 3] := Pix div (256*256); + 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 (TexOrygW <= Limit) and (TexOrygW <= Limit) then begin + if (TexOrigW <= Limit) and (TexOrigW <= Limit) then begin if (TextureB.PixelFormat = pf24bit) then begin - for Pet := 0 to TexOrygH-1 do begin - PPix := TextureB.ScanLine[Pet]; - for Pet2 := 0 to TexOrygW-1 do begin - TextureD24[Pet*TexNewW + Pet2+1, 1] := PPix[Pet2*3+2]; - TextureD24[Pet*TexNewW + Pet2+1, 2] := PPix[Pet2*3+1]; - TextureD24[Pet*TexNewW + Pet2+1, 3] := PPix[Pet2*3]; + 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 * (TexOrygW div 4); // fix for bug in gluScaleImage - TexFitH := TexOrygH; + TexFitW := 4 * (TexOrigW div 4); // fix for bug in gluScaleImage + TexFitH := TexOrigH; if (TextureB.PixelFormat = pf24bit) then begin - for Pet := 0 to TexOrygH-1 do begin - PPix := TextureB.ScanLine[Pet]; - for Pet2 := 0 to TexOrygW-1 do begin - TextureD24[Pet*TexFitW + Pet2+1, 1] := PPix[Pet2*3+2]; - TextureD24[Pet*TexFitW + Pet2+1, 2] := PPix[Pet2*3+1]; - TextureD24[Pet*TexFitW + Pet2+1, 3] := PPix[Pet2*3]; + 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; @@ -337,25 +322,25 @@ begin TexNewW := Limit; TexNewH := Limit; - TexOrygW := Limit; - TexOrygH := Limit; + TexOrigW := Limit; + TexOrigH := Limit; end; // creating cache mipmap if CreateCacheMipmap then begin - if (TexOrygW <> TexNewW) or (TexOrygH <> TexNewH) 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 * (TexOrygW div 4); // 0.5.0: fix for bug in gluScaleImage - SkipX := (TexOrygW div 2) mod 2; // 0.5.0: try to center image - - TexFitH := TexOrygH; - for Pet := 0 to TexOrygH-1 do begin - PPix := TextureB.ScanLine[Pet]; - for Pet2 := 0 to TexOrygW-1 do begin - TextureD242[Pet*TexFitW + Pet2+1, 1] := PPix[(Pet2+SkipX)*3+2]; - TextureD242[Pet*TexFitW + Pet2+1, 2] := PPix[(Pet2+SkipX)*3+1]; - TextureD242[Pet*TexFitW + Pet2+1, 3] := PPix[(Pet2+SkipX)*3]; + 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, @@ -363,7 +348,7 @@ begin end else begin // texture fits perfectly - gluScaleImage(GL_RGB, TexOrygW, TexOrygH, GL_UNSIGNED_BYTE, @TextureD24, + gluScaleImage(GL_RGB, TexOrigW, TexOrigH, GL_UNSIGNED_BYTE, @TextureD24, Covers.W, Covers.H, GL_UNSIGNED_BYTE, @CacheMipmap[0]); // takes some time end; end; @@ -376,31 +361,31 @@ begin end; if Typ = 'Transparent' then begin - // wymiary - TexOrygW := TextureB.Width; - TexOrygH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrygW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrygH)))); + // 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; - // kopiowanie - for Pet := 0 to TexOrygH-1 do begin - for Pet2 := 0 to TexOrygW-1 do begin - Pix := TextureB.Canvas.Pixels[Pet2, Pet]; + // 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[Pet*TexNewW + Pet2 + 1, 1] := 0; - TextureD32[Pet*TexNewW + Pet2 + 1, 2] := 0; - TextureD32[Pet*TexNewW + Pet2 + 1, 3] := 0; - TextureD32[Pet*TexNewW + Pet2 + 1, 4] := 0; + 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 begin - TextureD32[Pet*TexNewW + Pet2+1, 1] := Pix; - TextureD32[Pet*TexNewW + Pet2+1, 2] := Pix div 256; - TextureD32[Pet*TexNewW + Pet2+1, 3] := Pix div (256*256); + 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); // transparent png hack start (part 2 of 2) if (Format = 'PNG') and (length(TextureAlpha) <> 0) then begin - myAlpha:=TextureAlpha[Pet*TexOrygW+Pet2]; + myAlpha:=TextureAlpha[Position*TexOrigW+Position2]; // the following calculations tweak transparency so that it really looks transparent myAlpha:=myAlpha-75; @@ -409,10 +394,10 @@ begin myAlpha:=myAlpha*myAlpha*myAlpha; myAlpha:=myAlpha*255; - TextureD32[Pet*TexNewW+Pet2+1,4]:=floor(myAlpha); + TextureD32[Position*TexNewW+Position2+1,4]:=floor(myAlpha); end else // transparent png hack end - TextureD32[Pet*TexNewW + Pet2+1, 4] := 255; + TextureD32[Position*TexNewW + Position2+1, 4] := 255; end; end; end; @@ -424,21 +409,21 @@ begin end; if Typ = 'Transparent Range' then begin - // wymiary - TexOrygW := TextureB.Width; - TexOrygH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrygW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrygH)))); + // 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; - // kopiowanie - for Pet := 0 to TexOrygH-1 do begin - for Pet2 := 0 to TexOrygW-1 do begin - Pix := TextureB.Canvas.Pixels[Pet2, Pet]; - TextureD32[Pet*TexNewW + Pet2+1, 1] := Pix; - TextureD32[Pet*TexNewW + Pet2+1, 2] := Pix div 256; - TextureD32[Pet*TexNewW + Pet2+1, 3] := Pix div (256*256); - TextureD32[Pet*TexNewW + Pet2+1, 4] := 256 - Pix div 256; + // 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]; + 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); @@ -450,12 +435,12 @@ begin if Typ = 'Font' then begin TextureB.PixelFormat := pf24bit; - for Pet := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Pet]; - for Pet2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Pet2 * 3]; - TextureD16[Pet*TextureB.Width + Pet2 + 1, 1] := 255; - TextureD16[Pet*TextureB.Width + Pet2 + 1, 2] := Pix; + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + 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); @@ -469,10 +454,10 @@ begin if Typ = 'Font Outline' then begin TextureB.PixelFormat := pf24bit; - for Pet := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Pet]; - for Pet2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Pet2 * 3]; + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2 * 3]; Col := Pix; if Col < 127 then Col := 127; @@ -483,8 +468,8 @@ begin if Pix < 95 then TempA := (Pix * 256) div 96; - TextureD16[Pet*TextureB.Width + Pet2 + 1, 1] := Col; - TextureD16[Pet*TextureB.Width + Pet2 + 1, 2] := TempA; + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; end; end; glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); @@ -498,10 +483,10 @@ begin if Typ = 'Font Outline 2' then begin TextureB.PixelFormat := pf24bit; - for Pet := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Pet]; - for Pet2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Pet2 * 3]; + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2 * 3]; Col := Pix; if Col < 31 then Col := 31; @@ -510,8 +495,8 @@ begin if TempA >= 31 then TempA := 255; if Pix < 31 then TempA := Pix * (256 div 32); - TextureD16[Pet*TextureB.Width + Pet2 + 1, 1] := Col; - TextureD16[Pet*TextureB.Width + Pet2 + 1, 2] := TempA; + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; end; end; glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); @@ -524,24 +509,24 @@ begin end; if Typ = 'Font Black' then begin - // normalnie 0,125s bez niczego 0,015s - 0,030s z pix 0,125s - // wymiary + // normalnie 0,125s bez niczego 0,015s - 0,030s z pix 0,125s <-- ??? + // dimensions TextureB.PixelFormat := pf24bit; - TexOrygW := TextureB.Width; - TexOrygH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrygW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrygH)))); + 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; - // kopiowanie - for Pet := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Pet]; - for Pet2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Pet2*3]; - TextureD32[Pet*TextureB.Width + Pet2 + 1, 1] := 255; - TextureD32[Pet*TextureB.Width + Pet2 + 1, 2] := 255; - TextureD32[Pet*TextureB.Width + Pet2 + 1, 3] := 255; - TextureD32[Pet*TextureB.Width + Pet2 + 1, 4] := 255 - (Pix mod 256); + // copy and process pixeldata + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2*3]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); end; end; glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); @@ -549,42 +534,42 @@ begin if Typ = 'Alpha Black Colored' then begin TextureB.PixelFormat := pf24bit; - TexOrygW := TextureB.Width; - TexOrygH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrygW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrygH)))); + 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; - // kopiowanie - for Pet := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Pet]; - for Pet2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Pet2*3]; - TextureD32[Pet*TextureB.Width + Pet2 + 1, 1] := (Col div $10000) and $FF; - TextureD32[Pet*TextureB.Width + Pet2 + 1, 2] := (Col div $100) and $FF; - TextureD32[Pet*TextureB.Width + Pet2 + 1, 3] := Col and $FF; - TextureD32[Pet*TextureB.Width + Pet2 + 1, 4] := 255 - (Pix mod 256); + // copy and process pixeldata + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2*3]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := (Col div $10000) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Col div $100) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Col and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); end; end; glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); end; if Typ = 'Font Gray' then begin - // wymiary - TexOrygW := TextureB.Width; - TexOrygH := TextureB.Height; - TexNewW := Round(Power(2, Ceil(Log2(TexOrygW)))); - TexNewH := Round(Power(2, Ceil(Log2(TexOrygH)))); + // 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; - // kopiowanie - for Pet := 0 to TextureB.Height-1 do begin - for Pet2 := 0 to TextureB.Width-1 do begin - Pix := TextureB.Canvas.Pixels[Pet2, Pet]; - TextureD32[Pet*TextureB.Width + Pet2 + 1, 1] := 127; - TextureD32[Pet*TextureB.Width + Pet2 + 1, 2] := 127; - TextureD32[Pet*TextureB.Width + Pet2 + 1, 3] := 127; - TextureD32[Pet*TextureB.Width + Pet2 + 1, 4] := 255 - (Pix mod 256); + // copy and process pixeldata + for Position := 0 to TextureB.Height-1 do begin + for Position2 := 0 to TextureB.Width-1 do begin + Pix := TextureB.Canvas.Pixels[Position2, Position]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); end; end; glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); @@ -596,10 +581,10 @@ begin if Typ = 'Arrow' then begin TextureB.PixelFormat := pf24bit; - for Pet := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Pet]; - for Pet2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Pet2 * 3]; + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2 * 3]; // transparency if Pix >= 127 then TempA := 255; @@ -610,10 +595,10 @@ begin if Pix >= 127 then ColInt := 2 - Pix / 128; //0.75, 0.6, 0.25 - TextureD32[Pet*TextureB.Width + Pet2 + 1, 1] := Round(ColInt * 0.75 * 255 + (1 - ColInt) * 255); - TextureD32[Pet*TextureB.Width + Pet2 + 1, 2] := Round(ColInt * 0.6 * 255 + (1 - ColInt) * 255); - TextureD32[Pet*TextureB.Width + Pet2 + 1, 3] := Round(ColInt * 0.25 * 255 + (1 - ColInt) * 255); - TextureD32[Pet*TextureB.Width + Pet2 + 1, 4] := TempA; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Round(ColInt * 0.75 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := Round(ColInt * 0.6 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Round(ColInt * 0.25 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; end; end; glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); @@ -626,22 +611,22 @@ begin end; if Typ = 'Note Plain' then begin - for Pet := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Pet]; - for Pet2 := 0 to TextureB.Width-1 do begin + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin // Skin Patch // 0-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White - case PPix[Pet2*3] of - 0..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Pet2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Pet2*3]) div $Bf) + (((Col and $FF) * PPix[Pet2*3]) div $Bf); + case PPix[Position2*3] of + 0..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); 192: Pix := Col; - 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Pet2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Pet2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Pet2*3] - $C0) * 4)) div $FF)); + 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); 255: Pix := $FFFFFF; end; // 0.5.0. Original -// case PPix[Pet2*3] of +// case PPix[Position2*3] of // 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; // 192: Pix := Col; // 255: Pix := $FFFFFF; @@ -651,33 +636,33 @@ begin - TextureD24[Pet*TextureB.Width + Pet2 + 1, 1] := Pix div $10000; - TextureD24[Pet*TextureB.Width + Pet2 + 1, 2] := (Pix div $100) and $FF; - TextureD24[Pet*TextureB.Width + Pet2 + 1, 3] := Pix and $FF; + TextureD24[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; + TextureD24[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; + TextureD24[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; end; end; glTexImage2D(GL_TEXTURE_2D, 0, 3, TextureB.Width, TextureB.Height, 0, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); end; if Typ = 'Note Transparent' then begin - for Pet := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Pet]; - for Pet2 := 0 to TextureB.Width-1 do begin + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin TempA := 255; //Skin Patch // 0= Transparent, 1-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White - case PPix[Pet2*3] of + case PPix[Position2*3] of 0: TempA := 0; - 1..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Pet2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Pet2*3]) div $Bf) + (((Col and $FF) * PPix[Pet2*3]) div $Bf); + 1..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); 192: Pix := Col; - 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Pet2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Pet2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Pet2*3] - $C0) * 4)) div $FF)); + 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); 255: Pix := $FFFFFF; end; // 0.5.0 Original -// case PPix[Pet2*3] of +// case PPix[Position2*3] of // 0: TempA := 0; // 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; // 192: Pix := Col; @@ -687,25 +672,16 @@ begin - TextureD32[Pet*TextureB.Width + Pet2 + 1, 1] := Pix div $10000; - TextureD32[Pet*TextureB.Width + Pet2 + 1, 2] := (Pix div $100) and $FF; - TextureD32[Pet*TextureB.Width + Pet2 + 1, 3] := Pix and $FF; - TextureD32[Pet*TextureB.Width + Pet2 + 1, 4] := TempA; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; end; end; glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); end; - - - TextureB.Free; -// Inc(ActTex); -{ Tekst.Tekstura := ActTex; - Tekst.W := TexOrygW; - Tekst.H := TexOrygH; - Tekst.X2 := TexOrygW/TexNewW; - Tekst.Y2 := TexOrygH/TexNewH;} Result.X := 0; Result.Y := 0; Result.W := 0; @@ -714,8 +690,8 @@ begin Result.ScaleH := 1; Result.Rot := 0; Result.TexNum := ActTex; - Result.TexW := TexOrygW / TexNewW; - Result.TexH := TexOrygH / TexNewH; + Result.TexW := TexOrigW / TexNewW; + Result.TexH := TexOrigH / TexNewH; Result.Int := 1; Result.ColR := 1; @@ -730,32 +706,32 @@ begin Result.TexY2 := 1; // 0.5.0 - Result.Name := Nazwa; + Result.Name := Identifier; end; Log.BenchmarkEnd(4); if Log.BenchmarkTimeLength[4] >= 1 then - Log.LogBenchmark('**********> Texture Load Time Warning - ' + Format + '/' + Nazwa + '/' + Typ, 4); + Log.LogBenchmark('**********> Texture Load Time Warning - ' + Format + '/' + Identifier + '/' + Typ, 4); end; // logerror end; {procedure ResizeTexture(s: pbytearray; d: pbytearray); var - Pet: integer; - Pet2: integer; + Position: integer; + Position2: integer; begin - for Pet := 0 to TexNewH*4-1 do - for Pet2 := 0 to TexNewW-1 do - d[Pet*TexNewW + Pet2] := 0; - - for Pet := 0 to TexOrygH-1 do begin - for Pet2 := 0 to TexOrygW-1 do begin - d[(Pet*TexNewW + Pet2)*4] := Paleta[s[Pet*TexOrygW + Pet2], 1]; - d[(Pet*TexNewW + Pet2)*4+1] := Paleta[s[Pet*TexOrygW + Pet2], 2]; - d[(Pet*TexNewW + Pet2)*4+2] := Paleta[s[Pet*TexOrygW + Pet2], 3]; - d[(Pet*TexNewW + Pet2)*4+3] := Paleta[s[Pet*TexOrygW + Pet2], 4]; + 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]; end; end; end;} @@ -770,22 +746,22 @@ begin glTexImage2D(GL_TEXTURE_2D, 0, 4, TexNewW, TexNewH, 0, GL_RGBA, GL_UNSIGNED_BYTE, p); end;} -function TTextureUnit.LoadTexture(Nazwa, Format, Typ: PChar; Col: LongWord): TTexture; +function TTextureUnit.LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; begin - Result := LoadTexture(false, Nazwa, Format, Typ, Col); -// Result := LoadTexture(SkinReg, Nazwa, Format, Typ, Col); // default to SkinReg + Result := LoadTexture(false, Identifier, Format, Typ, Col); +// Result := LoadTexture(SkinReg, Identifier, Format, Typ, Col); // default to SkinReg end; -function TTextureUnit.LoadTexture(Nazwa: string): TTexture; +function TTextureUnit.LoadTexture(Identifier: string): TTexture; begin - Result := LoadTexture(false, pchar(Nazwa), 'JPG', 'Plain', 0); + Result := LoadTexture(false, pchar(Identifier), 'JPG', 'Plain', 0); end; function TTextureUnit.CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; var - Pet: integer; - Pet2: integer; + Position: integer; + Position2: integer; Pix: integer; ColInt: real; PPix: PByteArray; @@ -806,13 +782,6 @@ begin if Error > 0 then beep; end; - -// Inc(ActTex); -{ Tekst.Tekstura := ActTex; - Tekst.W := TexOrygW; - Tekst.H := TexOrygH; - Tekst.X2 := TexOrygW/TexNewW; - Tekst.Y2 := TexOrygH/TexNewH;} Result.X := 0; Result.Y := 0; Result.W := 0; -- cgit v1.2.3 From a5955bf26ecfe0ec20c70aff6522d1f8bd2e677d Mon Sep 17 00:00:00 2001 From: b1indy Date: Sun, 22 Jul 2007 18:30:33 +0000 Subject: changed loading of transparent PNGs, should be slower now, might break with some PNG types but gives nice correct transparency for 24bit transparent PNGs git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@320 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 42 ++++++++++++++++++++++++------------------ 1 file changed, 24 insertions(+), 18 deletions(-) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 43a8737e..84604367 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -184,6 +184,8 @@ var Error: integer; SkipX: integer; myAlpha: Real; + myRGBABitmap: array of byte; + RGBPtr: PByte; begin Log.BenchmarkStart(4); Mipmapping := true; @@ -240,6 +242,7 @@ begin if (Typ = 'Transparent') 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 @@ -247,9 +250,18 @@ begin 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; @@ -379,28 +391,22 @@ begin 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; - TextureD32[Position*TexNewW + Position2+1, 2] := Pix div 256; - TextureD32[Position*TexNewW + Position2+1, 3] := Pix div (256*256); - // transparent png hack start (part 2 of 2) - if (Format = 'PNG') and (length(TextureAlpha) <> 0) then begin - myAlpha:=TextureAlpha[Position*TexOrigW+Position2]; - - // the following calculations tweak transparency so that it really looks transparent - myAlpha:=myAlpha-75; - if myAlpha < 0 then myAlpha:=0; - myAlpha:=myAlpha/180; - myAlpha:=myAlpha*myAlpha*myAlpha; - myAlpha:=myAlpha*255; - - TextureD32[Position*TexNewW+Position2+1,4]:=floor(myAlpha); - end else - // transparent png hack end - TextureD32[Position*TexNewW + Position2+1, 4] := 255; + 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); -- cgit v1.2.3 From 3df211329573da9450b2388875ec952dcaa98eea Mon Sep 17 00:00:00 2001 From: mogguh Date: Sun, 2 Sep 2007 18:53:35 +0000 Subject: VFX: Some pre work for an upcoming (yet unfinished) feature git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@362 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 65 ++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 63 insertions(+), 2 deletions(-) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 84604367..161b5512 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -11,7 +11,7 @@ unit UTexture; // Arrow (for arrows, white is white, gray has color, black is transparent); interface -uses OpenGL12, Windows, Math, Classes, SysUtils, Graphics, JPEG, UThemes, PNGImage; +uses OpenGL12, Windows, Math, Classes, SysUtils, Graphics, JPEG, UThemes, PNGImage, GraphUtil, dialogs; procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32; @@ -66,6 +66,7 @@ type function LoadTexture(Identifier: string): TTexture; overload; function CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; procedure UnloadTexture(Name: string; FromCache: boolean); + procedure Colorize(var R,G,B : Byte; Color: Cardinal); // Real colorize instead of: "150 grey is now blue, k?" end; var @@ -239,7 +240,7 @@ begin end; TextureB.Assign(TexturePNG); // transparent png hack start (part 1 of 2) - if (Typ = 'Transparent') and (TexturePNG.TransparencyMode = ptmPartial) then + 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); @@ -414,6 +415,49 @@ begin end;} 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; + + // 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 begin + myAlpha:=TextureAlpha[Position*TexOrigW+Position2]; + TextureD32[Position*TexNewW + Position2+1, 1] := MyRGBABitmap[(Position*TexOrigW+Position2)*4+2]; // R + TextureD32[Position*TexNewW + Position2+1, 2] := MyRGBABitmap[(Position*TexOrigW+Position2)*4+1]; // G + TextureD32[Position*TexNewW + Position2+1, 3] := MyRGBABitmap[(Position*TexOrigW+Position2)*4]; // B + TextureD32[Position*TexNewW+Position2+1,4] := MyRGBABitmap[(Position*TexOrigW+Position2)*4+3]; // Alpha + 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; + + //now the colorize stuff + for Position := 0 to TexOrigH-1 do begin + for Position2 := 0 to TexOrigW-1 do begin + colorize(TextureD32[Position*TexNewW + Position2+1, 1],TextureD32[Position*TexNewW + Position2+1, 2],TextureD32[Position*TexNewW + Position2+1, 3], $fe198e); //pinkie :P + 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; @@ -759,6 +803,23 @@ begin end; + +// Funkyness of colorizing is done in this small box, remember to give credits when you copy from us +Procedure TTextureUnit.Colorize(var R,G,B : Byte; Color : Cardinal); +var + TexHue, TexLum, TexSat, ClrHue, ClrLum, ClrSat : Word; + ColorizedColors: Cardinal; +begin //red //green //blue + Color:=((Color and $ff) shl 16) or (Color and $ff00) or ((Color and $ff0000) shr 16); + ColorRGBToHLS(Color, ClrHue, ClrLum, ClrSat); + ColorRGBToHLS((((b shl 8) or g) shl 8 or r),TexHue, TexLum, TexSat); + ColorizedColors := ColorHLSToRGB(ClrHue, TexLum, TexSat); + R := ColorizedColors and $FF; + G := (ColorizedColors and $FF00) shr 8; + B := (ColorizedColors and $FF0000) shr 16; +end; +//eoa COLORIZE + function TTextureUnit.LoadTexture(Identifier: string): TTexture; begin Result := LoadTexture(false, pchar(Identifier), 'JPG', 'Plain', 0); -- cgit v1.2.3 From 69c42b2bde3146a61d4b1e8e1cbedfd7163b1c60 Mon Sep 17 00:00:00 2001 From: b1indy Date: Sun, 2 Sep 2007 21:06:08 +0000 Subject: finished stuff for colorized transparent textures with statics (credits to mog, who started it) still to do: same thing with buttons and maybe everything else ;) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@363 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 161b5512..3314f494 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -38,6 +38,10 @@ type TexY2: real; Alpha: real; Name: string; // 0.5.0: experimental for handling cache images. maybe it's useful for dynamic skins + // colorize hack + Colorized: Boolean; +// Colors: array of Cardinal; +// Texnums: array of Integer; end; TTextureEntry = record @@ -448,7 +452,7 @@ begin //now the colorize stuff for Position := 0 to TexOrigH-1 do begin for Position2 := 0 to TexOrigW-1 do begin - colorize(TextureD32[Position*TexNewW + Position2+1, 1],TextureD32[Position*TexNewW + Position2+1, 2],TextureD32[Position*TexNewW + Position2+1, 3], $fe198e); //pinkie :P + colorize(TextureD32[Position*TexNewW + Position2+1, 1],TextureD32[Position*TexNewW + Position2+1, 2],TextureD32[Position*TexNewW + Position2+1, 3], Col); //pinkie :P end; end; -- cgit v1.2.3 From d5ebad3a661194459da1b134978ed353e46c9b72 Mon Sep 17 00:00:00 2001 From: b1indy Date: Sun, 2 Sep 2007 23:45:33 +0000 Subject: now buttons can also have transparent colorized textures POC-Pic: http://imageshock.eu/img/colorizedbuttons-ao81.jpg git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@365 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 4 ---- 1 file changed, 4 deletions(-) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 3314f494..ab21d44c 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -38,10 +38,6 @@ type TexY2: real; Alpha: real; Name: string; // 0.5.0: experimental for handling cache images. maybe it's useful for dynamic skins - // colorize hack - Colorized: Boolean; -// Colors: array of Cardinal; -// Texnums: array of Integer; end; TTextureEntry = record -- cgit v1.2.3 From 69def54f79cace3a1a90ae71f03910986ff74da7 Mon Sep 17 00:00:00 2001 From: b1indy Date: Sat, 8 Sep 2007 15:03:05 +0000 Subject: re-did the colorize stuff, now no need for GraphUtils git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@378 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 150 ++++++++++++++++++++++++++++++----------- 1 file changed, 112 insertions(+), 38 deletions(-) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index ab21d44c..dc1f9fc2 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -11,7 +11,7 @@ unit UTexture; // Arrow (for arrows, white is white, gray has color, black is transparent); interface -uses OpenGL12, Windows, Math, Classes, SysUtils, Graphics, JPEG, UThemes, PNGImage, GraphUtil, dialogs; +uses OpenGL12, Windows, Math, Classes, SysUtils, Graphics, JPEG, UThemes, PNGImage; procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32; @@ -66,10 +66,10 @@ type function LoadTexture(Identifier: string): TTexture; overload; function CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; procedure UnloadTexture(Name: string; FromCache: boolean); - procedure Colorize(var R,G,B : Byte; Color: Cardinal); // Real colorize instead of: "150 grey is now blue, k?" end; var + lasthue: double; Texture: TTextureUnit; TextureDatabase: TTextureDatabase; @@ -165,6 +165,106 @@ begin Result := T; 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; +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[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 + 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]:=255; + 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.LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; var Res: TResourceStream; @@ -187,6 +287,7 @@ var myAlpha: Real; myRGBABitmap: array of byte; RGBPtr: PByte; + myHue: Double; begin Log.BenchmarkStart(4); Mipmapping := true; @@ -426,29 +527,19 @@ begin 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 begin - myAlpha:=TextureAlpha[Position*TexOrigW+Position2]; - TextureD32[Position*TexNewW + Position2+1, 1] := MyRGBABitmap[(Position*TexOrigW+Position2)*4+2]; // R - TextureD32[Position*TexNewW + Position2+1, 2] := MyRGBABitmap[(Position*TexOrigW+Position2)*4+1]; // G - TextureD32[Position*TexNewW + Position2+1, 3] := MyRGBABitmap[(Position*TexOrigW+Position2)*4]; // B - TextureD32[Position*TexNewW+Position2+1,4] := MyRGBABitmap[(Position*TexOrigW+Position2)*4+3]; // Alpha - 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; - - //now the colorize stuff - for Position := 0 to TexOrigH-1 do begin - for Position2 := 0 to TexOrigW-1 do begin - colorize(TextureD32[Position*TexNewW + Position2+1, 1],TextureD32[Position*TexNewW + Position2+1, 2],TextureD32[Position*TexNewW + Position2+1, 3], Col); //pinkie :P + 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; @@ -803,23 +894,6 @@ begin end; - -// Funkyness of colorizing is done in this small box, remember to give credits when you copy from us -Procedure TTextureUnit.Colorize(var R,G,B : Byte; Color : Cardinal); -var - TexHue, TexLum, TexSat, ClrHue, ClrLum, ClrSat : Word; - ColorizedColors: Cardinal; -begin //red //green //blue - Color:=((Color and $ff) shl 16) or (Color and $ff00) or ((Color and $ff0000) shr 16); - ColorRGBToHLS(Color, ClrHue, ClrLum, ClrSat); - ColorRGBToHLS((((b shl 8) or g) shl 8 or r),TexHue, TexLum, TexSat); - ColorizedColors := ColorHLSToRGB(ClrHue, TexLum, TexSat); - R := ColorizedColors and $FF; - G := (ColorizedColors and $FF00) shr 8; - B := (ColorizedColors and $FF0000) shr 16; -end; -//eoa COLORIZE - function TTextureUnit.LoadTexture(Identifier: string): TTexture; begin Result := LoadTexture(false, pchar(Identifier), 'JPG', 'Plain', 0); -- cgit v1.2.3 From 611f516b33a0c109893354593e28afe10f48e7db Mon Sep 17 00:00:00 2001 From: jaybinks Date: Tue, 18 Sep 2007 12:07:57 +0000 Subject: major tidy up of Umusic ... removes mplayer unit and dependency. tidy up of other units in move to compile in lazarus. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@392 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index dc1f9fc2..f79f66d6 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -11,7 +11,19 @@ unit UTexture; // Arrow (for arrows, white is white, gray has color, black is transparent); interface -uses OpenGL12, Windows, Math, Classes, SysUtils, Graphics, JPEG, UThemes, PNGImage; + +uses OpenGL12, + Windows, + Math, + Classes, + SysUtils, + {$IFNDEF FPC} + Graphics, + JPEG, + PNGImage, + {$ENDIF} + UThemes; + procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32; @@ -974,4 +986,4 @@ begin end; end; -end. \ No newline at end of file +end. -- cgit v1.2.3 From 433a1b7339e2bf96f3b0bb4c98b8c799c6540027 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Tue, 18 Sep 2007 13:19:20 +0000 Subject: changes in order to compile in lazarus... minor tidy ups and removal of big old comment blocks.. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@394 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index f79f66d6..d1ca0917 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -1,5 +1,10 @@ unit UTexture; +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + + // Plain (alpha = 1) // Transparent // Transparent Range -- cgit v1.2.3 From 62c82114318ed04ce42617fa9ce2e179834dbda4 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Wed, 19 Sep 2007 11:44:10 +0000 Subject: added UCommon ( in classes ) for lazarus... common functions needed for lazarus ( and others ) can be put in here. also this now compiles on lazarus.. ( dosnt link yet... but I dont get any critical compiler errors ) tested to compile in my delphi, and basic functionality is fine. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@395 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 45 +++++++++++++++++++++++++++++++----------- 1 file changed, 33 insertions(+), 12 deletions(-) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index d1ca0917..4eb00b4b 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -1,10 +1,5 @@ unit UTexture; -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - - // Plain (alpha = 1) // Transparent // Transparent Range @@ -17,16 +12,24 @@ unit UTexture; interface +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + uses OpenGL12, Windows, Math, Classes, SysUtils, - {$IFNDEF FPC} Graphics, + + {$IFDEF FPC} + lazjpeg, + {$ELSE} JPEG, PNGImage, {$ENDIF} + UCommon, UThemes; @@ -192,11 +195,19 @@ var begin hls[0]:=hue; - clr[0]:=src[0]/255; clr[1]:=src[1]/255; clr[2]:=src[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:=... + 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 @@ -287,7 +298,10 @@ var Res: TResourceStream; TextureB: TBitmap; TextureJ: TJPEGImage; + {$IFNDEF FPC} TexturePNG: TPNGObject; + {$ENDIF} + TextureAlpha: array of byte; AlphaPtr: PByte; TransparentColor: TColor; @@ -306,6 +320,8 @@ var RGBPtr: PByte; myHue: Double; begin + {$IFNDEF FPC} // TODO : JB eeeew this is a nasty one... + // but lazarus implementation scanlines is different :( Log.BenchmarkStart(4); Mipmapping := true; @@ -347,7 +363,10 @@ begin TextureJ.Free; end - else if Format = 'PNG' then begin + else if Format = 'PNG' then + begin + {$IFNDEF FPC} + // TODO : JB - fix this for lazarus.. TexturePNG := TPNGObject.Create; if FromRegistry then TexturePNG.LoadFromStream(Res) else begin @@ -389,6 +408,7 @@ begin setlength(TextureAlpha,0); // just no special transparency for unimplemented transparency types (ptmBit) // transparent png hack end TexturePNG.Free; + {$ENDIF} end; if FromRegistry then Res.Free; @@ -872,7 +892,8 @@ begin if Log.BenchmarkTimeLength[4] >= 1 then Log.LogBenchmark('**********> Texture Load Time Warning - ' + Format + '/' + Identifier + '/' + Typ, 4); - end; // logerror + end; // logerror + {$ENDIF} end; {procedure ResizeTexture(s: pbytearray; d: pbytearray); -- cgit v1.2.3 From 84beb7412eaca48cbf5c9915b83e5f8c79c9a0e7 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Wed, 19 Sep 2007 13:13:37 +0000 Subject: fixes to get working in lazarus.. compiling, linking, starting to run.. just fixing stuff :) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@397 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 4eb00b4b..c1862828 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -21,11 +21,10 @@ uses OpenGL12, Math, Classes, SysUtils, - Graphics, - {$IFDEF FPC} - lazjpeg, + ulazjpeg, {$ELSE} + Graphics, JPEG, PNGImage, {$ENDIF} -- cgit v1.2.3 From 5e01f4ab6d0f3dd5ffa011b2a5638d5248e99f0f Mon Sep 17 00:00:00 2001 From: jaybinks Date: Wed, 19 Sep 2007 13:26:58 +0000 Subject: trying to fix lazarus runtime errors.. also adding files to make sure everything required for lazarus compile, is in svn. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@399 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index c1862828..6895a250 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -870,10 +870,10 @@ begin Result.TexW := TexOrigW / TexNewW; Result.TexH := TexOrigH / TexNewH; - Result.Int := 1; - Result.ColR := 1; - Result.ColG := 1; - Result.ColB := 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 -- cgit v1.2.3 From 7ea4704bee262bd2dfd7c1eb240806e3911140cf Mon Sep 17 00:00:00 2001 From: jaybinks Date: Wed, 19 Sep 2007 13:47:27 +0000 Subject: minor changes.. links to information on lazarus scanlines. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@402 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 34 ++++++++++++++++++++++++---------- 1 file changed, 24 insertions(+), 10 deletions(-) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 6895a250..7f0b85c0 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -321,6 +321,10 @@ var begin {$IFNDEF FPC} // TODO : JB 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; @@ -344,36 +348,46 @@ begin if FromRegistry or ((not FromRegistry) and FileExists(Identifier)) then begin TextureB := TBitmap.Create; - if Format = 'BMP' then begin - if FromRegistry then TextureB.LoadFromStream(Res) - else TextureB.LoadFromFile(Identifier); + if Format = 'BMP' then + begin + if FromRegistry then + TextureB.LoadFromStream(Res) + else + TextureB.LoadFromFile(Identifier); end - - else if Format = 'JPG' then begin + else + if Format = 'JPG' then + begin TextureJ := TJPEGImage.Create; - if FromRegistry then TextureJ.LoadFromStream(Res) - else begin + + if FromRegistry then + TextureJ.LoadFromStream(Res) + else + begin if FileExists(Identifier) then TextureJ.LoadFromFile(Identifier) else Exit; end; + TextureB.Assign(TextureJ); TextureJ.Free; end - else if Format = 'PNG' then begin {$IFNDEF FPC} // TODO : JB - fix this for lazarus.. TexturePNG := TPNGObject.Create; - if FromRegistry then TexturePNG.LoadFromStream(Res) - else begin + if FromRegistry then + TexturePNG.LoadFromStream(Res) + else + begin if FileExists(Identifier) then TexturePNG.LoadFromFile(Identifier) else Exit; end; + TextureB.Assign(TexturePNG); // transparent png hack start (part 1 of 2) if ((Typ = 'Transparent') or (Typ = 'Colorized')) and (TexturePNG.TransparencyMode = ptmPartial) then -- cgit v1.2.3 From db82b7e30a1b58b56fdb4bfc6089b47200ca1da1 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 20 Sep 2007 06:36:58 +0000 Subject: Ultrastar-DX now compiles in linux (using lazarus) Bass etc is commented out.. but it compiles, and im working through the runtime errors. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@408 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 2071 ++++++++++++++++++++-------------------- 1 file changed, 1043 insertions(+), 1028 deletions(-) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 7f0b85c0..1bc4c558 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -1,1028 +1,1043 @@ -unit UTexture; - -// Plain (alpha = 1) -// Transparent -// Transparent Range -// Font (white is drawn, black is transparent) -// Font Outline (Font with darker outline) -// Font Outline 2 (Font with darker outline) -// Font Black (black is drawn, white is transparent) -// Font Gray (gray is drawn, white is transparent) -// Arrow (for arrows, white is white, gray has color, black is transparent); - -interface - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - -uses OpenGL12, - Windows, - Math, - Classes, - SysUtils, - {$IFDEF FPC} - ulazjpeg, - {$ELSE} - Graphics, - JPEG, - PNGImage, - {$ENDIF} - UCommon, - UThemes; - - -procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32; - -type - TTexture = record - TexNum: integer; - 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; - - TTextureEntry = record - Name: string; - Typ: string; - - // we use normal TTexture, it's easier to implement and if needed - we copy ready data - Texture: TTexture; - TextureCache: TTexture; // 0.5.0 - end; - - TTextureDatabase = record - Texture: array of TTextureEntry; - end; - - TTextureUnit = class - Limit: integer; - CreateCacheMipmap: boolean; - -// function GetNumberFor - function GetTexture(Name, Typ: string): TTexture; overload; - function GetTexture(Name, Typ: string; FromCache: boolean): TTexture; overload; - function FindTexture(Name: string): integer; - function LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; - function LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; - function LoadTexture(Identifier: string): TTexture; overload; - function CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; - procedure UnloadTexture(Name: string; FromCache: boolean); - end; - -var - lasthue: double; - Texture: TTextureUnit; - TextureDatabase: TTextureDatabase; - - 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 - 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) - // total 40MB at 2048*2048 - // total 10MB at 1024*1024 - - Mipmapping: Boolean; - - CacheMipmap: array[0..256*256*3-1] of byte; // 3KB - - -implementation -uses ULog, DateUtils, UCovers, StrUtils; - -function TTextureUnit.GetTexture(Name, Typ: string): TTexture; -begin - Result := GetTexture(Name, Typ, true); -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 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; - -function TTextureUnit.FindTexture(Name: string): integer; -var - T: integer; // texture -begin - Result := -1; - for T := 0 to high(TextureDatabase.Texture) do - if TextureDatabase.Texture[T].Name = Name then - Result := T; -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; -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[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 - 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]:=255; - 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.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; - - 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; -begin - {$IFNDEF FPC} // TODO : JB 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 - Res := TResourceStream.Create(HInstance, Identifier, Format); - except - beep; - Exit; - end; - end; - - // filetype "detection" - if (not FromRegistry) and (FileExists(Identifier)) then begin - Format:=''; - Format := PAnsichar(UpperCase(RightStr(ExtractFileExt(Identifier),3))); - end; -// else Format:='JPG'; -// if not ((Format='BMP')or(Format='JPG')or(Format='PNG')) then Format:='JPG'; - - if FromRegistry or ((not FromRegistry) and FileExists(Identifier)) then begin - TextureB := TBitmap.Create; - - if Format = 'BMP' then - begin - if FromRegistry then - TextureB.LoadFromStream(Res) - else - TextureB.LoadFromFile(Identifier); - end - else - if Format = 'JPG' then - begin - TextureJ := TJPEGImage.Create; - - if FromRegistry then - TextureJ.LoadFromStream(Res) - else - begin - if FileExists(Identifier) then - TextureJ.LoadFromFile(Identifier) - else - Exit; - end; - - TextureB.Assign(TextureJ); - TextureJ.Free; - end - else if Format = 'PNG' then - begin - {$IFNDEF FPC} - // TODO : JB - fix this for lazarus.. - TexturePNG := TPNGObject.Create; - if FromRegistry then - TexturePNG.LoadFromStream(Res) - else - begin - if FileExists(Identifier) then - TexturePNG.LoadFromFile(Identifier) - else - Exit; - 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} - 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 - - 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); - - if Typ = 'Plain' then begin - // 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 - 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;} - 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 - 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 - 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 - 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; - end; - - if Typ = 'Font Outline' then begin - 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 - Pix := PPix[Position2 * 3]; - - Col := Pix; - if Col < 127 then Col := 127; - - TempA := Pix; - if TempA >= 95 then TempA := 255; - if TempA >= 31 then TempA := 255; - if Pix < 95 then TempA := (Pix * 256) div 96; - - - TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; - TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; - 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; - end; - - if Typ = 'Font Outline 2' then begin - 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 - Pix := PPix[Position2 * 3]; - - Col := Pix; - if Col < 31 then Col := 31; - - TempA := Pix; - if TempA >= 31 then TempA := 255; - if Pix < 31 then TempA := Pix * (256 div 32); - - TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; - TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; - 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; - end; - - if Typ = 'Font Black' then begin - // normalnie 0,125s bez niczego 0,015s - 0,030s z pix 0,125s <-- ??? - // dimensions - TextureB.PixelFormat := pf24bit; - 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 TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2*3]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - if Typ = 'Alpha Black Colored' then begin - TextureB.PixelFormat := pf24bit; - 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 TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2*3]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := (Col div $10000) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Col div $100) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Col and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - if Typ = 'Font Gray' 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 TextureB.Height-1 do begin - for Position2 := 0 to TextureB.Width-1 do begin - Pix := TextureB.Canvas.Pixels[Position2, Position]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - 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;} - end; - - if Typ = 'Arrow' then begin - 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 - Pix := PPix[Position2 * 3]; - - // transparency - if Pix >= 127 then TempA := 255; - if Pix < 127 then TempA := Pix * 2; - - // ColInt = color intensity - if Pix < 127 then ColInt := 1; - if Pix >= 127 then ColInt := 2 - Pix / 128; - //0.75, 0.6, 0.25 - - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Round(ColInt * 0.75 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := Round(ColInt * 0.6 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Round(ColInt * 0.25 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - - if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); - 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 = 'Note Plain' then begin - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - - - - // Skin Patch - // 0-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White - case PPix[Position2*3] of - 0..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); - 192: Pix := Col; - 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); - 255: Pix := $FFFFFF; - end; -// 0.5.0. Original -// case PPix[Position2*3] of -// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; -// 192: Pix := Col; -// 255: Pix := $FFFFFF; -// end; - - - - - - TextureD24[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; - TextureD24[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; - TextureD24[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 3, TextureB.Width, TextureB.Height, 0, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); - end; - - if Typ = 'Note Transparent' then begin - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - TempA := 255; - - - - //Skin Patch - // 0= Transparent, 1-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White - case PPix[Position2*3] of - 0: TempA := 0; - 1..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); - 192: Pix := Col; - 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); - 255: Pix := $FFFFFF; - end; -// 0.5.0 Original -// case PPix[Position2*3] of -// 0: TempA := 0; -// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; -// 192: Pix := Col; -// 255: Pix := $FFFFFF; -// end; - - - - - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - TextureB.Free; - 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 := TexOrigW / TexNewW; - Result.TexH := TexOrigH / TexNewH; - - 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 := Identifier; - - end; - - Log.BenchmarkEnd(4); - if Log.BenchmarkTimeLength[4] >= 1 then - Log.LogBenchmark('**********> Texture Load Time Warning - ' + Format + '/' + Identifier + '/' + Typ, 4); - - end; // logerror - {$ENDIF} -end; - -{procedure ResizeTexture(s: pbytearray; d: pbytearray); -var - Position: integer; - Position2: integer; -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]; - end; - end; -end;} - -{procedure SetTexture(p: pointer); -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;} - -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; -begin - Result := LoadTexture(false, pchar(Identifier), 'JPG', 'Plain', 0); -end; - -function TTextureUnit.CreateTexture(var Data: array of byte; 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 beep; - 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(Name: string; FromCache: boolean); -var - T: integer; - TexNum: GLuint; -begin - T := FindTexture(Name); - - if not FromCache then begin - TexNum := TextureDatabase.Texture[T].Texture.TexNum; - if TexNum >= 0 then begin - glDeleteTextures(1, @TexNum); - TextureDatabase.Texture[T].Texture.TexNum := -1; -// 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 := -1; -// Log.LogError('Unload texture cache no '+IntToStr(TexNum)); - end; - end; -end; - -end. +unit UTexture; + +// Plain (alpha = 1) +// Transparent +// Transparent Range +// Font (white is drawn, black is transparent) +// Font Outline (Font with darker outline) +// Font Outline 2 (Font with darker outline) +// Font Black (black is drawn, white is transparent) +// Font Gray (gray is drawn, white is transparent) +// Arrow (for arrows, white is white, gray has color, black is transparent); + +interface + +{$I switches.inc} + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +uses OpenGL12, + {$IFDEF win32} + windows, + {$ENDIF} + Math, + Classes, + SysUtils, + {$IFDEF FPC} + ulazjpeg, + {$ELSE} + JPEG, + PNGImage, + {$ENDIF} + Graphics, + UCommon, + UThemes; + + + {$IFDEF Win32} + procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32; + + {$ELSE} + {$ifdef darwin} + const opengl32 = '/System/Library/Frameworks/OpenGL.framework/Libraries/libGL.dylib'; + {$ELSE} + const opengl32 = 'libGL.so' ; // YES Capital GL + {$ENDIF} + + procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32; + {$ENDIF} + +type + TTexture = record + TexNum: integer; + 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; + + TTextureEntry = record + Name: string; + Typ: string; + + // we use normal TTexture, it's easier to implement and if needed - we copy ready data + Texture: TTexture; + TextureCache: TTexture; // 0.5.0 + end; + + TTextureDatabase = record + Texture: array of TTextureEntry; + end; + + TTextureUnit = class + Limit: integer; + CreateCacheMipmap: boolean; + +// function GetNumberFor + function GetTexture(Name, Typ: string): TTexture; overload; + function GetTexture(Name, Typ: string; FromCache: boolean): TTexture; overload; + function FindTexture(Name: string): integer; + function LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; + function LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; + function LoadTexture(Identifier: string): TTexture; overload; + function CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; + procedure UnloadTexture(Name: string; FromCache: boolean); + end; + +var + lasthue: double; + Texture: TTextureUnit; + TextureDatabase: TTextureDatabase; + + 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 + 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) + // total 40MB at 2048*2048 + // total 10MB at 1024*1024 + + Mipmapping: Boolean; + + CacheMipmap: array[0..256*256*3-1] of byte; // 3KB + + +implementation +uses ULog, DateUtils, UCovers, StrUtils; + +function TTextureUnit.GetTexture(Name, Typ: string): TTexture; +begin + Result := GetTexture(Name, Typ, true); +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 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; + +function TTextureUnit.FindTexture(Name: string): integer; +var + T: integer; // texture +begin + Result := -1; + for T := 0 to high(TextureDatabase.Texture) do + if TextureDatabase.Texture[T].Name = Name then + Result := T; +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; +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[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 + 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]:=255; + 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.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; + + 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; +begin + {$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 + Res := TResourceStream.Create(HInstance, Identifier, Format); + except + beep; + Exit; + end; + end; + + // filetype "detection" + if (not FromRegistry) and (FileExists(Identifier)) then begin + Format:=''; + Format := PAnsichar(UpperCase(RightStr(ExtractFileExt(Identifier),3))); + end; +// else Format:='JPG'; +// if not ((Format='BMP')or(Format='JPG')or(Format='PNG')) then Format:='JPG'; + + if FromRegistry or ((not FromRegistry) and FileExists(Identifier)) then begin + TextureB := TBitmap.Create; + + if Format = 'BMP' then + begin + if FromRegistry then + TextureB.LoadFromStream(Res) + else + TextureB.LoadFromFile(Identifier); + end + else + if Format = 'JPG' then + begin + TextureJ := TJPEGImage.Create; + + if FromRegistry then + TextureJ.LoadFromStream(Res) + else + begin + if FileExists(Identifier) then + TextureJ.LoadFromFile(Identifier) + else + Exit; + end; + + TextureB.Assign(TextureJ); + TextureJ.Free; + end + else if Format = 'PNG' then + begin + {$IFNDEF FPC} + // TODO : JB_lazarus - fix this for lazarus.. + TexturePNG := TPNGObject.Create; + if FromRegistry then + TexturePNG.LoadFromStream(Res) + else + begin + if FileExists(Identifier) then + TexturePNG.LoadFromFile(Identifier) + else + Exit; + 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} + 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 + + 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); + + if Typ = 'Plain' then begin + // 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 + 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;} + 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 + 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 + 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 + 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; + end; + + if Typ = 'Font Outline' then begin + 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 + Pix := PPix[Position2 * 3]; + + Col := Pix; + if Col < 127 then Col := 127; + + TempA := Pix; + if TempA >= 95 then TempA := 255; + if TempA >= 31 then TempA := 255; + if Pix < 95 then TempA := (Pix * 256) div 96; + + + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; + 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; + end; + + if Typ = 'Font Outline 2' then begin + 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 + Pix := PPix[Position2 * 3]; + + Col := Pix; + if Col < 31 then Col := 31; + + TempA := Pix; + if TempA >= 31 then TempA := 255; + if Pix < 31 then TempA := Pix * (256 div 32); + + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; + 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; + end; + + if Typ = 'Font Black' then begin + // normalnie 0,125s bez niczego 0,015s - 0,030s z pix 0,125s <-- ??? + // dimensions + TextureB.PixelFormat := pf24bit; + 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 TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2*3]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + if Typ = 'Alpha Black Colored' then begin + TextureB.PixelFormat := pf24bit; + 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 TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2*3]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := (Col div $10000) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Col div $100) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Col and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + if Typ = 'Font Gray' 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 TextureB.Height-1 do begin + for Position2 := 0 to TextureB.Width-1 do begin + Pix := TextureB.Canvas.Pixels[Position2, Position]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + 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;} + end; + + if Typ = 'Arrow' then begin + 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 + Pix := PPix[Position2 * 3]; + + // transparency + if Pix >= 127 then TempA := 255; + if Pix < 127 then TempA := Pix * 2; + + // ColInt = color intensity + if Pix < 127 then ColInt := 1; + if Pix >= 127 then ColInt := 2 - Pix / 128; + //0.75, 0.6, 0.25 + + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Round(ColInt * 0.75 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := Round(ColInt * 0.6 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Round(ColInt * 0.25 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + + if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); + 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 = 'Note Plain' then begin + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + + + + // Skin Patch + // 0-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White + case PPix[Position2*3] of + 0..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); + 192: Pix := Col; + 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); + 255: Pix := $FFFFFF; + end; +// 0.5.0. Original +// case PPix[Position2*3] of +// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; +// 192: Pix := Col; +// 255: Pix := $FFFFFF; +// end; + + + + + + TextureD24[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; + TextureD24[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; + TextureD24[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 3, TextureB.Width, TextureB.Height, 0, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); + end; + + if Typ = 'Note Transparent' then begin + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + TempA := 255; + + + + //Skin Patch + // 0= Transparent, 1-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White + case PPix[Position2*3] of + 0: TempA := 0; + 1..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); + 192: Pix := Col; + 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); + 255: Pix := $FFFFFF; + end; +// 0.5.0 Original +// case PPix[Position2*3] of +// 0: TempA := 0; +// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; +// 192: Pix := Col; +// 255: Pix := $FFFFFF; +// end; + + + + + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + TextureB.Free; + 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 := TexOrigW / TexNewW; + Result.TexH := TexOrigH / TexNewH; + + 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 := Identifier; + + end; + + Log.BenchmarkEnd(4); + if Log.BenchmarkTimeLength[4] >= 1 then + Log.LogBenchmark('**********> Texture Load Time Warning - ' + Format + '/' + Identifier + '/' + Typ, 4); + + end; // logerror + {$ENDIF} +end; + +{procedure ResizeTexture(s: pbytearray; d: pbytearray); +var + Position: integer; + Position2: integer; +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]; + end; + end; +end;} + +{procedure SetTexture(p: pointer); +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;} + +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; +begin + Result := LoadTexture(false, pchar(Identifier), 'JPG', 'Plain', 0); +end; + +function TTextureUnit.CreateTexture(var Data: array of byte; 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 beep; + 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(Name: string; FromCache: boolean); +var + T: integer; + TexNum: GLuint; +begin + T := FindTexture(Name); + + if not FromCache then begin + TexNum := TextureDatabase.Texture[T].Texture.TexNum; + if TexNum >= 0 then begin + glDeleteTextures(1, @TexNum); + TextureDatabase.Texture[T].Texture.TexNum := -1; +// 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 := -1; +// Log.LogError('Unload texture cache no '+IntToStr(TexNum)); + end; + end; +end; + +end. -- cgit v1.2.3 From a1c2876fb12cfc860044f00210f69a9bdc2cf687 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 20 Sep 2007 10:35:02 +0000 Subject: minor fixes for lazarus build.. forgot file... oops.. :) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@416 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 2143 +++++++++++++++++++++------------------- 1 file changed, 1100 insertions(+), 1043 deletions(-) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 1bc4c558..364bbcc8 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -1,1043 +1,1100 @@ -unit UTexture; - -// Plain (alpha = 1) -// Transparent -// Transparent Range -// Font (white is drawn, black is transparent) -// Font Outline (Font with darker outline) -// Font Outline 2 (Font with darker outline) -// Font Black (black is drawn, white is transparent) -// Font Gray (gray is drawn, white is transparent) -// Arrow (for arrows, white is white, gray has color, black is transparent); - -interface - -{$I switches.inc} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - -uses OpenGL12, - {$IFDEF win32} - windows, - {$ENDIF} - Math, - Classes, - SysUtils, - {$IFDEF FPC} - ulazjpeg, - {$ELSE} - JPEG, - PNGImage, - {$ENDIF} - Graphics, - UCommon, - UThemes; - - - {$IFDEF Win32} - procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32; - - {$ELSE} - {$ifdef darwin} - const opengl32 = '/System/Library/Frameworks/OpenGL.framework/Libraries/libGL.dylib'; - {$ELSE} - const opengl32 = 'libGL.so' ; // YES Capital GL - {$ENDIF} - - procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32; - {$ENDIF} - -type - TTexture = record - TexNum: integer; - 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; - - TTextureEntry = record - Name: string; - Typ: string; - - // we use normal TTexture, it's easier to implement and if needed - we copy ready data - Texture: TTexture; - TextureCache: TTexture; // 0.5.0 - end; - - TTextureDatabase = record - Texture: array of TTextureEntry; - end; - - TTextureUnit = class - Limit: integer; - CreateCacheMipmap: boolean; - -// function GetNumberFor - function GetTexture(Name, Typ: string): TTexture; overload; - function GetTexture(Name, Typ: string; FromCache: boolean): TTexture; overload; - function FindTexture(Name: string): integer; - function LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; - function LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; - function LoadTexture(Identifier: string): TTexture; overload; - function CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; - procedure UnloadTexture(Name: string; FromCache: boolean); - end; - -var - lasthue: double; - Texture: TTextureUnit; - TextureDatabase: TTextureDatabase; - - 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 - 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) - // total 40MB at 2048*2048 - // total 10MB at 1024*1024 - - Mipmapping: Boolean; - - CacheMipmap: array[0..256*256*3-1] of byte; // 3KB - - -implementation -uses ULog, DateUtils, UCovers, StrUtils; - -function TTextureUnit.GetTexture(Name, Typ: string): TTexture; -begin - Result := GetTexture(Name, Typ, true); -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 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; - -function TTextureUnit.FindTexture(Name: string): integer; -var - T: integer; // texture -begin - Result := -1; - for T := 0 to high(TextureDatabase.Texture) do - if TextureDatabase.Texture[T].Name = Name then - Result := T; -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; -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[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 - 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]:=255; - 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.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; - - 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; -begin - {$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 - Res := TResourceStream.Create(HInstance, Identifier, Format); - except - beep; - Exit; - end; - end; - - // filetype "detection" - if (not FromRegistry) and (FileExists(Identifier)) then begin - Format:=''; - Format := PAnsichar(UpperCase(RightStr(ExtractFileExt(Identifier),3))); - end; -// else Format:='JPG'; -// if not ((Format='BMP')or(Format='JPG')or(Format='PNG')) then Format:='JPG'; - - if FromRegistry or ((not FromRegistry) and FileExists(Identifier)) then begin - TextureB := TBitmap.Create; - - if Format = 'BMP' then - begin - if FromRegistry then - TextureB.LoadFromStream(Res) - else - TextureB.LoadFromFile(Identifier); - end - else - if Format = 'JPG' then - begin - TextureJ := TJPEGImage.Create; - - if FromRegistry then - TextureJ.LoadFromStream(Res) - else - begin - if FileExists(Identifier) then - TextureJ.LoadFromFile(Identifier) - else - Exit; - end; - - TextureB.Assign(TextureJ); - TextureJ.Free; - end - else if Format = 'PNG' then - begin - {$IFNDEF FPC} - // TODO : JB_lazarus - fix this for lazarus.. - TexturePNG := TPNGObject.Create; - if FromRegistry then - TexturePNG.LoadFromStream(Res) - else - begin - if FileExists(Identifier) then - TexturePNG.LoadFromFile(Identifier) - else - Exit; - 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} - 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 - - 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); - - if Typ = 'Plain' then begin - // 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 - 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;} - 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 - 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 - 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 - 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; - end; - - if Typ = 'Font Outline' then begin - 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 - Pix := PPix[Position2 * 3]; - - Col := Pix; - if Col < 127 then Col := 127; - - TempA := Pix; - if TempA >= 95 then TempA := 255; - if TempA >= 31 then TempA := 255; - if Pix < 95 then TempA := (Pix * 256) div 96; - - - TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; - TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; - 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; - end; - - if Typ = 'Font Outline 2' then begin - 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 - Pix := PPix[Position2 * 3]; - - Col := Pix; - if Col < 31 then Col := 31; - - TempA := Pix; - if TempA >= 31 then TempA := 255; - if Pix < 31 then TempA := Pix * (256 div 32); - - TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; - TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; - 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; - end; - - if Typ = 'Font Black' then begin - // normalnie 0,125s bez niczego 0,015s - 0,030s z pix 0,125s <-- ??? - // dimensions - TextureB.PixelFormat := pf24bit; - 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 TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2*3]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - if Typ = 'Alpha Black Colored' then begin - TextureB.PixelFormat := pf24bit; - 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 TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2*3]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := (Col div $10000) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Col div $100) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Col and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - if Typ = 'Font Gray' 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 TextureB.Height-1 do begin - for Position2 := 0 to TextureB.Width-1 do begin - Pix := TextureB.Canvas.Pixels[Position2, Position]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - 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;} - end; - - if Typ = 'Arrow' then begin - 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 - Pix := PPix[Position2 * 3]; - - // transparency - if Pix >= 127 then TempA := 255; - if Pix < 127 then TempA := Pix * 2; - - // ColInt = color intensity - if Pix < 127 then ColInt := 1; - if Pix >= 127 then ColInt := 2 - Pix / 128; - //0.75, 0.6, 0.25 - - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Round(ColInt * 0.75 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := Round(ColInt * 0.6 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Round(ColInt * 0.25 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - - if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); - 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 = 'Note Plain' then begin - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - - - - // Skin Patch - // 0-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White - case PPix[Position2*3] of - 0..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); - 192: Pix := Col; - 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); - 255: Pix := $FFFFFF; - end; -// 0.5.0. Original -// case PPix[Position2*3] of -// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; -// 192: Pix := Col; -// 255: Pix := $FFFFFF; -// end; - - - - - - TextureD24[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; - TextureD24[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; - TextureD24[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 3, TextureB.Width, TextureB.Height, 0, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); - end; - - if Typ = 'Note Transparent' then begin - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - TempA := 255; - - - - //Skin Patch - // 0= Transparent, 1-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White - case PPix[Position2*3] of - 0: TempA := 0; - 1..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); - 192: Pix := Col; - 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); - 255: Pix := $FFFFFF; - end; -// 0.5.0 Original -// case PPix[Position2*3] of -// 0: TempA := 0; -// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; -// 192: Pix := Col; -// 255: Pix := $FFFFFF; -// end; - - - - - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - TextureB.Free; - 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 := TexOrigW / TexNewW; - Result.TexH := TexOrigH / TexNewH; - - 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 := Identifier; - - end; - - Log.BenchmarkEnd(4); - if Log.BenchmarkTimeLength[4] >= 1 then - Log.LogBenchmark('**********> Texture Load Time Warning - ' + Format + '/' + Identifier + '/' + Typ, 4); - - end; // logerror - {$ENDIF} -end; - -{procedure ResizeTexture(s: pbytearray; d: pbytearray); -var - Position: integer; - Position2: integer; -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]; - end; - end; -end;} - -{procedure SetTexture(p: pointer); -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;} - -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; -begin - Result := LoadTexture(false, pchar(Identifier), 'JPG', 'Plain', 0); -end; - -function TTextureUnit.CreateTexture(var Data: array of byte; 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 beep; - 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(Name: string; FromCache: boolean); -var - T: integer; - TexNum: GLuint; -begin - T := FindTexture(Name); - - if not FromCache then begin - TexNum := TextureDatabase.Texture[T].Texture.TexNum; - if TexNum >= 0 then begin - glDeleteTextures(1, @TexNum); - TextureDatabase.Texture[T].Texture.TexNum := -1; -// 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 := -1; -// Log.LogError('Unload texture cache no '+IntToStr(TexNum)); - end; - end; -end; - -end. +unit UTexture; + +// Plain (alpha = 1) +// Transparent +// Transparent Range +// Font (white is drawn, black is transparent) +// Font Outline (Font with darker outline) +// Font Outline 2 (Font with darker outline) +// Font Black (black is drawn, white is transparent) +// Font Gray (gray is drawn, white is transparent) +// Arrow (for arrows, white is white, gray has color, black is transparent); + +interface + +{$I switches.inc} + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +uses OpenGL12, + {$IFDEF win32} + windows, + {$ENDIF} + Math, + Classes, + SysUtils, + {$IFDEF FPC} + ulazjpeg, + {$ELSE} + JPEG, + PNGImage, + {$ENDIF} + Graphics, + UCommon, + UThemes; + + + {$IFDEF Win32} + procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32; + + {$ELSE} + {$ifdef darwin} + const opengl32 = '/System/Library/Frameworks/OpenGL.framework/Libraries/libGL.dylib'; + {$ELSE} + const opengl32 = 'libGL.so' ; // YES Capital GL + {$ENDIF} + + procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32; + {$ENDIF} + +type + TTexture = record + TexNum: integer; + 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; + + TTextureEntry = record + Name: string; + Typ: string; + + // we use normal TTexture, it's easier to implement and if needed - we copy ready data + Texture: TTexture; + TextureCache: TTexture; // 0.5.0 + end; + + TTextureDatabase = record + Texture: array of TTextureEntry; + end; + + TTextureUnit = class + + private + function LoadBitmap( aSourceStream : TStream; aBMP : TBitMap ): boolean; + public + Limit: integer; + CreateCacheMipmap: boolean; + +// function GetNumberFor + function GetTexture(Name, Typ: string): TTexture; overload; + function GetTexture(Name, Typ: string; FromCache: boolean): TTexture; overload; + function FindTexture(Name: string): integer; + function LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; + function LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; + function LoadTexture(Identifier: string): TTexture; overload; + function CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; + procedure UnloadTexture(Name: string; FromCache: boolean); + end; + +var + lasthue: double; + Texture: TTextureUnit; + TextureDatabase: TTextureDatabase; + + 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 + 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) + // total 40MB at 2048*2048 + // total 10MB at 1024*1024 + + Mipmapping: Boolean; + + CacheMipmap: array[0..256*256*3-1] of byte; // 3KB + + +implementation +uses ULog, DateUtils, UCovers, StrUtils; + +function TTextureUnit.GetTexture(Name, Typ: string): TTexture; +begin + Result := GetTexture(Name, Typ, true); +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 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; + +function TTextureUnit.FindTexture(Name: string): integer; +var + T: integer; // texture +begin + Result := -1; + for T := 0 to high(TextureDatabase.Texture) do + if TextureDatabase.Texture[T].Name = Name then + Result := T; +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; +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[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 + 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]:=255; + 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( aSourceStream : TStream; aBMP : TBitMap ): boolean; +begin + aSourceStream.position := 0; + boolean := aBMP.LoadFromStream( aSourceStream ) > 0; +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; + + 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 + + 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 +// Res := TResourceStream.Create(HInstance, Identifier, Format); + lTextureStream := TResourceStream.Create(HInstance, Identifier, Format); + + // TODO : Where does the format come from + except + Log.LogStatus( 'ERROR Could not load from resource' , Identifier +' '+ Format +' '+ Typ ); + beep; + Exit; + end; + end + else + begin + if ( FileExists(Identifier) ) then + begin + // Get the File Extension... + Format := PAnsichar(UpperCase(RightStr(ExtractFileExt(Identifier),3))); + lTextureStream := TFileStream.create( Identifier , fmOpenRead ); + end; + end; + + if FromRegistry or + ((not FromRegistry) and FileExists(Identifier)) then + begin + TextureB := TBitmap.Create; + + if Format = 'BMP' then + begin + LoadBitmap( aSourceStream : TStream; TextureB ); + + if FromRegistry then + TextureB.LoadFromStream(Res) + else + TextureB.LoadFromFile(Identifier); + end + else + if Format = 'JPG' then + begin + TextureJ := TJPEGImage.Create; + + if FromRegistry then + TextureJ.LoadFromStream(Res) + else + begin + if FileExists(Identifier) then + TextureJ.LoadFromFile(Identifier) + else + Exit; + end; + + TextureB.Assign(TextureJ); + TextureJ.Free; + end + else if Format = 'PNG' then + begin + {$IFNDEF FPC} + // TODO : JB_lazarus - fix this for lazarus.. + TexturePNG := TPNGObject.Create; + if FromRegistry then + TexturePNG.LoadFromStream(Res) + else + begin + if FileExists(Identifier) then + TexturePNG.LoadFromFile(Identifier) + else + Exit; + 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} + 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 + + 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); + + 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} + 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;} + 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 + 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 + 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 + 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 + Pix := PPix[Position2 * 3]; + + Col := Pix; + if Col < 127 then Col := 127; + + TempA := Pix; + if TempA >= 95 then TempA := 255; + if TempA >= 31 then TempA := 255; + if Pix < 95 then TempA := (Pix * 256) div 96; + + + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; + 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 + 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 + Pix := PPix[Position2 * 3]; + + Col := Pix; + if Col < 31 then Col := 31; + + TempA := Pix; + if TempA >= 31 then TempA := 255; + if Pix < 31 then TempA := Pix * (256 div 32); + + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; + 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 + begin + {$IFNDEF FPC} + // normalnie 0,125s bez niczego 0,015s - 0,030s z pix 0,125s <-- ??? + // dimensions + TextureB.PixelFormat := pf24bit; + 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 TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2*3]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + 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 + begin + {$IFNDEF FPC} + TextureB.PixelFormat := pf24bit; + 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 TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2*3]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := (Col div $10000) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Col div $100) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Col and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + 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; + 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 TextureB.Height-1 do begin + for Position2 := 0 to TextureB.Width-1 do begin + Pix := TextureB.Canvas.Pixels[Position2, Position]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + 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]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2 * 3]; + + // transparency + if Pix >= 127 then TempA := 255; + if Pix < 127 then TempA := Pix * 2; + + // ColInt = color intensity + if Pix < 127 then ColInt := 1; + if Pix >= 127 then ColInt := 2 - Pix / 128; + //0.75, 0.6, 0.25 + + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Round(ColInt * 0.75 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := Round(ColInt * 0.6 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Round(ColInt * 0.25 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + + if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); + 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 = 'Note Plain' 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 + + + + // Skin Patch + // 0-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White + case PPix[Position2*3] of + 0..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); + 192: Pix := Col; + 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); + 255: Pix := $FFFFFF; + end; +// 0.5.0. Original +// case PPix[Position2*3] of +// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; +// 192: Pix := Col; +// 255: Pix := $FFFFFF; +// end; + + + + + + TextureD24[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; + TextureD24[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; + TextureD24[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; + 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 + TempA := 255; + + + + //Skin Patch + // 0= Transparent, 1-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White + case PPix[Position2*3] of + 0: TempA := 0; + 1..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); + 192: Pix := Col; + 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); + 255: Pix := $FFFFFF; + end; +// 0.5.0 Original +// case PPix[Position2*3] of +// 0: TempA := 0; +// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; +// 192: Pix := Col; +// 255: Pix := $FFFFFF; +// end; + + + + + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; + 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; + Result.H := 0; + Result.ScaleW := 1; + Result.ScaleH := 1; + Result.Rot := 0; + Result.TexNum := ActTex; + Result.TexW := TexOrigW / TexNewW; + Result.TexH := TexOrigH / TexNewH; + + 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 := Identifier; + + end; + + Log.BenchmarkEnd(4); + if Log.BenchmarkTimeLength[4] >= 1 then + Log.LogBenchmark('**********> Texture Load Time Warning - ' + Format + '/' + Identifier + '/' + Typ, 4); + + end; // logerror +// {$ENDIF} +end; + +{procedure ResizeTexture(s: pbytearray; d: pbytearray); +var + Position: integer; + Position2: integer; +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]; + end; + end; +end;} + +{procedure SetTexture(p: pointer); +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;} + +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; +begin + Result := LoadTexture(false, pchar(Identifier), 'JPG', 'Plain', 0); +end; + +function TTextureUnit.CreateTexture(var Data: array of byte; 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 beep; + 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(Name: string; FromCache: boolean); +var + T: integer; + TexNum: GLuint; +begin + T := FindTexture(Name); + + if not FromCache then begin + TexNum := TextureDatabase.Texture[T].Texture.TexNum; + if TexNum >= 0 then begin + glDeleteTextures(1, @TexNum); + TextureDatabase.Texture[T].Texture.TexNum := -1; +// 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 := -1; +// Log.LogError('Unload texture cache no '+IntToStr(TexNum)); + end; + end; +end; + +end. -- cgit v1.2.3 From efef73dfde7de1692afb9aa8a9d51dcafc59fbb2 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 20 Sep 2007 10:53:12 +0000 Subject: started re-factoring TTextureUnit.LoadTexture only done BPM and JPEG for now. will do more as I add support for it to lazarus. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@418 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 69 +++++++++++++++++++++++------------------- 1 file changed, 38 insertions(+), 31 deletions(-) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 364bbcc8..e7038e78 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -90,7 +90,8 @@ type TTextureUnit = class private - function LoadBitmap( aSourceStream : TStream; aBMP : TBitMap ): boolean; + function LoadBitmap( aSourceStream : TStream; aIMG : TBitMap ): boolean; + function LoadJpeg( aSourceStream : TStream; aIMG : TBitMap ): boolean; public Limit: integer; CreateCacheMipmap: boolean; @@ -311,12 +312,40 @@ begin end; -function TTextureUnit.LoadBitmap( aSourceStream : TStream; aBMP : TBitMap ): boolean; +function TTextureUnit.LoadBitmap( aSourceStream : TStream; aIMG : TBitMap ): boolean; begin - aSourceStream.position := 0; - boolean := aBMP.LoadFromStream( aSourceStream ) > 0; + result := false; + try + aSourceStream.position := 0; + aIMG.LoadFromStream( aSourceStream ); + finally + result := aSourceStream.position > 0; + end; +end; + +function TTextureUnit.LoadJpeg( aSourceStream : TStream; aIMG : TBitMap ): boolean; +var + TextureJ: TJPEGImage; +begin + result := false; + try + aSourceStream.position := 0; + + TextureJ := TJPEGImage.Create; + try + TextureJ.LoadFromStream( aSourceStream ); + aIMG.Assign(TextureJ); + finally + TextureJ.Free; + end; + finally + result := aSourceStream.position > 0; + end; end; + + + function TTextureUnit.LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; var Res: TResourceStream; @@ -381,38 +410,16 @@ begin end; end; - if FromRegistry or - ((not FromRegistry) and FileExists(Identifier)) then +// if FromRegistry or +// ((not FromRegistry) and FileExists(Identifier)) then begin - TextureB := TBitmap.Create; + TextureB := TBitmap.Create; if Format = 'BMP' then - begin - LoadBitmap( aSourceStream : TStream; TextureB ); - - if FromRegistry then - TextureB.LoadFromStream(Res) - else - TextureB.LoadFromFile(Identifier); - end + LoadBitmap( lTextureStream , TextureB ) else if Format = 'JPG' then - begin - TextureJ := TJPEGImage.Create; - - if FromRegistry then - TextureJ.LoadFromStream(Res) - else - begin - if FileExists(Identifier) then - TextureJ.LoadFromFile(Identifier) - else - Exit; - end; - - TextureB.Assign(TextureJ); - TextureJ.Free; - end + LoadJpeg( lTextureStream , TextureB ) else if Format = 'PNG' then begin {$IFNDEF FPC} -- cgit v1.2.3 From 7e01085a1981f28e538b06bff5cebf2b88c975af Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 20 Sep 2007 11:20:20 +0000 Subject: fixed nasty bug I introduced... sorry.. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@419 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 23 ++++++++++++++++++----- 1 file changed, 18 insertions(+), 5 deletions(-) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index e7038e78..96c0ec28 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -316,6 +316,8 @@ function TTextureUnit.LoadBitmap( aSourceStream : TStream; aIMG : TBitMap ): boo begin result := false; try + Log.LogStatus( ' TTextureUnit.LoadBitmap' , '' ); + aSourceStream.position := 0; aIMG.LoadFromStream( aSourceStream ); finally @@ -329,6 +331,8 @@ var begin result := false; try + Log.LogStatus( ' TTextureUnit.LoadJpeg' , ''); + aSourceStream.position := 0; TextureJ := TJPEGImage.Create; @@ -375,6 +379,7 @@ var lTextureStream : TStream; begin + lTextureStream := nil; Log.LogStatus( 'From Resource - ' + inttostr( integer( FromRegistry ) ) , Identifier +' '+ Format +' '+ Typ ); // {$IFNDEF FPC} @@ -390,9 +395,13 @@ begin if FromRegistry then begin try -// Res := TResourceStream.Create(HInstance, Identifier, Format); + + Log.LogStatus( ' A' , ''); + + // Res := TResourceStream.Create(HInstance, Identifier, Format); lTextureStream := TResourceStream.Create(HInstance, Identifier, Format); - + Log.LogStatus( ' B' , ''); + // TODO : Where does the format come from except Log.LogStatus( 'ERROR Could not load from resource' , Identifier +' '+ Format +' '+ Typ ); @@ -406,13 +415,17 @@ begin begin // Get the File Extension... Format := PAnsichar(UpperCase(RightStr(ExtractFileExt(Identifier),3))); - lTextureStream := TFileStream.create( Identifier , fmOpenRead ); + lTextureStream := TFileStream.create( Identifier , fmOpenRead or fmShareDenyNone ); end; end; -// if FromRegistry or -// ((not FromRegistry) and FileExists(Identifier)) then + if assigned( lTextureStream ) then begin + Log.LogStatus( ' C - '+Format , ''); + + // TEmp, untill all code is moved to refactord way.. + Res := TResourceStream( lTextureStream ); + TextureB := TBitmap.Create; if Format = 'BMP' then -- cgit v1.2.3 From 333ec29a5275fb851f38f7be695930ea1dfe8340 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 20 Sep 2007 11:28:04 +0000 Subject: remove logging git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@420 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 15 ++++----------- 1 file changed, 4 insertions(+), 11 deletions(-) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 96c0ec28..389dd0b0 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -381,7 +381,8 @@ var begin lTextureStream := nil; - Log.LogStatus( 'From Resource - ' + inttostr( integer( FromRegistry ) ) , Identifier +' '+ Format +' '+ Typ ); +// 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 :( @@ -395,14 +396,11 @@ begin if FromRegistry then begin try - - Log.LogStatus( ' A' , ''); - // Res := TResourceStream.Create(HInstance, Identifier, Format); lTextureStream := TResourceStream.Create(HInstance, Identifier, Format); - Log.LogStatus( ' B' , ''); - // TODO : Where does the format come from + // TEmp, untill all code is moved to refactord way.. + Res := TResourceStream( lTextureStream ); except Log.LogStatus( 'ERROR Could not load from resource' , Identifier +' '+ Format +' '+ Typ ); beep; @@ -421,11 +419,6 @@ begin if assigned( lTextureStream ) then begin - Log.LogStatus( ' C - '+Format , ''); - - // TEmp, untill all code is moved to refactord way.. - Res := TResourceStream( lTextureStream ); - TextureB := TBitmap.Create; if Format = 'BMP' then -- cgit v1.2.3 From 707441e6eac0f628f9c61f0130df07c6768ba291 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 20 Sep 2007 11:45:24 +0000 Subject: tidy texture loading. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@421 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 389dd0b0..f01cfd23 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -90,8 +90,8 @@ type TTextureUnit = class private - function LoadBitmap( aSourceStream : TStream; aIMG : TBitMap ): boolean; - function LoadJpeg( aSourceStream : TStream; aIMG : TBitMap ): boolean; + function LoadBitmap( const aSourceStream : TStream; const aIMG : TBitMap ): boolean; + function LoadJpeg( const aSourceStream : TStream; const aIMG : TBitMap ): boolean; public Limit: integer; CreateCacheMipmap: boolean; @@ -312,7 +312,7 @@ begin end; -function TTextureUnit.LoadBitmap( aSourceStream : TStream; aIMG : TBitMap ): boolean; +function TTextureUnit.LoadBitmap( const aSourceStream : TStream; const aIMG : TBitMap ): boolean; begin result := false; try @@ -325,7 +325,7 @@ begin end; end; -function TTextureUnit.LoadJpeg( aSourceStream : TStream; aIMG : TBitMap ): boolean; +function TTextureUnit.LoadJpeg( const aSourceStream : TStream; const aIMG : TBitMap ): boolean; var TextureJ: TJPEGImage; begin @@ -396,7 +396,6 @@ begin if FromRegistry then begin try - // Res := TResourceStream.Create(HInstance, Identifier, Format); lTextureStream := TResourceStream.Create(HInstance, Identifier, Format); // TEmp, untill all code is moved to refactord way.. @@ -413,7 +412,9 @@ begin begin // Get the File Extension... Format := PAnsichar(UpperCase(RightStr(ExtractFileExt(Identifier),3))); - lTextureStream := TFileStream.create( Identifier , fmOpenRead or fmShareDenyNone ); + + lTextureStream := TMemoryStream.create(); + TMemoryStream(lTextureStream).loadfromfile( Identifier ); end; end; @@ -990,7 +991,9 @@ begin if Log.BenchmarkTimeLength[4] >= 1 then Log.LogBenchmark('**********> Texture Load Time Warning - ' + Format + '/' + Identifier + '/' + Typ, 4); - end; // logerror + end; // logerror + +// freeandnil( lTextureStream ); // TODO - jb - free this.. but we cant at the moment :( // {$ENDIF} end; -- cgit v1.2.3 From fd5f18250e6da98c47f23f49b7c4663c9a8bf7d3 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 20 Sep 2007 12:37:24 +0000 Subject: Adding new Resource compiler for lazarus projects.. (other one did not name resources correctly) this resource compiler could be expanded by someone to Parse Ultrastar.rc and compile the lrs file, rather than having it hardcoded in USDXResCompiler other changes, include ability to read the Resource String properly in code generated by lazarus. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@422 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 22 ++++++++++++++-------- 1 file changed, 14 insertions(+), 8 deletions(-) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index f01cfd23..1c436f04 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -154,32 +154,36 @@ begin // find texture entry T := FindTexture(Name); - if T = -1 then begin + 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].Typ := Typ; // inform database that no textures have been loaded into memory - TextureDatabase.Texture[T].Texture.TexNum := -1; + 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 + if (not FromCache) or (FromCache and not Covers.CoverExists(Name)) then + begin // use full texture - if TextureDatabase.Texture[T].Texture.TexNum = -1 then begin + 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 + if FromCache and Covers.CoverExists(Name) then + begin // use cache texture C := Covers.CoverNumber(Name); @@ -381,7 +385,7 @@ var begin lTextureStream := nil; -// Log.LogStatus( 'From Resource - ' + inttostr( integer( FromRegistry ) ) , Identifier +' '+ Format +' '+ Typ ); + Log.LogStatus( 'From Resource - ' + inttostr( integer( FromRegistry ) ) , Identifier +' '+ Format +' '+ Typ ); // {$IFNDEF FPC} // TODO : JB_lazarus eeeew this is a nasty one... @@ -396,10 +400,12 @@ begin 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; -- cgit v1.2.3 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/UTexture.pas') 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 From cf1102dac69a569279ae05dd95426d9e1c544ffc Mon Sep 17 00:00:00 2001 From: jaybinks Date: Sat, 22 Sep 2007 08:15:59 +0000 Subject: minor bug fixes to have lazarus build load resources into SDL_Image correctly... ( lazarus Resources are weak compared to delphi :( ) also Laz build will now run, and main loop works properly. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@429 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 250 ++++++++++++++++++++++++++++------------- 1 file changed, 172 insertions(+), 78 deletions(-) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 78a2573f..3d746813 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -136,58 +136,65 @@ var implementation -uses ULog, DateUtils, UCovers, StrUtils; + +uses ULog, + DateUtils, + UCovers, + {$IFDEF FPC} + LResources, + {$ENDIF} + StrUtils; 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); + 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; +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 +++++++++++++++ @@ -235,50 +242,119 @@ end; function TTextureUnit.LoadImage(Identifier: PChar): PSDL_Surface; var - TexStream: TStream; + TexRWops: PSDL_RWops; dHandle: THandle; + {$IFDEF FPC} + lLazRes : TLResource; + lResData : TStringStream; + {$ELSE} + TexStream: TStream; + {$ENDIF} + begin - Result:=nil; - TexRWops:=nil; - Log.LogStatus( ' start' , Identifier); + Result := nil; + TexRWops := nil; + +// Log.LogStatus( Identifier, 'LoadImage' ); + 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; - +// Log.LogStatus( 'Is File', ' LoadImage' ); 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; + Result:=IMG_Load(Identifier); except - Log.LogStatus( 'ERROR Could not load from resource' , Identifier); + Log.LogStatus( 'ERROR Could not load from file' , Identifier); beep; Exit; end; - Result:=IMG_Load_RW(TexRWops,0); - SDL_FreeRW(TexRWops); - TexStream.Free; + end + else + begin +// Log.LogStatus( 'NOT File', ' LoadImage' ); + + // load from resource stream + {$IFNDEF FPC} + dHandle := FindResource(hInstance, Identifier, 'TEX'); + if dHandle=0 then + begin + Log.LogStatus( 'ERROR Could not find resource' , ' '+ Identifier); + beep; + Exit; + end; + + + TexStream := nil; + try + TexStream := TResourceStream.Create(HInstance, Identifier, 'TEX'); + except + Log.LogStatus( 'ERROR Could not load from resource' , Identifier); + beep; + Exit; + end; + + try + try + 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 assign resource' , Identifier); + beep; + Exit; + end; + + Result:=IMG_Load_RW(TexRWops,0); + SDL_FreeRW(TexRWops); + + finally + if assigned( TexStream ) then + freeandnil( TexStream ); + end; + + + {$ELSE} + lLazRes := LazFindResource( Identifier, 'TEX' ); + if lLazRes <> nil then + begin + lResData := TStringStream.create( lLazRes.value ); + try + lResData.position := 0; + try + TexRWops := SDL_AllocRW; + TexRWops.unknown := TUnknown( lResData ); + TexRWops.seek := SDLStreamSeek; + TexRWops.read := SDLStreamRead; + TexRWops.write := nil; + TexRWops.close := SDLStreamClose; + TexRWops.type_ := 2; + except + Log.LogStatus( 'ERROR Could not assign resource' , Identifier); + beep; + Exit; + end; + + Result:=IMG_Load_RW(TexRWops,0); + SDL_FreeRW(TexRWops); + + finally + freeandnil( lResData ); + end; + end + else + begin + Log.LogStatus( 'NOT found in Resource', ' LoadImage' ); + end; + {$ENDIF} + + end; - Log.LogStatus( ' DONE' , '---'+ Identifier); end; procedure TTextureUnit.AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: PChar); @@ -417,13 +493,19 @@ 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 - TexSurface:=LoadImage(Identifier); + TexSurface := LoadImage(Identifier); if not assigned(TexSurface) then begin Log.LogStatus( 'ERROR Could not load texture' , Identifier +' '+ Format +' '+ Typ ); @@ -797,6 +879,10 @@ var C: integer; // cover Data: array of byte; begin + + if Name = '' then + exit; + // find texture entry T := FindTexture(Name); @@ -939,4 +1025,12 @@ begin end; end; +{$IFDEF FPC} +{$IFDEF win32} +initialization + {$I UltraStar.lrs} +{$ENDIF} +{$ENDIF} + + end. -- cgit v1.2.3 From 739ad9a6dee57375f05dcd20dc59ba2d619f11fa Mon Sep 17 00:00:00 2001 From: jaybinks Date: Mon, 24 Sep 2007 13:31:43 +0000 Subject: fixed song loading in Lazarus.. cant assume variables are initialized as 0 :) in UFile "Done: byte;" was no initialized on lazarus compiler. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@431 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 3d746813..40a3a30b 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -262,7 +262,7 @@ begin if ( FileExists(Identifier) ) then begin // load from file -// Log.LogStatus( 'Is File', ' LoadImage' ); + Log.LogStatus( 'Is File', ' LoadImage' ); try Result:=IMG_Load(Identifier); except @@ -273,7 +273,7 @@ begin end else begin -// Log.LogStatus( 'NOT File', ' LoadImage' ); + Log.LogStatus( 'IS Resource', ' LoadImage' ); // load from resource stream {$IFNDEF FPC} @@ -296,6 +296,7 @@ begin end; try + TexStream.position := 0; try TexRWops := SDL_AllocRW; TexRWops.unknown := TUnknown(TexStream); @@ -309,7 +310,8 @@ begin beep; Exit; end; - + + Log.LogStatus( 'resource Assigned....' , Identifier); Result:=IMG_Load_RW(TexRWops,0); SDL_FreeRW(TexRWops); @@ -340,9 +342,8 @@ begin Exit; end; - Result:=IMG_Load_RW(TexRWops,0); + Result := IMG_Load_RW(TexRWops,0); SDL_FreeRW(TexRWops); - finally freeandnil( lResData ); end; -- cgit v1.2.3 From bf3cb9322bc1f582061b489ddf7a65c681fafed5 Mon Sep 17 00:00:00 2001 From: b1indy Date: Thu, 27 Sep 2007 22:33:35 +0000 Subject: Loading of Covers should now work (should be tested) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@441 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 122 ++++++++++++++++++++++++++++++----------- 1 file changed, 91 insertions(+), 31 deletions(-) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 40a3a30b..76eab676 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -1,4 +1,6 @@ unit UTexture; +// added for easier debug disabling +//{$define blindydebug} // Plain (alpha = 1) // Transparent @@ -111,6 +113,8 @@ type function LoadTexture(Identifier: string): TTexture; overload; function CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; procedure UnloadTexture(Name: string; FromCache: boolean); + Constructor Create; + Destructor Destroy; end; var @@ -133,6 +137,7 @@ var Mipmapping: Boolean; CacheMipmap: array[0..256*256*3-1] of byte; // 3KB + CacheMipmapSurface: PSDL_Surface; implementation @@ -143,7 +148,7 @@ uses ULog, {$IFDEF FPC} LResources, {$ENDIF} - StrUtils; + StrUtils, dialogs; const fmt_rgba: TSDL_Pixelformat=(palette: nil; @@ -182,6 +187,16 @@ const Alpha: 255); +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 @@ -364,10 +379,14 @@ var NeededPixFmt: PSDL_Pixelformat; begin NeededPixFmt:=@fmt_rgba; - if Typ= 'Plain' then NeededPixFmt:=@fmt_rgb; + if Typ= 'Plain' then NeededPixFmt:=@fmt_rgb + else if (Typ='Transparent') or (Typ='Colorized') - then NeededPixFmt:=@fmt_rgba; + then NeededPixFmt:=@fmt_rgba + else + NeededPixFmt:=@fmt_rgb; + if not pixfmt_eq(TexSurface^.format, NeededPixFmt) then begin @@ -489,43 +508,58 @@ var MipmapSurface: PSDL_Surface; newWidth, newHeight: Cardinal; oldWidth, oldHeight: Cardinal; - + kopierindex: 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 + // load texture data into memory + {$ifdef blindydebug} + Log.LogStatus('',' LoadImage('''+Identifier+''') (called by '+Format+')'); + {$endif} TexSurface := LoadImage(Identifier); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + {$endif} if not assigned(TexSurface) then begin Log.LogStatus( 'ERROR Could not load texture' , Identifier +' '+ Format +' '+ Typ ); beep; Exit; end; - - // convert pixel format as needed + // convert pixel format as needed + {$ifdef blindydebug} + Log.LogStatus('',' AdjustPixelFormat'); + {$endif} AdjustPixelFormat(TexSurface, Typ); - - // adjust texture size (scale down, if necessary) - newWidth:=TexSurface^.W; + {$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 + 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; // don't actually understand, if this is needed... // this should definately be changed... together with all this @@ -534,21 +568,43 @@ begin begin if (Covers.W <= 256) and (Covers.H <= 256) then begin + {$ifdef blindydebug} + Log.LogStatus('',' GetScaledTexture('''+inttostr(Covers.W)+''','''+inttostr(Covers.H)+''') (for CacheMipmap)'); + {$endif} MipmapSurface:=GetScaledTexture(TexSurface,Covers.W, Covers.H); - System.Move(MipmapSurface^.pixels,CacheMipmap,Covers.W*Covers.H*3-1); - SDL_FreeSurface(MipmapSurface); + 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 + CacheMipmapSurface:=SDL_CreateRGBSurfaceFrom(@CacheMipmap[0], Covers.W, Covers.H, 24, Covers.W*3, $000000ff, $0000ff00, $00ff0000, 0); + SDL_BlitSurface(MipMapSurface,nil,CacheMipmapSurface,nil); + SDL_FreeSurface(CacheMipmapSurface); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + Log.LogStatus('',' SDL_FreeSurface (CacheMipmap)'); + {$endif} + SDL_FreeSurface(MipmapSurface); + {$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; - - // now we might colorize the whole thing + // now we might colorize the whole thing if Typ='Colorized' then ColorizeTexture(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 @@ -564,21 +620,19 @@ begin // 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); 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 - glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, TexSurface^.pixels); - end; - + // load data into gl texture if (Typ = 'Transparent') or (Typ='Colorized') then begin - glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TexSurface^.pixels); + glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TexSurface.pixels); + end + {if Typ = 'Plain' then} else + begin + glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, TexSurface.pixels); end; { if Typ = 'Transparent Range' then @@ -908,7 +962,13 @@ begin if TextureDatabase.Texture[T].Texture.TexNum = -1 then begin // load texture + {$ifdef blindydebug} + Log.LogStatus('...', 'GetTexture('''+Name+''','''+Typ+''')'); + {$endif} TextureDatabase.Texture[T].Texture := LoadTexture(false, pchar(Name), 'JPG', pchar(Typ), $0); + {$ifdef blindydebug} + Log.LogStatus('done',' '); + {$endif} end; // use texture -- cgit v1.2.3 From 95662b4cb8252ae665de8222762f9fc320f11ea0 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Sat, 29 Sep 2007 01:47:49 +0000 Subject: small fixes for lazarus build. cleanup on some code. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@445 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 76eab676..eb01b4c4 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -980,7 +980,8 @@ begin // use cache texture C := Covers.CoverNumber(Name); - if TextureDatabase.Texture[T].TextureCache.TexNum = -1 then begin + 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); -- cgit v1.2.3 From 82621bfeb1ccbda7425b5d11b8315a9cb91509c2 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Sun, 30 Sep 2007 04:54:03 +0000 Subject: fixed credits screen in lazarus build. ( now looks and operates the same as delphi build ) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@450 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index eb01b4c4..f5169e8c 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -1,6 +1,6 @@ unit UTexture; // added for easier debug disabling -//{$define blindydebug} +{$define blindydebug} // Plain (alpha = 1) // Transparent -- cgit v1.2.3 From b29759fbfdd8a013e3d0a85b578934ebec028c41 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Tue, 2 Oct 2007 04:39:22 +0000 Subject: Fixed linux compilation. Linux is now running in the main loop fine. * no audio playback or input yet... * Timing hack inplace.. that must be replace * bunch of textures not working.. however the play screen is looking similar to windows builds. I hope this dosnt break windows builds to much. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@460 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 2249 ++++++++++++++++++++-------------------- 1 file changed, 1151 insertions(+), 1098 deletions(-) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index f5169e8c..173fbd4c 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -1,1098 +1,1151 @@ -unit UTexture; -// added for easier debug disabling -{$define blindydebug} - -// Plain (alpha = 1) -// Transparent -// Colorized - -// obsolete? -// Transparent Range -// Font (white is drawn, black is transparent) -// Font Outline (Font with darker outline) -// Font Outline 2 (Font with darker outline) -// Font Black (black is drawn, white is transparent) -// Font Gray (gray is drawn, white is transparent) -// Arrow (for arrows, white is white, gray has color, black is transparent); - -interface - -{$I switches.inc} - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - -uses OpenGL12, - {$IFDEF win32} - windows, - {$ENDIF} - Math, - Classes, - SysUtils, - Graphics, - UCommon, - UThemes, - SDL, - sdlutils, - SDL_Image; - - - {$IFDEF Win32} - procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32; - - {$ELSE} - {$ifdef darwin} - const opengl32 = '/System/Library/Frameworks/OpenGL.framework/Libraries/libGL.dylib'; - {$ELSE} - const opengl32 = 'libGL.so' ; // YES Capital GL - {$ENDIF} - - procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32; - {$ENDIF} - -type - TTexture = record - TexNum: integer; - 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; - - TTextureEntry = record - Name: string; - Typ: string; - - // we use normal TTexture, it's easier to implement and if needed - we copy ready data - Texture: TTexture; - TextureCache: TTexture; // 0.5.0 - end; - - TTextureDatabase = record - Texture: array of TTextureEntry; - end; - - TTextureUnit = class - - private - 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; - -// function GetNumberFor - function GetTexture(Name, Typ: string): TTexture; overload; - function GetTexture(Name, Typ: string; FromCache: boolean): TTexture; overload; - function FindTexture(Name: string): integer; - function LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; - function LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; - function LoadTexture(Identifier: string): TTexture; overload; - function CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; - procedure UnloadTexture(Name: string; FromCache: boolean); - Constructor Create; - Destructor Destroy; - end; - -var - Texture: TTextureUnit; - TextureDatabase: TTextureDatabase; - - // this should be in UDisplay?! - PrintScreenData: array[0..1024*768-1] of longword; - - ActTex: GLuint;//integer; - -// 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) - // total 40MB at 2048*2048 - // total 10MB at 1024*1024 - - Mipmapping: Boolean; - - CacheMipmap: array[0..256*256*3-1] of byte; // 3KB - CacheMipmapSurface: PSDL_Surface; - - -implementation - -uses ULog, - DateUtils, - UCovers, - {$IFDEF FPC} - LResources, - {$ENDIF} - StrUtils, dialogs; - -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); - - -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(Identifier: PChar): PSDL_Surface; -var - - TexRWops: PSDL_RWops; - dHandle: THandle; - - {$IFDEF FPC} - lLazRes : TLResource; - lResData : TStringStream; - {$ELSE} - TexStream: TStream; - {$ENDIF} - -begin - Result := nil; - TexRWops := nil; - -// Log.LogStatus( Identifier, 'LoadImage' ); - - if ( FileExists(Identifier) ) then - begin - // load from file - Log.LogStatus( 'Is File', ' LoadImage' ); - try - Result:=IMG_Load(Identifier); - except - Log.LogStatus( 'ERROR Could not load from file' , Identifier); - beep; - Exit; - end; - end - else - begin - Log.LogStatus( 'IS Resource', ' LoadImage' ); - - // load from resource stream - {$IFNDEF FPC} - dHandle := FindResource(hInstance, Identifier, 'TEX'); - if dHandle=0 then - begin - Log.LogStatus( 'ERROR Could not find resource' , ' '+ Identifier); - beep; - Exit; - end; - - - TexStream := nil; - try - TexStream := TResourceStream.Create(HInstance, Identifier, 'TEX'); - except - Log.LogStatus( 'ERROR Could not load from resource' , Identifier); - beep; - Exit; - end; - - try - TexStream.position := 0; - try - 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 assign resource' , Identifier); - beep; - Exit; - end; - - Log.LogStatus( 'resource Assigned....' , Identifier); - Result:=IMG_Load_RW(TexRWops,0); - SDL_FreeRW(TexRWops); - - finally - if assigned( TexStream ) then - freeandnil( TexStream ); - end; - - - {$ELSE} - lLazRes := LazFindResource( Identifier, 'TEX' ); - if lLazRes <> nil then - begin - lResData := TStringStream.create( lLazRes.value ); - try - lResData.position := 0; - try - TexRWops := SDL_AllocRW; - TexRWops.unknown := TUnknown( lResData ); - TexRWops.seek := SDLStreamSeek; - TexRWops.read := SDLStreamRead; - TexRWops.write := nil; - TexRWops.close := SDLStreamClose; - TexRWops.type_ := 2; - except - Log.LogStatus( 'ERROR Could not assign resource' , Identifier); - beep; - Exit; - end; - - Result := IMG_Load_RW(TexRWops,0); - SDL_FreeRW(TexRWops); - finally - freeandnil( lResData ); - end; - end - else - begin - Log.LogStatus( 'NOT found in Resource', ' LoadImage' ); - end; - {$ENDIF} - - - end; -end; - -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 - else - if (Typ='Transparent') or - (Typ='Colorized') - then NeededPixFmt:=@fmt_rgba - else - NeededPixFmt:=@fmt_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); -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 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; - - //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 - Pix[0]:=floor(255*clr[0]); - Pix[1]:=floor(255*clr[1]); - Pix[2]:=floor(255*clr[2]); - end; - end; - -var - DestinationHue: Double; - PixelIndex: Cardinal; -begin - 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 - TexSurface: PSDL_Surface; - MipmapSurface: PSDL_Surface; - newWidth, newHeight: Cardinal; - oldWidth, oldHeight: Cardinal; - kopierindex: 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('',' LoadImage('''+Identifier+''') (called by '+Format+')'); - {$endif} - TexSurface := LoadImage(Identifier); - {$ifdef blindydebug} - Log.LogStatus('',' ok'); - {$endif} - if not assigned(TexSurface) then - begin - Log.LogStatus( 'ERROR Could not load texture' , Identifier +' '+ Format +' '+ Typ ); - beep; - 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; - - // 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 - if (Covers.W <= 256) and (Covers.H <= 256) then - begin - {$ifdef blindydebug} - Log.LogStatus('',' GetScaledTexture('''+inttostr(Covers.W)+''','''+inttostr(Covers.H)+''') (for CacheMipmap)'); - {$endif} - MipmapSurface:=GetScaledTexture(TexSurface,Covers.W, Covers.H); - 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 - CacheMipmapSurface:=SDL_CreateRGBSurfaceFrom(@CacheMipmap[0], Covers.W, Covers.H, 24, Covers.W*3, $000000ff, $0000ff00, $00ff0000, 0); - SDL_BlitSurface(MipMapSurface,nil,CacheMipmapSurface,nil); - SDL_FreeSurface(CacheMipmapSurface); - {$ifdef blindydebug} - Log.LogStatus('',' ok'); - Log.LogStatus('',' SDL_FreeSurface (CacheMipmap)'); - {$endif} - SDL_FreeSurface(MipmapSurface); - {$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; - - // 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 = 'Transparent') or (Typ='Colorized') then begin - glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TexSurface.pixels); - end - {if Typ = 'Plain' then} else - begin - glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, TexSurface.pixels); - end; -{ - 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; -} -{ - if Typ = 'Font' then - // 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; - glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); -} -{ - if Typ = 'Font Outline' then - // no idea... - begin - 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 - Pix := PPix[Position2 * 3]; - - Col := Pix; - if Col < 127 then Col := 127; - - TempA := Pix; - if TempA >= 95 then TempA := 255; - if TempA >= 31 then TempA := 255; - if Pix < 95 then TempA := (Pix * 256) div 96; - - - TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; - TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - end; -} -{ - if Typ = 'Font Outline 2' then - // same as above - begin - 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 - Pix := PPix[Position2 * 3]; - - Col := Pix; - if Col < 31 then Col := 31; - - TempA := Pix; - if TempA >= 31 then TempA := 255; - if Pix < 31 then TempA := Pix * (256 div 32); - - TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; - TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; - 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; - end; - - if Typ = 'Font Black' then - // and so on - begin - // normalnie 0,125s bez niczego 0,015s - 0,030s z pix 0,125s <-- ??? - // dimensions - TextureB.PixelFormat := pf24bit; - 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 TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2*3]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - if Typ = 'Alpha Black Colored' then - // ... hope, noone needs this - begin - TextureB.PixelFormat := pf24bit; - 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 TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2*3]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := (Col div $10000) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Col div $100) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Col and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - if Typ = 'Font Gray' 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 TextureB.Height-1 do begin - for Position2 := 0 to TextureB.Width-1 do begin - Pix := TextureB.Canvas.Pixels[Position2, Position]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - if Typ = 'Arrow' then - begin - 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 - Pix := PPix[Position2 * 3]; - - // transparency - if Pix >= 127 then TempA := 255; - if Pix < 127 then TempA := Pix * 2; - - // ColInt = color intensity - if Pix < 127 then ColInt := 1; - if Pix >= 127 then ColInt := 2 - Pix / 128; - //0.75, 0.6, 0.25 - - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Round(ColInt * 0.75 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := Round(ColInt * 0.6 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Round(ColInt * 0.25 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - - if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); - 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 = 'Note Plain' then - begin - for Position := 0 to TextureB.Height-1 do - begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do - begin - - - - // Skin Patch - // 0-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White - case PPix[Position2*3] of - 0..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); - 192: Pix := Col; - 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); - 255: Pix := $FFFFFF; - end; -// 0.5.0. Original -// case PPix[Position2*3] of -// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; -// 192: Pix := Col; -// 255: Pix := $FFFFFF; -// end; - - - - - - TextureD24[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; - TextureD24[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; - TextureD24[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 3, TextureB.Width, TextureB.Height, 0, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); - end; - - if Typ = 'Note Transparent' then - begin - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - TempA := 255; - - - - //Skin Patch - // 0= Transparent, 1-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White - case PPix[Position2*3] of - 0: TempA := 0; - 1..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); - 192: Pix := Col; - 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); - 255: Pix := $FFFFFF; - end; -// 0.5.0 Original -// case PPix[Position2*3] of -// 0: TempA := 0; -// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; -// 192: Pix := Col; -// 255: Pix := $FFFFFF; -// end; - - - - - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - 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 := oldWidth / newWidth; - Result.TexH := oldHeight / newHeight; - - 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 := Identifier; - - SDL_FreeSurface(TexSurface); - - - Log.BenchmarkEnd(4); - if Log.BenchmarkTimeLength[4] >= 1 then - Log.LogBenchmark('**********> Texture Load Time Warning - ' + Format + '/' + Identifier + '/' + Typ, 4); -end; - - -function TTextureUnit.GetTexture(Name, Typ: string): TTexture; -begin - Result := GetTexture(Name, Typ, true); -end; - -function TTextureUnit.GetTexture(Name, Typ: string; 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); - - 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 - {$ifdef blindydebug} - Log.LogStatus('...', 'GetTexture('''+Name+''','''+Typ+''')'); - {$endif} - TextureDatabase.Texture[T].Texture := LoadTexture(false, pchar(Name), 'JPG', pchar(Typ), $0); - {$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 = -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; - -function TTextureUnit.FindTexture(Name: string): integer; -var - T: integer; // texture -begin - 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); -end; - -function TTextureUnit.LoadTexture(Identifier: string): TTexture; -begin - Result := LoadTexture(false, pchar(Identifier), 'JPG', 'Plain', 0); -end; - -function TTextureUnit.CreateTexture(var Data: array of byte; 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 beep; - 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(Name: string; FromCache: boolean); -var - T: integer; - TexNum: GLuint; -begin - T := FindTexture(Name); - - if not FromCache then begin - TexNum := TextureDatabase.Texture[T].Texture.TexNum; - if TexNum >= 0 then begin - glDeleteTextures(1, @TexNum); - TextureDatabase.Texture[T].Texture.TexNum := -1; -// 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 := -1; -// Log.LogError('Unload texture cache no '+IntToStr(TexNum)); - end; - end; -end; - -{$IFDEF FPC} -{$IFDEF win32} -initialization - {$I UltraStar.lrs} -{$ENDIF} -{$ENDIF} - - -end. +unit UTexture; +// added for easier debug disabling +{$define blindydebug} + +// Plain (alpha = 1) +// Transparent +// Colorized + +// obsolete? +// Transparent Range +// Font (white is drawn, black is transparent) +// Font Outline (Font with darker outline) +// Font Outline 2 (Font with darker outline) +// Font Black (black is drawn, white is transparent) +// Font Gray (gray is drawn, white is transparent) +// Arrow (for arrows, white is white, gray has color, black is transparent); + +interface + +{$I switches.inc} + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +uses OpenGL12, + {$IFDEF win32} + windows, + {$ENDIF} + Math, + Classes, + SysUtils, + Graphics, + UCommon, + UThemes, + SDL, + sdlutils, + SDL_Image; + + + {$IFDEF Win32} + procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32; + +(* + {$ELSE} + {$ifdef darwin} + const opengl32 = '/System/Library/Frameworks/OpenGL.framework/Libraries/libGL.dylib'; + {$ELSE} + const opengl32 = 'libGL.so' ; // YES Capital GL + {$ENDIF} + + procedure glGenTextures(n: GLsizei; var textures: PGLuint); stdcall; external opengl32; +*) + {$ENDIF} + +type + TTexture = record + TexNum: integer; + 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; + + TTextureEntry = record + Name: string; + Typ: string; + + // we use normal TTexture, it's easier to implement and if needed - we copy ready data + Texture: TTexture; + TextureCache: TTexture; // 0.5.0 + end; + + TTextureDatabase = record + Texture: array of TTextureEntry; + end; + + TTextureUnit = class + + private + 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; + +// function GetNumberFor + function GetTexture(Name, Typ: string): TTexture; overload; + function GetTexture(Name, Typ: string; FromCache: boolean): TTexture; overload; + function FindTexture(Name: string): integer; + function LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; + function LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; + function LoadTexture(Identifier: string): TTexture; overload; + function CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; + procedure UnloadTexture(Name: string; FromCache: boolean); + Constructor Create; + Destructor Destroy; + end; + +var + Texture: TTextureUnit; + TextureDatabase: TTextureDatabase; + + // this should be in UDisplay?! + PrintScreenData: array[0..1024*768-1] of longword; + + ActTex: GLuint;//integer; + +// 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) + // total 40MB at 2048*2048 + // total 10MB at 1024*1024 + + Mipmapping: Boolean; + + CacheMipmap: array[0..256*256*3-1] of byte; // 3KB + CacheMipmapSurface: PSDL_Surface; + + +implementation + +uses ULog, + DateUtils, + UCovers, + {$IFDEF FPC} + LResources, + {$ENDIF} + StrUtils, dialogs; + +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); + + +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(Identifier: PChar): PSDL_Surface; +var + + TexRWops: PSDL_RWops; + dHandle: THandle; + + {$IFDEF FPC} + lLazRes : TLResource; + lResData : TStringStream; + {$ELSE} + TexStream: TStream; + {$ENDIF} + +begin + Result := nil; + TexRWops := nil; + +// Log.LogStatus( Identifier, 'LoadImage' ); + + if ( FileExists(Identifier) ) then + begin + // load from file + Log.LogStatus( 'Is File', ' LoadImage' ); + try + Result:=IMG_Load(Identifier); + except + Log.LogStatus( 'ERROR Could not load from file' , Identifier); + beep; + Exit; + end; + end + else + begin + Log.LogStatus( 'IS Resource, because file does not exist.('+Identifier+')', ' LoadImage' ); + + // load from resource stream + {$IFNDEF FPC} + dHandle := FindResource(hInstance, Identifier, 'TEX'); + if dHandle=0 then + begin + Log.LogStatus( 'ERROR Could not find resource' , ' '+ Identifier); + beep; + Exit; + end; + + + TexStream := nil; + try + TexStream := TResourceStream.Create(HInstance, Identifier, 'TEX'); + except + Log.LogStatus( 'ERROR Could not load from resource' , Identifier); + beep; + Exit; + end; + + try + TexStream.position := 0; + try + 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 assign resource' , Identifier); + beep; + Exit; + end; + + Log.LogStatus( 'resource Assigned....' , Identifier); + Result:=IMG_Load_RW(TexRWops,0); + SDL_FreeRW(TexRWops); + + finally + if assigned( TexStream ) then + freeandnil( TexStream ); + end; + + + {$ELSE} + lLazRes := LazFindResource( Identifier, 'TEX' ); + if lLazRes <> nil then + begin + lResData := TStringStream.create( lLazRes.value ); + try + lResData.position := 0; + try + TexRWops := SDL_AllocRW; + TexRWops.unknown := TUnknown( lResData ); + TexRWops.seek := SDLStreamSeek; + TexRWops.read := SDLStreamRead; + TexRWops.write := nil; + TexRWops.close := SDLStreamClose; + TexRWops.type_ := 2; + except + Log.LogStatus( 'ERROR Could not assign resource ('+Identifier+')' , Identifier); + beep; + Exit; + end; + + Result := IMG_Load_RW(TexRWops,0); + SDL_FreeRW(TexRWops); + finally + freeandnil( lResData ); + end; + end + else + begin + Log.LogStatus( 'NOT found in Resource ('+Identifier+')', ' LoadImage' ); + end; + {$ENDIF} + + + end; +end; + +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 + else + if (Typ='Transparent') or + (Typ='Colorized') + then NeededPixFmt:=@fmt_rgba + else + NeededPixFmt:=@fmt_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); +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 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; + + //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 + Pix[0]:=floor(255*clr[0]); + Pix[1]:=floor(255*clr[1]); + Pix[2]:=floor(255*clr[2]); + end; + end; + +var + DestinationHue: Double; + PixelIndex: Cardinal; +begin + 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 + TexSurface: PSDL_Surface; + MipmapSurface: PSDL_Surface; + newWidth, newHeight: Cardinal; + oldWidth, oldHeight: Cardinal; + kopierindex: 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('',' LoadImage('''+Identifier+''') (called by '+Format+')'); + {$endif} + TexSurface := LoadImage(Identifier); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + {$endif} + if not assigned(TexSurface) then + begin + Log.LogStatus( 'ERROR Could not load texture' , Identifier +' '+ Format +' '+ Typ ); + beep; + 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'); + {$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='Plain') then + begin + if (Covers.W <= 256) and (Covers.H <= 256) then + begin + {$ifdef blindydebug} + Log.LogStatus('',' GetScaledTexture('''+inttostr(Covers.W)+''','''+inttostr(Covers.H)+''') (for CacheMipmap)'); + {$endif} + MipmapSurface:=GetScaledTexture(TexSurface,Covers.W, Covers.H); + 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 + CacheMipmapSurface:=SDL_CreateRGBSurfaceFrom(@CacheMipmap[0], Covers.W, Covers.H, 24, Covers.W*3, $000000ff, $0000ff00, $00ff0000, 0); + SDL_BlitSurface(MipMapSurface,nil,CacheMipmapSurface,nil); + SDL_FreeSurface(CacheMipmapSurface); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + Log.LogStatus('',' SDL_FreeSurface (CacheMipmap)'); + {$endif} + SDL_FreeSurface(MipmapSurface); + {$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='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 = 'Transparent') or (Typ='Colorized') then begin + glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TexSurface.pixels); + end + {if Typ = 'Plain' then} else + begin + glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, TexSurface.pixels); + end; + + {$ifdef blindydebug} + Log.LogStatus('',' JB-4'); + {$endif} + +{ + 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; +} +{ + if Typ = 'Font' then + // 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; + glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); +} +{ + if Typ = 'Font Outline' then + // no idea... + begin + 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 + Pix := PPix[Position2 * 3]; + + Col := Pix; + if Col < 127 then Col := 127; + + TempA := Pix; + if TempA >= 95 then TempA := 255; + if TempA >= 31 then TempA := 255; + if Pix < 95 then TempA := (Pix * 256) div 96; + + + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); + end; +} +{ + if Typ = 'Font Outline 2' then + // same as above + begin + 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 + Pix := PPix[Position2 * 3]; + + Col := Pix; + if Col < 31 then Col := 31; + + TempA := Pix; + if TempA >= 31 then TempA := 255; + if Pix < 31 then TempA := Pix * (256 div 32); + + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; + 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; + end; + + if Typ = 'Font Black' then + // and so on + begin + // normalnie 0,125s bez niczego 0,015s - 0,030s z pix 0,125s <-- ??? + // dimensions + TextureB.PixelFormat := pf24bit; + 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 TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2*3]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + if Typ = 'Alpha Black Colored' then + // ... hope, noone needs this + begin + TextureB.PixelFormat := pf24bit; + 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 TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2*3]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := (Col div $10000) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Col div $100) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Col and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + if Typ = 'Font Gray' 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 TextureB.Height-1 do begin + for Position2 := 0 to TextureB.Width-1 do begin + Pix := TextureB.Canvas.Pixels[Position2, Position]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + if Typ = 'Arrow' then + begin + 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 + Pix := PPix[Position2 * 3]; + + // transparency + if Pix >= 127 then TempA := 255; + if Pix < 127 then TempA := Pix * 2; + + // ColInt = color intensity + if Pix < 127 then ColInt := 1; + if Pix >= 127 then ColInt := 2 - Pix / 128; + //0.75, 0.6, 0.25 + + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Round(ColInt * 0.75 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := Round(ColInt * 0.6 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Round(ColInt * 0.25 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + + if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); + 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 = 'Note Plain' then + begin + for Position := 0 to TextureB.Height-1 do + begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do + begin + + + + // Skin Patch + // 0-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White + case PPix[Position2*3] of + 0..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); + 192: Pix := Col; + 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); + 255: Pix := $FFFFFF; + end; +// 0.5.0. Original +// case PPix[Position2*3] of +// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; +// 192: Pix := Col; +// 255: Pix := $FFFFFF; +// end; + + + + + + TextureD24[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; + TextureD24[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; + TextureD24[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 3, TextureB.Width, TextureB.Height, 0, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); + end; + + if Typ = 'Note Transparent' then + begin + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + TempA := 255; + + + + //Skin Patch + // 0= Transparent, 1-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White + case PPix[Position2*3] of + 0: TempA := 0; + 1..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); + 192: Pix := Col; + 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); + 255: Pix := $FFFFFF; + end; +// 0.5.0 Original +// case PPix[Position2*3] of +// 0: TempA := 0; +// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; +// 192: Pix := Col; +// 255: Pix := $FFFFFF; +// end; + + + + + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; +} + + {$ifdef blindydebug} + Log.LogStatus('',' JB-5'); + {$endif} + + + 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 := oldWidth / newWidth; + Result.TexH := oldHeight / newHeight; + + 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; + + {$ifdef blindydebug} + Log.LogStatus('',' JB-6'); + {$endif} + + + // 0.5.0 + 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 - ' + Format + '/' + Identifier + '/' + Typ, 4); + + {$ifdef blindydebug} + Log.LogStatus('',' JB-8'); + {$endif} + +end; + + +function TTextureUnit.GetTexture(Name, Typ: string): TTexture; +begin + Result := GetTexture(Name, Typ, true); +end; + +function TTextureUnit.GetTexture(Name, Typ: string; 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); + + 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 + {$ifdef blindydebug} + Log.LogStatus('...', 'GetTexture('''+Name+''','''+Typ+''')'); + {$endif} + TextureDatabase.Texture[T].Texture := LoadTexture(false, pchar(Name), 'JPG', pchar(Typ), $0); + {$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 = -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; + +function TTextureUnit.FindTexture(Name: string): integer; +var + T: integer; // texture +begin + 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); +end; + +function TTextureUnit.LoadTexture(Identifier: string): TTexture; +begin + Result := LoadTexture(false, pchar(Identifier), 'JPG', 'Plain', 0); +end; + +function TTextureUnit.CreateTexture(var Data: array of byte; 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 beep; + 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(Name: string; FromCache: boolean); +var + T: integer; + TexNum: GLuint; +begin + T := FindTexture(Name); + + if not FromCache then begin + TexNum := TextureDatabase.Texture[T].Texture.TexNum; + if TexNum >= 0 then begin + glDeleteTextures(1, @TexNum); + TextureDatabase.Texture[T].Texture.TexNum := -1; +// 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 := -1; +// Log.LogError('Unload texture cache no '+IntToStr(TexNum)); + end; + end; +end; + +{$IFDEF FPC} +initialization + {$I UltraStar.lrs} +{$ENDIF} + + +end. -- cgit v1.2.3 From ad7420f5a6d81e43bd098ea7c972fd4bc2ca1f26 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Tue, 2 Oct 2007 04:48:42 +0000 Subject: git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@461 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 173fbd4c..b18724bf 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -39,7 +39,7 @@ uses OpenGL12, {$IFDEF Win32} - procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32; +// procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32; (* {$ELSE} -- cgit v1.2.3 From 979d59410f1625a4943a8a84e0f204465800453f Mon Sep 17 00:00:00 2001 From: jaybinks Date: Mon, 8 Oct 2007 00:19:58 +0000 Subject: fixed some stuff for linux build... now its getting close to the look of the windows build... YAY ! see http://www.flickr.com/photos/31428768@N00/sets/72157602234125005/ git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@468 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 36 ++++++++++++++---------------------- 1 file changed, 14 insertions(+), 22 deletions(-) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index b18724bf..5ef29316 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -37,22 +37,6 @@ uses OpenGL12, sdlutils, SDL_Image; - - {$IFDEF Win32} -// procedure glGenTextures(n: GLsizei; var textures: GLuint); stdcall; external opengl32; - -(* - {$ELSE} - {$ifdef darwin} - const opengl32 = '/System/Library/Frameworks/OpenGL.framework/Libraries/libGL.dylib'; - {$ELSE} - const opengl32 = 'libGL.so' ; // YES Capital GL - {$ENDIF} - - procedure glGenTextures(n: GLsizei; var textures: PGLuint); stdcall; external opengl32; -*) - {$ENDIF} - type TTexture = record TexNum: integer; @@ -525,6 +509,7 @@ begin // load texture data into memory {$ifdef blindydebug} + Log.LogStatus('',' ----------------------------------------------------'); Log.LogStatus('',' LoadImage('''+Identifier+''') (called by '+Format+')'); {$endif} TexSurface := LoadImage(Identifier); @@ -537,6 +522,7 @@ begin beep; Exit; end; + // convert pixel format as needed {$ifdef blindydebug} Log.LogStatus('',' AdjustPixelFormat'); @@ -567,7 +553,7 @@ begin end; {$ifdef blindydebug} - Log.LogStatus('',' JB-1'); + Log.LogStatus('',' JB-1 : typ='+Typ); {$endif} @@ -577,6 +563,10 @@ begin // cover cache stuff if (CreateCacheMipmap) and (Typ='Plain') then begin + {$ifdef blindydebug} + Log.LogStatus('',' JB-1 : Minimap'); + {$endif} + if (Covers.W <= 256) and (Covers.H <= 256) then begin {$ifdef blindydebug} @@ -645,10 +635,10 @@ begin // 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} +// {$IFnDEF win32} +// if pointer(ActTex) = nil then +// exit; +// {$endif} glGenTextures(1, @ActTex); @@ -658,7 +648,9 @@ begin glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); // load data into gl texture - if (Typ = 'Transparent') or (Typ='Colorized') then begin + 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 {if Typ = 'Plain' then} else -- cgit v1.2.3 From 391d30716d48dc709f6444b19c008e82311623b9 Mon Sep 17 00:00:00 2001 From: eddie-0815 Date: Thu, 1 Nov 2007 19:34:40 +0000 Subject: Mac OS X version compiles and links. I hope I didn't break too many files on windows/linux. Added switches.inc to all files. Changed many IFDEFs. For Windows-only code please use MSWINDOWS instead of WIN32 now. WIN32 is also used by the Mac port. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@546 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 5ef29316..76d78f5b 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -19,10 +19,6 @@ interface {$I switches.inc} -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - uses OpenGL12, {$IFDEF win32} windows, @@ -131,7 +127,7 @@ implementation uses ULog, DateUtils, UCovers, - {$IFDEF FPC} + {$IFDEF LAZARUS} LResources, {$ENDIF} StrUtils, dialogs; @@ -247,7 +243,7 @@ var TexRWops: PSDL_RWops; dHandle: THandle; - {$IFDEF FPC} + {$IFDEF LAZARUS} lLazRes : TLResource; lResData : TStringStream; {$ELSE} @@ -277,7 +273,7 @@ begin Log.LogStatus( 'IS Resource, because file does not exist.('+Identifier+')', ' LoadImage' ); // load from resource stream - {$IFNDEF FPC} + {$IFDEF WIN32} dHandle := FindResource(hInstance, Identifier, 'TEX'); if dHandle=0 then begin @@ -1134,7 +1130,7 @@ begin end; end; -{$IFDEF FPC} +{$IFDEF LAZARUS} initialization {$I UltraStar.lrs} {$ENDIF} -- cgit v1.2.3 From 99955c78f63d1cb0d8bec666bc33953590a74c8a Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 1 Nov 2007 23:22:01 +0000 Subject: fixed failed builds build:USDX-LAZLIN-75 build:USDX-LAZLIN-76 for some reason we can not use {$MODE Delphi} in an included file. ( Probably because of the way the compier scopes this switch to each pas file ) ive had to revert this part of eddies changes. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@548 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 76d78f5b..f1f7fe47 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -17,6 +17,10 @@ unit UTexture; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} uses OpenGL12, -- cgit v1.2.3 From 8c9c787a1326b90490543bd50b56fce9b89d9807 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Sat, 3 Nov 2007 02:31:06 +0000 Subject: Windows Lazarus Build working again... Lazarus Project file includes the DPR, so that we have a unified Uses Clause ( keep this in mind please ) added "Delphi" to switches git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@560 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 2286 ++++++++++++++++++++-------------------- 1 file changed, 1143 insertions(+), 1143 deletions(-) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index f1f7fe47..ac3aa7d6 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -1,1143 +1,1143 @@ -unit UTexture; -// added for easier debug disabling -{$define blindydebug} - -// Plain (alpha = 1) -// Transparent -// Colorized - -// obsolete? -// Transparent Range -// Font (white is drawn, black is transparent) -// Font Outline (Font with darker outline) -// Font Outline 2 (Font with darker outline) -// Font Black (black is drawn, white is transparent) -// Font Gray (gray is drawn, white is transparent) -// Arrow (for arrows, white is white, gray has color, black is transparent); - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses OpenGL12, - {$IFDEF win32} - windows, - {$ENDIF} - Math, - Classes, - SysUtils, - Graphics, - UCommon, - UThemes, - SDL, - sdlutils, - SDL_Image; - -type - TTexture = record - TexNum: integer; - 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; - - TTextureEntry = record - Name: string; - Typ: string; - - // we use normal TTexture, it's easier to implement and if needed - we copy ready data - Texture: TTexture; - TextureCache: TTexture; // 0.5.0 - end; - - TTextureDatabase = record - Texture: array of TTextureEntry; - end; - - TTextureUnit = class - - private - 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; - -// function GetNumberFor - function GetTexture(Name, Typ: string): TTexture; overload; - function GetTexture(Name, Typ: string; FromCache: boolean): TTexture; overload; - function FindTexture(Name: string): integer; - function LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; - function LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; - function LoadTexture(Identifier: string): TTexture; overload; - function CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; - procedure UnloadTexture(Name: string; FromCache: boolean); - Constructor Create; - Destructor Destroy; - end; - -var - Texture: TTextureUnit; - TextureDatabase: TTextureDatabase; - - // this should be in UDisplay?! - PrintScreenData: array[0..1024*768-1] of longword; - - ActTex: GLuint;//integer; - -// 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) - // total 40MB at 2048*2048 - // total 10MB at 1024*1024 - - Mipmapping: Boolean; - - CacheMipmap: array[0..256*256*3-1] of byte; // 3KB - CacheMipmapSurface: PSDL_Surface; - - -implementation - -uses ULog, - DateUtils, - UCovers, - {$IFDEF LAZARUS} - LResources, - {$ENDIF} - StrUtils, dialogs; - -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); - - -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(Identifier: PChar): PSDL_Surface; -var - - TexRWops: PSDL_RWops; - dHandle: THandle; - - {$IFDEF LAZARUS} - lLazRes : TLResource; - lResData : TStringStream; - {$ELSE} - TexStream: TStream; - {$ENDIF} - -begin - Result := nil; - TexRWops := nil; - -// Log.LogStatus( Identifier, 'LoadImage' ); - - if ( FileExists(Identifier) ) then - begin - // load from file - Log.LogStatus( 'Is File', ' LoadImage' ); - try - Result:=IMG_Load(Identifier); - except - Log.LogStatus( 'ERROR Could not load from file' , Identifier); - beep; - Exit; - end; - end - else - begin - Log.LogStatus( 'IS Resource, because file does not exist.('+Identifier+')', ' LoadImage' ); - - // load from resource stream - {$IFDEF WIN32} - dHandle := FindResource(hInstance, Identifier, 'TEX'); - if dHandle=0 then - begin - Log.LogStatus( 'ERROR Could not find resource' , ' '+ Identifier); - beep; - Exit; - end; - - - TexStream := nil; - try - TexStream := TResourceStream.Create(HInstance, Identifier, 'TEX'); - except - Log.LogStatus( 'ERROR Could not load from resource' , Identifier); - beep; - Exit; - end; - - try - TexStream.position := 0; - try - 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 assign resource' , Identifier); - beep; - Exit; - end; - - Log.LogStatus( 'resource Assigned....' , Identifier); - Result:=IMG_Load_RW(TexRWops,0); - SDL_FreeRW(TexRWops); - - finally - if assigned( TexStream ) then - freeandnil( TexStream ); - end; - - - {$ELSE} - lLazRes := LazFindResource( Identifier, 'TEX' ); - if lLazRes <> nil then - begin - lResData := TStringStream.create( lLazRes.value ); - try - lResData.position := 0; - try - TexRWops := SDL_AllocRW; - TexRWops.unknown := TUnknown( lResData ); - TexRWops.seek := SDLStreamSeek; - TexRWops.read := SDLStreamRead; - TexRWops.write := nil; - TexRWops.close := SDLStreamClose; - TexRWops.type_ := 2; - except - Log.LogStatus( 'ERROR Could not assign resource ('+Identifier+')' , Identifier); - beep; - Exit; - end; - - Result := IMG_Load_RW(TexRWops,0); - SDL_FreeRW(TexRWops); - finally - freeandnil( lResData ); - end; - end - else - begin - Log.LogStatus( 'NOT found in Resource ('+Identifier+')', ' LoadImage' ); - end; - {$ENDIF} - - - end; -end; - -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 - else - if (Typ='Transparent') or - (Typ='Colorized') - then NeededPixFmt:=@fmt_rgba - else - NeededPixFmt:=@fmt_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); -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 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; - - //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 - Pix[0]:=floor(255*clr[0]); - Pix[1]:=floor(255*clr[1]); - Pix[2]:=floor(255*clr[2]); - end; - end; - -var - DestinationHue: Double; - PixelIndex: Cardinal; -begin - 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 - TexSurface: PSDL_Surface; - MipmapSurface: PSDL_Surface; - newWidth, newHeight: Cardinal; - oldWidth, oldHeight: Cardinal; - kopierindex: 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.LogStatus( 'ERROR Could not load texture' , Identifier +' '+ Format +' '+ Typ ); - beep; - 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='Plain') then - begin - {$ifdef blindydebug} - Log.LogStatus('',' JB-1 : Minimap'); - {$endif} - - if (Covers.W <= 256) and (Covers.H <= 256) then - begin - {$ifdef blindydebug} - Log.LogStatus('',' GetScaledTexture('''+inttostr(Covers.W)+''','''+inttostr(Covers.H)+''') (for CacheMipmap)'); - {$endif} - MipmapSurface:=GetScaledTexture(TexSurface,Covers.W, Covers.H); - 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 - CacheMipmapSurface:=SDL_CreateRGBSurfaceFrom(@CacheMipmap[0], Covers.W, Covers.H, 24, Covers.W*3, $000000ff, $0000ff00, $00ff0000, 0); - SDL_BlitSurface(MipMapSurface,nil,CacheMipmapSurface,nil); - SDL_FreeSurface(CacheMipmapSurface); - {$ifdef blindydebug} - Log.LogStatus('',' ok'); - Log.LogStatus('',' SDL_FreeSurface (CacheMipmap)'); - {$endif} - SDL_FreeSurface(MipmapSurface); - {$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='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 = 'Transparent') or - (Typ='Colorized') then - begin - glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TexSurface.pixels); - end - {if Typ = 'Plain' then} else - begin - glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, TexSurface.pixels); - end; - - {$ifdef blindydebug} - Log.LogStatus('',' JB-4'); - {$endif} - -{ - 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; -} -{ - if Typ = 'Font' then - // 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; - glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); -} -{ - if Typ = 'Font Outline' then - // no idea... - begin - 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 - Pix := PPix[Position2 * 3]; - - Col := Pix; - if Col < 127 then Col := 127; - - TempA := Pix; - if TempA >= 95 then TempA := 255; - if TempA >= 31 then TempA := 255; - if Pix < 95 then TempA := (Pix * 256) div 96; - - - TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; - TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - end; -} -{ - if Typ = 'Font Outline 2' then - // same as above - begin - 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 - Pix := PPix[Position2 * 3]; - - Col := Pix; - if Col < 31 then Col := 31; - - TempA := Pix; - if TempA >= 31 then TempA := 255; - if Pix < 31 then TempA := Pix * (256 div 32); - - TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; - TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; - 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; - end; - - if Typ = 'Font Black' then - // and so on - begin - // normalnie 0,125s bez niczego 0,015s - 0,030s z pix 0,125s <-- ??? - // dimensions - TextureB.PixelFormat := pf24bit; - 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 TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2*3]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - if Typ = 'Alpha Black Colored' then - // ... hope, noone needs this - begin - TextureB.PixelFormat := pf24bit; - 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 TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2*3]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := (Col div $10000) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Col div $100) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Col and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - if Typ = 'Font Gray' 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 TextureB.Height-1 do begin - for Position2 := 0 to TextureB.Width-1 do begin - Pix := TextureB.Canvas.Pixels[Position2, Position]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - if Typ = 'Arrow' then - begin - 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 - Pix := PPix[Position2 * 3]; - - // transparency - if Pix >= 127 then TempA := 255; - if Pix < 127 then TempA := Pix * 2; - - // ColInt = color intensity - if Pix < 127 then ColInt := 1; - if Pix >= 127 then ColInt := 2 - Pix / 128; - //0.75, 0.6, 0.25 - - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Round(ColInt * 0.75 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := Round(ColInt * 0.6 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Round(ColInt * 0.25 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - - if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); - 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 = 'Note Plain' then - begin - for Position := 0 to TextureB.Height-1 do - begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do - begin - - - - // Skin Patch - // 0-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White - case PPix[Position2*3] of - 0..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); - 192: Pix := Col; - 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); - 255: Pix := $FFFFFF; - end; -// 0.5.0. Original -// case PPix[Position2*3] of -// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; -// 192: Pix := Col; -// 255: Pix := $FFFFFF; -// end; - - - - - - TextureD24[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; - TextureD24[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; - TextureD24[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 3, TextureB.Width, TextureB.Height, 0, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); - end; - - if Typ = 'Note Transparent' then - begin - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - TempA := 255; - - - - //Skin Patch - // 0= Transparent, 1-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White - case PPix[Position2*3] of - 0: TempA := 0; - 1..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); - 192: Pix := Col; - 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); - 255: Pix := $FFFFFF; - end; -// 0.5.0 Original -// case PPix[Position2*3] of -// 0: TempA := 0; -// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; -// 192: Pix := Col; -// 255: Pix := $FFFFFF; -// end; - - - - - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; -} - - {$ifdef blindydebug} - Log.LogStatus('',' JB-5'); - {$endif} - - - 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 := oldWidth / newWidth; - Result.TexH := oldHeight / newHeight; - - 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; - - {$ifdef blindydebug} - Log.LogStatus('',' JB-6'); - {$endif} - - - // 0.5.0 - 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 - ' + Format + '/' + Identifier + '/' + Typ, 4); - - {$ifdef blindydebug} - Log.LogStatus('',' JB-8'); - {$endif} - -end; - - -function TTextureUnit.GetTexture(Name, Typ: string): TTexture; -begin - Result := GetTexture(Name, Typ, true); -end; - -function TTextureUnit.GetTexture(Name, Typ: string; 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); - - 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 - {$ifdef blindydebug} - Log.LogStatus('...', 'GetTexture('''+Name+''','''+Typ+''')'); - {$endif} - TextureDatabase.Texture[T].Texture := LoadTexture(false, pchar(Name), 'JPG', pchar(Typ), $0); - {$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 = -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; - -function TTextureUnit.FindTexture(Name: string): integer; -var - T: integer; // texture -begin - 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); -end; - -function TTextureUnit.LoadTexture(Identifier: string): TTexture; -begin - Result := LoadTexture(false, pchar(Identifier), 'JPG', 'Plain', 0); -end; - -function TTextureUnit.CreateTexture(var Data: array of byte; 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 beep; - 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(Name: string; FromCache: boolean); -var - T: integer; - TexNum: GLuint; -begin - T := FindTexture(Name); - - if not FromCache then begin - TexNum := TextureDatabase.Texture[T].Texture.TexNum; - if TexNum >= 0 then begin - glDeleteTextures(1, @TexNum); - TextureDatabase.Texture[T].Texture.TexNum := -1; -// 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 := -1; -// Log.LogError('Unload texture cache no '+IntToStr(TexNum)); - end; - end; -end; - -{$IFDEF LAZARUS} -initialization - {$I UltraStar.lrs} -{$ENDIF} - - -end. +unit UTexture; +// added for easier debug disabling +{$define blindydebug} + +// Plain (alpha = 1) +// Transparent +// Colorized + +// obsolete? +// Transparent Range +// Font (white is drawn, black is transparent) +// Font Outline (Font with darker outline) +// Font Outline 2 (Font with darker outline) +// Font Black (black is drawn, white is transparent) +// Font Gray (gray is drawn, white is transparent) +// Arrow (for arrows, white is white, gray has color, black is transparent); + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses OpenGL12, + {$IFDEF win32} + windows, + {$ENDIF} + Math, + Classes, + SysUtils, + Graphics, + UCommon, + UThemes, + SDL, + sdlutils, + SDL_Image; + +type + TTexture = record + TexNum: integer; + 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; + + TTextureEntry = record + Name: string; + Typ: string; + + // we use normal TTexture, it's easier to implement and if needed - we copy ready data + Texture: TTexture; + TextureCache: TTexture; // 0.5.0 + end; + + TTextureDatabase = record + Texture: array of TTextureEntry; + end; + + TTextureUnit = class + + private + 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; + +// function GetNumberFor + function GetTexture(Name, Typ: string): TTexture; overload; + function GetTexture(Name, Typ: string; FromCache: boolean): TTexture; overload; + function FindTexture(Name: string): integer; + function LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; + function LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; + function LoadTexture(Identifier: string): TTexture; overload; + function CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; + procedure UnloadTexture(Name: string; FromCache: boolean); + Constructor Create; + Destructor Destroy; + end; + +var + Texture: TTextureUnit; + TextureDatabase: TTextureDatabase; + + // this should be in UDisplay?! + PrintScreenData: array[0..1024*768-1] of longword; + + ActTex: GLuint;//integer; + +// 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) + // total 40MB at 2048*2048 + // total 10MB at 1024*1024 + + Mipmapping: Boolean; + + CacheMipmap: array[0..256*256*3-1] of byte; // 3KB + CacheMipmapSurface: PSDL_Surface; + + +implementation + +uses ULog, + DateUtils, + UCovers, + {$IFDEF LAZARUS} + LResources, + {$ENDIF} + StrUtils, dialogs; + +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); + + +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(Identifier: PChar): PSDL_Surface; +var + + TexRWops: PSDL_RWops; + dHandle: THandle; + + {$IFDEF LAZARUS} + lLazRes : TLResource; + lResData : TStringStream; + {$ELSE} + TexStream: TStream; + {$ENDIF} + +begin + Result := nil; + TexRWops := nil; + +// Log.LogStatus( Identifier, 'LoadImage' ); + + if ( FileExists(Identifier) ) then + begin + // load from file + Log.LogStatus( 'Is File', ' LoadImage' ); + try + Result:=IMG_Load(Identifier); + except + Log.LogStatus( 'ERROR Could not load from file' , Identifier); + beep; + Exit; + end; + end + else + begin + Log.LogStatus( 'IS Resource, because file does not exist.('+Identifier+')', ' LoadImage' ); + + // load from resource stream + {$IFDEF DELPHI} + dHandle := FindResource(hInstance, Identifier, 'TEX'); + if dHandle=0 then + begin + Log.LogStatus( 'ERROR Could not find resource' , ' '+ Identifier); + beep; + Exit; + end; + + + TexStream := nil; + try + TexStream := TResourceStream.Create(HInstance, Identifier, 'TEX'); + except + Log.LogStatus( 'ERROR Could not load from resource' , Identifier); + beep; + Exit; + end; + + try + TexStream.position := 0; + try + 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 assign resource' , Identifier); + beep; + Exit; + end; + + Log.LogStatus( 'resource Assigned....' , Identifier); + Result:=IMG_Load_RW(TexRWops,0); + SDL_FreeRW(TexRWops); + + finally + if assigned( TexStream ) then + freeandnil( TexStream ); + end; + + + {$ELSE} + lLazRes := LazFindResource( Identifier, 'TEX' ); + if lLazRes <> nil then + begin + lResData := TStringStream.create( lLazRes.value ); + try + lResData.position := 0; + try + TexRWops := SDL_AllocRW; + TexRWops.unknown := TUnknown( lResData ); + TexRWops.seek := SDLStreamSeek; + TexRWops.read := SDLStreamRead; + TexRWops.write := nil; + TexRWops.close := SDLStreamClose; + TexRWops.type_ := 2; + except + Log.LogStatus( 'ERROR Could not assign resource ('+Identifier+')' , Identifier); + beep; + Exit; + end; + + Result := IMG_Load_RW(TexRWops,0); + SDL_FreeRW(TexRWops); + finally + freeandnil( lResData ); + end; + end + else + begin + Log.LogStatus( 'NOT found in Resource ('+Identifier+')', ' LoadImage' ); + end; + {$ENDIF} + + + end; +end; + +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 + else + if (Typ='Transparent') or + (Typ='Colorized') + then NeededPixFmt:=@fmt_rgba + else + NeededPixFmt:=@fmt_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); +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 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; + + //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 + Pix[0]:=floor(255*clr[0]); + Pix[1]:=floor(255*clr[1]); + Pix[2]:=floor(255*clr[2]); + end; + end; + +var + DestinationHue: Double; + PixelIndex: Cardinal; +begin + 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 + TexSurface: PSDL_Surface; + MipmapSurface: PSDL_Surface; + newWidth, newHeight: Cardinal; + oldWidth, oldHeight: Cardinal; + kopierindex: 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.LogStatus( 'ERROR Could not load texture' , Identifier +' '+ Format +' '+ Typ ); + beep; + 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='Plain') then + begin + {$ifdef blindydebug} + Log.LogStatus('',' JB-1 : Minimap'); + {$endif} + + if (Covers.W <= 256) and (Covers.H <= 256) then + begin + {$ifdef blindydebug} + Log.LogStatus('',' GetScaledTexture('''+inttostr(Covers.W)+''','''+inttostr(Covers.H)+''') (for CacheMipmap)'); + {$endif} + MipmapSurface:=GetScaledTexture(TexSurface,Covers.W, Covers.H); + 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 + CacheMipmapSurface:=SDL_CreateRGBSurfaceFrom(@CacheMipmap[0], Covers.W, Covers.H, 24, Covers.W*3, $000000ff, $0000ff00, $00ff0000, 0); + SDL_BlitSurface(MipMapSurface,nil,CacheMipmapSurface,nil); + SDL_FreeSurface(CacheMipmapSurface); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + Log.LogStatus('',' SDL_FreeSurface (CacheMipmap)'); + {$endif} + SDL_FreeSurface(MipmapSurface); + {$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='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 = 'Transparent') or + (Typ='Colorized') then + begin + glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TexSurface.pixels); + end + {if Typ = 'Plain' then} else + begin + glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, TexSurface.pixels); + end; + + {$ifdef blindydebug} + Log.LogStatus('',' JB-4'); + {$endif} + +{ + 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; +} +{ + if Typ = 'Font' then + // 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; + glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); +} +{ + if Typ = 'Font Outline' then + // no idea... + begin + 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 + Pix := PPix[Position2 * 3]; + + Col := Pix; + if Col < 127 then Col := 127; + + TempA := Pix; + if TempA >= 95 then TempA := 255; + if TempA >= 31 then TempA := 255; + if Pix < 95 then TempA := (Pix * 256) div 96; + + + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); + end; +} +{ + if Typ = 'Font Outline 2' then + // same as above + begin + 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 + Pix := PPix[Position2 * 3]; + + Col := Pix; + if Col < 31 then Col := 31; + + TempA := Pix; + if TempA >= 31 then TempA := 255; + if Pix < 31 then TempA := Pix * (256 div 32); + + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; + 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; + end; + + if Typ = 'Font Black' then + // and so on + begin + // normalnie 0,125s bez niczego 0,015s - 0,030s z pix 0,125s <-- ??? + // dimensions + TextureB.PixelFormat := pf24bit; + 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 TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2*3]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + if Typ = 'Alpha Black Colored' then + // ... hope, noone needs this + begin + TextureB.PixelFormat := pf24bit; + 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 TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2*3]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := (Col div $10000) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Col div $100) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Col and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + if Typ = 'Font Gray' 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 TextureB.Height-1 do begin + for Position2 := 0 to TextureB.Width-1 do begin + Pix := TextureB.Canvas.Pixels[Position2, Position]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + if Typ = 'Arrow' then + begin + 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 + Pix := PPix[Position2 * 3]; + + // transparency + if Pix >= 127 then TempA := 255; + if Pix < 127 then TempA := Pix * 2; + + // ColInt = color intensity + if Pix < 127 then ColInt := 1; + if Pix >= 127 then ColInt := 2 - Pix / 128; + //0.75, 0.6, 0.25 + + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Round(ColInt * 0.75 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := Round(ColInt * 0.6 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Round(ColInt * 0.25 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + + if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); + 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 = 'Note Plain' then + begin + for Position := 0 to TextureB.Height-1 do + begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do + begin + + + + // Skin Patch + // 0-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White + case PPix[Position2*3] of + 0..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); + 192: Pix := Col; + 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); + 255: Pix := $FFFFFF; + end; +// 0.5.0. Original +// case PPix[Position2*3] of +// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; +// 192: Pix := Col; +// 255: Pix := $FFFFFF; +// end; + + + + + + TextureD24[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; + TextureD24[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; + TextureD24[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 3, TextureB.Width, TextureB.Height, 0, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); + end; + + if Typ = 'Note Transparent' then + begin + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + TempA := 255; + + + + //Skin Patch + // 0= Transparent, 1-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White + case PPix[Position2*3] of + 0: TempA := 0; + 1..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); + 192: Pix := Col; + 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); + 255: Pix := $FFFFFF; + end; +// 0.5.0 Original +// case PPix[Position2*3] of +// 0: TempA := 0; +// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; +// 192: Pix := Col; +// 255: Pix := $FFFFFF; +// end; + + + + + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; +} + + {$ifdef blindydebug} + Log.LogStatus('',' JB-5'); + {$endif} + + + 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 := oldWidth / newWidth; + Result.TexH := oldHeight / newHeight; + + 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; + + {$ifdef blindydebug} + Log.LogStatus('',' JB-6'); + {$endif} + + + // 0.5.0 + 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 - ' + Format + '/' + Identifier + '/' + Typ, 4); + + {$ifdef blindydebug} + Log.LogStatus('',' JB-8'); + {$endif} + +end; + + +function TTextureUnit.GetTexture(Name, Typ: string): TTexture; +begin + Result := GetTexture(Name, Typ, true); +end; + +function TTextureUnit.GetTexture(Name, Typ: string; 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); + + 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 + {$ifdef blindydebug} + Log.LogStatus('...', 'GetTexture('''+Name+''','''+Typ+''')'); + {$endif} + TextureDatabase.Texture[T].Texture := LoadTexture(false, pchar(Name), 'JPG', pchar(Typ), $0); + {$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 = -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; + +function TTextureUnit.FindTexture(Name: string): integer; +var + T: integer; // texture +begin + 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); +end; + +function TTextureUnit.LoadTexture(Identifier: string): TTexture; +begin + Result := LoadTexture(false, pchar(Identifier), 'JPG', 'Plain', 0); +end; + +function TTextureUnit.CreateTexture(var Data: array of byte; 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 beep; + 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(Name: string; FromCache: boolean); +var + T: integer; + TexNum: GLuint; +begin + T := FindTexture(Name); + + if not FromCache then begin + TexNum := TextureDatabase.Texture[T].Texture.TexNum; + if TexNum >= 0 then begin + glDeleteTextures(1, @TexNum); + TextureDatabase.Texture[T].Texture.TexNum := -1; +// 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 := -1; +// Log.LogError('Unload texture cache no '+IntToStr(TexNum)); + end; + end; +end; + +{$IFDEF LAZARUS} +initialization + {$I UltraStar.lrs} +{$ENDIF} + + +end. -- cgit v1.2.3 From 84a799853df75973fe4560576d9257f20b5bef85 Mon Sep 17 00:00:00 2001 From: eddie-0815 Date: Sat, 3 Nov 2007 08:47:56 +0000 Subject: Changed DELPHI define to IFDEF LAZARUS ... ELSE ... ENDIF. This should work on all Platforms now (I hope). git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@564 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 68 ++++++++++++++++++++---------------------- 1 file changed, 32 insertions(+), 36 deletions(-) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index ac3aa7d6..c3ab0d41 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -277,7 +277,38 @@ begin Log.LogStatus( 'IS Resource, because file does not exist.('+Identifier+')', ' LoadImage' ); // load from resource stream - {$IFDEF DELPHI} + {$IFDEF LAZARUS} + lLazRes := LazFindResource( Identifier, 'TEX' ); + if lLazRes <> nil then + begin + lResData := TStringStream.create( lLazRes.value ); + try + lResData.position := 0; + try + TexRWops := SDL_AllocRW; + TexRWops.unknown := TUnknown( lResData ); + TexRWops.seek := SDLStreamSeek; + TexRWops.read := SDLStreamRead; + TexRWops.write := nil; + TexRWops.close := SDLStreamClose; + TexRWops.type_ := 2; + except + Log.LogStatus( 'ERROR Could not assign resource ('+Identifier+')' , Identifier); + beep; + Exit; + end; + + Result := IMG_Load_RW(TexRWops,0); + SDL_FreeRW(TexRWops); + finally + freeandnil( lResData ); + end; + end + else + begin + Log.LogStatus( 'NOT found in Resource ('+Identifier+')', ' LoadImage' ); + end; + {$ELSE} dHandle := FindResource(hInstance, Identifier, 'TEX'); if dHandle=0 then begin @@ -320,42 +351,7 @@ begin if assigned( TexStream ) then freeandnil( TexStream ); end; - - - {$ELSE} - lLazRes := LazFindResource( Identifier, 'TEX' ); - if lLazRes <> nil then - begin - lResData := TStringStream.create( lLazRes.value ); - try - lResData.position := 0; - try - TexRWops := SDL_AllocRW; - TexRWops.unknown := TUnknown( lResData ); - TexRWops.seek := SDLStreamSeek; - TexRWops.read := SDLStreamRead; - TexRWops.write := nil; - TexRWops.close := SDLStreamClose; - TexRWops.type_ := 2; - except - Log.LogStatus( 'ERROR Could not assign resource ('+Identifier+')' , Identifier); - beep; - Exit; - end; - - Result := IMG_Load_RW(TexRWops,0); - SDL_FreeRW(TexRWops); - finally - freeandnil( lResData ); - end; - end - else - begin - Log.LogStatus( 'NOT found in Resource ('+Identifier+')', ' LoadImage' ); - end; {$ENDIF} - - end; end; -- cgit v1.2.3 From 9edc9535e5570807990e39703dca7c05e6758256 Mon Sep 17 00:00:00 2001 From: eddie-0815 Date: Sun, 4 Nov 2007 15:23:42 +0000 Subject: Added MacResources.pas. Fixed some resource loading issues on OS X. The main screen is still not loading. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@581 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 2281 ++++++++++++++++++++-------------------- 1 file changed, 1142 insertions(+), 1139 deletions(-) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index c3ab0d41..7b537840 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -1,1139 +1,1142 @@ -unit UTexture; -// added for easier debug disabling -{$define blindydebug} - -// Plain (alpha = 1) -// Transparent -// Colorized - -// obsolete? -// Transparent Range -// Font (white is drawn, black is transparent) -// Font Outline (Font with darker outline) -// Font Outline 2 (Font with darker outline) -// Font Black (black is drawn, white is transparent) -// Font Gray (gray is drawn, white is transparent) -// Arrow (for arrows, white is white, gray has color, black is transparent); - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses OpenGL12, - {$IFDEF win32} - windows, - {$ENDIF} - Math, - Classes, - SysUtils, - Graphics, - UCommon, - UThemes, - SDL, - sdlutils, - SDL_Image; - -type - TTexture = record - TexNum: integer; - 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; - - TTextureEntry = record - Name: string; - Typ: string; - - // we use normal TTexture, it's easier to implement and if needed - we copy ready data - Texture: TTexture; - TextureCache: TTexture; // 0.5.0 - end; - - TTextureDatabase = record - Texture: array of TTextureEntry; - end; - - TTextureUnit = class - - private - 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; - -// function GetNumberFor - function GetTexture(Name, Typ: string): TTexture; overload; - function GetTexture(Name, Typ: string; FromCache: boolean): TTexture; overload; - function FindTexture(Name: string): integer; - function LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; - function LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; - function LoadTexture(Identifier: string): TTexture; overload; - function CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; - procedure UnloadTexture(Name: string; FromCache: boolean); - Constructor Create; - Destructor Destroy; - end; - -var - Texture: TTextureUnit; - TextureDatabase: TTextureDatabase; - - // this should be in UDisplay?! - PrintScreenData: array[0..1024*768-1] of longword; - - ActTex: GLuint;//integer; - -// 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) - // total 40MB at 2048*2048 - // total 10MB at 1024*1024 - - Mipmapping: Boolean; - - CacheMipmap: array[0..256*256*3-1] of byte; // 3KB - CacheMipmapSurface: PSDL_Surface; - - -implementation - -uses ULog, - DateUtils, - UCovers, - {$IFDEF LAZARUS} - LResources, - {$ENDIF} - StrUtils, dialogs; - -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); - - -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(Identifier: PChar): PSDL_Surface; -var - - TexRWops: PSDL_RWops; - dHandle: THandle; - - {$IFDEF LAZARUS} - lLazRes : TLResource; - lResData : TStringStream; - {$ELSE} - TexStream: TStream; - {$ENDIF} - -begin - Result := nil; - TexRWops := nil; - -// Log.LogStatus( Identifier, 'LoadImage' ); - - if ( FileExists(Identifier) ) then - begin - // load from file - Log.LogStatus( 'Is File', ' LoadImage' ); - try - Result:=IMG_Load(Identifier); - except - Log.LogStatus( 'ERROR Could not load from file' , Identifier); - beep; - Exit; - end; - end - else - begin - Log.LogStatus( 'IS Resource, because file does not exist.('+Identifier+')', ' LoadImage' ); - - // load from resource stream - {$IFDEF LAZARUS} - lLazRes := LazFindResource( Identifier, 'TEX' ); - if lLazRes <> nil then - begin - lResData := TStringStream.create( lLazRes.value ); - try - lResData.position := 0; - try - TexRWops := SDL_AllocRW; - TexRWops.unknown := TUnknown( lResData ); - TexRWops.seek := SDLStreamSeek; - TexRWops.read := SDLStreamRead; - TexRWops.write := nil; - TexRWops.close := SDLStreamClose; - TexRWops.type_ := 2; - except - Log.LogStatus( 'ERROR Could not assign resource ('+Identifier+')' , Identifier); - beep; - Exit; - end; - - Result := IMG_Load_RW(TexRWops,0); - SDL_FreeRW(TexRWops); - finally - freeandnil( lResData ); - end; - end - else - begin - Log.LogStatus( 'NOT found in Resource ('+Identifier+')', ' LoadImage' ); - end; - {$ELSE} - dHandle := FindResource(hInstance, Identifier, 'TEX'); - if dHandle=0 then - begin - Log.LogStatus( 'ERROR Could not find resource' , ' '+ Identifier); - beep; - Exit; - end; - - - TexStream := nil; - try - TexStream := TResourceStream.Create(HInstance, Identifier, 'TEX'); - except - Log.LogStatus( 'ERROR Could not load from resource' , Identifier); - beep; - Exit; - end; - - try - TexStream.position := 0; - try - 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 assign resource' , Identifier); - beep; - Exit; - end; - - Log.LogStatus( 'resource Assigned....' , Identifier); - Result:=IMG_Load_RW(TexRWops,0); - SDL_FreeRW(TexRWops); - - finally - if assigned( TexStream ) then - freeandnil( TexStream ); - end; - {$ENDIF} - end; -end; - -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 - else - if (Typ='Transparent') or - (Typ='Colorized') - then NeededPixFmt:=@fmt_rgba - else - NeededPixFmt:=@fmt_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); -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 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; - - //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 - Pix[0]:=floor(255*clr[0]); - Pix[1]:=floor(255*clr[1]); - Pix[2]:=floor(255*clr[2]); - end; - end; - -var - DestinationHue: Double; - PixelIndex: Cardinal; -begin - 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 - TexSurface: PSDL_Surface; - MipmapSurface: PSDL_Surface; - newWidth, newHeight: Cardinal; - oldWidth, oldHeight: Cardinal; - kopierindex: 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.LogStatus( 'ERROR Could not load texture' , Identifier +' '+ Format +' '+ Typ ); - beep; - 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='Plain') then - begin - {$ifdef blindydebug} - Log.LogStatus('',' JB-1 : Minimap'); - {$endif} - - if (Covers.W <= 256) and (Covers.H <= 256) then - begin - {$ifdef blindydebug} - Log.LogStatus('',' GetScaledTexture('''+inttostr(Covers.W)+''','''+inttostr(Covers.H)+''') (for CacheMipmap)'); - {$endif} - MipmapSurface:=GetScaledTexture(TexSurface,Covers.W, Covers.H); - 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 - CacheMipmapSurface:=SDL_CreateRGBSurfaceFrom(@CacheMipmap[0], Covers.W, Covers.H, 24, Covers.W*3, $000000ff, $0000ff00, $00ff0000, 0); - SDL_BlitSurface(MipMapSurface,nil,CacheMipmapSurface,nil); - SDL_FreeSurface(CacheMipmapSurface); - {$ifdef blindydebug} - Log.LogStatus('',' ok'); - Log.LogStatus('',' SDL_FreeSurface (CacheMipmap)'); - {$endif} - SDL_FreeSurface(MipmapSurface); - {$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='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 = 'Transparent') or - (Typ='Colorized') then - begin - glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TexSurface.pixels); - end - {if Typ = 'Plain' then} else - begin - glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, TexSurface.pixels); - end; - - {$ifdef blindydebug} - Log.LogStatus('',' JB-4'); - {$endif} - -{ - 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; -} -{ - if Typ = 'Font' then - // 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; - glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); -} -{ - if Typ = 'Font Outline' then - // no idea... - begin - 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 - Pix := PPix[Position2 * 3]; - - Col := Pix; - if Col < 127 then Col := 127; - - TempA := Pix; - if TempA >= 95 then TempA := 255; - if TempA >= 31 then TempA := 255; - if Pix < 95 then TempA := (Pix * 256) div 96; - - - TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; - TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - end; -} -{ - if Typ = 'Font Outline 2' then - // same as above - begin - 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 - Pix := PPix[Position2 * 3]; - - Col := Pix; - if Col < 31 then Col := 31; - - TempA := Pix; - if TempA >= 31 then TempA := 255; - if Pix < 31 then TempA := Pix * (256 div 32); - - TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; - TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; - 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; - end; - - if Typ = 'Font Black' then - // and so on - begin - // normalnie 0,125s bez niczego 0,015s - 0,030s z pix 0,125s <-- ??? - // dimensions - TextureB.PixelFormat := pf24bit; - 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 TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2*3]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - if Typ = 'Alpha Black Colored' then - // ... hope, noone needs this - begin - TextureB.PixelFormat := pf24bit; - 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 TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2*3]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := (Col div $10000) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Col div $100) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Col and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - if Typ = 'Font Gray' 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 TextureB.Height-1 do begin - for Position2 := 0 to TextureB.Width-1 do begin - Pix := TextureB.Canvas.Pixels[Position2, Position]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - if Typ = 'Arrow' then - begin - 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 - Pix := PPix[Position2 * 3]; - - // transparency - if Pix >= 127 then TempA := 255; - if Pix < 127 then TempA := Pix * 2; - - // ColInt = color intensity - if Pix < 127 then ColInt := 1; - if Pix >= 127 then ColInt := 2 - Pix / 128; - //0.75, 0.6, 0.25 - - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Round(ColInt * 0.75 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := Round(ColInt * 0.6 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Round(ColInt * 0.25 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - - if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); - 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 = 'Note Plain' then - begin - for Position := 0 to TextureB.Height-1 do - begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do - begin - - - - // Skin Patch - // 0-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White - case PPix[Position2*3] of - 0..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); - 192: Pix := Col; - 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); - 255: Pix := $FFFFFF; - end; -// 0.5.0. Original -// case PPix[Position2*3] of -// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; -// 192: Pix := Col; -// 255: Pix := $FFFFFF; -// end; - - - - - - TextureD24[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; - TextureD24[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; - TextureD24[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 3, TextureB.Width, TextureB.Height, 0, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); - end; - - if Typ = 'Note Transparent' then - begin - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - TempA := 255; - - - - //Skin Patch - // 0= Transparent, 1-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White - case PPix[Position2*3] of - 0: TempA := 0; - 1..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); - 192: Pix := Col; - 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); - 255: Pix := $FFFFFF; - end; -// 0.5.0 Original -// case PPix[Position2*3] of -// 0: TempA := 0; -// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; -// 192: Pix := Col; -// 255: Pix := $FFFFFF; -// end; - - - - - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; -} - - {$ifdef blindydebug} - Log.LogStatus('',' JB-5'); - {$endif} - - - 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 := oldWidth / newWidth; - Result.TexH := oldHeight / newHeight; - - 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; - - {$ifdef blindydebug} - Log.LogStatus('',' JB-6'); - {$endif} - - - // 0.5.0 - 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 - ' + Format + '/' + Identifier + '/' + Typ, 4); - - {$ifdef blindydebug} - Log.LogStatus('',' JB-8'); - {$endif} - -end; - - -function TTextureUnit.GetTexture(Name, Typ: string): TTexture; -begin - Result := GetTexture(Name, Typ, true); -end; - -function TTextureUnit.GetTexture(Name, Typ: string; 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); - - 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 - {$ifdef blindydebug} - Log.LogStatus('...', 'GetTexture('''+Name+''','''+Typ+''')'); - {$endif} - TextureDatabase.Texture[T].Texture := LoadTexture(false, pchar(Name), 'JPG', pchar(Typ), $0); - {$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 = -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; - -function TTextureUnit.FindTexture(Name: string): integer; -var - T: integer; // texture -begin - 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); -end; - -function TTextureUnit.LoadTexture(Identifier: string): TTexture; -begin - Result := LoadTexture(false, pchar(Identifier), 'JPG', 'Plain', 0); -end; - -function TTextureUnit.CreateTexture(var Data: array of byte; 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 beep; - 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(Name: string; FromCache: boolean); -var - T: integer; - TexNum: GLuint; -begin - T := FindTexture(Name); - - if not FromCache then begin - TexNum := TextureDatabase.Texture[T].Texture.TexNum; - if TexNum >= 0 then begin - glDeleteTextures(1, @TexNum); - TextureDatabase.Texture[T].Texture.TexNum := -1; -// 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 := -1; -// Log.LogError('Unload texture cache no '+IntToStr(TexNum)); - end; - end; -end; - -{$IFDEF LAZARUS} -initialization - {$I UltraStar.lrs} -{$ENDIF} - - -end. +unit UTexture; +// added for easier debug disabling +{$define blindydebug} + +// Plain (alpha = 1) +// Transparent +// Colorized + +// obsolete? +// Transparent Range +// Font (white is drawn, black is transparent) +// Font Outline (Font with darker outline) +// Font Outline 2 (Font with darker outline) +// Font Black (black is drawn, white is transparent) +// Font Gray (gray is drawn, white is transparent) +// Arrow (for arrows, white is white, gray has color, black is transparent); + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses OpenGL12, + {$IFDEF win32} + windows, + {$ENDIF} + Math, + Classes, + SysUtils, + Graphics, + UCommon, + UThemes, + SDL, + sdlutils, + SDL_Image; + +type + TTexture = record + TexNum: integer; + 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; + + TTextureEntry = record + Name: string; + Typ: string; + + // we use normal TTexture, it's easier to implement and if needed - we copy ready data + Texture: TTexture; + TextureCache: TTexture; // 0.5.0 + end; + + TTextureDatabase = record + Texture: array of TTextureEntry; + end; + + TTextureUnit = class + + private + 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; + +// function GetNumberFor + function GetTexture(Name, Typ: string): TTexture; overload; + function GetTexture(Name, Typ: string; FromCache: boolean): TTexture; overload; + function FindTexture(Name: string): integer; + function LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; + function LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; + function LoadTexture(Identifier: string): TTexture; overload; + function CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; + procedure UnloadTexture(Name: string; FromCache: boolean); + Constructor Create; + Destructor Destroy; + end; + +var + Texture: TTextureUnit; + TextureDatabase: TTextureDatabase; + + // this should be in UDisplay?! + PrintScreenData: array[0..1024*768-1] of longword; + + ActTex: GLuint;//integer; + +// 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) + // total 40MB at 2048*2048 + // total 10MB at 1024*1024 + + Mipmapping: Boolean; + + CacheMipmap: array[0..256*256*3-1] of byte; // 3KB + CacheMipmapSurface: PSDL_Surface; + + +implementation + +uses ULog, + DateUtils, + UCovers, + {$IFDEF LAZARUS} + LResources, + {$ENDIF} + {$IFDEF DARWIN} + MacResources, + {$ENDIF} + StrUtils, dialogs; + +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); + + +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(Identifier: PChar): PSDL_Surface; +var + + TexRWops: PSDL_RWops; + dHandle: THandle; + + {$IFDEF LAZARUS} + lLazRes : TLResource; + lResData : TStringStream; + {$ELSE} + TexStream: TStream; + {$ENDIF} + +begin + Result := nil; + TexRWops := nil; + +// Log.LogStatus( Identifier, 'LoadImage' ); + + if ( FileExists(Identifier) ) then + begin + // load from file + Log.LogStatus( 'Is File', ' LoadImage' ); + try + Result:=IMG_Load(Identifier); + except + Log.LogStatus( 'ERROR Could not load from file' , Identifier); + beep; + Exit; + end; + end + else + begin + Log.LogStatus( 'IS Resource, because file does not exist.('+Identifier+')', ' LoadImage' ); + + // load from resource stream + {$IFDEF LAZARUS} + lLazRes := LazFindResource( Identifier, 'TEX' ); + if lLazRes <> nil then + begin + lResData := TStringStream.create( lLazRes.value ); + try + lResData.position := 0; + try + TexRWops := SDL_AllocRW; + TexRWops.unknown := TUnknown( lResData ); + TexRWops.seek := SDLStreamSeek; + TexRWops.read := SDLStreamRead; + TexRWops.write := nil; + TexRWops.close := SDLStreamClose; + TexRWops.type_ := 2; + except + Log.LogStatus( 'ERROR Could not assign resource ('+Identifier+')' , Identifier); + beep; + Exit; + end; + + Result := IMG_Load_RW(TexRWops,0); + SDL_FreeRW(TexRWops); + finally + freeandnil( lResData ); + end; + end + else + begin + Log.LogStatus( 'NOT found in Resource ('+Identifier+')', ' LoadImage' ); + end; + {$ELSE} + dHandle := FindResource(hInstance, Identifier, 'TEX'); + if dHandle=0 then + begin + Log.LogStatus( 'ERROR Could not find resource' , ' '+ Identifier); + beep; + Exit; + end; + + + TexStream := nil; + try + TexStream := TResourceStream.Create(HInstance, Identifier, 'TEX'); + except + Log.LogStatus( 'ERROR Could not load from resource' , Identifier); + beep; + Exit; + end; + + try + TexStream.position := 0; + try + 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 assign resource' , Identifier); + beep; + Exit; + end; + + Log.LogStatus( 'resource Assigned....' , Identifier); + Result:=IMG_Load_RW(TexRWops,0); + SDL_FreeRW(TexRWops); + + finally + if assigned( TexStream ) then + freeandnil( TexStream ); + end; + {$ENDIF} + end; +end; + +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 + else + if (Typ='Transparent') or + (Typ='Colorized') + then NeededPixFmt:=@fmt_rgba + else + NeededPixFmt:=@fmt_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); +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 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; + + //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 + Pix[0]:=floor(255*clr[0]); + Pix[1]:=floor(255*clr[1]); + Pix[2]:=floor(255*clr[2]); + end; + end; + +var + DestinationHue: Double; + PixelIndex: Cardinal; +begin + 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 + TexSurface: PSDL_Surface; + MipmapSurface: PSDL_Surface; + newWidth, newHeight: Cardinal; + oldWidth, oldHeight: Cardinal; + kopierindex: 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.LogStatus( 'ERROR Could not load texture' , Identifier +' '+ Format +' '+ Typ ); + beep; + 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='Plain') then + begin + {$ifdef blindydebug} + Log.LogStatus('',' JB-1 : Minimap'); + {$endif} + + if (Covers.W <= 256) and (Covers.H <= 256) then + begin + {$ifdef blindydebug} + Log.LogStatus('',' GetScaledTexture('''+inttostr(Covers.W)+''','''+inttostr(Covers.H)+''') (for CacheMipmap)'); + {$endif} + MipmapSurface:=GetScaledTexture(TexSurface,Covers.W, Covers.H); + 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 + CacheMipmapSurface:=SDL_CreateRGBSurfaceFrom(@CacheMipmap[0], Covers.W, Covers.H, 24, Covers.W*3, $000000ff, $0000ff00, $00ff0000, 0); + SDL_BlitSurface(MipMapSurface,nil,CacheMipmapSurface,nil); + SDL_FreeSurface(CacheMipmapSurface); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + Log.LogStatus('',' SDL_FreeSurface (CacheMipmap)'); + {$endif} + SDL_FreeSurface(MipmapSurface); + {$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='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 = 'Transparent') or + (Typ='Colorized') then + begin + glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TexSurface.pixels); + end + {if Typ = 'Plain' then} else + begin + glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, TexSurface.pixels); + end; + + {$ifdef blindydebug} + Log.LogStatus('',' JB-4'); + {$endif} + +{ + 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; +} +{ + if Typ = 'Font' then + // 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; + glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); +} +{ + if Typ = 'Font Outline' then + // no idea... + begin + 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 + Pix := PPix[Position2 * 3]; + + Col := Pix; + if Col < 127 then Col := 127; + + TempA := Pix; + if TempA >= 95 then TempA := 255; + if TempA >= 31 then TempA := 255; + if Pix < 95 then TempA := (Pix * 256) div 96; + + + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); + end; +} +{ + if Typ = 'Font Outline 2' then + // same as above + begin + 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 + Pix := PPix[Position2 * 3]; + + Col := Pix; + if Col < 31 then Col := 31; + + TempA := Pix; + if TempA >= 31 then TempA := 255; + if Pix < 31 then TempA := Pix * (256 div 32); + + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; + 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; + end; + + if Typ = 'Font Black' then + // and so on + begin + // normalnie 0,125s bez niczego 0,015s - 0,030s z pix 0,125s <-- ??? + // dimensions + TextureB.PixelFormat := pf24bit; + 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 TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2*3]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + if Typ = 'Alpha Black Colored' then + // ... hope, noone needs this + begin + TextureB.PixelFormat := pf24bit; + 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 TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2*3]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := (Col div $10000) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Col div $100) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Col and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + if Typ = 'Font Gray' 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 TextureB.Height-1 do begin + for Position2 := 0 to TextureB.Width-1 do begin + Pix := TextureB.Canvas.Pixels[Position2, Position]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + if Typ = 'Arrow' then + begin + 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 + Pix := PPix[Position2 * 3]; + + // transparency + if Pix >= 127 then TempA := 255; + if Pix < 127 then TempA := Pix * 2; + + // ColInt = color intensity + if Pix < 127 then ColInt := 1; + if Pix >= 127 then ColInt := 2 - Pix / 128; + //0.75, 0.6, 0.25 + + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Round(ColInt * 0.75 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := Round(ColInt * 0.6 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Round(ColInt * 0.25 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + + if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); + 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 = 'Note Plain' then + begin + for Position := 0 to TextureB.Height-1 do + begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do + begin + + + + // Skin Patch + // 0-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White + case PPix[Position2*3] of + 0..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); + 192: Pix := Col; + 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); + 255: Pix := $FFFFFF; + end; +// 0.5.0. Original +// case PPix[Position2*3] of +// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; +// 192: Pix := Col; +// 255: Pix := $FFFFFF; +// end; + + + + + + TextureD24[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; + TextureD24[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; + TextureD24[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 3, TextureB.Width, TextureB.Height, 0, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); + end; + + if Typ = 'Note Transparent' then + begin + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + TempA := 255; + + + + //Skin Patch + // 0= Transparent, 1-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White + case PPix[Position2*3] of + 0: TempA := 0; + 1..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); + 192: Pix := Col; + 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); + 255: Pix := $FFFFFF; + end; +// 0.5.0 Original +// case PPix[Position2*3] of +// 0: TempA := 0; +// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; +// 192: Pix := Col; +// 255: Pix := $FFFFFF; +// end; + + + + + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; +} + + {$ifdef blindydebug} + Log.LogStatus('',' JB-5'); + {$endif} + + + 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 := oldWidth / newWidth; + Result.TexH := oldHeight / newHeight; + + 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; + + {$ifdef blindydebug} + Log.LogStatus('',' JB-6'); + {$endif} + + + // 0.5.0 + 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 - ' + Format + '/' + Identifier + '/' + Typ, 4); + + {$ifdef blindydebug} + Log.LogStatus('',' JB-8'); + {$endif} + +end; + + +function TTextureUnit.GetTexture(Name, Typ: string): TTexture; +begin + Result := GetTexture(Name, Typ, true); +end; + +function TTextureUnit.GetTexture(Name, Typ: string; 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); + + 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 + {$ifdef blindydebug} + Log.LogStatus('...', 'GetTexture('''+Name+''','''+Typ+''')'); + {$endif} + TextureDatabase.Texture[T].Texture := LoadTexture(false, pchar(Name), 'JPG', pchar(Typ), $0); + {$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 = -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; + +function TTextureUnit.FindTexture(Name: string): integer; +var + T: integer; // texture +begin + 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); +end; + +function TTextureUnit.LoadTexture(Identifier: string): TTexture; +begin + Result := LoadTexture(false, pchar(Identifier), 'JPG', 'Plain', 0); +end; + +function TTextureUnit.CreateTexture(var Data: array of byte; 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 beep; + 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(Name: string; FromCache: boolean); +var + T: integer; + TexNum: GLuint; +begin + T := FindTexture(Name); + + if not FromCache then begin + TexNum := TextureDatabase.Texture[T].Texture.TexNum; + if TexNum >= 0 then begin + glDeleteTextures(1, @TexNum); + TextureDatabase.Texture[T].Texture.TexNum := -1; +// 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 := -1; +// Log.LogError('Unload texture cache no '+IntToStr(TexNum)); + end; + end; +end; + +{$IFDEF LAZARUS} +initialization + {$I UltraStar.lrs} +{$ENDIF} + + +end. -- cgit v1.2.3 From 80f3f5fe438a48b94a2ec9c70e6ff8475ede4ff3 Mon Sep 17 00:00:00 2001 From: b1indy Date: Fri, 23 Nov 2007 21:32:44 +0000 Subject: checking for delta=0 in col2h git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@652 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 2 ++ 1 file changed, 2 insertions(+) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 7b537840..445c7d4f 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -427,6 +427,8 @@ procedure TTextureUnit.ColorizeTexture(TexSurface: PSDL_Surface; Col: Cardinal); clr[2]:=(Color and $ff)/255; hls[1]:=maxvalue(clr); delta:=hls[1]-minvalue(clr); + // this is for safety reasons + if delta = 0.0 then delta:=0.000000000001; 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; -- cgit v1.2.3 From 0f482be3ee9588081363963b382faabcef07c295 Mon Sep 17 00:00:00 2001 From: tobigun Date: Tue, 18 Dec 2007 23:47:42 +0000 Subject: Added a missing override for the destroy-destructor git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@730 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 445c7d4f..8701673e 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -100,7 +100,7 @@ type function CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; procedure UnloadTexture(Name: string; FromCache: boolean); Constructor Create; - Destructor Destroy; + Destructor Destroy; override; end; var -- cgit v1.2.3 From a00122fe60de966751b637477ac8e0a4fdcfbf4b Mon Sep 17 00:00:00 2001 From: jaybinks Date: Thu, 20 Dec 2007 23:59:59 +0000 Subject: removed a bunch of debugging from usdx startup. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@738 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 8701673e..f57c9c15 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -1,6 +1,6 @@ unit UTexture; // added for easier debug disabling -{$define blindydebug} +{$undefine blindydebug} // Plain (alpha = 1) // Transparent -- cgit v1.2.3 From bb30a9bec3566db0a8a8a65a0afe6cf864cdeb11 Mon Sep 17 00:00:00 2001 From: b1indy Date: Sat, 22 Dec 2007 16:53:25 +0000 Subject: fixed a "typo" git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@740 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index f57c9c15..82dedf45 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -1,6 +1,6 @@ unit UTexture; // added for easier debug disabling -{$undefine blindydebug} +{$undef blindydebug} // Plain (alpha = 1) // Transparent -- cgit v1.2.3 From ffd5faaf020fa5f8504c2b8b90e5daf93ed1edaf Mon Sep 17 00:00:00 2001 From: tobigun Date: Mon, 28 Jan 2008 09:31:22 +0000 Subject: TTexture.Z was never initialized (TTextureUnit.LoadTexture). In FPC (not in delphi) this resulted in a floating-point error when calling glVertex3f(x1, y1, z) in DrawTexture (UDrawTexture.pas) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@807 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 2289 ++++++++++++++++++++-------------------- 1 file changed, 1145 insertions(+), 1144 deletions(-) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 82dedf45..770b88bd 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -1,1144 +1,1145 @@ -unit UTexture; -// added for easier debug disabling -{$undef blindydebug} - -// Plain (alpha = 1) -// Transparent -// Colorized - -// obsolete? -// Transparent Range -// Font (white is drawn, black is transparent) -// Font Outline (Font with darker outline) -// Font Outline 2 (Font with darker outline) -// Font Black (black is drawn, white is transparent) -// Font Gray (gray is drawn, white is transparent) -// Arrow (for arrows, white is white, gray has color, black is transparent); - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses OpenGL12, - {$IFDEF win32} - windows, - {$ENDIF} - Math, - Classes, - SysUtils, - Graphics, - UCommon, - UThemes, - SDL, - sdlutils, - SDL_Image; - -type - TTexture = record - TexNum: integer; - 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; - - TTextureEntry = record - Name: string; - Typ: string; - - // we use normal TTexture, it's easier to implement and if needed - we copy ready data - Texture: TTexture; - TextureCache: TTexture; // 0.5.0 - end; - - TTextureDatabase = record - Texture: array of TTextureEntry; - end; - - TTextureUnit = class - - private - 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; - -// function GetNumberFor - function GetTexture(Name, Typ: string): TTexture; overload; - function GetTexture(Name, Typ: string; FromCache: boolean): TTexture; overload; - function FindTexture(Name: string): integer; - function LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; - function LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; - function LoadTexture(Identifier: string): TTexture; overload; - function CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; - procedure UnloadTexture(Name: string; FromCache: boolean); - Constructor Create; - Destructor Destroy; override; - end; - -var - Texture: TTextureUnit; - TextureDatabase: TTextureDatabase; - - // this should be in UDisplay?! - PrintScreenData: array[0..1024*768-1] of longword; - - ActTex: GLuint;//integer; - -// 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) - // total 40MB at 2048*2048 - // total 10MB at 1024*1024 - - Mipmapping: Boolean; - - CacheMipmap: array[0..256*256*3-1] of byte; // 3KB - CacheMipmapSurface: PSDL_Surface; - - -implementation - -uses ULog, - DateUtils, - UCovers, - {$IFDEF LAZARUS} - LResources, - {$ENDIF} - {$IFDEF DARWIN} - MacResources, - {$ENDIF} - StrUtils, dialogs; - -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); - - -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(Identifier: PChar): PSDL_Surface; -var - - TexRWops: PSDL_RWops; - dHandle: THandle; - - {$IFDEF LAZARUS} - lLazRes : TLResource; - lResData : TStringStream; - {$ELSE} - TexStream: TStream; - {$ENDIF} - -begin - Result := nil; - TexRWops := nil; - -// Log.LogStatus( Identifier, 'LoadImage' ); - - if ( FileExists(Identifier) ) then - begin - // load from file - Log.LogStatus( 'Is File', ' LoadImage' ); - try - Result:=IMG_Load(Identifier); - except - Log.LogStatus( 'ERROR Could not load from file' , Identifier); - beep; - Exit; - end; - end - else - begin - Log.LogStatus( 'IS Resource, because file does not exist.('+Identifier+')', ' LoadImage' ); - - // load from resource stream - {$IFDEF LAZARUS} - lLazRes := LazFindResource( Identifier, 'TEX' ); - if lLazRes <> nil then - begin - lResData := TStringStream.create( lLazRes.value ); - try - lResData.position := 0; - try - TexRWops := SDL_AllocRW; - TexRWops.unknown := TUnknown( lResData ); - TexRWops.seek := SDLStreamSeek; - TexRWops.read := SDLStreamRead; - TexRWops.write := nil; - TexRWops.close := SDLStreamClose; - TexRWops.type_ := 2; - except - Log.LogStatus( 'ERROR Could not assign resource ('+Identifier+')' , Identifier); - beep; - Exit; - end; - - Result := IMG_Load_RW(TexRWops,0); - SDL_FreeRW(TexRWops); - finally - freeandnil( lResData ); - end; - end - else - begin - Log.LogStatus( 'NOT found in Resource ('+Identifier+')', ' LoadImage' ); - end; - {$ELSE} - dHandle := FindResource(hInstance, Identifier, 'TEX'); - if dHandle=0 then - begin - Log.LogStatus( 'ERROR Could not find resource' , ' '+ Identifier); - beep; - Exit; - end; - - - TexStream := nil; - try - TexStream := TResourceStream.Create(HInstance, Identifier, 'TEX'); - except - Log.LogStatus( 'ERROR Could not load from resource' , Identifier); - beep; - Exit; - end; - - try - TexStream.position := 0; - try - 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 assign resource' , Identifier); - beep; - Exit; - end; - - Log.LogStatus( 'resource Assigned....' , Identifier); - Result:=IMG_Load_RW(TexRWops,0); - SDL_FreeRW(TexRWops); - - finally - if assigned( TexStream ) then - freeandnil( TexStream ); - end; - {$ENDIF} - end; -end; - -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 - else - if (Typ='Transparent') or - (Typ='Colorized') - then NeededPixFmt:=@fmt_rgba - else - NeededPixFmt:=@fmt_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); -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 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); - // this is for safety reasons - if delta = 0.0 then delta:=0.000000000001; - 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; - - //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 - Pix[0]:=floor(255*clr[0]); - Pix[1]:=floor(255*clr[1]); - Pix[2]:=floor(255*clr[2]); - end; - end; - -var - DestinationHue: Double; - PixelIndex: Cardinal; -begin - 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 - TexSurface: PSDL_Surface; - MipmapSurface: PSDL_Surface; - newWidth, newHeight: Cardinal; - oldWidth, oldHeight: Cardinal; - kopierindex: 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.LogStatus( 'ERROR Could not load texture' , Identifier +' '+ Format +' '+ Typ ); - beep; - 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='Plain') then - begin - {$ifdef blindydebug} - Log.LogStatus('',' JB-1 : Minimap'); - {$endif} - - if (Covers.W <= 256) and (Covers.H <= 256) then - begin - {$ifdef blindydebug} - Log.LogStatus('',' GetScaledTexture('''+inttostr(Covers.W)+''','''+inttostr(Covers.H)+''') (for CacheMipmap)'); - {$endif} - MipmapSurface:=GetScaledTexture(TexSurface,Covers.W, Covers.H); - 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 - CacheMipmapSurface:=SDL_CreateRGBSurfaceFrom(@CacheMipmap[0], Covers.W, Covers.H, 24, Covers.W*3, $000000ff, $0000ff00, $00ff0000, 0); - SDL_BlitSurface(MipMapSurface,nil,CacheMipmapSurface,nil); - SDL_FreeSurface(CacheMipmapSurface); - {$ifdef blindydebug} - Log.LogStatus('',' ok'); - Log.LogStatus('',' SDL_FreeSurface (CacheMipmap)'); - {$endif} - SDL_FreeSurface(MipmapSurface); - {$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='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 = 'Transparent') or - (Typ='Colorized') then - begin - glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TexSurface.pixels); - end - {if Typ = 'Plain' then} else - begin - glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, TexSurface.pixels); - end; - - {$ifdef blindydebug} - Log.LogStatus('',' JB-4'); - {$endif} - -{ - 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; -} -{ - if Typ = 'Font' then - // 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; - glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); -} -{ - if Typ = 'Font Outline' then - // no idea... - begin - 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 - Pix := PPix[Position2 * 3]; - - Col := Pix; - if Col < 127 then Col := 127; - - TempA := Pix; - if TempA >= 95 then TempA := 255; - if TempA >= 31 then TempA := 255; - if Pix < 95 then TempA := (Pix * 256) div 96; - - - TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; - TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - end; -} -{ - if Typ = 'Font Outline 2' then - // same as above - begin - 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 - Pix := PPix[Position2 * 3]; - - Col := Pix; - if Col < 31 then Col := 31; - - TempA := Pix; - if TempA >= 31 then TempA := 255; - if Pix < 31 then TempA := Pix * (256 div 32); - - TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; - TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; - 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; - end; - - if Typ = 'Font Black' then - // and so on - begin - // normalnie 0,125s bez niczego 0,015s - 0,030s z pix 0,125s <-- ??? - // dimensions - TextureB.PixelFormat := pf24bit; - 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 TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2*3]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - if Typ = 'Alpha Black Colored' then - // ... hope, noone needs this - begin - TextureB.PixelFormat := pf24bit; - 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 TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2*3]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := (Col div $10000) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Col div $100) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Col and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - if Typ = 'Font Gray' 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 TextureB.Height-1 do begin - for Position2 := 0 to TextureB.Width-1 do begin - Pix := TextureB.Canvas.Pixels[Position2, Position]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - if Typ = 'Arrow' then - begin - 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 - Pix := PPix[Position2 * 3]; - - // transparency - if Pix >= 127 then TempA := 255; - if Pix < 127 then TempA := Pix * 2; - - // ColInt = color intensity - if Pix < 127 then ColInt := 1; - if Pix >= 127 then ColInt := 2 - Pix / 128; - //0.75, 0.6, 0.25 - - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Round(ColInt * 0.75 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := Round(ColInt * 0.6 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Round(ColInt * 0.25 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - - if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); - 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 = 'Note Plain' then - begin - for Position := 0 to TextureB.Height-1 do - begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do - begin - - - - // Skin Patch - // 0-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White - case PPix[Position2*3] of - 0..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); - 192: Pix := Col; - 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); - 255: Pix := $FFFFFF; - end; -// 0.5.0. Original -// case PPix[Position2*3] of -// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; -// 192: Pix := Col; -// 255: Pix := $FFFFFF; -// end; - - - - - - TextureD24[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; - TextureD24[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; - TextureD24[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 3, TextureB.Width, TextureB.Height, 0, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); - end; - - if Typ = 'Note Transparent' then - begin - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - TempA := 255; - - - - //Skin Patch - // 0= Transparent, 1-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White - case PPix[Position2*3] of - 0: TempA := 0; - 1..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); - 192: Pix := Col; - 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); - 255: Pix := $FFFFFF; - end; -// 0.5.0 Original -// case PPix[Position2*3] of -// 0: TempA := 0; -// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; -// 192: Pix := Col; -// 255: Pix := $FFFFFF; -// end; - - - - - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; -} - - {$ifdef blindydebug} - Log.LogStatus('',' JB-5'); - {$endif} - - - 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 := oldWidth / newWidth; - Result.TexH := oldHeight / newHeight; - - 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; - - {$ifdef blindydebug} - Log.LogStatus('',' JB-6'); - {$endif} - - - // 0.5.0 - 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 - ' + Format + '/' + Identifier + '/' + Typ, 4); - - {$ifdef blindydebug} - Log.LogStatus('',' JB-8'); - {$endif} - -end; - - -function TTextureUnit.GetTexture(Name, Typ: string): TTexture; -begin - Result := GetTexture(Name, Typ, true); -end; - -function TTextureUnit.GetTexture(Name, Typ: string; 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); - - 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 - {$ifdef blindydebug} - Log.LogStatus('...', 'GetTexture('''+Name+''','''+Typ+''')'); - {$endif} - TextureDatabase.Texture[T].Texture := LoadTexture(false, pchar(Name), 'JPG', pchar(Typ), $0); - {$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 = -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; - -function TTextureUnit.FindTexture(Name: string): integer; -var - T: integer; // texture -begin - 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); -end; - -function TTextureUnit.LoadTexture(Identifier: string): TTexture; -begin - Result := LoadTexture(false, pchar(Identifier), 'JPG', 'Plain', 0); -end; - -function TTextureUnit.CreateTexture(var Data: array of byte; 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 beep; - 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(Name: string; FromCache: boolean); -var - T: integer; - TexNum: GLuint; -begin - T := FindTexture(Name); - - if not FromCache then begin - TexNum := TextureDatabase.Texture[T].Texture.TexNum; - if TexNum >= 0 then begin - glDeleteTextures(1, @TexNum); - TextureDatabase.Texture[T].Texture.TexNum := -1; -// 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 := -1; -// Log.LogError('Unload texture cache no '+IntToStr(TexNum)); - end; - end; -end; - -{$IFDEF LAZARUS} -initialization - {$I UltraStar.lrs} -{$ENDIF} - - -end. +unit UTexture; +// added for easier debug disabling +{$undef blindydebug} + +// Plain (alpha = 1) +// Transparent +// Colorized + +// obsolete? +// Transparent Range +// Font (white is drawn, black is transparent) +// Font Outline (Font with darker outline) +// Font Outline 2 (Font with darker outline) +// Font Black (black is drawn, white is transparent) +// Font Gray (gray is drawn, white is transparent) +// Arrow (for arrows, white is white, gray has color, black is transparent); + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses OpenGL12, + {$IFDEF win32} + windows, + {$ENDIF} + Math, + Classes, + SysUtils, + Graphics, + UCommon, + UThemes, + SDL, + sdlutils, + SDL_Image; + +type + TTexture = record + TexNum: integer; + 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; + + TTextureEntry = record + Name: string; + Typ: string; + + // we use normal TTexture, it's easier to implement and if needed - we copy ready data + Texture: TTexture; + TextureCache: TTexture; // 0.5.0 + end; + + TTextureDatabase = record + Texture: array of TTextureEntry; + end; + + TTextureUnit = class + + private + 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; + +// function GetNumberFor + function GetTexture(Name, Typ: string): TTexture; overload; + function GetTexture(Name, Typ: string; FromCache: boolean): TTexture; overload; + function FindTexture(Name: string): integer; + function LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; + function LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; + function LoadTexture(Identifier: string): TTexture; overload; + function CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; + procedure UnloadTexture(Name: string; FromCache: boolean); + Constructor Create; + Destructor Destroy; override; + end; + +var + Texture: TTextureUnit; + TextureDatabase: TTextureDatabase; + + // this should be in UDisplay?! + PrintScreenData: array[0..1024*768-1] of longword; + + ActTex: GLuint;//integer; + +// 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) + // total 40MB at 2048*2048 + // total 10MB at 1024*1024 + + Mipmapping: Boolean; + + CacheMipmap: array[0..256*256*3-1] of byte; // 3KB + CacheMipmapSurface: PSDL_Surface; + + +implementation + +uses ULog, + DateUtils, + UCovers, + {$IFDEF LAZARUS} + LResources, + {$ENDIF} + {$IFDEF DARWIN} + MacResources, + {$ENDIF} + StrUtils, dialogs; + +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); + + +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(Identifier: PChar): PSDL_Surface; +var + + TexRWops: PSDL_RWops; + dHandle: THandle; + + {$IFDEF LAZARUS} + lLazRes : TLResource; + lResData : TStringStream; + {$ELSE} + TexStream: TStream; + {$ENDIF} + +begin + Result := nil; + TexRWops := nil; + +// Log.LogStatus( Identifier, 'LoadImage' ); + + if ( FileExists(Identifier) ) then + begin + // load from file + Log.LogStatus( 'Is File', ' LoadImage' ); + try + Result:=IMG_Load(Identifier); + except + Log.LogStatus( 'ERROR Could not load from file' , Identifier); + beep; + Exit; + end; + end + else + begin + Log.LogStatus( 'IS Resource, because file does not exist.('+Identifier+')', ' LoadImage' ); + + // load from resource stream + {$IFDEF LAZARUS} + lLazRes := LazFindResource( Identifier, 'TEX' ); + if lLazRes <> nil then + begin + lResData := TStringStream.create( lLazRes.value ); + try + lResData.position := 0; + try + TexRWops := SDL_AllocRW; + TexRWops.unknown := TUnknown( lResData ); + TexRWops.seek := SDLStreamSeek; + TexRWops.read := SDLStreamRead; + TexRWops.write := nil; + TexRWops.close := SDLStreamClose; + TexRWops.type_ := 2; + except + Log.LogStatus( 'ERROR Could not assign resource ('+Identifier+')' , Identifier); + beep; + Exit; + end; + + Result := IMG_Load_RW(TexRWops,0); + SDL_FreeRW(TexRWops); + finally + freeandnil( lResData ); + end; + end + else + begin + Log.LogStatus( 'NOT found in Resource ('+Identifier+')', ' LoadImage' ); + end; + {$ELSE} + dHandle := FindResource(hInstance, Identifier, 'TEX'); + if dHandle=0 then + begin + Log.LogStatus( 'ERROR Could not find resource' , ' '+ Identifier); + beep; + Exit; + end; + + + TexStream := nil; + try + TexStream := TResourceStream.Create(HInstance, Identifier, 'TEX'); + except + Log.LogStatus( 'ERROR Could not load from resource' , Identifier); + beep; + Exit; + end; + + try + TexStream.position := 0; + try + 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 assign resource' , Identifier); + beep; + Exit; + end; + + Log.LogStatus( 'resource Assigned....' , Identifier); + Result:=IMG_Load_RW(TexRWops,0); + SDL_FreeRW(TexRWops); + + finally + if assigned( TexStream ) then + freeandnil( TexStream ); + end; + {$ENDIF} + end; +end; + +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 + else + if (Typ='Transparent') or + (Typ='Colorized') + then NeededPixFmt:=@fmt_rgba + else + NeededPixFmt:=@fmt_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); +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 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); + // this is for safety reasons + if delta = 0.0 then delta:=0.000000000001; + 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; + + //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 + Pix[0]:=floor(255*clr[0]); + Pix[1]:=floor(255*clr[1]); + Pix[2]:=floor(255*clr[2]); + end; + end; + +var + DestinationHue: Double; + PixelIndex: Cardinal; +begin + 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 + TexSurface: PSDL_Surface; + MipmapSurface: PSDL_Surface; + newWidth, newHeight: Cardinal; + oldWidth, oldHeight: Cardinal; + kopierindex: 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.LogStatus( 'ERROR Could not load texture' , Identifier +' '+ Format +' '+ Typ ); + beep; + 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='Plain') then + begin + {$ifdef blindydebug} + Log.LogStatus('',' JB-1 : Minimap'); + {$endif} + + if (Covers.W <= 256) and (Covers.H <= 256) then + begin + {$ifdef blindydebug} + Log.LogStatus('',' GetScaledTexture('''+inttostr(Covers.W)+''','''+inttostr(Covers.H)+''') (for CacheMipmap)'); + {$endif} + MipmapSurface:=GetScaledTexture(TexSurface,Covers.W, Covers.H); + 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 + CacheMipmapSurface:=SDL_CreateRGBSurfaceFrom(@CacheMipmap[0], Covers.W, Covers.H, 24, Covers.W*3, $000000ff, $0000ff00, $00ff0000, 0); + SDL_BlitSurface(MipMapSurface,nil,CacheMipmapSurface,nil); + SDL_FreeSurface(CacheMipmapSurface); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + Log.LogStatus('',' SDL_FreeSurface (CacheMipmap)'); + {$endif} + SDL_FreeSurface(MipmapSurface); + {$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='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 = 'Transparent') or + (Typ='Colorized') then + begin + glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TexSurface.pixels); + end + {if Typ = 'Plain' then} else + begin + glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, TexSurface.pixels); + end; + + {$ifdef blindydebug} + Log.LogStatus('',' JB-4'); + {$endif} + +{ + 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; +} +{ + if Typ = 'Font' then + // 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; + glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); +} +{ + if Typ = 'Font Outline' then + // no idea... + begin + 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 + Pix := PPix[Position2 * 3]; + + Col := Pix; + if Col < 127 then Col := 127; + + TempA := Pix; + if TempA >= 95 then TempA := 255; + if TempA >= 31 then TempA := 255; + if Pix < 95 then TempA := (Pix * 256) div 96; + + + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); + end; +} +{ + if Typ = 'Font Outline 2' then + // same as above + begin + 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 + Pix := PPix[Position2 * 3]; + + Col := Pix; + if Col < 31 then Col := 31; + + TempA := Pix; + if TempA >= 31 then TempA := 255; + if Pix < 31 then TempA := Pix * (256 div 32); + + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; + 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; + end; + + if Typ = 'Font Black' then + // and so on + begin + // normalnie 0,125s bez niczego 0,015s - 0,030s z pix 0,125s <-- ??? + // dimensions + TextureB.PixelFormat := pf24bit; + 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 TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2*3]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + if Typ = 'Alpha Black Colored' then + // ... hope, noone needs this + begin + TextureB.PixelFormat := pf24bit; + 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 TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2*3]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := (Col div $10000) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Col div $100) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Col and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + if Typ = 'Font Gray' 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 TextureB.Height-1 do begin + for Position2 := 0 to TextureB.Width-1 do begin + Pix := TextureB.Canvas.Pixels[Position2, Position]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + if Typ = 'Arrow' then + begin + 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 + Pix := PPix[Position2 * 3]; + + // transparency + if Pix >= 127 then TempA := 255; + if Pix < 127 then TempA := Pix * 2; + + // ColInt = color intensity + if Pix < 127 then ColInt := 1; + if Pix >= 127 then ColInt := 2 - Pix / 128; + //0.75, 0.6, 0.25 + + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Round(ColInt * 0.75 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := Round(ColInt * 0.6 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Round(ColInt * 0.25 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + + if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); + 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 = 'Note Plain' then + begin + for Position := 0 to TextureB.Height-1 do + begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do + begin + + + + // Skin Patch + // 0-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White + case PPix[Position2*3] of + 0..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); + 192: Pix := Col; + 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); + 255: Pix := $FFFFFF; + end; +// 0.5.0. Original +// case PPix[Position2*3] of +// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; +// 192: Pix := Col; +// 255: Pix := $FFFFFF; +// end; + + + + + + TextureD24[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; + TextureD24[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; + TextureD24[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 3, TextureB.Width, TextureB.Height, 0, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); + end; + + if Typ = 'Note Transparent' then + begin + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + TempA := 255; + + + + //Skin Patch + // 0= Transparent, 1-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White + case PPix[Position2*3] of + 0: TempA := 0; + 1..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); + 192: Pix := Col; + 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); + 255: Pix := $FFFFFF; + end; +// 0.5.0 Original +// case PPix[Position2*3] of +// 0: TempA := 0; +// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; +// 192: Pix := Col; +// 255: Pix := $FFFFFF; +// end; + + + + + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + 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; + + // 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; + + {$ifdef blindydebug} + Log.LogStatus('',' JB-6'); + {$endif} + + + // 0.5.0 + 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 - ' + Format + '/' + Identifier + '/' + Typ, 4); + + {$ifdef blindydebug} + Log.LogStatus('',' JB-8'); + {$endif} + +end; + + +function TTextureUnit.GetTexture(Name, Typ: string): TTexture; +begin + Result := GetTexture(Name, Typ, true); +end; + +function TTextureUnit.GetTexture(Name, Typ: string; 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); + + 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 + {$ifdef blindydebug} + Log.LogStatus('...', 'GetTexture('''+Name+''','''+Typ+''')'); + {$endif} + TextureDatabase.Texture[T].Texture := LoadTexture(false, pchar(Name), 'JPG', pchar(Typ), $0); + {$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 = -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; + +function TTextureUnit.FindTexture(Name: string): integer; +var + T: integer; // texture +begin + 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); +end; + +function TTextureUnit.LoadTexture(Identifier: string): TTexture; +begin + Result := LoadTexture(false, pchar(Identifier), 'JPG', 'Plain', 0); +end; + +function TTextureUnit.CreateTexture(var Data: array of byte; 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 beep; + 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(Name: string; FromCache: boolean); +var + T: integer; + TexNum: GLuint; +begin + T := FindTexture(Name); + + if not FromCache then begin + TexNum := TextureDatabase.Texture[T].Texture.TexNum; + if TexNum >= 0 then begin + glDeleteTextures(1, @TexNum); + TextureDatabase.Texture[T].Texture.TexNum := -1; +// 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 := -1; +// Log.LogError('Unload texture cache no '+IntToStr(TexNum)); + end; + end; +end; + +{$IFDEF LAZARUS} +initialization + {$I UltraStar.lrs} +{$ENDIF} + + +end. -- cgit v1.2.3 From 0c8777a5798a39dee058cbdd713bd095bff8c9a0 Mon Sep 17 00:00:00 2001 From: jaybinks Date: Wed, 13 Feb 2008 12:08:19 +0000 Subject: Fixed popUpBg image not displaying in game. this was not so much a problem with loading this type of texture, more so it was the fact that the file name had incorrect capitialization in the theme.ini file causing the png file to be not found on *nix systems. Ive implemented a workaround that will solve this without the theme files needing to be changed. so the game is now tolerant of themes having incorrect case in the filenames. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@849 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UTexture.pas | 2319 ++++++++++++++++++++-------------------- 1 file changed, 1174 insertions(+), 1145 deletions(-) (limited to 'Game/Code/Classes/UTexture.pas') diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas index 770b88bd..deff8b94 100644 --- a/Game/Code/Classes/UTexture.pas +++ b/Game/Code/Classes/UTexture.pas @@ -1,1145 +1,1174 @@ -unit UTexture; -// added for easier debug disabling -{$undef blindydebug} - -// Plain (alpha = 1) -// Transparent -// Colorized - -// obsolete? -// Transparent Range -// Font (white is drawn, black is transparent) -// Font Outline (Font with darker outline) -// Font Outline 2 (Font with darker outline) -// Font Black (black is drawn, white is transparent) -// Font Gray (gray is drawn, white is transparent) -// Arrow (for arrows, white is white, gray has color, black is transparent); - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses OpenGL12, - {$IFDEF win32} - windows, - {$ENDIF} - Math, - Classes, - SysUtils, - Graphics, - UCommon, - UThemes, - SDL, - sdlutils, - SDL_Image; - -type - TTexture = record - TexNum: integer; - 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; - - TTextureEntry = record - Name: string; - Typ: string; - - // we use normal TTexture, it's easier to implement and if needed - we copy ready data - Texture: TTexture; - TextureCache: TTexture; // 0.5.0 - end; - - TTextureDatabase = record - Texture: array of TTextureEntry; - end; - - TTextureUnit = class - - private - 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; - -// function GetNumberFor - function GetTexture(Name, Typ: string): TTexture; overload; - function GetTexture(Name, Typ: string; FromCache: boolean): TTexture; overload; - function FindTexture(Name: string): integer; - function LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; - function LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; - function LoadTexture(Identifier: string): TTexture; overload; - function CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; - procedure UnloadTexture(Name: string; FromCache: boolean); - Constructor Create; - Destructor Destroy; override; - end; - -var - Texture: TTextureUnit; - TextureDatabase: TTextureDatabase; - - // this should be in UDisplay?! - PrintScreenData: array[0..1024*768-1] of longword; - - ActTex: GLuint;//integer; - -// 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) - // total 40MB at 2048*2048 - // total 10MB at 1024*1024 - - Mipmapping: Boolean; - - CacheMipmap: array[0..256*256*3-1] of byte; // 3KB - CacheMipmapSurface: PSDL_Surface; - - -implementation - -uses ULog, - DateUtils, - UCovers, - {$IFDEF LAZARUS} - LResources, - {$ENDIF} - {$IFDEF DARWIN} - MacResources, - {$ENDIF} - StrUtils, dialogs; - -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); - - -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(Identifier: PChar): PSDL_Surface; -var - - TexRWops: PSDL_RWops; - dHandle: THandle; - - {$IFDEF LAZARUS} - lLazRes : TLResource; - lResData : TStringStream; - {$ELSE} - TexStream: TStream; - {$ENDIF} - -begin - Result := nil; - TexRWops := nil; - -// Log.LogStatus( Identifier, 'LoadImage' ); - - if ( FileExists(Identifier) ) then - begin - // load from file - Log.LogStatus( 'Is File', ' LoadImage' ); - try - Result:=IMG_Load(Identifier); - except - Log.LogStatus( 'ERROR Could not load from file' , Identifier); - beep; - Exit; - end; - end - else - begin - Log.LogStatus( 'IS Resource, because file does not exist.('+Identifier+')', ' LoadImage' ); - - // load from resource stream - {$IFDEF LAZARUS} - lLazRes := LazFindResource( Identifier, 'TEX' ); - if lLazRes <> nil then - begin - lResData := TStringStream.create( lLazRes.value ); - try - lResData.position := 0; - try - TexRWops := SDL_AllocRW; - TexRWops.unknown := TUnknown( lResData ); - TexRWops.seek := SDLStreamSeek; - TexRWops.read := SDLStreamRead; - TexRWops.write := nil; - TexRWops.close := SDLStreamClose; - TexRWops.type_ := 2; - except - Log.LogStatus( 'ERROR Could not assign resource ('+Identifier+')' , Identifier); - beep; - Exit; - end; - - Result := IMG_Load_RW(TexRWops,0); - SDL_FreeRW(TexRWops); - finally - freeandnil( lResData ); - end; - end - else - begin - Log.LogStatus( 'NOT found in Resource ('+Identifier+')', ' LoadImage' ); - end; - {$ELSE} - dHandle := FindResource(hInstance, Identifier, 'TEX'); - if dHandle=0 then - begin - Log.LogStatus( 'ERROR Could not find resource' , ' '+ Identifier); - beep; - Exit; - end; - - - TexStream := nil; - try - TexStream := TResourceStream.Create(HInstance, Identifier, 'TEX'); - except - Log.LogStatus( 'ERROR Could not load from resource' , Identifier); - beep; - Exit; - end; - - try - TexStream.position := 0; - try - 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 assign resource' , Identifier); - beep; - Exit; - end; - - Log.LogStatus( 'resource Assigned....' , Identifier); - Result:=IMG_Load_RW(TexRWops,0); - SDL_FreeRW(TexRWops); - - finally - if assigned( TexStream ) then - freeandnil( TexStream ); - end; - {$ENDIF} - end; -end; - -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 - else - if (Typ='Transparent') or - (Typ='Colorized') - then NeededPixFmt:=@fmt_rgba - else - NeededPixFmt:=@fmt_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); -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 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); - // this is for safety reasons - if delta = 0.0 then delta:=0.000000000001; - 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; - - //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 - Pix[0]:=floor(255*clr[0]); - Pix[1]:=floor(255*clr[1]); - Pix[2]:=floor(255*clr[2]); - end; - end; - -var - DestinationHue: Double; - PixelIndex: Cardinal; -begin - 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 - TexSurface: PSDL_Surface; - MipmapSurface: PSDL_Surface; - newWidth, newHeight: Cardinal; - oldWidth, oldHeight: Cardinal; - kopierindex: 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.LogStatus( 'ERROR Could not load texture' , Identifier +' '+ Format +' '+ Typ ); - beep; - 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='Plain') then - begin - {$ifdef blindydebug} - Log.LogStatus('',' JB-1 : Minimap'); - {$endif} - - if (Covers.W <= 256) and (Covers.H <= 256) then - begin - {$ifdef blindydebug} - Log.LogStatus('',' GetScaledTexture('''+inttostr(Covers.W)+''','''+inttostr(Covers.H)+''') (for CacheMipmap)'); - {$endif} - MipmapSurface:=GetScaledTexture(TexSurface,Covers.W, Covers.H); - 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 - CacheMipmapSurface:=SDL_CreateRGBSurfaceFrom(@CacheMipmap[0], Covers.W, Covers.H, 24, Covers.W*3, $000000ff, $0000ff00, $00ff0000, 0); - SDL_BlitSurface(MipMapSurface,nil,CacheMipmapSurface,nil); - SDL_FreeSurface(CacheMipmapSurface); - {$ifdef blindydebug} - Log.LogStatus('',' ok'); - Log.LogStatus('',' SDL_FreeSurface (CacheMipmap)'); - {$endif} - SDL_FreeSurface(MipmapSurface); - {$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='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 = 'Transparent') or - (Typ='Colorized') then - begin - glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TexSurface.pixels); - end - {if Typ = 'Plain' then} else - begin - glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, TexSurface.pixels); - end; - - {$ifdef blindydebug} - Log.LogStatus('',' JB-4'); - {$endif} - -{ - 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; -} -{ - if Typ = 'Font' then - // 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; - glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); -} -{ - if Typ = 'Font Outline' then - // no idea... - begin - 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 - Pix := PPix[Position2 * 3]; - - Col := Pix; - if Col < 127 then Col := 127; - - TempA := Pix; - if TempA >= 95 then TempA := 255; - if TempA >= 31 then TempA := 255; - if Pix < 95 then TempA := (Pix * 256) div 96; - - - TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; - TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); - end; -} -{ - if Typ = 'Font Outline 2' then - // same as above - begin - 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 - Pix := PPix[Position2 * 3]; - - Col := Pix; - if Col < 31 then Col := 31; - - TempA := Pix; - if TempA >= 31 then TempA := 255; - if Pix < 31 then TempA := Pix * (256 div 32); - - TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; - TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; - 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; - end; - - if Typ = 'Font Black' then - // and so on - begin - // normalnie 0,125s bez niczego 0,015s - 0,030s z pix 0,125s <-- ??? - // dimensions - TextureB.PixelFormat := pf24bit; - 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 TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2*3]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 255; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - if Typ = 'Alpha Black Colored' then - // ... hope, noone needs this - begin - TextureB.PixelFormat := pf24bit; - 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 TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - Pix := PPix[Position2*3]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := (Col div $10000) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Col div $100) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Col and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - if Typ = 'Font Gray' 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 TextureB.Height-1 do begin - for Position2 := 0 to TextureB.Width-1 do begin - Pix := TextureB.Canvas.Pixels[Position2, Position]; - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 127; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - end; - - if Typ = 'Arrow' then - begin - 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 - Pix := PPix[Position2 * 3]; - - // transparency - if Pix >= 127 then TempA := 255; - if Pix < 127 then TempA := Pix * 2; - - // ColInt = color intensity - if Pix < 127 then ColInt := 1; - if Pix >= 127 then ColInt := 2 - Pix / 128; - //0.75, 0.6, 0.25 - - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Round(ColInt * 0.75 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := Round(ColInt * 0.6 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Round(ColInt * 0.25 * 255 + (1 - ColInt) * 255); - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - - if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); - 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 = 'Note Plain' then - begin - for Position := 0 to TextureB.Height-1 do - begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do - begin - - - - // Skin Patch - // 0-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White - case PPix[Position2*3] of - 0..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); - 192: Pix := Col; - 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); - 255: Pix := $FFFFFF; - end; -// 0.5.0. Original -// case PPix[Position2*3] of -// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; -// 192: Pix := Col; -// 255: Pix := $FFFFFF; -// end; - - - - - - TextureD24[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; - TextureD24[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; - TextureD24[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 3, TextureB.Width, TextureB.Height, 0, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); - end; - - if Typ = 'Note Transparent' then - begin - for Position := 0 to TextureB.Height-1 do begin - PPix := TextureB.ScanLine[Position]; - for Position2 := 0 to TextureB.Width-1 do begin - TempA := 255; - - - - //Skin Patch - // 0= Transparent, 1-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White - case PPix[Position2*3] of - 0: TempA := 0; - 1..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); - 192: Pix := Col; - 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); - 255: Pix := $FFFFFF; - end; -// 0.5.0 Original -// case PPix[Position2*3] of -// 0: TempA := 0; -// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; -// 192: Pix := Col; -// 255: Pix := $FFFFFF; -// end; - - - - - TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; - TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; - TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; - end; - end; - glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); - 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; - - // 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; - - {$ifdef blindydebug} - Log.LogStatus('',' JB-6'); - {$endif} - - - // 0.5.0 - 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 - ' + Format + '/' + Identifier + '/' + Typ, 4); - - {$ifdef blindydebug} - Log.LogStatus('',' JB-8'); - {$endif} - -end; - - -function TTextureUnit.GetTexture(Name, Typ: string): TTexture; -begin - Result := GetTexture(Name, Typ, true); -end; - -function TTextureUnit.GetTexture(Name, Typ: string; 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); - - 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 - {$ifdef blindydebug} - Log.LogStatus('...', 'GetTexture('''+Name+''','''+Typ+''')'); - {$endif} - TextureDatabase.Texture[T].Texture := LoadTexture(false, pchar(Name), 'JPG', pchar(Typ), $0); - {$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 = -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; - -function TTextureUnit.FindTexture(Name: string): integer; -var - T: integer; // texture -begin - 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); -end; - -function TTextureUnit.LoadTexture(Identifier: string): TTexture; -begin - Result := LoadTexture(false, pchar(Identifier), 'JPG', 'Plain', 0); -end; - -function TTextureUnit.CreateTexture(var Data: array of byte; 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 beep; - 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(Name: string; FromCache: boolean); -var - T: integer; - TexNum: GLuint; -begin - T := FindTexture(Name); - - if not FromCache then begin - TexNum := TextureDatabase.Texture[T].Texture.TexNum; - if TexNum >= 0 then begin - glDeleteTextures(1, @TexNum); - TextureDatabase.Texture[T].Texture.TexNum := -1; -// 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 := -1; -// Log.LogError('Unload texture cache no '+IntToStr(TexNum)); - end; - end; -end; - -{$IFDEF LAZARUS} -initialization - {$I UltraStar.lrs} -{$ENDIF} - - -end. +unit UTexture; +// added for easier debug disabling +{$undef blindydebug} + +// Plain (alpha = 1) +// Transparent +// Colorized + +// obsolete? +// Transparent Range +// Font (white is drawn, black is transparent) +// Font Outline (Font with darker outline) +// Font Outline 2 (Font with darker outline) +// Font Black (black is drawn, white is transparent) +// Font Gray (gray is drawn, white is transparent) +// Arrow (for arrows, white is white, gray has color, black is transparent); + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses OpenGL12, + {$IFDEF win32} + windows, + {$ENDIF} + Math, + Classes, + SysUtils, + Graphics, + UCommon, + UThemes, + SDL, + sdlutils, + SDL_Image; + +type + TTexture = record + TexNum: integer; + 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; + + TTextureEntry = record + Name: string; + Typ: string; + + // we use normal TTexture, it's easier to implement and if needed - we copy ready data + Texture: TTexture; + TextureCache: TTexture; // 0.5.0 + end; + + TTextureDatabase = record + Texture: array of TTextureEntry; + end; + + TTextureUnit = class + + private + 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; + +// function GetNumberFor + function GetTexture(Name, Typ: string): TTexture; overload; + function GetTexture(Name, Typ: string; FromCache: boolean): TTexture; overload; + function FindTexture(Name: string): integer; + function LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; + function LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; + function LoadTexture(Identifier: string): TTexture; overload; + function CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; + procedure UnloadTexture(Name: string; FromCache: boolean); + Constructor Create; + Destructor Destroy; override; + end; + +var + Texture: TTextureUnit; + TextureDatabase: TTextureDatabase; + + // this should be in UDisplay?! + PrintScreenData: array[0..1024*768-1] of longword; + + ActTex: GLuint;//integer; + +// 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) + // total 40MB at 2048*2048 + // total 10MB at 1024*1024 + + Mipmapping: Boolean; + + CacheMipmap: array[0..256*256*3-1] of byte; // 3KB + CacheMipmapSurface: PSDL_Surface; + + +implementation + +uses ULog, + DateUtils, + UCovers, + {$ifdef FPC} + fileutil, + {$endif} + {$IFDEF LAZARUS} + LResources, + {$ENDIF} + {$IFDEF DARWIN} + MacResources, + {$ENDIF} + StrUtils, dialogs; + +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); + + +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(Identifier: PChar): PSDL_Surface; + + function FileExistsInsensative( var aFileName : PChar ): boolean; + begin +{$IFDEF fpc} + result := true; + + if FileExists( aFileName ) then + exit; + + aFileName := pchar( FindDiskFileCaseInsensitive( aFileName ) ); + result := FileExists( aFileName ); +{$ELSE} + result := FileExists( aFileName ); +{$ENDIF} + end; + +var + + TexRWops: PSDL_RWops; + dHandle: THandle; + + {$IFDEF LAZARUS} + lLazRes : TLResource; + lResData : TStringStream; + {$ELSE} + TexStream: TStream; + {$ENDIF} + + lFileName : pchar; + +begin + Result := nil; + TexRWops := nil; + + if Identifier = '' then + exit; + + lFileName := Identifier; + +// Log.LogStatus( Identifier, 'LoadImage' ); + + Log.LogStatus( 'Looking for File ( Loading : '+Identifier+' - '+ FindDiskFileCaseInsensitive(Identifier) +')', ' LoadImage' ); + + if ( FileExistsInsensative(lFileName) ) then + begin + // load from file + Log.LogStatus( 'Is File ( Loading : '+lFileName+')', ' LoadImage' ); + try + Result:=IMG_Load(lFileName); + Log.LogStatus( ' '+inttostr( integer( Result ) ), ' LoadImage' ); + except + Log.LogStatus( 'ERROR Could not load from file' , Identifier); + beep; + Exit; + end; + end + else + begin + Log.LogStatus( 'IS Resource, because file does not exist.('+Identifier+')', ' LoadImage' ); + + // load from resource stream + {$IFDEF LAZARUS} + lLazRes := LazFindResource( Identifier, 'TEX' ); + if lLazRes <> nil then + begin + lResData := TStringStream.create( lLazRes.value ); + try + lResData.position := 0; + try + TexRWops := SDL_AllocRW; + TexRWops.unknown := TUnknown( lResData ); + TexRWops.seek := SDLStreamSeek; + TexRWops.read := SDLStreamRead; + TexRWops.write := nil; + TexRWops.close := SDLStreamClose; + TexRWops.type_ := 2; + except + Log.LogStatus( 'ERROR Could not assign resource ('+Identifier+')' , Identifier); + beep; + Exit; + end; + + Result := IMG_Load_RW(TexRWops,0); + SDL_FreeRW(TexRWops); + finally + freeandnil( lResData ); + end; + end + else + begin + Log.LogStatus( 'NOT found in Resource ('+Identifier+')', ' LoadImage' ); + end; + {$ELSE} + dHandle := FindResource(hInstance, Identifier, 'TEX'); + if dHandle=0 then + begin + Log.LogStatus( 'ERROR Could not find resource' , ' '+ Identifier); + beep; + Exit; + end; + + + TexStream := nil; + try + TexStream := TResourceStream.Create(HInstance, Identifier, 'TEX'); + except + Log.LogStatus( 'ERROR Could not load from resource' , Identifier); + beep; + Exit; + end; + + try + TexStream.position := 0; + try + 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 assign resource' , Identifier); + beep; + Exit; + end; + + Log.LogStatus( 'resource Assigned....' , Identifier); + Result:=IMG_Load_RW(TexRWops,0); + SDL_FreeRW(TexRWops); + + finally + if assigned( TexStream ) then + freeandnil( TexStream ); + end; + {$ENDIF} + end; +end; + +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 + else + if (Typ='Transparent') or + (Typ='Colorized') + then NeededPixFmt:=@fmt_rgba + else + NeededPixFmt:=@fmt_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); +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 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); + // this is for safety reasons + if delta = 0.0 then delta:=0.000000000001; + 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; + + //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 + Pix[0]:=floor(255*clr[0]); + Pix[1]:=floor(255*clr[1]); + Pix[2]:=floor(255*clr[2]); + end; + end; + +var + DestinationHue: Double; + PixelIndex: Cardinal; +begin + 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 + TexSurface: PSDL_Surface; + MipmapSurface: PSDL_Surface; + newWidth, newHeight: Cardinal; + oldWidth, oldHeight: Cardinal; + kopierindex: 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.LogStatus( 'ERROR Could not load texture' , Identifier +' '+ Format +' '+ Typ ); + beep; + 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='Plain') then + begin + {$ifdef blindydebug} + Log.LogStatus('',' JB-1 : Minimap'); + {$endif} + + if (Covers.W <= 256) and (Covers.H <= 256) then + begin + {$ifdef blindydebug} + Log.LogStatus('',' GetScaledTexture('''+inttostr(Covers.W)+''','''+inttostr(Covers.H)+''') (for CacheMipmap)'); + {$endif} + MipmapSurface:=GetScaledTexture(TexSurface,Covers.W, Covers.H); + 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 + CacheMipmapSurface:=SDL_CreateRGBSurfaceFrom(@CacheMipmap[0], Covers.W, Covers.H, 24, Covers.W*3, $000000ff, $0000ff00, $00ff0000, 0); + SDL_BlitSurface(MipMapSurface,nil,CacheMipmapSurface,nil); + SDL_FreeSurface(CacheMipmapSurface); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + Log.LogStatus('',' SDL_FreeSurface (CacheMipmap)'); + {$endif} + SDL_FreeSurface(MipmapSurface); + {$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='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 = 'Transparent') or + (Typ='Colorized') then + begin + glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TexSurface.pixels); + end + {if Typ = 'Plain' then} else + begin + glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, TexSurface.pixels); + end; + + {$ifdef blindydebug} + Log.LogStatus('',' JB-4'); + {$endif} + +{ + 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; +} +{ + if Typ = 'Font' then + // 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; + glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); +} +{ + if Typ = 'Font Outline' then + // no idea... + begin + 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 + Pix := PPix[Position2 * 3]; + + Col := Pix; + if Col < 127 then Col := 127; + + TempA := Pix; + if TempA >= 95 then TempA := 255; + if TempA >= 31 then TempA := 255; + if Pix < 95 then TempA := (Pix * 256) div 96; + + + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); + end; +} +{ + if Typ = 'Font Outline 2' then + // same as above + begin + 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 + Pix := PPix[Position2 * 3]; + + Col := Pix; + if Col < 31 then Col := 31; + + TempA := Pix; + if TempA >= 31 then TempA := 255; + if Pix < 31 then TempA := Pix * (256 div 32); + + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; + 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; + end; + + if Typ = 'Font Black' then + // and so on + begin + // normalnie 0,125s bez niczego 0,015s - 0,030s z pix 0,125s <-- ??? + // dimensions + TextureB.PixelFormat := pf24bit; + 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 TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2*3]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + if Typ = 'Alpha Black Colored' then + // ... hope, noone needs this + begin + TextureB.PixelFormat := pf24bit; + 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 TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2*3]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := (Col div $10000) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Col div $100) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Col and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + if Typ = 'Font Gray' 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 TextureB.Height-1 do begin + for Position2 := 0 to TextureB.Width-1 do begin + Pix := TextureB.Canvas.Pixels[Position2, Position]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + if Typ = 'Arrow' then + begin + 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 + Pix := PPix[Position2 * 3]; + + // transparency + if Pix >= 127 then TempA := 255; + if Pix < 127 then TempA := Pix * 2; + + // ColInt = color intensity + if Pix < 127 then ColInt := 1; + if Pix >= 127 then ColInt := 2 - Pix / 128; + //0.75, 0.6, 0.25 + + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Round(ColInt * 0.75 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := Round(ColInt * 0.6 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Round(ColInt * 0.25 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + + if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); + 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 = 'Note Plain' then + begin + for Position := 0 to TextureB.Height-1 do + begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do + begin + + + + // Skin Patch + // 0-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White + case PPix[Position2*3] of + 0..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); + 192: Pix := Col; + 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); + 255: Pix := $FFFFFF; + end; +// 0.5.0. Original +// case PPix[Position2*3] of +// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; +// 192: Pix := Col; +// 255: Pix := $FFFFFF; +// end; + + + + + + TextureD24[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; + TextureD24[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; + TextureD24[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 3, TextureB.Width, TextureB.Height, 0, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); + end; + + if Typ = 'Note Transparent' then + begin + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + TempA := 255; + + + + //Skin Patch + // 0= Transparent, 1-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White + case PPix[Position2*3] of + 0: TempA := 0; + 1..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); + 192: Pix := Col; + 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); + 255: Pix := $FFFFFF; + end; +// 0.5.0 Original +// case PPix[Position2*3] of +// 0: TempA := 0; +// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; +// 192: Pix := Col; +// 255: Pix := $FFFFFF; +// end; + + + + + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + 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; + + // 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; + + {$ifdef blindydebug} + Log.LogStatus('',' JB-6'); + {$endif} + + + // 0.5.0 + 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 - ' + Format + '/' + Identifier + '/' + Typ, 4); + + {$ifdef blindydebug} + Log.LogStatus('',' JB-8'); + {$endif} + +end; + + +function TTextureUnit.GetTexture(Name, Typ: string): TTexture; +begin + Result := GetTexture(Name, Typ, true); +end; + +function TTextureUnit.GetTexture(Name, Typ: string; 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); + + 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 + {$ifdef blindydebug} + Log.LogStatus('...', 'GetTexture('''+Name+''','''+Typ+''')'); + {$endif} + TextureDatabase.Texture[T].Texture := LoadTexture(false, pchar(Name), 'JPG', pchar(Typ), $0); + {$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 = -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; + +function TTextureUnit.FindTexture(Name: string): integer; +var + T: integer; // texture +begin + 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); +end; + +function TTextureUnit.LoadTexture(Identifier: string): TTexture; +begin + Result := LoadTexture(false, pchar(Identifier), 'JPG', 'Plain', 0); +end; + +function TTextureUnit.CreateTexture(var Data: array of byte; 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 beep; + 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(Name: string; FromCache: boolean); +var + T: integer; + TexNum: GLuint; +begin + T := FindTexture(Name); + + if not FromCache then begin + TexNum := TextureDatabase.Texture[T].Texture.TexNum; + if TexNum >= 0 then begin + glDeleteTextures(1, @TexNum); + TextureDatabase.Texture[T].Texture.TexNum := -1; +// 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 := -1; +// Log.LogError('Unload texture cache no '+IntToStr(TexNum)); + end; + end; +end; + +{$IFDEF LAZARUS} +initialization + {$I UltraStar.lrs} +{$ENDIF} + + +end. -- cgit v1.2.3