unit BGRAZenGL;

{ This unit is to be used with BGRABitmapPack4NoGUI_OpenGL

  Add this unit to the Uses clause of your application.
  Note that it is not registered in BGRABitmap package,
  in order to be linked to ZenGL.

  So you must either:
  - supply the full path for this unit like this
  
    Uses BGRAZenGL in '..\bgrabitmap\bgrazengl.pas'; 
	
  - or copy this unit into ZenGL source path 
    
  Other units do not require copying }  

{$mode delphi}

interface

{$DEFINE USE_ZENGL_SPRITE_ENGINE}

uses
  Classes,
  BGRAOpenGLType, BGRASpriteGL,
  BGRAGraphics, BGRABitmap, BGRABitmapTypes,
  zgl_textures, zgl_memory, FPimage, zgl_font,
  zgl_math_2d, zgl_sengine_2d,
  BGRATransform;

type
  TAlignment = Classes.TAlignment;
  TTextLayout = BGRAGraphics.TTextLayout;
  TOpenGLResampleFilter = BGRAOpenGLType.TOpenGLResampleFilter;

const
  taLeftJustify = Classes.taLeftJustify;
  taCenter = Classes.taCenter;
  taRightJustify = Classes.taRightJustify;

  tlTop = BGRAGraphics.tlTop;
  tlCenter = BGRAGraphics.tlCenter;
  tlBottom = BGRAGraphics.tlBottom;

  orfBox = BGRAOpenGLType.orfBox;
  orfLinear = BGRAOpenGLType.orfLinear;

type
  IBGLFont = BGRAOpenGLType.IBGLFont;
  IBGLTexture = BGRAOpenGLType.IBGLTexture;

  { TBGLBitmap }

  TBGLBitmap = class(TBGLCustomBitmap)
  protected
    function GetOpenGLMaxTexSize: integer; override;
    procedure NotifySizeTooBigForOpenGL; override;
  public
    constructor Create(AFilename: string); override; overload; //UTF8 by default
    constructor Create(var AMemory: zglTMemory); overload;
    function NewBitmap(Filename: string): TBGRACustomBitmap; override; overload;  //UTF8 by default
    procedure LoadFromFile(const filename: string); override; overload; //UTF8 by default
    procedure LoadFromFile(const filename: String; Handler: TFPCustomImageReader); override; overload; //UTF8 by default
    procedure SaveToFile(const filename: string); override; overload; //UTF8 by default
    procedure SaveToFile(const filename: string; Handler: TFPCustomImageWriter); override; overload; //UTF8 by default
  end;

  { TBGLSprite }

{$IFDEF USE_ZENGL_SPRITE_ENGINE}
  TBGLSprite = class(TBGLCustomSprite)
  private
    function GetZenSprite: zglPSprite2D;
  protected
    FColor  : TBGRAPixel;
    FHorizontalAlign: TAlignment;
    FVerticalAlign: TTextLayout;
    function GetHorizontalAlign: TAlignment; override;
    function GetVerticalAlign: TTextLayout; override;
    procedure SetHorizontalAlign(AValue: TAlignment); override;
    procedure SetVerticalAlign(AValue: TTextLayout); override;
    function GetAlpha: Integer; override;
    function GetAngle: Single; override;
    function GetColor: TBGRAPixel; override;
    function GetDestroy: Boolean;
    function GetActualFrame: Single; override;
    function GetH: Single; override;
    function GetLayer: Integer; override;
    function GetW: Single; override;
    function GetX: Single; override;
    function GetY: Single; override;
    procedure SetAlpha(AValue: Integer); override;
    procedure SetAngle(AValue: Single); override;
    procedure SetColor(AValue: TBGRAPixel); override;
    procedure SetDestroy(AValue: Boolean);
    procedure SetActualFrame(AValue: Single); override;
    procedure SetH(AValue: Single); override;
    procedure SetLayer(AValue: Integer); override;
    procedure SetW(AValue: Single); override;
    procedure SetX(AValue: Single); override;
    procedure SetY(AValue: Single); override;
    property ZenSprite: zglPSprite2D read GetZenSprite;
    procedure CreateHandle(ATexture: IBGLTexture; ALayer: Integer); override;
  public
    procedure QueryDestroy; override;
  end;
{$ELSE}
  TBGLSprite = TBGLDefaultSprite;
{$ENDIF}

function BGRAToZenGL(AColor: TBGRAPixel): Longword;
function ZenGLToBGRA(AColor: LongWord): TBGRAPixel; overload;
function ZenGLToBGRA(AColor: LongWord; AAlpha: byte): TBGRAPixel; overload;
function ColorToZenGL(AColor: TColor): Longword;

function BGLZenFont(AFilename: UTF8String): IBGLFont; overload;
function BGLZenFont(AZenFont: zglPFont): IBGLFont; overload;

