unit uRect;

interface

uses
  Types,
  Rubies;

var
  cRect: Tvalue;

function ap_cRect: Tvalue;
function ap_iRect(real: TRect; owner: Tvalue): Tvalue;
procedure Init_Rect;
function dl_Rect(v: Tvalue): TRect;

implementation

uses SysUtils, uDefUtils, uIntern, uAlloc, uPhi, uConv, uPoint;

function dl_Rect(v: Tvalue): TRect;
begin
  Result := PRect(ap_data_get_struct(v))^;
end;

procedure ap_dispose(p: Pointer); cdecl;
begin
  try
    Dispose(p);
  except
    on E: Exception do;
  end;
end;

function ap_cRect: Tvalue;
begin
  result := cRect;
end;

function Rect_alloc(klass: Tvalue; real: TRect): Tvalue;
var
  p: PRect;
begin
  new(p);
  result := rb_data_object_alloc(klass, p, nil, @ap_dispose);
  p^.TopLeft     := real.TopLeft;
  p^.BottomRight := real.BottomRight;
end;

function ap_iRect(real: TRect; owner: Tvalue): Tvalue;
begin
  result := Rect_alloc(cRect, real);
  ap_owner(result, owner);
end;

function Rect_new(argc: integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
  args: array of Tvalue;
  p: PRect;
begin
  SetLength(args, argc);
  args := argv;
  new(p);
  result := rb_data_object_alloc(This, p, nil, @ap_dispose);
  case argc of
  0:
    begin
      p^.left   := 0;
      p^.top    := 0;
      p^.right  := 0;
      p^.bottom := 0;
    end;
  4:
    begin
      p^.left   := dl_Integer(args[0]);
      p^.top    := dl_Integer(args[1]);
      p^.right  := dl_Integer(args[2]);
      p^.bottom := dl_Integer(args[3]);
    end;
  else
    ap_raise(ap_eArgError, sWrong_num_of_args);
  end;
  ap_obj_call_init(result, argc, argv);
end;

function Rect_to_s(This: Tvalue): Tvalue; cdecl;
var
  real: TRect;
begin
  real := PRect(ap_data_get_struct(This))^;
  with real do result := ap_String(Format(
      '#<%s: left=%d top=%d right=%d bottom=%d>',
    [dl_class_name_of(This), left, top, right, bottom]));
end;

function Rect_to_a(This: Tvalue): Tvalue; cdecl;
begin
  with dl_Rect(This) do begin
    result := rb_ary_new;
    rb_ary_push(result, INT2FIX(left));
    rb_ary_push(result, INT2FIX(top));
    rb_ary_push(result, INT2FIX(right));
    rb_ary_push(result, INT2FIX(bottom));
  end
end;

function Rect_set_left(This, v: Tvalue): Tvalue; cdecl;
begin
  PRect(ap_data_get_struct(This))^.left := dl_Integer(v);
  result := v;
end;

function Rect_get_left(This: Tvalue): Tvalue; cdecl;
begin
  result := INT2FIX(PRect(ap_data_get_struct(This))^.left);
end;

function Rect_set_top(This, v: Tvalue): Tvalue; cdecl;
begin
  PRect(ap_data_get_struct(This))^.top := dl_Integer(v);
  result := v;
end;

function Rect_get_top(This: Tvalue): Tvalue; cdecl;
begin
  result := INT2FIX(PRect(ap_data_get_struct(This))^.top);
end;

function Rect_set_right(This, v: Tvalue): Tvalue; cdecl;
begin
  PRect(ap_data_get_struct(This))^.right := dl_Integer(v);
  result := v;
end;

function Rect_get_right(This: Tvalue): Tvalue; cdecl;
begin
  result := INT2FIX(PRect(ap_data_get_struct(This))^.right);
end;

function Rect_set_bottom(This, v: Tvalue): Tvalue; cdecl;
begin
  PRect(ap_data_get_struct(This))^.bottom := dl_Integer(v);
  result := v;
end;

function Rect_get_bottom(This: Tvalue): Tvalue; cdecl;
begin
  result := INT2FIX(PRect(ap_data_get_struct(This))^.bottom);
end;

function Rect_set_top_left(This, v: Tvalue): Tvalue; cdecl;
begin
  PRect(ap_data_get_struct(This))^.TopLeft :=
    PPoint(ap_data_get_struct(This))^;
  result := v;
end;

function Rect_get_top_left(This: Tvalue): Tvalue; cdecl;
begin
  result := ap_iPoint(PRect(ap_data_get_struct(This))^.TopLeft, Qnil);
end;

function Rect_set_bottom_right(This, v: Tvalue): Tvalue; cdecl;
begin
  PRect(ap_data_get_struct(This))^.BottomRight :=
    PPoint(ap_data_get_struct(This))^;
  result := v;
end;

function Rect_get_bottom_right(This: Tvalue): Tvalue; cdecl;
begin
  result := ap_iPoint(PRect(ap_data_get_struct(This))^.BottomRight, Qnil);
end;

procedure Init_Rect;
begin
  cRect := rb_define_class_under(mPhi, 'Rect', ap_cObject);
  DefineSingletonMethod(cRect, 'new', Rect_new);
  DefineAttrSet(cRect, 'left', Rect_set_left);
  DefineAttrGet(cRect, 'left', Rect_get_left);
  DefineAttrSet(cRect, 'top', Rect_set_top);
  DefineAttrGet(cRect, 'top', Rect_get_top);
  DefineAttrSet(cRect, 'right', Rect_set_right);
  DefineAttrGet(cRect, 'right', Rect_get_right);
  DefineAttrSet(cRect, 'bottom', Rect_set_bottom);
  DefineAttrGet(cRect, 'bottom', Rect_get_bottom);
  DefineAttrSet(cRect, 'top_left', Rect_set_top_left);
  DefineAttrGet(cRect, 'top_left', Rect_get_top_left);
  DefineAttrSet(cRect, 'bottom_right', Rect_set_bottom_right);
  DefineAttrGet(cRect, 'bottom_right', Rect_get_bottom_right);
  DefineAttrGet(cRect, 'to_s', Rect_to_s);
  DefineAttrGet(cRect, 'to_a', Rect_to_a);
  rb_define_alias(cRect, 'to_ary', 'to_a');
end;

end.
