unit uPoint;

interface

uses
  Types,
  Rubies;

var
  cPoint: Tvalue;

function ap_cPoint: Tvalue;
function ap_iPoint(real: TPoint; owner: Tvalue): Tvalue;
procedure Init_Point;

implementation

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

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

function ap_cPoint: Tvalue;
begin
  result := cPoint;
end;

function Point_alloc(klass: Tvalue; real: TPoint): Tvalue;
var
  p: PPoint;
begin
  new(p);
  result := rb_data_object_alloc(klass, p, nil, @ap_dispose);
  p^.x := real.x;
  p^.y := real.y;
end;

function ap_iPoint(real: TPoint; owner: Tvalue): Tvalue;
begin
  result := Point_alloc(cPoint, real);
  ap_owner(result, owner);
end;

function Point_new(argc: integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
  args: array of Tvalue;
  p: PPoint;
begin
  SetLength(args, argc);
  args := argv;
  new(p);
  result := rb_data_object_alloc(This, p, nil, @ap_dispose);
  case argc of
  0:
    begin
      p^.x := 0;
      p^.y := 0;
    end;
  2:
    begin
      p^.x := dl_Integer(args[0]);
      p^.y := dl_Integer(args[1]);
    end;
  else
    ap_raise(ap_eArgError, sWrong_num_of_args);
  end;

  ap_obj_call_init(result, argc, argv);
end;

function Point_to_s(This: Tvalue): Tvalue; cdecl;
var
  real: TPoint;
begin
  real := PPoint(ap_data_get_struct(This))^;
  with real do result := ap_String(Format(
    '#<%s: x=%d y=%d>', [dl_class_name_of(This), x, y]));
end;

function Point_to_a(This: Tvalue): Tvalue; cdecl;
begin
  with PPoint(ap_data_get_struct(This))^ do begin
    result := rb_ary_new;
    rb_ary_push(result, INT2FIX(x));
    rb_ary_push(result, INT2FIX(y));
  end
end;

function Point_set_x(This, v: Tvalue): Tvalue; cdecl;
begin
  PPoint(ap_data_get_struct(This))^.x := dl_Integer(v);
  result := v;
end;

function Point_get_x(This: Tvalue): Tvalue; cdecl;
begin
  result := INT2FIX(PPoint(ap_data_get_struct(This))^.x);
end;

function Point_set_y(This, v: Tvalue): Tvalue; cdecl;
begin
  PPoint(ap_data_get_struct(This))^.y := dl_Integer(v);
  result := v;
end;

function Point_get_y(This: Tvalue): Tvalue; cdecl;
begin
  result := INT2FIX(PPoint(ap_data_get_struct(This))^.y);
end;

procedure Init_Point;
begin
  cPoint := rb_define_class_under(mPhi, 'Point', ap_cObject);
  DefineSingletonMethod(cPoint, 'new', Point_new);
  DefineAttrSet(cPoint, 'x', Point_set_x);
  DefineAttrGet(cPoint, 'x', Point_get_x);
  DefineAttrSet(cPoint, 'y', Point_set_y);
  DefineAttrGet(cPoint, 'y', Point_get_y);
  DefineAttrGet(cPoint, 'to_s', Point_to_s);
  DefineAttrGet(cPoint, 'to_a', Point_to_a);
  rb_define_alias(cPoint, 'to_ary', 'to_a');
end;

end.