function BGLTexture(ATexture: TBGLTextureHandle; AWidth,AHeight: integer): IBGLTexture; overload;
function BGLTexture(ARGBAData: PBGRAPixel; AllocatedWidth,AllocatedHeight, ActualWidth,ActualHeight: integer): IBGLTexture; overload;
function BGLTexture(AFPImage: TFPCustomImage): IBGLTexture; overload;
function BGLTexture(ABitmap: TBitmap): IBGLTexture; overload;
function BGLTexture(AWidth, AHeight: integer; Color: TColor): IBGLTexture; overload;
function BGLTexture(AWidth, AHeight: integer; Color: TBGRAPixel): IBGLTexture; overload;
function BGLTexture(AFilenameUTF8: string): IBGLTexture; overload;
function BGLTexture(AStream: TStream): IBGLTexture; overload;
function BGLTexture(var AMemory: zglTMemory): IBGLTexture; overload;

function BGLSpriteEngine: TBGLCustomSpriteEngine;

implementation

uses Types, zgl_utils, zgl_opengl_all, zgl_opengl, zgl_render_2d,
  zgl_sprite_2d, zgl_log, zgl_fx, zgl_file, zgl_text;

type
  PSpriteData = ^TSpriteData;
  TSpriteData = record
    ZenSprite: zglTSprite2D;
    Obj: TBGLCustomSprite;
  end;

  { TZenMemoryStream }

  TZenMemoryStream = class(TStream)
  private
    function GetHandle: zglPMemory;
  protected
    FZenMemory: zglPMemory;
    FZenMemoryOwned: boolean;
    function GetSize: Int64; override;
    procedure SetSize(NewSize: Longint); override; overload;
    function GetPosition: Int64; override;
  public
    constructor Create; overload;
    constructor Create(AHandle: zglPMemory); overload;
    destructor Destroy; override;
    function Read(var Buffer; Count: Longint): Longint; override;
    function Write(const Buffer; Count: Longint): Longint; override;
    function Seek(Offset: Longint; Origin: Word): Longint; override;
    property Handle: zglPMemory read FZenMemory;
  end;

  { TBGLTexture }

  TBGLTexture = class(TBGLCustomTexture)
  protected
    FZenFlags: LongWord;

    function GetOpenGLMaxTexSize: integer; override;
    function CreateOpenGLTexture(ARGBAData: PBGRAPixel; AAllocatedWidth, AAllocatedHeight, AActualWidth, AActualHeight: integer): TBGLTextureHandle; override;
    procedure UpdateOpenGLTexture(ATexture: TBGLTextureHandle; ARGBAData: PBGRAPixel; AAllocatedWidth, AAllocatedHeight, AActualWidth,AActualHeight: integer); override;
    procedure SetOpenGLTextureSize(ATexture: TBGLTextureHandle; AAllocatedWidth, AAllocatedHeight, AActualWidth, AActualHeight: integer); override;
    procedure ComputeOpenGLFramesCoord(ATexture: TBGLTextureHandle; FramesX: Integer=1; FramesY: Integer=1); override;
    function GetOpenGLFrameCount(ATexture: TBGLTextureHandle): integer; override;
    function GetEmptyTexture: TBGLTextureHandle; override;
    procedure FreeOpenGLTexture(ATexture: TBGLTextureHandle); override;
    procedure UpdateGLResampleFilter(ATexture: TBGLTextureHandle; AFilter: TOpenGLResampleFilter); override;

    procedure DoStretchDraw(x,y,w,h: single; AColor: TBGRAPixel); override;
    procedure DoStretchDrawAngle(x,y,w,h,angleDeg: single; rotationCenter: TPointF; AColor: TBGRAPixel); override;
    procedure DoDrawAffine(Origin, HAxis, VAxis: TPointF; AColor: TBGRAPixel); override;
    procedure ToggleFlipX; override;
    procedure ToggleFlipY; override;
    procedure Init(ATexture: TBGLTextureHandle; AWidth,AHeight: integer; AOwned: boolean); override;
    procedure NotifyInvalidFrameSize; override;
    procedure NotifyErrorLoadingFile(AFilename: string); override;

    function NewEmpty: TBGLCustomTexture; override;
    function NewFromTexture(ATexture: TBGLTextureHandle; AWidth,AHeight: integer): TBGLCustomTexture; override;
    function Duplicate: TBGLCustomTexture; override;
    procedure FreeMemoryOnDestroy; override;
  public
    constructor Create(var AMemory: zglTMemory); overload;
  end;

  { TBGRAZenFont }

  TBGRAZenFont = class(TBGLCustomFont)
  protected
    FZenFont: zglPFont;
    FZenFontOwned: boolean;
    FFlags: LongWord;
    FGradientColors: array[1..4] of TBGRAPixel;
    function LoadFromFile(AFilename: UTF8String): boolean; override;
    function GetPage(AIndex: integer): zglPTexture;
    procedure SetPage(AIndex: integer; AValue: zglPTexture);
    function GetFlags: LongWord;

    procedure Init; override;
    procedure FreeMemoryOnDestroy; override;
    procedure DoTextOut(X, Y: Single; const Text : UTF8String; AColor: TBGRAPixel); override;
    procedure DoTextRect(X, Y, Width, Height: Single; const Text : UTF8String; AColor: TBGRAPixel); override;

    function GetClipped: boolean; override;
    function GetUseGradientColors: boolean; override;
    function GetJustify: boolean; override;
    procedure SetClipped(AValue: boolean); override;
    procedure SetUseGradientColors(AValue: boolean); override;
    procedure SetJustify(AValue: boolean); override;
  public
    constructor Create(AHandle: zglPFont); overload;
    procedure FreeMemory; override;
    procedure SetGradientColors(ATopLeft, ATopRight, ABottomRight, ABottomLeft: TBGRAPixel); override;
    function TextWidth(const Text: UTF8String): single; override;
    function TextHeight(const Text: UTF8String): single; override; overload;
    function TextHeight(const Text: UTF8String; AWidth: single): single; override; overload;
  end;

  { TBGLZenSpriteEngine }

  TBGLZenSpriteEngine = class(TBGLCustomSpriteEngine)
  protected
    FSprites: array of TBGLCustomSprite;
    function GetCount: integer; override;
    function GetSprite(AIndex: integer): TBGLCustomSprite; override;
  public
    procedure Add(ASprite: TBGLCustomSprite); override;
    procedure OnDraw; override;
    procedure OnTimer; override;
    procedure Clear; override;
    procedure Delete(AIndex: integer); override;
  end;

