unit uComponent;

interface

uses Rubies, SysUtils, Classes;

var
  cComponent: Tvalue;

function ap_cComponent: Tvalue;
procedure SetParentAttr(obj, ceo: Tvalue; name: String);
procedure RemoveParentAttr(real: TComponent);
procedure CompoSetup(argc: integer; argv: Pointer; real: TComponent);
procedure Init_Component;

implementation

uses
{$IFDEF VCL}
  Controls,
{$ELSE}
  QControls,
{$ENDIF}
  uConv, uDefUtils, uHandle, uError, uPhi, uProp, uPropInfo, uMarshal, uPersistent;

function ap_cComponent: Tvalue;
begin
  result := cComponent;
end;

procedure SetParentAttr(obj, ceo: Tvalue; name: String);
begin
  rb_iv_set(ceo, PChar('@'+name), obj);
  rb_define_attr(rb_singleton_class(ceo), PChar(name), 1, 0);
end;

procedure RemoveParentAttr(real: TComponent);
var
  obj, ceo: Tvalue;
begin
  if Length(real.name) = 0 then Exit;
  obj := real.tag;
  ceo := rb_iv_get(obj, '@parent');
  rb_iv_set(ceo, PChar('@'+real.name), Qnil);

  rb_undef_method(rb_singleton_class(ceo), PChar(real.name));
end;

procedure CompoSetup(argc: integer; argv: Pointer; real: TComponent);
var
  args: Pvalue;
  d_parent: TComponent;
  a_real, a_parent, a_caption, a_proc, a_default_event: Tvalue;
  d_name: string;

  procedure value_set_if_defined(obj: Tvalue; S: PChar; v:Tvalue);
  begin
    if Boolean(rb_method_boundp(CLASS_OF(obj), rb_intern(S), 1)) then
      rb_funcall2(obj, rb_intern(S), 1, @v);
  end;

begin
  args := Pvalue(argv);
  a_real := real.tag;

  if (argc > 0) and (ap_kind_of(args^, cComponent)) then
  begin
    ap_data_get_object(args^, TComponent, d_parent);
    dec(argc);
    inc(args);
  end else
    d_parent := nil;

  if d_parent = nil then
    a_parent := Qnil
  else
    a_parent := d_parent.tag;

  if (argc > 0) and (dl_class_name_of(args^) = 'Symbol') then
  begin
    d_name := dl_caption(args^);
    dec(argc);
    inc(args);
  end else if dl_Boolean(ap_const_get(mPhi, 'DELPHIAN_AUTO_NAME')) then
    d_name := dl_string(rb_funcall2(mPhi, rb_intern('delphian_auto_name'), 1, @a_real))
  else
    d_name := 'c_'+IntToStr(a_real);

  if d_parent <> nil then
    SetParentAttr(a_real, a_parent, d_name);

  try
    real.name := d_name;
  except
    on E: Exception do
        ap_raise(ap_eArgError, E.message);
  end;

  if (argc > 0) and (dl_class_name_of(args^) = 'String') then
  begin
    a_caption := args^;
    dec(argc);
    inc(args);
  end else begin
    a_caption := ap_String('');
  end;
  value_set_if_defined(a_real, 'text=', a_caption);
  value_set_if_defined(a_real, 'caption=', a_caption);

  if (argc > 0) and (dl_class_name_of(args^) = 'Proc') then
  begin
    a_proc := args^;
    a_default_event := rb_const_get(CLASS_OF(a_real), rb_intern('DEFAULT_EVENT'));
    rb_funcall2(a_real, SYM2ID(a_default_event) , 1, @a_proc);
    dec(argc);
    inc(args);
  end;

  if (real is TControl) and (d_parent is TWinControl) then
    TControl(real).parent := TWinControl(d_parent);
  rb_iv_set(a_real, '@parent', a_parent);
end;

function Component_prop_info(This, prop: Tvalue): Tvalue; cdecl;
begin
  result := PropInfo_new(cPropInfo, This, prop);
end;

function Component_dump(This, limit_obj: Tvalue): Tvalue; cdecl;
var
  real: TComponent;
  limit: Integer;
begin
  real := ap_data_get_struct(This);
  limit := FIX2INT(limit_obj);
  result := rb_str_new2(PChar(ComponentToString1(real, limit, 0)));
end;

function Component_marshal_dump(This: Tvalue): Tvalue; cdecl;
begin
  result := Component_dump(This, INT2FIX(-1));
end;

function Component_write_res_file(This, name: Tvalue): Tvalue; cdecl;
var
  real: TComponent;
begin
  real := ap_data_get_struct(This);
  WriteComponentResFile(dl_String(name), real);
  result := This;
end;

function Component_get_component_count(This: Tvalue): Tvalue; cdecl;
var
  real: TComponent;
begin
  real := ap_data_get_struct(This);
  result := INT2FIX(real.ComponentCount);
end;

function Component_get_components(This: Tvalue): Tvalue; cdecl;
var
  real: TComponent;
  i: Integer;
begin
  real := ap_data_get_struct(This);
  result := rb_ary_new;
  for i := 0 to real.ComponentCount-1 do
    rb_ary_push(result, real.Components[i].tag);
end;

procedure Init_Component;
var
  default_event: Tvalue;
begin
  cComponent := rb_define_class_under(mPhi, 'Component', ap_cPersistent);
  rb_define_method(cComponent, 'prop_info', @Component_prop_info, 1);
  rb_define_method(cComponent, '_dump', @Component_dump, 1);
  rb_define_method(cComponent, 'marshal_dump', @Component_marshal_dump, 0);
  rb_define_method(cComponent, 'write_res_file', @Component_write_res_file, 1);
  DefineAttrGet(cComponent, 'component_count', Component_get_component_count);
  DefineAttrGet(cComponent, 'components', Component_get_components);
  default_event := rb_intern('on_click=');
  rb_define_const(cComponent, 'DEFAULT_EVENT', ID2SYM(default_event));
  //rb_define_const(cComponent, 'DEFAULT_EVENT', ap_Symbol('on_click='));
end;

end.
