unit uListItem;

interface

uses
  Types,
{$IFDEF VCL}
  ComCtrls,
{$ELSE}
  QComCtrls,
{$ENDIF}
  Rubies;

var
  cListItem, cListItems: Tvalue;

//function GetItem(obj: Tvalue): TListItem;
function ap_cListItem: Tvalue;
function ap_iListItem(real: TListItem; owner: Tvalue): Tvalue;
function ap_cListItems: Tvalue;
function ap_iListItems(real: TListItems; owner: Tvalue): Tvalue;
function dl_ListItem(obj: Tvalue): TListItem;
function ap_ListItem(item: TListItem): Tvalue;
procedure Init_ListItem;

implementation

uses
  SysUtils, Classes,
  uDefUtils, uIntern, uHandle, uAlloc, uProp, uPhi, uError, uConv, uIndexer,
  uPoint, uRect, uSizeConstraints, uStrings,
  uPersistent, uComponent, uControl;

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

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

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

function ListItem_alloc1(klass: Tvalue; real: TListItem): 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, @ListItem_mark, @ListItem_free);
  rb_iv_set(result, '@events', rb_hash_new);
  real.Data := Pointer(result);
end;

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

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

function dl_ListItem(obj: Tvalue): TListItem;
begin
  result := GetItem(obj);
end;

function ap_ListItem(item: TListItem): Tvalue;
begin
  result := Qnil ; if item = nil then exit;
  result := Tvalue(item.data);
end;

function ap_cListItem: Tvalue;
begin
  result := cListItem;
end;

function ap_cListItems: Tvalue;
begin
  result := cListItems;
end;

procedure ListItem_setup(obj: Tvalue; real: TListItem);
begin
  rb_iv_set(obj, '@sub_items', ap_iStrings(real.SubItems, obj));
end;

function ListItem_alloc(This: Tvalue; real: TListItem): Tvalue;
begin
  result := ListItem_alloc1(This, real);
  ListItem_setup(result, real);
end;

function ap_iListItem(real: TListItem; owner: Tvalue): Tvalue;
begin
  result := ListItem_alloc(cListItem, real);
  ap_owner(result, owner);
end;

function ListItem_get_data(This: Tvalue): Tvalue; cdecl;
var
  p: PItem;
begin
  p := GetP(This);
  result := p^.data;
end;

function ListItem_set_data(This, v: Tvalue): Tvalue; cdecl;
var
  p: PItem;
begin
  p := GetP(This);
  p^.data := v;
  result := v;
end;

function ListItem_get_handle(This: Tvalue): Tvalue; cdecl;
var
  real: TListItem;
begin
  real := GetItem(This);
  result := ap_Handle(real.Handle);
end;

function ListItem_get_caption(This: Tvalue): Tvalue; cdecl;
var
  real: TListItem;
begin
  real := GetItem(This);
  result := ap_String(real.Caption);
end;

function ListItem_set_caption(This, v: Tvalue): Tvalue; cdecl;
var
  real: TListItem;
begin
  real := GetItem(This);
  real.Caption := dl_String(v);
  result := v;
end;

function ListItem_get_list_view(This: Tvalue): Tvalue; cdecl;
var
  real: TListItem;
begin
  real := GetItem(This);
  if real.ListView = nil then
    result := Qnil
  else
    result := real.ListView.tag;
end;

function ListItem_get_index(This: Tvalue): Tvalue; cdecl;
var
  real: TListItem;
begin
  real := GetItem(This);
  result := INT2FIX(real.Index);
end;

{$IFDEF VCL}
function ListItem_update(This: Tvalue): Tvalue; cdecl;
var
  real: TListItem;
begin
  real := GetItem(This);
  real.Update;
  result := This;
end;

function ListItem_get_left(This: Tvalue): Tvalue; cdecl;
var
  real: TListItem;
begin
  real := GetItem(This);
  result := INT2FIX(real.Left);
end;

function ListItem_get_top(This: Tvalue): Tvalue; cdecl;
var
  real: TListItem;
begin
  real := GetItem(This);
  result := INT2FIX(real.Top);