function BGRAToZenGL(AColor: TBGRAPixel): Longword;
begin
  result := (AColor.red shl 16) + (AColor.green shl 8) + AColor.blue;
end;

function ZenGLToBGRA(AColor: LongWord): TBGRAPixel;
begin
  result := ZenGLToBGRA(AColor,255);
end;

function ZenGLToBGRA(AColor: LongWord; AAlpha: byte): TBGRAPixel;
begin
  result.red := AColor shr 16 and $ff;
  result.green := AColor shr 8 and $ff;
  result.blue := AColor and $ff;
  result.alpha := AAlpha;
end;

function ColorToZenGL(AColor: TColor): Longword;
var r,g,b: byte;
begin
  RedGreenBlue(AColor,r,g,b);
  result := (r shl 16) + (g shl 8) + b;
end;

function BGLZenFont(AFilename: UTF8String): IBGLFont;
begin
  result := TBGRAZenFont.Create(AFilename);
end;

function BGLZenFont(AZenFont: zglPFont): IBGLFont;
begin
  result := TBGRAZenFont.Create(AZenFont);
end;

function BGLTexture(ATexture: TBGLTextureHandle; AWidth, AHeight: integer
  ): IBGLTexture;
begin
  result := TBGLTexture.Create(ATexture, AWidth,AHeight);
end;

function BGLTexture(ARGBAData: PBGRAPixel; AllocatedWidth, AllocatedHeight,
  ActualWidth, ActualHeight: integer): IBGLTexture;
begin
  result := TBGLTexture.Create(ARGBAData, AllocatedWidth,AllocatedHeight,ActualWidth,ActualHeight);
end;

function BGLTexture(AFPImage: TFPCustomImage): IBGLTexture;
begin
  result := TBGLTexture.Create(AFPImage);
end;

function BGLTexture(ABitmap: TBitmap): IBGLTexture;
begin
  result := TBGLTexture.Create(ABitmap);
end;

function BGLTexture(AWidth, AHeight: integer; Color: TColor): IBGLTexture;
begin
  result := TBGLTexture.Create(AWidth,AHeight,Color);
end;

function BGLTexture(AWidth, AHeight: integer; Color: TBGRAPixel): IBGLTexture;
begin
  result := TBGLTexture.Create(AWidth,AHeight,Color);
end;

function BGLTexture(AFilenameUTF8: string): IBGLTexture;
begin
  result := TBGLTexture.Create(AFilenameUTF8);
end;

function BGLTexture(AStream: TStream): IBGLTexture;
begin
  result := TBGLTexture.Create(AStream);
end;

function BGLTexture(var AMemory: zglTMemory): IBGLTexture;
begin
  result := TBGLTexture.Create(AMemory);
end;

function BGLSpriteEngine: TBGLCustomSpriteEngine;
begin
  result := BGRASpriteGL.BGLSpriteEngine;
end;

{ TBGLZenSpriteEngine }

function TBGLZenSpriteEngine.GetCount: integer;
begin
  result := sengine2d_Get.Count;
end;

function TBGLZenSpriteEngine.GetSprite(AIndex: integer): TBGLCustomSprite;
begin
  if (AIndex < 0) or (AIndex >= Count) then
    result := nil
  else
    result := PSpriteData(sengine2d_Get.List[AIndex])^.Obj;
end;

procedure TBGLZenSpriteEngine.Add(ASprite: TBGLCustomSprite);
begin
  //nothing, already added when creating handle
end;

procedure TBGLZenSpriteEngine.OnDraw;
begin
  sengine2d_Draw();
end;

procedure TBGLZenSpriteEngine.OnTimer;
begin
  sengine2d_Proc();
end;

procedure TBGLZenSpriteEngine.Clear;
begin
  sengine2d_ClearAll();
end;

