path: root/Game/Code/Classes/UTexture.pas

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, PNGImage;

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
  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;

function TTextureUnit.LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture;
var
  Res:        TResourceStream;
  TextureB:   TBitmap;
  TextureJ:   TJPEGImage;
  TexturePNG: TPNGObject;
  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;
begin
  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
    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') 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;
  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;

  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
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.