end;
{$ENDIF}

function ListItem_get_selected(This: Tvalue): Tvalue; cdecl;
var
  real: TListItem;
begin
  real := GetItem(This);
  result := ap_Bool(real.Selected);
end;

function ListItem_set_selected(This, v: Tvalue): Tvalue; cdecl;
var
  real: TListItem;
begin
  result := v;
  real := GetItem(This);
  real.Selected := dl_Boolean(v);
end;

function ListItem_get_checked(This: Tvalue): Tvalue; cdecl;
var
  real: TListItem;
begin
  real := GetItem(This);
  result := ap_Bool(real.Checked);
end;

function ListItem_set_checked(This, v: Tvalue): Tvalue; cdecl;
var
  real: TListItem;
begin
  result := v;
  real := GetItem(This);
  real.Checked := dl_Boolean(v);
end;

function ListItem_get_image_index(This: Tvalue): Tvalue; cdecl;
var
  real: TListItem;
begin
  real := GetItem(This);
  result := INT2FIX(real.ImageIndex);
end;

function ListItem_set_image_index(This, v: Tvalue): Tvalue; cdecl;
var
  real: TListItem;
begin
  real := GetItem(This);
  real.ImageIndex := NUM2INT(v);
  result := v;
end;

function ListItem_get_state_index(This: Tvalue): Tvalue; cdecl;
var
  real: TListItem;
begin
  real := GetItem(This);
  result := INT2FIX(real.StateIndex);
end;

function ListItem_set_state_index(This, v: Tvalue): Tvalue; cdecl;
var
  real: TListItem;
begin
  real := GetItem(This);
  real.StateIndex := NUM2INT(v);
  result := v;
end;

{$IFDEF VCL}
function ListItem_get_overlay_index(This: Tvalue): Tvalue; cdecl;
var
  real: TListItem;
begin
  real := GetItem(This);
  result := INT2FIX(real.OverlayIndex);
end;

function ListItem_set_overlay_index(This, v: Tvalue): Tvalue; cdecl;
var
  real: TListItem;
begin
  real := GetItem(This);
  real.OverlayIndex := NUM2INT(v);
  result := v;
end;
{$ENDIF}

function ListItem_get_sub_item_images(argc: Integer; argv: Rubies.Pvalue; This: Tvalue): Tvalue; cdecl;
var
  real: TListItem;
  index: Integer;
begin
  if argc < 1 then ap_raise(ap_eArgError, sToo_few_args);
  real := GetItem(This);
  index := argv^;
  inc(argv); dec(argc);
  result := Qnil;
  try
    result := INT2FIX(real.SubItemImages[index]);
  except
    on E: EListError do
      ap_raise(ap_eIndexError, sOut_of_range);
  end;
end;

function ListItem_set_sub_item_images(argc: Integer; argv: Rubies.Pvalue; This: Tvalue): Tvalue; cdecl;
var
  real: TListItem;
  index, v: Integer;
begin
  if argc < 2 then ap_raise(ap_eArgError, sToo_few_args);
  real := GetItem(This);
  index := argv^;
  inc(argv); dec(argc);
  v := argv^;
  inc(argv); dec(argc);
  try
    real.SubItemImages[index] := NUM2INT(v);
  except
    on E: EListError do
      ap_raise(ap_eIndexError, sOut_of_range);
  end;
  result := v;
end;

function ListItem_cancel_edit(This: Tvalue): Tvalue; cdecl;
var
  real: TListItem;
begin
  real := GetItem(This);
  real.CancelEdit;
  result := This;
end;

function ListItem_edit_caption(This: Tvalue): Tvalue; cdecl;
var
  real: TListItem;
begin
  real := GetItem(This);
  result := ap_bool(real.EditCaption);
end;

function ListItem_display_rect(This, vcode: Tvalue): Tvalue; cdecl;
var
  real: TListItem;
  Code: TDisplayCode;
begin
  real := GetItem(This);
  Code := TDisplayCode(dl_Integer(vcode));
  result := ap_iRect(real.DisplayRect(Code), This);
