unit uPhi;

interface

uses Rubies;

var
  mPhi: Tvalue;
  vPhiComponents: Tvalue;
  alive_p: Boolean = False;
  mainloop_p: Boolean = False;

function ap_mPhi: Tvalue;
procedure Init_phi_module;
procedure ap_obj_call_init(obj: Tvalue; argc: Integer; argv: Pvalue);
function ap_define_method(klass: Tvalue; name: PChar; func: Pointer; argc: integer): Tvalue;
procedure ap_set_child_attr_module(This: Tvalue);
procedure ap_str_cat(var str: Tvalue; S: string);
procedure ap_str_cat_int(var str: Tvalue; i: Integer);
procedure ap_raise(exc: Tvalue; S: string);
procedure ap_loaderror(S: string);
procedure ap_fatal(S: string);
procedure ap_sys_fail(S: string);
function ap_const_get(klass: Tvalue; const name: String): Tvalue;
procedure ap_const_set(klass: Tvalue; const name: String; val: Tvalue);
function ap_funcall2(recv: Tvalue; const name: String; argc: Integer; argv: Pointer): Tvalue;

implementation

uses SysUtils, uError, uStrUtils;

function ap_mPhi: Tvalue;
begin
  result := mPhi;
end;

procedure Init_phi_module;
begin
  mPhi := rb_define_module('Phi');

  vPhiComponents := rb_ary_new();
  rb_global_variable(@vPhiComponents);
end;

procedure ap_obj_call_init(obj: Tvalue; argc: Integer; argv: Pvalue);
begin
  try
    rb_obj_call_init(obj, argc, argv)
  except
    on E: Exception do
      ap_raise(eDelphiError, E.classname+': '+E.message);
  end;
end;

function ap_define_method(klass: Tvalue; name: PChar; func: Pointer; argc: integer): Tvalue;
begin
  result := rb_define_method(klass, name, func, argc);
  rb_enable_super(klass, name);
end;

procedure ap_set_child_attr_module(This: Tvalue);
var
  module: Tvalue;
begin
  module := rb_module_new;
  rb_extend_object(This, module);
  rb_iv_set(This, '@child_attr_module', module);
end;

procedure ap_str_cat(var str: Tvalue; S: string);
begin
  rb_str_cat(str, PChar(S), Length(S));
end;

procedure ap_str_cat_int(var str: Tvalue; i: Integer);
begin
  ap_str_cat(str, IntToStr(i));
end;

procedure ap_raise(exc: Tvalue; S: string);
begin
  S := deleteCR(S);
  rb_exc_raise(rb_exc_new2(exc, PChar(S)));
end;

procedure ap_loaderror(S: string);
begin
  S := deleteCR(S);
  rb_exc_raise(rb_exc_new2(ap_eLoadError, PChar(S)));
end;

procedure ap_fatal(S: string);
begin
  S := deleteCR(S);
  rb_exc_fatal(rb_exc_new2(ap_eFatal, PChar(S)));
end;

procedure ap_sys_fail(S: string);
begin
  S := deleteCR(S);
  rb_sys_fail(PChar(S));
end;

function ap_const_get(klass: Tvalue; const name: String): Tvalue;
begin
  result := rb_const_get(klass,rb_intern(PChar(name)));
end;

procedure ap_const_set(klass: Tvalue; const name: String; val: Tvalue);
begin
  rb_const_set(klass, rb_intern(PChar(name)), val);
end;

function ap_funcall2(recv: Tvalue; const name: String; argc: Integer; argv: Pointer): Tvalue;
begin
  result := rb_funcall2(recv, rb_intern(PChar(name)), argc, argv);
end;

end.
