1 files changed, 0 insertions, 525 deletions
diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas
deleted file mode 100644
index 4879760a..00000000
--- a/Game/Code/Classes/UTexture.pas
+++ /dev/null
@@ -1,525 +0,0 @@
-unit UTexture;
-
-interface
-
-{$IFDEF FPC}
-  {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
-  gl,
-  glu,
-  glext,
-  Classes,
-  SysUtils,
-  UCommon,
-  SDL,
-  SDL_Image;
-
-type
-  PTexture = ^TTexture;
-  TTexture = record
-    TexNum:   GLuint;
-    X:        real;
-    Y:        real;
-    Z:        real;
-    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; // percentage of width to use [0..1]
-    TexH:     real; // percentage of height to use [0..1]
-    TexX1:    real;
-    TexY1:    real;
-    TexX2:    real;
-    TexY2:    real;
-    Alpha:    real;
-    Name:     string; // experimental for handling cache images. maybe it's useful for dynamic skins
-  end;
-
-type
-  TTextureType = (
-    TEXTURE_TYPE_PLAIN,        // Plain (alpha = 1)
-    TEXTURE_TYPE_TRANSPARENT,  // Alpha is used
-    TEXTURE_TYPE_COLORIZED     // Alpha is used; Hue of the HSV color-model will be replaced by a new value
-  );
-
-const
-  TextureTypeStr: array[TTextureType] of string = (
-    'Plain',
-    'Transparent',
-    'Colorized'
-  );
-
-function TextureTypeToStr(TexType: TTextureType): string;
-function ParseTextureType(const TypeStr: string; Default: TTextureType): TTextureType;
-
-procedure AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: TTextureType);
-
-type
-  PTextureEntry = ^TTextureEntry;
-  TTextureEntry = record
-    Name:         string;
-    Typ:          TTextureType;
-    Color:        Cardinal;
-
-    // we use normal TTexture, it's easier to implement and if needed - we copy ready data
-    Texture:      TTexture; // Full-size texture
-    TextureCache: TTexture; // Thumbnail texture
-  end;
-
-  TTextureDatabase = class
-    private
-      Texture: array of TTextureEntry;
-    public
-      procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Color: Cardinal; Cache: boolean);
-      function FindTexture(const Name: string; Typ: TTextureType; Color: Cardinal): integer;
-  end;
-
-  TTextureUnit = class
-    private
-      TextureDatabase: TTextureDatabase;
-    public
-      Limit: integer;
-
-      procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Cache: boolean = false); overload;
-      procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Color: Cardinal; Cache: boolean = false); overload;
-      function GetTexture(const Name: string; Typ: TTextureType; FromCache: boolean = false): TTexture; overload;
-      function GetTexture(const Name: string; Typ: TTextureType; Col: LongWord; FromCache: boolean = false): TTexture; overload;
-      function LoadTexture(FromRegistry: boolean; const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture; overload;
-      function LoadTexture(const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture; overload;
-      function LoadTexture(const Identifier: string): TTexture; overload;
-      function CreateTexture(Data: PChar; const Name: string; Width, Height: word; BitsPerPixel: byte): TTexture;
-      procedure UnloadTexture(const Name: string; Typ: TTextureType; FromCache: boolean); overload;
-      procedure UnloadTexture(const Name: string; Typ: TTextureType; Col: Cardinal; FromCache: boolean); overload;
-      //procedure FlushTextureDatabase();
-
-      constructor Create;
-      destructor Destroy; override;
-  end;
-
-var
-  Texture: TTextureUnit;
-
-implementation
-
-uses
-  DateUtils,
-  StrUtils,
-  Math,
-  ULog,
-  UCovers,
-  UThemes,
-  UImage;
-
-procedure AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: TTextureType);
-var
-  TempSurface: PSDL_Surface;
-  NeededPixFmt: PSDL_Pixelformat;
-begin
-  if      (Typ = TEXTURE_TYPE_PLAIN) then
-    NeededPixFmt := @PixelFmt_RGB
-  else if (Typ = TEXTURE_TYPE_TRANSPARENT) or
-          (Typ = TEXTURE_TYPE_COLORIZED) then
-    NeededPixFmt := @PixelFmt_RGBA
-  else
-    NeededPixFmt := @PixelFmt_RGB;
-
-  if not PixelformatEquals(TexSurface^.format, NeededPixFmt) then
-  begin
-    TempSurface := TexSurface;
-    TexSurface := SDL_ConvertSurface(TempSurface, NeededPixFmt, SDL_SWSURFACE);
-    SDL_FreeSurface(TempSurface);
-  end;
-end;
-  
-{ TTextureDatabase }
-
-procedure TTextureDatabase.AddTexture(var Tex: TTexture; Typ: TTextureType; Color: Cardinal; Cache: boolean);
-var
-  TextureIndex: integer;
-begin
-  TextureIndex := FindTexture(Tex.Name, Typ, Color);
-  if (TextureIndex = -1) then
-  begin
-    TextureIndex := Length(Texture);
-    SetLength(Texture, TextureIndex+1);
-
-    Texture[TextureIndex].Name  := Tex.Name;
-    Texture[TextureIndex].Typ   := Typ;
-    Texture[TextureIndex].Color := Color;
-  end;
-
-  if (Cache) then
-    Texture[TextureIndex].TextureCache := Tex
-  else
-    Texture[TextureIndex].Texture      := Tex;
-end;
-
-function TTextureDatabase.FindTexture(const Name: string; Typ: TTextureType; Color: Cardinal): integer;
-var
-  TextureIndex: integer;
-  CurrentTexture: PTextureEntry;
-begin
-  Result := -1;
-  for TextureIndex := 0 to High(Texture) do
-  begin
-    CurrentTexture := @Texture[TextureIndex];
-    if (CurrentTexture.Name = Name) and
-       (CurrentTexture.Typ = Typ) then
-    begin
-      // colorized textures must match in their color too
-      if (CurrentTexture.Typ <> TEXTURE_TYPE_COLORIZED) or
-         (CurrentTexture.Color = Color) then
-      begin
-        Result := TextureIndex;
-        Break;
-      end;
-    end;
-  end;
-end;
-
-
-{ TTextureUnit }
-
-constructor TTextureUnit.Create;
-begin
-  inherited Create;
-  TextureDatabase := TTextureDatabase.Create;
-end;
-
-destructor TTextureUnit.Destroy;
-begin
-  TextureDatabase.Free;
-  inherited Destroy;
-end;
-
-
-procedure TTextureUnit.AddTexture(var Tex: TTexture; Typ: TTextureType; Cache: boolean);
-begin
-  TextureDatabase.AddTexture(Tex, Typ, 0, Cache);
-end;
-
-procedure TTextureUnit.AddTexture(var Tex: TTexture; Typ: TTextureType; Color: Cardinal; Cache: boolean);
-begin
-  TextureDatabase.AddTexture(Tex, Typ, Color, Cache);
-end;
-
-function TTextureUnit.LoadTexture(FromRegistry: boolean; const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture;
-begin
-  // FIXME: what is the FromRegistry parameter supposed to do?
-  Result := LoadTexture(Identifier, Typ, Col);
-end;
-
-function TTextureUnit.LoadTexture(const Identifier: string): TTexture;
-begin
-  Result := LoadTexture(Identifier, TEXTURE_TYPE_PLAIN, 0);
-end;
-
-function TTextureUnit.LoadTexture(const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture;
-var
-  TexSurface: PSDL_Surface;
-  MipmapSurface: PSDL_Surface;
-  newWidth, newHeight: Cardinal;
-  oldWidth, oldHeight: Cardinal;
-  ActTex: GLuint;
-begin
-  // zero texture data
-  FillChar(Result, SizeOf(Result), 0);
-
-  // load texture data into memory
-  TexSurface := LoadImage(Identifier);
-  if not assigned(TexSurface) then
-  begin
-    Log.LogError('Could not load texture: "' + Identifier +' '+ TextureTypeToStr(Typ) +'"',
-                 'TTextureUnit.LoadTexture');
-    Exit;
-  end;
-
-  // 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
-    ScaleImage(TexSurface, newWidth, newHeight);
-
-  // now we might colorize the whole thing
-  if (Typ = TEXTURE_TYPE_COLORIZED) then
-    ColorizeImage(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
-    FitImage(TexSurface, newWidth, newHeight);
-
-  // at this point we have the image in memory...
-  // scaled to be at most 1024x1024 pixels large
-  // scaled so that dimensions are powers of 2
-  // and converted to either RGB or RGBA
-
-  // 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 = TEXTURE_TYPE_TRANSPARENT) or
-     (Typ = TEXTURE_TYPE_COLORIZED) then
-  begin
-    glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TexSurface.pixels);
-  end
-  else //if Typ = TEXTURE_TYPE_PLAIN then
-  begin
-    glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, TexSurface.pixels);
-  end;
-
-  // setup texture struct
-  with Result do
-  begin
-    X := 0;
-    Y := 0;
-    Z := 0;
-    W := 0;
-    H := 0;
-    ScaleW := 1;
-    ScaleH := 1;
-    Rot := 0;
-    TexNum := ActTex;
-    TexW := oldWidth / newWidth;
-    TexH := oldHeight / newHeight;
-
-    Int   := 1;
-    ColR  := 1;
-    ColG  := 1;
-    ColB  := 1;
-    Alpha := 1;
-
-    // new test - default use whole texure, taking TexW and TexH as const and changing these
-    TexX1 := 0;
-    TexY1 := 0;
-    TexX2 := 1;
-    TexY2 := 1;
-
-    Name := Identifier;
-  end;
-
-  SDL_FreeSurface(TexSurface);
-end;
-
-function TTextureUnit.GetTexture(const Name: string; Typ: TTextureType; FromCache: boolean): TTexture;
-begin
-  Result := GetTexture(Name, Typ, 0, FromCache);
-end;
-
-function TTextureUnit.GetTexture(const Name: string; Typ: TTextureType; Col: LongWord; FromCache: boolean): TTexture;
-var
-  TextureIndex: integer;
-  CoverIndex:   integer;
-begin
-  if (Name = '') then
-  begin
-    // zero texture data
-    FillChar(Result, SizeOf(Result), 0);
-    Exit;
-  end;
-
-  if (FromCache) then
-  begin
-    (*
-    // use cache texture
-    CoverIndex := Covers.FindCover(Name);
-
-    if TextureDatabase.Texture[TextureIndex].TextureCache.TexNum = 0 then
-    begin
-      // load texture
-      Covers.PrepareData(Name);
-      TextureDatabase.Texture[TextureIndex].TextureCache := CreateTexture(Covers.Data, Name, Covers.Cover[CoverIndex].Width, Covers.Cover[CoverIndex].Height, 24);
-    end;
-    *)
-
-    // use texture
-    TextureIndex := TextureDatabase.FindTexture(Name, Typ, Col);
-    if (TextureIndex > -1) then
-      Result := TextureDatabase.Texture[TextureIndex].TextureCache;
-    Exit;
-  end;
-
-  // find texture entry in database
-  TextureIndex := TextureDatabase.FindTexture(Name, Typ, Col);
-  if (TextureIndex = -1) then
-  begin
-    // create texture entry in database
-    TextureIndex := Length(TextureDatabase.Texture);
-    SetLength(TextureDatabase.Texture, TextureIndex+1);
-
-    TextureDatabase.Texture[TextureIndex].Name  := Name;
-    TextureDatabase.Texture[TextureIndex].Typ   := Typ;
-    TextureDatabase.Texture[TextureIndex].Color := Col;
-
-    // inform database that no textures have been loaded into memory
-    TextureDatabase.Texture[TextureIndex].Texture.TexNum      := 0;
-    TextureDatabase.Texture[TextureIndex].TextureCache.TexNum := 0;
-  end;
-
-  // load full texture
-  if (TextureDatabase.Texture[TextureIndex].Texture.TexNum = 0) then
-    TextureDatabase.Texture[TextureIndex].Texture := LoadTexture(false, Name, Typ, Col);
-
-  // use texture
-  Result := TextureDatabase.Texture[TextureIndex].Texture;
-end;
-
-function TTextureUnit.CreateTexture(Data: PChar; const Name: string; Width, Height: word; BitsPerPixel: byte): TTexture;
-var
-  Error:     integer;
-  ActTex:    GLuint;
-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_TO_EDGE);
-  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);
-
-  glTexImage2D(GL_TEXTURE_2D, 0, 3, Width, Height, 0, GL_RGB, GL_UNSIGNED_BYTE, Data);
-  
-  {
-  if Mipmapping then
-  begin
-    Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 3, W, H, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]);
-    if Error > 0 then
-      Log.LogError('gluBuild2DMipmaps() failed', 'TTextureUnit.CreateTexture');
-  end;
-  }
-  
-  Result.X := 0;
-  Result.Y := 0;
-  Result.Z := 0;
-  Result.W := 0;
-  Result.H := 0;
-  Result.ScaleW := 1;
-  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;
-
-  // 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;
-
-  Result.Name := Name;
-end;
-
-procedure TTextureUnit.UnloadTexture(const Name: string; Typ: TTextureType; FromCache: boolean);
-begin
-  UnloadTexture(Name, Typ, 0, FromCache);
-end;
-
-procedure TTextureUnit.UnloadTexture(const Name: string; Typ: TTextureType; Col: Cardinal; FromCache: boolean);
-var
-  T:      integer;
-  TexNum: GLuint;
-begin
-  T := TextureDatabase.FindTexture(Name, Typ, Col);
-
-  if not FromCache then 
-  begin
-    TexNum := TextureDatabase.Texture[T].Texture.TexNum;
-    if TexNum > 0 then
-    begin
-      glDeleteTextures(1, PGLuint(@TexNum));
-      TextureDatabase.Texture[T].Texture.TexNum := 0;
-      //Log.LogError('Unload texture no '+IntToStr(TexNum));
-    end;
-  end
-  else
-  begin
-    TexNum := TextureDatabase.Texture[T].TextureCache.TexNum;
-    if TexNum > 0 then
-    begin
-      glDeleteTextures(1, @TexNum);
-      TextureDatabase.Texture[T].TextureCache.TexNum := 0;
-      //Log.LogError('Unload texture cache no '+IntToStr(TexNum));
-    end;
-  end;
-end;
-
-(* This needs some work
-procedure TTextureUnit.FlushTextureDatabase();
-var
-  i: integer;
-  Tex: ^TTexture;
-begin
-  for i := 0 to High(TextureDatabase.Texture) do
-  begin
-    // only delete non-cached entries
-    if (TextureDatabase.Texture[i].Texture.TexNum > 0) then
-    begin
-      Tex := @TextureDatabase.Texture[i].Texture;
-      glDeleteTextures(1, PGLuint(Tex^.TexNum));
-      Tex^.TexNum := 0;
-    end;
-  end;
-end;
-*)
-
-function TextureTypeToStr(TexType: TTextureType): string;
-begin
-  Result := TextureTypeStr[TexType];
-end;
-
-function ParseTextureType(const TypeStr: string; Default: TTextureType): TTextureType;
-var
-  TexType: TTextureType;
-  UpCaseStr: string;
-begin
-  UpCaseStr := UpperCase(TypeStr);
-  for TexType := Low(TextureTypeStr) to High(TextureTypeStr) do
-  begin
-    if (UpCaseStr = UpperCase(TextureTypeStr[TexType])) then
-    begin
-      Result := TexType;
-      Exit;
-    end;
-  end;
-  Log.LogWarn('Unknown texture-type: "' + TypeStr + '"', 'ParseTextureType');
-  Result := TEXTURE_TYPE_PLAIN;
-end;
-
-end.