end;

function ListItem_get_position(This: Tvalue): Tvalue; cdecl;
var
  real: TListItem;
begin
  real := GetItem(This);
  result := ap_iPoint(real.Position, This);
end;

function ListItem_set_position(This, v: Tvalue): Tvalue; cdecl;
var
  real: TListItem;
begin
  real := GetItem(This);
  real.Position := PPoint(ap_data_get_struct(v))^;
  result := v;
end;

function ListItem_make_visible(This, vpartial: Tvalue): Tvalue; cdecl;
var
  real: TListItem;
begin
  real := GetItem(This);
  real.MakeVisible(dl_Boolean(vpartial));
  result := This;
end;

{$IFDEF VCL}
function ListItem_get_indent(This: Tvalue): Tvalue; cdecl;
var
  real: TListItem;
begin
  real := GetItem(This);
  result := ap_Integer(real.Indent);
end;

function ListItem_set_indent(This, v: Tvalue): Tvalue; cdecl;
var
  real: TListItem;
begin
  real := GetItem(This);
  real.Indent := dl_Integer(v);
  result := v;
end;

function ListItem_get_cut(This: Tvalue): Tvalue; cdecl;
var
  real: TListItem;
begin
  real := GetItem(This);
  result := ap_Bool(real.Cut);
end;

function ListItem_set_cut(This, v: Tvalue): Tvalue; cdecl;
var
  real: TListItem;
begin
  result := v;
  real := GetItem(This);
  real.Cut := dl_Boolean(v);
end;

function ListItem_get_drop_target(This: Tvalue): Tvalue; cdecl;
var
  real: TListItem;
begin
  real := GetItem(This);
  result := ap_Bool(real.DropTarget);
end;

function ListItem_set_drop_target(This, v: Tvalue): Tvalue; cdecl;
var
  real: TListItem;
begin
  result := v;
  real := GetItem(This);
  real.DropTarget := dl_Boolean(v);
end;
{$ENDIF}

function ListItem_get_deleting(This: Tvalue): Tvalue; cdecl;
var
  real: TListItem;
begin
  real := GetItem(This);
  result := ap_Bool(real.Deleting);
end;

function ListItem_get_focused(This: Tvalue): Tvalue; cdecl;
var
  real: TListItem;
begin
  real := GetItem(This);
  result := ap_Bool(real.Focused);
end;

function ListItem_set_focused(This, v: Tvalue): Tvalue; cdecl;
var
  real: TListItem;
begin
  result := v;
  real := GetItem(This);
  real.Focused := dl_Boolean(v);
end;

function ListItem_delete(This: Tvalue): Tvalue; cdecl;
var
  p: PItem;
begin
  p := GetP(This);
  p^.dead := True;
  p^.real.Delete;//Free;
  result := This;
end;

function ListItem_assign(This, v: Tvalue): Tvalue; cdecl;
var
  real: TListItem;
  source: TPersistent;
  p: PItem;
begin
  real := GetItem(This);
  if rb_obj_is_kind_of(v, cListItem) = 0 then
    ap_data_get_object(v, TPersistent, source)
  else begin
    p := ap_data_get_struct(v);
    if p^.dead then
      ap_raise(eDelphiError, 'dead item');
    source := p^.real;
  end;
  real.Assign(source);
  result := v;
end;

(**** ListItems ****)

procedure ListItems_setup(obj: Tvalue; real: TListItems);
begin
  rb_iv_set(obj, '@items', rb_ary_new);
end;

function ListItems_alloc(This: Tvalue; real: TListItems): Tvalue;
begin
  result := TmpAlloc(This, real);
  ListItems_setup(result, real);
end;

function ap_iListItems(real: TListItems; owner: Tvalue): Tvalue;
begin
  result := ListItems_alloc(cListItems, real);
  ap_owner(result, owner);
end;