procedure TBGLZenSpriteEngine.Delete(AIndex: integer);
begin
  sengine2d_DelSprite( AIndex );
end;

{ TBGLSprite }

{$IFDEF USE_ZENGL_SPRITE_ENGINE}
function TBGLSprite.GetZenSprite: zglPSprite2D;
begin
  result := zglPSprite2D(FHandle);
end;

function TBGLSprite.GetHorizontalAlign: TAlignment;
begin
  result := FHorizontalAlign;
end;

function TBGLSprite.GetVerticalAlign: TTextLayout;
begin
  result := FVerticalAlign;
end;

procedure TBGLSprite.SetHorizontalAlign(AValue: TAlignment);
begin
  FHorizontalAlign := AValue;
end;

procedure TBGLSprite.SetVerticalAlign(AValue: TTextLayout);
begin
  FVerticalAlign := AValue;
end;

function TBGLSprite.GetAlpha: Integer;
begin
  result := ZenSprite.Alpha;
end;

function TBGLSprite.GetAngle: Single;
begin
  result := ZenSprite.Angle;
end;

function TBGLSprite.GetColor: TBGRAPixel;
begin
  result := FColor;
  result.alpha:= ZenSprite.Alpha;
end;

function TBGLSprite.GetDestroy: Boolean;
begin
  result := ZenSprite.Destroy;
end;

function TBGLSprite.GetActualFrame: Single;
begin
  result := ZenSprite.Frame;
end;

function TBGLSprite.GetH: Single;
begin
  result := ZenSprite.H;
end;

function TBGLSprite.GetLayer: Integer;
begin
  result := ZenSprite.Layer;
end;

function TBGLSprite.GetW: Single;
begin
  result := ZenSprite.W;
end;

function TBGLSprite.GetX: Single;
begin
  result := ZenSprite.X;
end;

function TBGLSprite.GetY: Single;
begin
  result := ZenSprite.Y;
end;

procedure TBGLSprite.SetAlpha(AValue: Integer);
begin
  ZenSprite.Alpha := AValue;
end;

procedure TBGLSprite.SetAngle(AValue: Single);
begin
  ZenSprite.Angle := AValue;
end;

procedure TBGLSprite.SetColor(AValue: TBGRAPixel);
begin
  FColor := AValue;
  ZenSprite.Alpha := AValue.alpha;
end;

procedure TBGLSprite.SetDestroy(AValue: Boolean);
begin
  ZenSprite.Destroy := AValue;
end;

procedure TBGLSprite.SetActualFrame(AValue: Single);
begin
  ZenSprite.Frame := AValue;
end;

procedure TBGLSprite.SetH(AValue: Single);
begin
  ZenSprite.H := AValue;
end;

procedure TBGLSprite.SetLayer(AValue: Integer);
begin
  ZenSprite.Layer := AValue;
end;

procedure TBGLSprite.SetW(AValue: Single);
begin
  ZenSprite.W := AValue;
end;

procedure TBGLSprite.SetX(AValue: Single);
begin
  ZenSprite.X := AValue;
end;

procedure TBGLSprite.SetY(AValue: Single);
begin
  ZenSprite.Y := AValue;
end;

procedure SpriteDrawHandler( var Sprite : TSpriteData);
begin
  if Assigned(Sprite.Obj) then
    Sprite.Obj.OnDraw;
end;

procedure SpriteProcHandler( var Sprite : TSpriteData);
begin
  if Assigned(Sprite.Obj) then
    Sprite.Obj.OnTimer;
end;

procedure SpriteFreeHandler( var Sprite : TSpriteData);
begin
  if Assigned(Sprite.Obj) then
  begin
    Sprite.Obj.Free;
    Sprite.Obj := nil;
  end;
end;

procedure TBGLSprite.CreateHandle(ATexture: IBGLTexture; ALayer: Integer);
begin
  FHandle := sengine2d_AddCustom(ATexture.Handle, SizeOf(TSpriteData), ALayer, nil, @SpriteDrawHandler, @SpriteProcHandler, @SpriteFreeHandler);
  TSpriteData(FHandle^).Obj := self;
end;

procedure TBGLSprite.QueryDestroy;
begin
  SetDestroy(True);
end;
{$ENDIF}

{ TBGRAZenFont }

function TBGRAZenFont.GetClipped: boolean;
begin
  result := (FFlags and TEXT_CLIP_RECT)<>0;
end;

function TBGRAZenFont.GetJustify: boolean;
begin
  result := (FFlags and TEXT_HALIGN_JUSTIFY)<>0;
end;

function TBGRAZenFont.GetPage(AIndex: integer): zglPTexture;
begin
  if FZenFont = nil then
    result := nil
  else
    result := FZenFont.Pages[AIndex];
end;

function TBGRAZenFont.GetUseGradientColors: boolean;
begin
  result := (FFlags and TEXT_FX_VCA)<>0;
end;

procedure TBGRAZenFont.SetClipped(AValue: boolean);
begin
  if AValue then
    FFlags:= FFlags or TEXT_CLIP_RECT
  else
    FFlags:= FFlags and not TEXT_CLIP_RECT;
