unit uCanvas;

interface

uses SysUtils, Classes, DXDraws, Rubies, Pythia, uDirect;

var
  cCanvas: Tvalue;

function dx_iCanvas(real: TDirectDrawSurfaceCanvas; owner: Tvalue): Tvalue;
procedure Init_Canvas;

implementation

procedure Canvas_setup(obj: Tvalue; real: TDirectDrawSurfaceCanvas);
begin
//
end;

procedure Canvas_free(real: TDirectDrawSurfaceCanvas); cdecl;
begin
  try
    real.Release;
    PhiObjectList.Remove(real);
  except
    on E: Exception do;
  end;
end;

function Canvas_alloc(klass: Tvalue; real: TDirectDrawSurfaceCanvas): Tvalue;
begin
  if real = nil then begin result := Qnil; exit; end;
  result := rb_data_object_alloc(klass, real, nil, @Canvas_free);
  Canvas_setup(result, real);
end;

function dx_iCanvas(real: TDirectDrawSurfaceCanvas; owner: Tvalue): Tvalue;
begin
  result := Canvas_alloc(cCanvas, real);
  ap_owner(result, owner);
end;

function dx_iCanvas_v(var AControl; owner: Tvalue): Tvalue;
begin
  result := dx_iCanvas(TDirectDrawSurfaceCanvas(AControl), owner)
end;

function Canvas_release(This: Tvalue): Tvalue; cdecl;
var
  real: TDirectDrawSurfaceCanvas;
begin
  real := ap_data_get_struct(This);
  real.Release;
  result := This;
end;

procedure Init_Canvas;
begin
  RegisterClass(TDirectDrawSurfaceCanvas);
  PhiAllocFuncList.AddObject('TDirectDrawSurfaceCanvas', @dx_iCanvas_v);
  cCanvas := rb_define_class_under(mDirect, 'Canvas', ap_cCanvas);
  DefineProp(cCanvas, TDirectDrawSurfaceCanvas);
  rb_define_method(cCanvas, 'release', @Canvas_release, 0);
end;

end.