function ListItems_aref(This, index: Tvalue): Tvalue; cdecl;
var
  real: TListItems;
  n: Integer;
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);
  if not TListView(real.Owner).OwnerData then
  begin
    if real[n].Data = nil then
      result := Qnil
    else
      result := Tvalue(real[n].Data);
  end
  else
  begin
    result := rb_iv_get(This, '@tmp_item');
    if result = Qnil then
    begin
      result := ap_iListItem(real[n], This);
      rb_iv_set(This, '@tmp_item', result);
    end;
  end;
end;

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

{$IFDEF VCL}
function ListItems_set_count(This, v: Tvalue): Tvalue; cdecl;
var
  real: TListItems;
begin
  real := ap_data_get_struct(This);
  real.Count := NUM2INT(v);
  result := v;
end;
{$ENDIF}

function ListItems_get_owner(This: Tvalue): Tvalue; cdecl;
var
  real: TListItems;
begin
  real := ap_data_get_struct(This);
  if real.Owner = nil then
    result := Qnil
  else
    result := real.Owner.tag
  ;
end;

function ListItems_add(This: Tvalue): Tvalue; cdecl;
var
  real: TListItems;
begin
  real := ap_data_get_struct(This);
  result := ap_iListItem(real.Add, This);
  if rb_block_given_p <> 0 then rb_obj_instance_eval(0, nil, result);
  if not TListView(real.Owner).OwnerData then
    rb_ary_push(rb_iv_get(This, '@items'), result);
end;

function ListItems_insert(This, index: Tvalue): Tvalue; cdecl;
var
  real: TListItems;
  n: Integer;
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);
  result := ap_iListItem(real.Insert(n), This);
  if not TListView(real.Owner).OwnerData then
    ap_ary_insert(rb_iv_get(This, '@items'), index, result);
end;

function ListItems_delete(This, index: Tvalue): Tvalue; cdecl;
var
  real: TListItems;
  n: Integer;
  vitem: Tvalue;
  p: PItem;
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);
  vitem := Tvalue(real[n].Data);
  p := GetP(vitem);
  p^.dead := True;
  if not TListView(real.Owner).OwnerData then
    rb_ary_delete_at(rb_iv_get(This, '@items'), n);
  real.Delete(n);
  result := This;
end;

function ListItems_clear(This: Tvalue): Tvalue; cdecl;
var
  real: TListItems;
  ary: Tvalue;
  ptr: Pvalue;
  len: Integer;
  vitem: Tvalue;
  p: PItem;
begin
  ary := rb_iv_get(This, '@items');
  ptr := ap_ary_ptr(ary);
  len := ap_ary_len(ary);
  while len > 0 do
  begin
    vitem := ptr^;
    p := GetP(vitem);
    p^.dead := True;
    Inc(ptr);
    Dec(len);
  end;
  rb_ary_clear(ary);
  real := ap_data_get_struct(This);
  real.Clear;
  result := This;
end;

function ListItems_index_of(This, v: Tvalue): Tvalue; cdecl;
var
  real: TListItems;
  item: TListItem;
begin
  real := ap_data_get_struct(This);
  ap_data_get_object(v, TListItem, item);
  result := INT2FIX(real.IndexOf(item));
end;

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

