unit uSurface;

interface

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

var
  cSurface: Tvalue;

function dx_iSurface(real: TDirectDrawSurface; owner: Tvalue): Tvalue;
procedure Init_Surface;

implementation

procedure Surface_setup(obj: Tvalue; real: TDirectDrawSurface);
begin
//
end;

function Surface_alloc(This: Tvalue; real: TDirectDrawSurface): Tvalue;
begin
  result := TmpAlloc(This, real);
  Surface_setup(result, real);
end;

function dx_iSurface(real: TDirectDrawSurface; owner: Tvalue): Tvalue;
begin
  result := Surface_alloc(cSurface, real);
  ap_owner(result, owner);
end;

function dx_iSurface_v(var AControl; owner: Tvalue): Tvalue;
begin
  result := dx_iSurface(TDirectDrawSurface(AControl), owner)
end;

function Surface_fill(This, dev_color: Tvalue): Tvalue; cdecl;
var
  real: TDirectDrawSurface;
begin
  real := ap_data_get_struct(This);
  real.Fill(NUM2INT(dev_color));
  result := This;
end;

function Surface_get_canvas(This: Tvalue): Tvalue; cdecl;
var
  real: TDirectDrawSurface;
begin
  real := ap_data_get_struct(This);
  if real.Canvas = nil then
    result := Qnil
  else
    result := dx_iCanvas(real.Canvas, This);
end;

procedure Init_Surface;
begin
  RegisterClass(TDirectDrawSurface);
  PhiAllocFuncList.AddObject('TDirectDrawSurface', @dx_iSurface_v);
  cSurface := rb_define_class_under(mDirect, 'Surface', ap_cObject);
  DefineProp(cSurface, TDirectDrawSurface);
  rb_define_method(cSurface, 'fill', @Surface_fill, 1);
  DefineAttrGet(cSurface, 'canvas', Surface_get_canvas);
end;

end.