end;

procedure TBGRAZenFont.SetJustify(AValue: boolean);
begin
  if AValue then
    FFlags:= FFlags or TEXT_HALIGN_JUSTIFY
  else
    FFlags:= FFlags and not TEXT_HALIGN_JUSTIFY;
end;

procedure TBGRAZenFont.SetPage(AIndex: integer; AValue: zglPTexture);
begin
  if FZenFont <> nil then
  begin
    if (AIndex >= 0) and (AIndex < length(FZenFont.Pages)) then
      FZenFont.Pages[AIndex] := AValue;
  end;
end;

procedure TBGRAZenFont.SetUseGradientColors(AValue: boolean);
begin
  if AValue then
    FFlags:= FFlags or TEXT_FX_VCA
  else
    FFlags:= FFlags and not TEXT_FX_VCA;
end;

procedure TBGRAZenFont.Init;
begin
  inherited Init;
  FZenFont := nil;
  FZenFontOwned := false;
  FFlags:= 0;
  FGradientColors[1] := BGRAWhite;
  FGradientColors[2] := BGRAWhite;
  FGradientColors[3] := BGRAWhite;
  FGradientColors[4] := BGRAWhite;
end;

procedure TBGRAZenFont.FreeMemoryOnDestroy;
begin
  //do not free memory because it is taken care of by ZenGL
end;

function TBGRAZenFont.LoadFromFile(AFilename: UTF8String): boolean;
var
  fntMem : zglTMemory;
  i, j   : Integer;
  dir    : UTF8String;
  name   : UTF8String;
  tmp    : UTF8String;
  imgFormat: TBGRAImageFormat;
  tempBmp: TBGLBitmap;
  newFont: zglPFont;
begin
  Result := false;
  newFont := nil;

  if not file_Exists( AFilename ) Then
    begin
      log_Add( 'Cannot read "' + AFilename + '"' );
      exit;
    end;

  mem_LoadFromFile( fntMem, AFilename );
  font_Load( newFont, fntMem );
  mem_Free( fntMem );

  if not Assigned( newFont ) Then
    begin
      log_Add( 'Unable to load font: "' + AFilename + '"' );
      exit;
    end;

  FZenFont := newFont;
  FZenFontOwned := true;
  dir  := file_GetDirectory( AFilename );
  name := file_GetName( AFilename );
  for i := 0 to newFont.Count.Pages - 1 do
    for imgFormat:= low(TBGRAImageFormat) to high(TBGRAImageFormat) do
      if Assigned(DefaultBGRAImageReader[imgFormat]) then
      begin
        tmp := dir + name + '-page' + u_IntToStr( i ) + '.' + SuggestImageExtension(imgFormat);
        if file_Exists( tmp ) Then
          begin
            tempBmp := TBGLBitmap.Create(tmp, True);
            tempBmp.VerticalFlip;
            newFont.Pages[ i ] := tempBmp.MakeTextureAndFree.Handle;
            break;
          end;
      end;
end;

procedure TBGRAZenFont.DoTextOut(X, Y: Single;
  const Text: UTF8String; AColor: TBGRAPixel);
begin
  text_DrawEx(FZenFont, X,Y,FScale,FStepX, Text, AColor.alpha, BGRAToZenGL(AColor), GetFlags);
end;

procedure TBGRAZenFont.DoTextRect(X, Y, Width, Height: Single; const Text : UTF8String; AColor: TBGRAPixel);
var r: zglTRect;
begin
  r.X := X;
  r.Y := Y;
  r.W := Width;
  r.H := Height;
  text_DrawInRectEx(FZenFont, r, FScale,FStepX, Text, AColor.alpha, BGRAToZenGL(AColor), GetFlags);
end;

function TBGRAZenFont.GetFlags: LongWord;
begin
  result := FFlags;
  if GetJustify then
    result := result OR TEXT_HALIGN_JUSTIFY
  else
    case GetHorizontalAlign of
      taCenter: result:= result or TEXT_HALIGN_CENTER;
      taRightJustify: result:= result or TEXT_HALIGN_RIGHT;
      else
        result:= result or TEXT_HALIGN_LEFT;
    end;
  case GetVerticalAlign of
    tlCenter: result:= result or TEXT_VALIGN_CENTER;
    tlBottom: result:= result or TEXT_VALIGN_BOTTOM;
    else
      result:= result or TEXT_VALIGN_TOP;
  end;
  if GradientColors then
    fx2d_SetVCA( BGRAToZenGL(FGradientColors[1]), BGRAToZenGL(FGradientColors[2]), BGRAToZenGL(FGradientColors[3]), BGRAToZenGL(FGradientColors[4]),
       FGradientColors[1].alpha, FGradientColors[2].alpha, FGradientColors[3].alpha, FGradientColors[4].alpha );
end;

constructor TBGRAZenFont.Create(AHandle: zglPFont);
begin
  Init;
  FZenFont := AHandle;
  FZenFontOwned := false;
end;

