cgtexture.pas

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

unit CgTexture;

{ CgLib: Bitmap image and texture objects.
  Version 1.10
  (c) 1998-2000 Tom Nuydens. Use at your own risk. See cglib.txt for details. }

interface

uses
  Classes, Windows, CgTypes, Graphics, JPEG, DArrays;

type
  TCGTextureOptions = (toHTile, toVTile, toMinLinear, toMagLinear);
  TCGTexOptionSet = set of TCGTextureOptions;
  TCGImageHeader = record
    Width: Integer;
    Height: Integer;                 // Dimensions.
    TexOptions: TCGTexOptionSet;     // Texture properties (used only by TCGTexture).
    Filler: array [0..118] of Byte;  // For future versions of the file format.
  end;

  TCGImage = class(TDArray)
  private
    FWidth, FHeight: Integer;
  protected
    procedure SetWidth(w: Integer); virtual;
    procedure SetHeight(h: Integer); virtual;  // Overrided in TCGTexture.
  public
    constructor Create; override;
    function GetPixel(x, y: Integer): TCGColorB;
    procedure SetPixel(x, y: Integer; color: TCGColorB);
    property Pixels[x,y: Integer]: TCGColorB read GetPixel write SetPixel; default;
    property Width: Integer read FWidth write SetWidth;
    property Height: Integer read FHeight write SetHeight;
    procedure LoadFromFile(filename: String);
    procedure LoadFromStream(s: TStream);
    procedure SaveToFile(filename: String);
    procedure SaveToStream(s: TStream);
    procedure LoadAlpha(bmp: TBitmap);
    procedure ConvertBitmap(bmp: TBitmap);
    procedure LoadJPEG(jpg: String);
    function PixelPtr(x, y: Integer): PCGColorB;
    procedure Clear;
  end;

  TCGTexture = class(TCGImage)
  private
    FHTile: Boolean;
    FVTile: Boolean;
    FMinLinear: Boolean;
    FMagLinear: Boolean;
    procedure SetHTileMode(tile: Boolean);
    procedure SetVTileMode(tile: Boolean);
    procedure SetMinFilter(linear: Boolean);
    procedure SetMagFilter(linear: Boolean);
  protected
    procedure SetWidth(w: Integer); override;
    procedure SetHeight(h: Integer); override;
  public
    constructor Create; override;
    procedure Enable;
    procedure Disable;
    procedure LoadFromFile(filename: String);
    procedure LoadFromStream(s: TStream);
    procedure SaveToFile(filename: String);
    procedure SaveToStream(s: TStream);
    property Width: Integer read FWidth write SetWidth;
    property Height: Integer read FHeight write SetHeight;
    property HTile: Boolean read FHTile write SetHTileMode;         { Tile horizontally? }
    property VTile: Boolean read FVTile write SetVTileMode;         { Tile vertically? }
    property MinLinear: Boolean read FMinLinear write SetMinFilter; { Linear filtering on }
    property MagLinear: Boolean read FMagLinear write SetMagFilter; {  min/magnification? }
  end;

  TCGTextureObject = class
  public
    Image: TCGTexture;
    TexObject: Cardinal;
    constructor Create;
    destructor Destroy; override;
    procedure Enable;
    procedure Disable;
    procedure Upload;
  end;

  TCGTexLibHeader = record
    Count: Integer;
    Filler: array [0..123] of Byte;
  end;
  TCGTextureLib = class(TDArray)
  public
    constructor Create; override;
    function GetTexture(i: Integer): TCGTexture;
    procedure SetTexture(i: Integer; t: TCGTexture);
    procedure LoadFromFile(filename: String);
    procedure SaveToFile(filename: String);
    procedure LoadFromStream(s: TStream);
    procedure SaveToStream(s: TStream);
    function CopyTexture(i: Integer): TCGTexture;
    property Textures[i: Integer]: TCGTexture read GetTexture write SetTexture; default;
  end;

  TJPEG = class(TJPEGImage)  // This class is a helper to load JPEGs as textures.
  public
    procedure DrawTo(c: TCanvas; Rect: TRect);
  end;

function cgIsPowerOf2(n: Integer): Boolean;

implementation

uses
  SysUtils, GL, CgUtils;

function cgIsPowerOf2(n: Integer): Boolean;
var
  i: Integer;
begin

  // Test if n is a power of 2.
  Result := FALSE;
  i := 0;
  while i <= (n div 2) do
  begin
    if cgIntPower(2, i) = n then
    begin
      Result := TRUE;
      Exit;
    end;
    INC(i);
  end;

end;

procedure TJPEG.DrawTo(c: TCanvas; Rect: TRect);
begin

  { It really is that easy. Draw() is a protected method, so we need a public
    wrapper for it. }
  Draw(c, Rect);

end;

{******************************************************************************}
{ TCGIMAGE IMPLEMENTATION                                                      }
{******************************************************************************}

