unit uProperty;

interface

uses ADODB, Rubies;

var
  cBlobStream, cProperty, cPropertys: Tvalue;

function ap_iProperty(real: Property_; owner: Tvalue): Tvalue;
procedure Init_Property;

implementation

uses uDefUtils, Pythia, uRDBExt;

type
  PItem = ^TItem;
  TItem = record
    real: Property_;
    dead: Boolean;
    data: Tvalue;
  end;

procedure Property_free(p: PItem); cdecl;
begin
  dispose(p);
end;

procedure Property_mark(p: PItem); cdecl;
begin
  rb_gc_mark(Pointer(p^.data));
end;

function Property_alloc1(klass: Tvalue; real: Property_): Tvalue;
var
  p: PItem;
begin
  if real = nil then begin result := Qnil; exit; end;
  new(p);
  p^.real := real;
  p^.dead := False;
  p^.data := Qnil;
  result := rb_data_object_alloc(klass, p, @Property_mark, @Property_free);
end;

function GetP(obj: Tvalue): PItem;
begin
  if rb_obj_is_instance_of(obj, cProperty) = 0 then
    ap_raise(ap_eArgError, sWrong_arg_type);
  result := ap_data_get_struct(obj);
end;

function GetItem(obj: Tvalue): Property_;
var
  p: PItem;
begin
  p := GetP(obj);
  if p^.dead then
  begin
    ap_raise(ap_eArgError, 'dead item');
    result := nil;
  end
  else
    result := p^.real;
end;

function ap_cProperty: Tvalue;
begin
  result := cProperty;
end;

procedure Property_setup(obj: Tvalue; real: Property_);
begin
//
end;

function Property_alloc(This: Tvalue; real: Property_): Tvalue;
begin
  result := Property_alloc1(This, real);
  Property_setup(result, real);
end;

function ap_iProperty(real: Property_; owner: Tvalue): Tvalue;
begin
  result := Property_alloc(cProperty, real);
  ap_owner(result, owner);
end;

function ap_iProperty_v(var obj; owner: Tvalue): Tvalue;
begin
  result := ap_iProperty(Property_(obj), owner)
end;

function ListItem_get_value(This: Tvalue): Tvalue; cdecl;
var
  real: Property_;
begin
  real := GetItem(This);
  result := ap_Variant(real.Value);
end;

function ListItem_set_value(This, v: Tvalue): Tvalue; cdecl;
var
  real: Property_;
begin
  real := GetItem(This);
  real.Value := dl_Variant(v);
  result := v;
end;

procedure Init_Property;
begin
  cProperty := rb_define_class_under(ap_mRDB, 'Property', ap_cObject);
  DefineAttrGet(cProperty, 'value', ListItem_get_value);
  DefineAttrSet(cProperty, 'value', ListItem_set_value);
end;

end.
