unit Images;

interface

uses Windows, SysUtils;

type
  PByteArray = ^TByteArray;
  TByteArray = array[0..$FFFFFF] of byte;
  PCardinalArray = ^TCardinalArray;
  TCardinalArray = array[0..$FFFFFF] of cardinal;
  TImage = class
  public
    Data                : PByteArray;
    Width               : cardinal;
    Depth               : cardinal;
    Height              : cardinal;
    BytesPerPel         : cardinal;
    constructor Create(xsize, ysize, bpp: cardinal);
    destructor Destroy; override;
    procedure GetPixel(x, y: cardinal; var result);
    procedure SetPixel(x, y: cardinal; var value);
    procedure Stretch(newx, newy: cardinal);
    procedure Copy(image: TImage; srcx, srcy, dstx, dsty, width, height: integer);
    procedure MakeDepthMap; // WARNING!! This function is very experimental!
  end;

  TImage3D = class(TImage)
  public
    constructor Create(xsize, ysize, zsize, bpp: cardinal); reintroduce;
    destructor Destroy; override;
    procedure GetPixel(x, y, z: cardinal; var result); reintroduce;
    procedure SetPixel(x, y, z: cardinal; var value); reintroduce;
    procedure Stretch(newx, newy, newz: cardinal);
  end;

  TCompressedImage = class(TImage3D)
  public
    DataSize            : cardinal;
    InternalFormat      : cardinal;
    constructor Create(xsize, ysize, zsize, bpp, size: cardinal); reintroduce;
    destructor Destroy; override;
  end;

implementation

constructor TImage.Create;
begin
  inherited Create;

  Width         := xsize;
  Height        := ysize;
  BytesPerPel   := (bpp + 7) div 8;
  GetMem(Data, Width * Height * BytesPerPel);
end;

destructor TImage.Destroy;
begin
  FreeMem(Data, Width * Height * BytesPerPel);

  inherited Destroy;
end;

procedure TImage.GetPixel;
begin
  y := Height - y - 1;
  Move(Data^[(y*Width+x)*BytesPerPel], Result, BytesPerPel);
end;

procedure TImage.SetPixel;
begin
  y := Height - y - 1;
  Move(Value, Data^[(y*Width+x)*BytesPerPel], BytesPerPel);
end;

procedure Timage.Copy(image: TImage; srcx: Integer; srcy: Integer; dstx: Integer; dsty: Integer; width: Integer; height: Integer);
var
  i, j: Integer;
  value: cardinal;
begin
  for i := 0 to height-1 do
  for j := 0 to width-1 do
  begin
    GetPixel(srcx+j, srcy+i, value);
    image.SetPixel(dstx+j, dsty+i, value);
  end;
end;

procedure TImage.Stretch;
var
  i, ii, j, jj: longint;
  p: PByteArray;
  value: cardinal;
begin
  GetMem(p, newx * newy * BytesPerPel);
{$WARNINGS OFF}
  for i := 1 to newy do
  for j := 1 to newx do
  begin
    ii := (i * Height) div newy - 1;
    jj := (j * Width) div newx - 1;
    if ii < 0 then ii := 0;
    if jj < 0 then jj := 0;
    if ii >= Height then ii := Height-1;
    if jj >= Width then jj := Width-1;
    Move(Data^[(ii*Width+jj)*BytesPerPel], value, BytesPerPel);
    Move(value, p^[((i-1)*newx+(j-1))*BytesPerPel], BytesPerPel);
  end;
{$WARNINGS ON}
  FreeMem(Data, Width * Height * BytesPerPel);
  Data          := p;
  Width         := newx;
  Height        := newy;
end;

procedure TImage.MakeDepthMap;
var
  data2: PByteArray;
  i, j: integer;
  xchg, k: byte;
begin
  Width := Width div 4;
  GetMem(data2, Width * Height * BytesPerPel);
  for i := 0 to Height-1 do
  for j := 0 to Width-1 do
  begin
    data2[(i*Width + j)*BytesPerPel +0] := Data[(i*Width*4 + j)*BytesPerPel +2];
    data2[(i*Width + j)*BytesPerPel +1] := Data[(i*Width*4 + j)*BytesPerPel +2];
    data2[(i*Width + j)*BytesPerPel +2] := Data[(i*Width*4 + j)*BytesPerPel +2];
    data2[(i*Width + j)*BytesPerPel +3] := Data[(i*Width*4 + j)*BytesPerPel +2]; 
  end;
  for i := 0 to Height-1 do
  for j := 0 to (Width div 4)-1 do
  for k := 0 to 3 do
  begin
    xchg := data2[(i*Width + j*4)*BytesPerPel +k];
    data2[(i*Width + j*4)*BytesPerPel +k] := data2[(i*Width + j*4+2)*BytesPerPel +k];
    data2[(i*Width + j*4+2)*BytesPerPel +k] := xchg;
  end;
  FreeMem(Data, Width * Height * BytesPerPel * 4);
  Data := data2;
end;

constructor TImage3D.Create;
begin
  Width                 := xsize;
  Height                := ysize;
  Depth                 := zsize;
  BytesPerPel           := (bpp + 7) div 8;
  GetMem(Data, Width * Height * Depth * BytesPerPel);
end;

destructor TImage3D.Destroy;
begin
  FreeMem(Data, Width * Height * Depth * BytesPerPel);
end;

procedure TImage3D.GetPixel;
begin
  y := Height - y - 1;
  Move(Data^[(((z*Height)+y)*Width+x)*BytesPerPel], result, BytesPerPel);
end;

procedure TImage3D.SetPixel;
begin
  y := Height - y - 1;
  Move(value, Data^[(((z*Height)+y)*Width+x)*BytesPerPel], BytesPerPel);
end;

procedure TImage3D.Stretch;
var
  i, ii, j, jj, k, kk: longint;
  p: PByteArray;
  value: cardinal;
begin
  GetMem(p, newx * newy * newz * BytesPerPel);
{$WARNINGS OFF}
  for k := 1 to newz do
  for i := 1 to newy do
  for j := 1 to newx do
  begin
    kk := (k * Depth) div newz - 1;
    ii := (i * Height) div newy - 1;
    jj := (j * Width) div newx - 1;
    if kk < 0 then kk := 0;
    if ii < 0 then ii := 0;
    if jj < 0 then jj := 0;
    if kk >= Depth then kk := Depth-1;
    if ii >= Height then ii := Height-1;
    if jj >= Width then jj := Width-1;
    Move(Data^[((kk*Height+ii)*Width+jj)*BytesPerPel], value, BytesPerPel);
    Move(value, p^[(((k-1)*newy+i-1)*newx+(j-1))*BytesPerPel], BytesPerPel);
  end;
{$WARNINGS ON}
  FreeMem(Data, Width * Height * BytesPerPel);
  Data          := p;
  Width         := newx;
  Height        := newy;
end;

constructor TCompressedImage.Create;
begin
  DataSize      := size;
  Width         := xsize;
  Height        := ysize;
  Depth         := zsize;
  BytesPerPel   := (bpp + 7) div 8;
  GetMem(Data, DataSize);
end;

destructor TCompressedImage.Destroy;
begin
  FreeMem(Data, DataSize);
end;

end.