function TBGRAZenFont.TextWidth(const Text: UTF8String): single;
begin
  result := text_GetWidth(FZenFont, Text, FStepX)*FScale;
end;

function TBGRAZenFont.TextHeight(const Text: UTF8String): single;
begin
  result := FZenFont.MaxHeight*FScale;
end;

function TBGRAZenFont.TextHeight(const Text: UTF8String; AWidth: single
  ): single;
begin
  result := text_GetHeight(FZenFont, AWidth, Text, FScale, FStepX);
end;

procedure TBGRAZenFont.FreeMemory;
begin
  if FZenFontOwned then
  begin
    font_Del(FZenFont);
    FZenFont := nil;
  end;
end;

procedure TBGRAZenFont.SetGradientColors(ATopLeft, ATopRight, ABottomRight, ABottomLeft: TBGRAPixel);
begin
  FGradientColors[1] := ATopLeft;
  FGradientColors[2] := ATopRight;
  FGradientColors[3] := ABottomRight;
  FGradientColors[4] := ABottomLeft;
  GradientColors := true;
end;

{ TZenMemoryStream }

function TZenMemoryStream.GetHandle: zglPMemory;
begin
  result := @FZenMemory;
end;

function TZenMemoryStream.GetSize: Int64;
begin
  Result:= FZenMemory^.Size;
end;

procedure TZenMemoryStream.SetSize(NewSize: Longint);
begin
  if NewSize < 0 then NewSize := 0;
  mem_SetSize(FZenMemory^, NewSize);
end;

function TZenMemoryStream.GetPosition: Int64;
begin
  Result:= FZenMemory.Position;
end;

constructor TZenMemoryStream.Create;
begin
  New(FZenMemory);
  FillChar(FZenMemory, SizeOf(zglTMemory), 0);
  FZenMemoryOwned := true;
end;

constructor TZenMemoryStream.Create(AHandle: zglPMemory);
begin
  FZenMemory := AHandle;
  FZenMemoryOwned := false;
end;

destructor TZenMemoryStream.Destroy;
begin
  if FZenMemoryOwned then
  begin
    Dispose(FZenMemory);
    FZenMemory := nil;
  end;
  inherited Destroy;
end;

function TZenMemoryStream.Read(var Buffer; Count: Longint): Longint;
begin
  if Count < 0 then Count := 0;
  result := mem_Read(FZenMemory^, Buffer, Count);
end;

function TZenMemoryStream.Write(const Buffer; Count: Longint): Longint;
begin
  if Count < 0 then Count := 0;
  result := mem_Write(FZenMemory^, Buffer, Count);
end;

function TZenMemoryStream.Seek(Offset: Longint; Origin: Word): Longint;
begin
  result := mem_Seek(FZenMemory^, Offset, Origin+1);
end;

{ TBGLTexture }

procedure TBGLTexture.ComputeOpenGLFramesCoord( ATexture : TBGLTextureHandle; FramesX : Integer = 1; FramesY : Integer = 1 );
  var
    i,ix,iy : Integer;
    tX, tY, fU, fV : Single;
begin
  with (zglPTexture(ATexture)^) do
  begin
    if FramesX <= 0 Then FramesX := 1;
    if FramesY <= 0 Then FramesY := 1;

    SetLength( FramesCoord, FramesX * FramesY + 1 );
    fU := U / FramesX;
    fV := V / FramesY;

    FramesCoord[ 0, 0 ].X := 0;
    FramesCoord[ 0, 0 ].Y := 0;
    FramesCoord[ 0, 1 ].X := U;
    FramesCoord[ 0, 1 ].Y := 0;
    FramesCoord[ 0, 2 ].X := U;
    FramesCoord[ 0, 2 ].Y := V;
    FramesCoord[ 0, 3 ].X := 0;
    FramesCoord[ 0, 3 ].Y := V;
    ix := 1;
    iy := 1;
    for i := 1 to FramesX * FramesY do
      begin
        tX := ix * fU;
        tY := iy * fV;

        FramesCoord[ i, 0 ].X := tX - fU;
        FramesCoord[ i, 0 ].Y := tY - fV;

        FramesCoord[ i, 1 ].X := tX;
        FramesCoord[ i, 1 ].Y := tY - fV;

        FramesCoord[ i, 2 ].X := tX;
        FramesCoord[ i, 2 ].Y := tY;

        FramesCoord[ i, 3 ].X := tX - fU;
        FramesCoord[ i, 3 ].Y := tY;

        inc(ix);
        if ix > FramesX then
        begin
          ix := 1;
          inc(iy);
        end;
      end;
  end;
end;

function TBGLTexture.GetOpenGLFrameCount(ATexture: TBGLTextureHandle): integer;
begin
  if ATexture = nil then
    result := 0
  else
  begin
    result := length(zglPTexture(ATexture)^.FramesCoord);
    if result > 0 then dec(result); //frame 0 is the whole picture
  end;
end;

function TBGLTexture.GetEmptyTexture: TBGLTextureHandle;
begin
  result := managerZeroTexture;
end;

