cgtexture.pas

一款RPG游戏的引擎可以自己制作一款RPG游戏的引擎可以自己制作

  HTile := TRUE;
  VTile := TRUE;          // Tiling is on.
  MinLinear := FALSE;
  MagLinear := FALSE;     // Linear interpolation is off.
  // Assume texture mapping function is GL_MODULATE.
  glTexEnvf(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);

end;

procedure TCGTexture.SetWidth(w: Integer);
begin

  { Resize the texture to the next power of two. The image will be severely distorted
    by this... }
  if cgIsPowerOf2(w) then inherited SetWidth(w)
  else begin
    repeat
      INC(w);
    until cgIsPowerOf2(w);
    inherited SetWidth(w);
  end;

end;

procedure TCGTexture.SetHeight(h: Integer);
begin

  if cgIsPowerOf2(h) then inherited SetHeight(h)
  else begin
    repeat
      INC(h);
    until cgIsPowerOf2(h);
    inherited SetHeight(h);
  end;

end;

procedure TCGTexture.SetHTileMode(tile: Boolean);
begin

  // Toggle horizontal tiling on/off.
  if tile then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT)
  else glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP);
  FHTile := tile;

end;

procedure TCGTexture.SetVTileMode(tile: Boolean);
begin

  // Toggle vertical tiling on/off.
  if tile then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT)
  else glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP);
  FVTile := tile;

end;

procedure TCGTexture.SetMinFilter(linear: Boolean);
begin

  // Toggle between nearest neighbour and linear interpolation for texture minification.
  if linear then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR)
  else glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  FMinLinear := linear;

end;

procedure TCGTexture.SetMagFilter(linear: Boolean);
begin

  // Toggle between nearest neighbour and linear interpolation for texture magnification.
  if linear then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR)
  else glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  FMagLinear := linear;

end;

procedure TCGTexture.Enable;
begin

  // Enable texture mapping with this image.
  // Apply the texture parameters for THIS texture, not the previous one.
  SetHTileMode(FHTile);
  SetVTileMode(FVTile);
  SetMinFilter(FMinLinear);
  SetMagFilter(FMagLinear);
  // Feed the bitmap data into OpenGL.
  glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA8, Width, Height, 0, GL_RGBA,
               GL_UNSIGNED_BYTE, Data);
  glEnable(GL_TEXTURE_2D);

end;

procedure TCGTexture.Disable;
begin

  // Disable texture mapping.
  glDisable(GL_TEXTURE_2D);

end;

procedure TCGTexture.LoadFromFile(filename: String);
var
  f: File;
  hdr: TCGImageHeader;
  i: Integer;
begin

  // Load a texture from file.
  AssignFile(f, filename);
  try
    Reset(f, 1);
    BlockRead(f, hdr, SizeOf(hdr));
    Width := hdr.Width;
    Height := hdr.Height;
    HTile := toHTile in hdr.TexOptions;
    VTile := toVTile in hdr.TexOptions;
    MinLinear := toMinLinear in hdr.TexOptions;
    MagLinear := toMagLinear in hdr.TexOptions;
    // Clear the image before (re)loading it.
    FillChar(Data^, Width * Height, 0);
    // Read pixel data row by row to avoid reading beyond EoF.
    // At this point, hdr's Width and Height might not match the texture's properties!
    for i := 0 to hdr.Height - 1 do BlockRead(f, PixelPtr(0,i)^, hdr.Width * ItemSize);
  finally
    CloseFile(f);
  end;

end;

procedure TCGTexture.LoadFromStream(s: TStream);
var
  hdr: TCGImageHeader;
  i: Integer;
begin

  // Load a texture from a stream.
  s.Read(hdr, SizeOf(hdr));
  Width := hdr.Width;
  Height := hdr.Height;
  HTile := toHTile in hdr.TexOptions;
  VTile := toVTile in hdr.TexOptions;
  MinLinear := toMinLinear in hdr.TexOptions;
  MagLinear := toMagLinear in hdr.TexOptions;
  // Clear the image before (re)loading it.
  FillChar(Data^, Width * Height, 0);
  // Read pixel data row by row to avoid reading beyond EoF.
  for i := 0 to hdr.Height - 1 do s.Read(PixelPtr(0,i)^, hdr.Width * ItemSize);

end;

procedure TCGTexture.SaveToFile(filename: String);
var
  f: File;
  hdr: TCGImageHeader;
begin

  // Save texture data to custom format for faster loading.
  AssignFile(f, filename);
  try
    Rewrite(f, 1);
    FillChar(hdr, SizeOf(hdr), 0);
    hdr.Width := FWidth;
    hdr.Height := FHeight;
    hdr.TexOptions := [];
    if HTile then hdr.TexOptions := hdr.TexOptions + [toHTile];
    if VTile then hdr.TexOptions := hdr.TexOptions + [toVTile];
    if MinLinear then hdr.TexOptions := hdr.TexOptions + [toMinLinear];
    if MagLinear then hdr.TexOptions := hdr.TexOptions + [toMagLinear];
    BlockWrite(f, hdr, SizeOf(hdr));
    // Now write pixel data.
    BlockWrite(f, Data^, Count * ItemSize);
  finally
    CloseFile(f);
  end;