constructor TCGImage.Create;
begin

  // Inherit Create from TDArray.
  inherited Create;
  FItemSize := SizeOf(TCGColorB);

end;

function TCGImage.GetPixel(x, y: Integer): TCGColorB;
begin

  // Get a pixel. The index is computed with y * Width + x.
  GetItem(y * Width + x, Result);

end;

procedure TCGImage.SetPixel(x, y: Integer; color: TCGColorB);
begin

  // Set a pixel.
  SetItem(y * Width + x, color);

end;

procedure TCGImage.SetWidth(w: Integer);
var
  i: Integer;
  src, dst: Pointer;
begin

  // Resize the array to accomodate width * height pixels.
  // THIS NEEDS WORK!!! Lines of data need to be moved to a new location.
  Count := FWidth * FHeight;
  for i := FHeight - 1 downto 0 do
  begin
    // Move each scanline to the appropriate location.
    src := PixelPtr(0, i);
    dst := Pointer(i * w * FItemSize);
    CopyMemory(dst, src, FWidth * FItemSize);
  end;
  FWidth := w;

end;

procedure TCGImage.SetHeight(h: Integer);
begin

  { Same as before, but set height.
    There's no need to move the original data here, because the newly allocated
    memory is appended at the end (="bottom") of the texture. }
  FHeight := h;
  Count := FWidth * FHeight;

end;

procedure TCGImage.LoadFromFile(filename: String);
var
  f: File;
  hdr: TCGImageHeader;
begin

  // Load an image from file.
  AssignFile(f, filename);
  try
    Reset(f, 1);
    BlockRead(f, hdr, SizeOf(hdr));
    Width := hdr.Width;
    Height := hdr.Height;
    // Read pixel data.
    BlockRead(f, Data^, Count * ItemSize);
  finally
    CloseFile(f);
  end;

end;

procedure TCGImage.LoadFromStream(s: TStream);
var
  hdr: TCGImageHeader;
begin

  // Load an image from a stream.
  s.Read(hdr, SizeOf(hdr));
  Width := hdr.Width;
  Height := hdr.Height;
  // Read pixel data.
  s.Read(Data^, Count * ItemSize);

end;

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

  // Save bitmap 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;
    BlockWrite(f, hdr, SizeOf(hdr));
    // Now write pixel data.
    BlockWrite(f, Data^, Count * ItemSize);
  finally
    CloseFile(f);
  end;

end;

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

  // Save bitmap data to stream.
  FillChar(hdr, SizeOf(hdr), 0);
  hdr.Width := FWidth;
  hdr.Height := FHeight;
  s.Write(hdr, SizeOf(hdr));
  // Now write pixel data.
  s.Write(Data^, Count * ItemSize);

end;

procedure TCGImage.LoadAlpha(bmp: TBitmap);
var
  x, y: Integer;
  c: TCGColorB;
begin

  { Load alpha values from a TBitmap. If the original image also came from a
    .BMP file, it didn't have an alpha channel yet. }
  for y := 0 to FHeight - 1 do
  begin
    for x := 0 to FWidth - 1 do
    begin
      c := cgTColorToCGColorB(bmp.Canvas.Pixels[x,FHeight - 1 - y], 0);
      PixelPtr(x,y)^.A := (c.R + c.G + c.B) div 3;
    end;
  end;

end;

procedure TCGImage.ConvertBitmap(bmp: TBitmap);
var
  x, y: Integer;
begin

  // Resize the array to match the bitmap.
  SetWidth(bmp.Width);
  SetHeight(bmp.Height);
  // Loop and convert pixels.
  for y := 0 to FHeight - 1 do
  begin
    for x := 0 to FWidth - 1 do
    begin
      SetPixel(x, FHeight - 1 - y, cgTColorToCGColorB(bmp.Canvas.Pixels[x,y], 255));
    end;
  end;

end;

procedure TCGImage.LoadJPEG(jpg: String);
var
  jpeg: TJPEG;
  bmp: TBitmap;
begin

  // Load an image from a JPEG file.
  jpeg := TJPEG.Create;
  jpeg.LoadFromFile(jpg);
  bmp := TBitmap.Create;
  bmp.Width := jpeg.Width;
  bmp.Height := jpeg.Height;
  jpeg.DrawTo(bmp.Canvas, Rect(0, 0, bmp.Width, bmp.Height));
  ConvertBitmap(bmp);
  bmp.Free;
  jpeg.Free;

end;

function TCGImage.PixelPtr(x, y: Integer): PCGColorB;
begin

  // Return a pointer to a given pixel.
  Result := Pointer(Integer(Data) + ((y * FWidth) + x) * ItemSize);

end;

procedure TCGImage.Clear;
begin

  // Clear the whole image to black.
  ZeroMemory(Data, FWidth * FHeight * FItemSize);

end;

{******************************************************************************}
{ TCGTEXTURE IMPLEMENTATION                                                    }
{******************************************************************************}

constructor TCGTexture.Create;
begin

  inherited Create;
  // Set default properties: }