procedure TBGLTexture.SetOpenGLTextureSize(ATexture: TBGLTextureHandle; AAllocatedWidth,AAllocatedHeight, AActualWidth,AActualHeight: integer);
begin
  with (zglPTexture(ATexture)^) do
  begin
    Width := AActualWidth;
    Height:= AActualHeight;
    U := AActualWidth/AAllocatedWidth;
    V := AActualHeight/AAllocatedHeight;
  end;
end;

procedure TBGLTexture.UpdateOpenGLTexture(ATexture: TBGLTextureHandle;
  ARGBAData: PBGRAPixel; AAllocatedWidth, AAllocatedHeight, AActualWidth,
  AActualHeight: integer);
begin
  batch2d_Flush;
  SetOpenGLTextureSize(ATexture, AAllocatedWidth,AAllocatedHeight, AActualWidth,AActualHeight);
  with (zglPTexture(ATexture)^) do
  begin
    dec(oglVRAMUsed, Round(Width/U) * Round(Height/V)*4);
    glBindTexture( GL_TEXTURE_2D, ID );
    glTexImage2D( GL_TEXTURE_2D, 0, GL_RGBA, AAllocatedWidth, AAllocatedHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, ARGBAData );
    inc(oglVRAMUsed, AAllocatedWidth*AAllocatedHeight*4);
  end;
end;

function TBGLTexture.GetOpenGLMaxTexSize: integer;
begin
  result := oglMaxTexSize;
end;

function TBGLTexture.CreateOpenGLTexture(ARGBAData: PBGRAPixel; AAllocatedWidth, AAllocatedHeight, AActualWidth, AActualHeight: integer): TBGLTextureHandle;
var tex: zglPTexture;
begin
  tex := tex_Add;
  tex.Format := TEX_FORMAT_RGBA;
  tex.Flags := TEX_FILTER_LINEAR;
  tex.Width := AAllocatedWidth;
  tex.Height := AAllocatedHeight;
  tex.U := 1;
  tex.V := 1;
  batch2d_Flush;
  tex_CreateGL(tex^, Pointer(ARGBAData));
  SetOpenGLTextureSize(tex, AAllocatedWidth,AAllocatedHeight, AActualWidth,AActualHeight);
  result := tex;
end;

procedure TBGLTexture.DoStretchDraw(x, y, w, h: single; AColor: TBGRAPixel);
begin
  if AColor.Alpha = 0 then exit;
  if (BGRAToColor(AColor)=clWhite) and not FIsMask then
  begin
    if FFrame > 0 then
     asprite2d_Draw( FOpenGLTexture, x, y, w, h, 0, FFrame, AColor.Alpha, FZenFlags)
    else
     ssprite2d_Draw( FOpenGLTexture, x, y, w, h, 0, AColor.Alpha, FZenFlags);
  end else
  begin
    fx2d_SetColor(BGRAToZenGL(AColor));
    if FIsMask then fx_SetColorMode( FX_COLOR_SET );
    if FFrame > 0 then
      asprite2d_Draw( FOpenGLTexture, x, y, w, h, 0, FFrame, AColor.Alpha, FZenFlags OR FX_COLOR)
    else
      ssprite2d_Draw( FOpenGLTexture, x, y, w, h, 0, AColor.Alpha, FZenFlags OR FX_COLOR);
    if FIsMask then fx_SetColorMode( FX_COLOR_MIX );
  end;
end;

procedure TBGLTexture.DoStretchDrawAngle(x, y, w,h, angleDeg: single;
  rotationCenter: TPointF; AColor: TBGRAPixel);
begin
  if AColor.Alpha = 0 then exit;
  fx2d_SetRotatingPivot(rotationCenter.X-x,rotationCenter.Y-y);
  if (BGRAToColor(AColor)=clWhite) and not FIsMask then
  begin
    if FFrame > 0 then
      asprite2d_Draw( FOpenGLTexture, x,y, w, h, angleDeg, FFrame, AColor.Alpha , FZenFlags OR FX2D_RPIVOT)
    else
      ssprite2d_Draw( FOpenGLTexture, x,y, w, h, angleDeg, AColor.Alpha , FZenFlags OR FX2D_RPIVOT)
  end
  else
  begin
    fx2d_SetColor(BGRAToZenGL(AColor));
    if FIsMask then fx_SetColorMode( FX_COLOR_SET );
    if FFrame > 0 then
      asprite2d_Draw( FOpenGLTexture, x,y, w, h, angleDeg, FFrame, AColor.Alpha , FZenFlags OR FX2D_RPIVOT or FX_COLOR)
    else
      ssprite2d_Draw( FOpenGLTexture, x,y, w, h, angleDeg, AColor.Alpha , FZenFlags OR FX2D_RPIVOT or FX_COLOR);
    if FIsMask then fx_SetColorMode( FX_COLOR_MIX );
  end;
end;

procedure TBGLTexture.DoDrawAffine(Origin, HAxis, VAxis: TPointF;
  AColor: TBGRAPixel);
var oldFlags: LongWord;
  p1,p2,p3,p4: TPointF;