end;

procedure TCGTexture.SaveToStream(s: TStream);
var
  hdr: TCGImageHeader;
begin

  // Save texture data to stream.
  FillChar(hdr, SizeOf(hdr), 0);
  hdr.Width := FWidth;
  hdr.Height := FHeight;
  hdr.TexOptions := [];
  if HTile then hdr.TexOptions := hdr.TexOptions + [toHTile];
  if VTile then hdr.TexOptions := hdr.TexOptions + [toVTile];
  if MinLinear then hdr.TexOptions := hdr.TexOptions + [toMinLinear];
  if MagLinear then hdr.TexOptions := hdr.TexOptions + [toMagLinear];
  s.Write(hdr, SizeOf(hdr));
  // Now write pixel data.
  s.Write(Data^, Count * ItemSize);

end;

{******************************************************************************}
{ TCGTEXTURELIB IMPLEMENTATION                                                }
{******************************************************************************}

constructor TCGTextureLib.Create;
begin

  inherited Create;
  FItemSize := SizeOf(TCGTexture);

end;

function TCGTextureLib.GetTexture(i: Integer): TCGTexture;
begin

  GetItem(i, Result);

end;

procedure TCGTextureLib.SetTexture(i: Integer; t: TCGTexture);
begin

  SetItem(i, t);

end;

procedure TCGTextureLib.LoadFromFile(filename: String);
var
  s: TFileStream;
  hdr: TCGTexLibHeader;
  i: Integer;
begin

  // Load textures from a library using a stream.
  s := TFileStream.Create(filename, fmOpenRead or fmShareDenyWrite);
  s.Read(hdr, SizeOf(hdr));
  Count := hdr.Count;
  for i := 0 to Count - 1 do
  begin
    Textures[i] := TCGTexture.Create;
    Textures[i].LoadFromStream(s);
  end;
  s.Free;

end;

procedure TCGTextureLib.SaveToFile(filename: String);
var
  s: TFileStream;
  hdr: TCGTexLibHeader;
  i: Integer;
begin

  // Save textures to a library using a stream.
  s := TFileStream.Create(filename, fmCreate or fmShareDenyWrite);
  FillChar(hdr, SizeOf(hdr), 0);
  hdr.Count := Count;
  s.Write(hdr, SizeOf(hdr));
  for i := 0 to Count - 1 do Textures[i].SaveToStream(s);
  s.Free;

end;

procedure TCGTextureLib.LoadFromStream(s: TStream);
var
  hdr: TCGTexLibHeader;
  i: Integer;
begin

  // Load textures from a stream.
  s.Read(hdr, SizeOf(hdr));
  Count := hdr.Count;
  for i := 0 to Count - 1 do
  begin
    Textures[i] := TCGTexture.Create;
    Textures[i].LoadFromStream(s);
  end;

end;

procedure TCGTextureLib.SaveToStream(s: TStream);
var
  hdr: TCGTexLibHeader;
  i: Integer;
begin

  // Save textures to a library using a stream.
  FillChar(hdr, SizeOf(hdr), 0);
  hdr.Count := Count;
  s.Write(hdr, SizeOf(hdr));
  for i := 0 to Count - 1 do Textures[i].SaveToStream(s);

end;

function TCGTextureLib.CopyTexture(i: Integer): TCGTexture;
begin

  { Return a copy of one of the textures. }
  Result := TCGTexture.Create;
  with Result do
  begin
    HTile := Textures[i].HTile;
    VTile := Textures[i].VTile;
    MinLinear := Textures[i].MinLinear;
    MagLinear := Textures[i].MagLinear;
    Count := Textures[i].Count;
    FWidth := Textures[i].Width;
    FHeight := Textures[i].Height;
    CopyMemory(Data, Textures[i].Data, Count * FItemSize);
  end;

end;

{ TCGTextureObject }

constructor TCGTextureObject.Create;
begin

  inherited Create;
  glGenTextures(1, @TexObject);
  glBindTexture(GL_TEXTURE_2D, TexObject);
  Image := TCGTexture.Create;

end;

destructor TCGTextureObject.Destroy;
begin

  glDeleteTextures(1, @TexObject);
  inherited Destroy;

end;

procedure TCGTextureObject.Disable;
begin

  glBindTexture(GL_TEXTURE_2D, 0);

end;

procedure TCGTextureObject.Enable;
begin

  glBindTexture(GL_TEXTURE_2D, TexObject);

end;

procedure TCGTextureObject.Upload;
begin

  Image.HTile := TRUE;
  Image.VTile := TRUE;
  Image.Enable;
  Disable;

end;

end.