procedure Init_ListItem;
begin
  OutputConstSetType(mPhi, TypeInfo(TDisplayCode));

  cListItem := rb_define_class_under(mPhi, 'ListItem', cPersistent);
  OutputProp(cListItem, TListItem);

  DefineAttrGet(cListItem, 'data', ListItem_get_data);
  DefineAttrSet(cListItem, 'data', ListItem_set_data);
  DefineAttrGet(cListItem, 'handle', ListItem_get_handle);
  DefineAttrGet(cListItem, 'caption', ListItem_get_caption);
  DefineAttrSet(cListItem, 'caption', ListItem_set_caption);
  DefineAttrGet(cListItem, 'list_view', ListItem_get_list_view);
  DefineAttrGet(cListItem, 'index', ListItem_get_index);
{$IFDEF VCL}
  rb_define_method(cListItem, 'update', @ListItem_update, 0);
  DefineAttrGet(cListItem, 'left', ListItem_get_left);
  DefineAttrGet(cListItem, 'top', ListItem_get_top);
{$ENDIF}
  rb_define_attr(cListItem, 'sub_items', 1, 0);
  rb_define_attr(cListItem, 'owner', 1, 0);

  DefineAttrGet(cListItem, 'selected', ListItem_get_selected);
  rb_define_alias(cListItem, 'selected?', 'selected');
  DefineAttrSet(cListItem, 'selected', ListItem_set_selected);
  DefineAttrGet(cListItem, 'checked', ListItem_get_checked);
  rb_define_alias(cListItem, 'checked?', 'checked');
  DefineAttrSet(cListItem, 'checked', ListItem_set_checked);
  DefineAttrGet(cListItem, 'image_index', ListItem_get_image_index);
  DefineAttrSet(cListItem, 'image_index', ListItem_set_image_index);
  DefineAttrGet(cListItem, 'state_index', ListItem_get_state_index);
  DefineAttrSet(cListItem, 'state_index', ListItem_set_state_index);
{$IFDEF VCL}
  DefineAttrGet(cListItem, 'overlay_index', ListItem_get_overlay_index);
  DefineAttrSet(cListItem, 'overlay_index', ListItem_set_overlay_index);
{$ENDIF}
  DefineIndexer(cListItem, 'sub_item_images', @ListItem_get_sub_item_images, @ListItem_set_sub_item_images);
  rb_define_method(cListItem, 'cancel_edit', @ListItem_cancel_edit, 0);
  rb_define_method(cListItem, 'edit_caption', @ListItem_edit_caption, 0);
  rb_define_method(cListItem, 'display_rect', @ListItem_display_rect, 1);
  DefineAttrGet(cListItem, 'position', ListItem_get_position);
  DefineAttrSet(cListItem, 'position', ListItem_set_position);
  rb_define_method(cListItem, 'make_visible', @ListItem_make_visible, 1);
{$IFDEF VCL}
  DefineAttrGet(cListItem, 'indent', ListItem_get_indent);
  DefineAttrSet(cListItem, 'indent', ListItem_set_indent);
  DefineAttrGet(cListItem, 'cut', ListItem_get_cut);
  rb_define_alias(cListItem, 'cut?', 'cut');
  DefineAttrSet(cListItem, 'cut', ListItem_set_cut);
  DefineAttrGet(cListItem, 'drop_target', ListItem_get_drop_target);
  rb_define_alias(cListItem, 'drop_target?', 'drop_target');
  DefineAttrSet(cListItem, 'drop_target', ListItem_set_drop_target);
{$ENDIF}
  DefineAttrGet(cListItem, 'deleting', ListItem_get_deleting);
  rb_define_alias(cListItem, 'deleting?', 'deleting');
  DefineAttrGet(cListItem, 'focused', ListItem_get_focused);
  rb_define_alias(cListItem, 'focused?', 'focused');
  DefineAttrSet(cListItem, 'focused', ListItem_set_focused);
  rb_define_method(cListItem, 'delete', @ListItem_delete, 0);
  rb_define_method(cListItem, 'assign', @ListItem_assign, 1);

  cListItems := rb_define_class_under(mPhi, 'ListItems', cPersistent);
  OutputProp(cListItems, TListItems);

  rb_define_method(cListItems, '[]', @ListItems_aref, 1);
  DefineAttrGet(cListItems, 'count', ListItems_get_count);
{$IFDEF VCL}
  DefineAttrSet(cListItems, 'count', ListItems_set_count);
{$ENDIF}
  DefineAttrGet(cListItems, 'owner', ListItems_get_owner);
  rb_define_method(cListItems, 'add', @ListItems_add, 0);
  rb_define_method(cListItems, 'insert', @ListItems_insert, 1);
  rb_define_method(cListItems, 'delete', @ListItems_delete, 1);
  rb_define_method(cListItems, 'clear', @ListItems_clear, 0);
  rb_define_method(cListItems, 'index_of', @ListItems_index_of, 1);
{$IFDEF VCL}
  rb_define_method(cListItems, 'update', @ListItems_update, 0);
{$ENDIF}
end;

end.