begin
  oldFlags:= FZenFlags;
  FZenFlags:= FZenFlags or FX2D_VCHANGE;
  p1 := PointF(0,0);
  p2 := HAxis - (Origin+PointF(Width,0));
  p3 := HAxis+(VAxis-Origin) - (Origin+PointF(Width,Height));
  p4 := VAxis - (Origin+PointF(0,Height));
  fx2d_SetVertexes(p1.x,p1.y,p2.x,p2.y,p3.x,p3.y,p4.x,p4.y);
  DoStretchDraw(Origin.x,Origin.y, Width,Height, AColor);
  FZenFlags:= oldFlags;
end;

procedure TBGLTexture.ToggleFlipX;
begin
  FZenFlags := FZenFlags xor FX2D_FLIPX;
end;

procedure TBGLTexture.ToggleFlipY;
begin
  FZenFlags := FZenFlags xor FX2D_FLIPY;
end;

procedure TBGLTexture.Init(ATexture: TBGLTextureHandle; AWidth, AHeight: integer; AOwned: boolean);
begin
  inherited Init(ATexture,AWidth,AHeight,AOwned);
  FZenFlags:= FX_BLEND;
end;

procedure TBGLTexture.NotifyInvalidFrameSize;
begin
  log_Add('Invalid frame size');
end;

procedure TBGLTexture.NotifyErrorLoadingFile(AFilename: string);
begin
  log_Add('Cannot load "'+AFilename+'"');
end;

function TBGLTexture.NewEmpty: TBGLCustomTexture;
begin
  result := TBGLTexture.Create;
end;

function TBGLTexture.NewFromTexture(ATexture: TBGLTextureHandle;
  AWidth, AHeight: integer): TBGLCustomTexture;
begin
  result := TBGLTexture.Create(ATexture,AWidth,AHeight);
end;

function TBGLTexture.Duplicate: TBGLCustomTexture;
begin
  result := inherited Duplicate;
  if (result is TBGLTexture) then
    TBGLTexture(result).FZenFlags := FZenFlags;
end;

procedure TBGLTexture.FreeMemoryOnDestroy;
begin
  //do not free handle, ZenGL takes care of it
end;

constructor TBGLTexture.Create(var AMemory: zglTMemory);
var s: TStream;
begin
  s := TZenMemoryStream.Create(@AMemory);
  InitFromStream(s);
  s.Free;
end;

procedure TBGLTexture.FreeOpenGLTexture(ATexture: TBGLTextureHandle);
begin
  if (ATexture <> nil) and (ATexture <> managerZeroTexture) then
  begin
    tex_Del(ATexture);
    FOpenGLTexture:= nil;
  end;
end;

procedure TBGLTexture.UpdateGLResampleFilter(ATexture: TBGLTextureHandle;
  AFilter: TOpenGLResampleFilter);
begin
  batch2d_Flush;
  glBindTexture( GL_TEXTURE_2D, (zglPTexture(ATexture)^).ID );
  if AFilter = orfLinear then
  begin
    glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR );
    glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR );
  end else
  begin
    glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST );
    glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST );
  end;
end;

{ TBGLBitmap }

function TBGLBitmap.GetOpenGLMaxTexSize: integer;
begin
  result := oglMaxTexSize;
end;

procedure TBGLBitmap.NotifySizeTooBigForOpenGL;
begin
  log_Add('Size too big for OpenGL');
end;

constructor TBGLBitmap.Create(AFilename: string);
begin
  inherited Create(AFilename, True);
end;

constructor TBGLBitmap.Create(var AMemory: zglTMemory);
var s: TStream;
begin
  s := TZenMemoryStream.Create(@AMemory);
  try
    inherited Create(s);
  finally
    s.Free;
  end;
end;

function TBGLBitmap.NewBitmap(Filename: string): TBGRACustomBitmap;
begin
  Result:=inherited NewBitmap(Filename, True);
end;

procedure TBGLBitmap.LoadFromFile(const filename: string);
begin
  inherited LoadFromFileUTF8(filename);
end;

procedure TBGLBitmap.LoadFromFile(const filename: String;
  Handler: TFPCustomImageReader);
begin
  inherited LoadFromFileUTF8(filename, Handler);
end;

procedure TBGLBitmap.SaveToFile(const filename: string);
begin
  inherited SaveToFileUTF8(filename);
end;

procedure TBGLBitmap.SaveToFile(const filename: string;
  Handler: TFPCustomImageWriter);
begin
  inherited SaveToFileUTF8(filename, Handler);
end;

initialization

  BGLBitmapFactory := TBGLBitmap;
  BGLTextureFactory := TBGLTexture;
{$IFDEF USE_ZENGL_SPRITE_ENGINE}
  BGRASpriteGL.BGLSpriteEngine := TBGLZenSpriteEngine.Create;
{$ELSE}
  BGRASpriteGL.BGLSpriteEngine := TBGLDefaultSpriteEngine.Create;
{$ENDIF}

finalization

  BGRASpriteGL.BGLSpriteEngine.Free;
  BGRASpriteGL.BGLSpriteEngine := nil;

end.

