unit uCollection;

interface

uses Classes, SysUtils, Rubies;

function ap_cCollectionItem: Tvalue;
function ap_cCollection: Tvalue;
procedure SetCollectionItemClass(klass: Tvalue; name: string);
procedure Collection_setup(obj: Tvalue; real: TCollection);
function Collection_aref(This, index: Tvalue): Tvalue; cdecl;
function Collection_aset(This, index, obj: Tvalue): Tvalue; cdecl;
procedure Init_Collection;

implementation

uses uHandle, uError, uPhi, uDefUtils, uConv, uPersistent;

var
  id_item_class_name: Tid;
  cCollectionItem: Tvalue;
  cCollection: Tvalue;

function ap_cCollectionItem: Tvalue;
begin
  result := cCollectionItem;
end;

function CollectionItem_get_index(This: Tvalue): Tvalue; cdecl;
var
  real: TCollectionItem;
begin
  real := ap_data_get_struct(This);
  result := INT2FIX(real.Index);
end;

function CollectionItem_set_index(This, v: Tvalue): Tvalue; cdecl;
var
  real: TCollectionItem;
  owner, items: Tvalue;
begin
  real := ap_data_get_struct(This);
  owner := rb_iv_get(This, '@owner');
  if owner = Qnil then
    ap_fatal('owner is nil');
  items := rb_iv_get(owner, '@items');
//ap_ary_insert(items, v, rb_ary_delete_at(items, real.Index));
  ap_ary_move(items, real.Index, FIX2INT(v));
  real.Index := FIX2INT(v);
  result := v;
end;

function ap_cCollection: Tvalue;
begin
  result := cCollection;
end;

procedure SetCollectionItemClass(klass: Tvalue; name: string);
begin
  rb_define_const(klass, 'ITEM_CLASS_NAME', ap_String(name));
end;

function GetCollectionItemClass(klass: Tvalue): TAllocFunc;
var
  item_class_name: Tvalue;
begin
  item_class_name := rb_const_get(klass, id_item_class_name);
  result := GetAllocFunc(dl_String(item_class_name));
end;

procedure Collection_setup(obj: Tvalue; real: TCollection);
var
  items: Tvalue;
  CollectionItem: TCollectionItem;
  ap_iCollectionItem: TAllocFunc;
  i: Integer;
begin
  items := rb_ary_new;
  rb_iv_set(obj, '@items', items);
  ap_iCollectionItem := GetCollectionItemClass(CLASS_OF(obj));
  for i := 0 to real.Count-1 do
  begin
    CollectionItem := real.Items[i];
    rb_ary_push(items, ap_iCollectionItem(CollectionItem, obj));
  end;
end;

function Collection_add(This: Tvalue): Tvalue; cdecl;
var
  real: TCollection;
  CollectionItem: TCollectionItem;
  ap_iCollectionItem: TAllocFunc;
begin
  real := ap_data_get_struct(This);
  ap_iCollectionItem := GetCollectionItemClass(CLASS_OF(This));
  CollectionItem := real.Add;
  result := ap_iCollectionItem(CollectionItem, This);
  if rb_block_given_p <> 0 then rb_obj_instance_eval(0, nil, result);
  rb_ary_push(rb_iv_get(This, '@items'), result);
end;

function Collection_insert(This, index: Tvalue): Tvalue; cdecl;
var
  real: TCollection;
  n: Integer;
  CollectionItem: TCollectionItem;
  ap_iCollectionItem: TAllocFunc;
begin
  real := ap_data_get_struct(This);
  n := FIX2INT(index);
  if (n < 0) or (real.Count < n) then
    ap_raise(ap_eIndexError, sOut_of_range);
  ap_iCollectionItem := GetCollectionItemClass(CLASS_OF(This));
  CollectionItem := real.Insert(n);
  result := ap_iCollectionItem(CollectionItem, This);
  ap_ary_insert(rb_iv_get(This, '@items'), index, result);
end;

function Collection_delete(This, index: Tvalue): Tvalue; cdecl;
var
  real: TCollection;
  n: Integer;
begin
  real := ap_data_get_struct(This);
  n := FIX2INT(index);
  if (n < 0) or (n >= real.Count) then
    ap_raise(ap_eArgError, sOut_of_range);
  rb_ary_delete_at(rb_iv_get(This, '@items'), n);
  real.Items[n].Collection := nil;
  result := This;
end;

function Collection_get_count(This: Tvalue): Tvalue; cdecl;
var
  real: TCollection;
begin
  real := ap_data_get_struct(This);
  result := INT2FIX(real.Count);
end;

function Collection_aref(This, index: Tvalue): Tvalue; cdecl;
begin
  result := ap_ary_aref(rb_iv_get(This, '@items'), index);
end;

function Collection_aset(This, index, obj: Tvalue): Tvalue; cdecl;
var
  real: TCollection;
  n: Integer;
begin
  real := ap_data_get_struct(This);
  n := FIX2INT(index);
  try
    real.Items[n] := ap_data_get_struct(obj);
  except
    on E: Exception do
      ap_raise(ap_eArgError, E.message);
  end;
  result := obj;
  ap_ary_aset(rb_iv_get(This, '@items'), index, result);
end;

function Collection_update(This: Tvalue): Tvalue; cdecl;
var
  real: TCollection;
begin
  real := ap_data_get_struct(This);
  real.BeginUpdate;
  try
    result := rb_yield(Qnil);
  finally
    real.EndUpdate;
  end;
end;

function Collection_clear(This: Tvalue): Tvalue; cdecl;
var
  real: TCollection;
begin
  real := ap_data_get_struct(This);
  real.Clear;
  result := This;
  rb_ary_clear(rb_iv_get(This, '@items'));
end;

function Collection_get_owner(This: Tvalue): Tvalue; cdecl;
var
  real: TCollection;
begin
  real := ap_data_get_struct(This);
  if real.Owner = nil then
    result := Qnil
  else
  if real.Owner is TComponent then
    result := TComponent(real.Owner).tag
  else
    result := Qnil;
end;

procedure Init_Collection;
begin
  cCollectionItem := rb_define_class_under(ap_mPhi, 'CollectionItem', cPersistent);

  DefineAttrGet(cCollectionItem, 'index', @CollectionItem_get_index);
  DefineAttrSet(cCollectionItem, 'index', @CollectionItem_set_index);

  id_item_class_name := rb_intern('ITEM_CLASS_NAME');

  cCollection := rb_define_class_under(ap_mPhi, 'Collection', cPersistent);
  DefineAttrGet(cCollection, 'count', @Collection_get_count);

  rb_define_method(cCollection, 'add', @Collection_add, 0);
  rb_define_method(cCollection, 'insert', @Collection_insert, 1);
  rb_define_method(cCollection, 'delete', @Collection_delete, 1);

//  rb_define_method(cCollection, '[]', @Collection_aref, -1);
  rb_define_method(cCollection, '[]', @Collection_aref, 1);
  rb_define_method(cCollection, '[]=', @Collection_aset, 2);
  rb_define_method(cCollection, 'update', @Collection_update, 0);
  rb_define_method(cCollection, 'clear', @Collection_clear, 0);

  DefineAttrGet(cCollection, 'owner', Collection_get_owner);
end;

end.
