function INT2FIX(i: Integer): Tvalue; { Fixnum }
function FIX2INT(var x): Integer;
function FIXNUM_P(var x): Boolean; function NUM2INT(var x): Integer; function NUM2UINT(var x): Cardinal;
function rb_uint2big(n: Cardinal): Tvalue; { Bignum }
function rb_int2big(n: Integer): Tvalue; { Bignum }
function rb_uint2inum(n: Cardinal): Tvalue; { Fixnum or Bignum }
function rb_int2inum(n: Integer): Tvalue; { Fixnum or Bignum }
rb_define_const(mPhi, PChar(UpperCase1('clAqua')), INT2FIX(clAqua));
clAqua 空色 clBlack 黒色 clBlue 青色 ...
print <<EOT
procedure Init_Color;
begin
EOT
while gets
name, = split(/\t/)
print <<EOT
rb_define_const(mPhi, PChar(UpperCase1('#{name}')), INT2FIX(#{name}));
EOT
end
print <<EOT
end;
EOT
ruby const.rb src.txt > out.pas
DefineConstSetType(mPhi, TypeInfo(TAlign));
[Phi::MB_OK, Phi::MB_CANCEL]
1 << Phi::MB_OK | 1 << Phi::MB_CANCEL
function ShiftStateValue(Shift: TShiftState): Tvalue; var v: Tvalue; begin v := rb_ary_new; if ssShift in Shift then rb_ary_push(v, INT2FIX(Ord(ssShift ))); if ssAlt in Shift then rb_ary_push(v, INT2FIX(Ord(ssAlt ))); if ssCtrl in Shift then rb_ary_push(v, INT2FIX(Ord(ssCtrl ))); if ssLeft in Shift then rb_ary_push(v, INT2FIX(Ord(ssLeft ))); if ssRight in Shift then rb_ary_push(v, INT2FIX(Ord(ssRight ))); if ssMiddle in Shift then rb_ary_push(v, INT2FIX(Ord(ssMiddle))); if ssDouble in Shift then rb_ary_push(v, INT2FIX(Ord(ssDouble))); result := v; end;
var
...
ary: Tvalue;
len: Integer;
ptr: Pvalue;
btns: TMsgDlgButtons;
n: Integer;
...
begin
...
Check_Type(ary, T_ARRAY);
len := ap_ary_len(ary);
ptr := ap_ary_ptr(ary);
btns := [];
while len > 0 do
begin
n := FIX2INT(ptr^);
if (n < Ord(Low(TMsgDlgBtn))) or (Ord(High(TMsgDlgBtn)) < n) then
ap_raise(ap_eIndexError, sOut_of_range);
Include(btns, TMsgDlgBtn(FIX2INT(ptr^)));
Dec(len);
Inc(ptr);
end;
...
end;
rb_data_object_alloc(klass: Tvalue; datap, dmark, dfree: Pointer): Tvalue;
function CompoAlloc(klass: Tvalue; real: TComponent): Tvalue; function FormAlloc(klass: Tvalue; real: TComponent): Tvalue; function ObjAlloc(klass: Tvalue; real: TObject): Tvalue; function ChildAlloc(klass: Tvalue; real: TComponent): Tvalue; function TmpAlloc(klass: Tvalue; real: TObject): Tvalue;
ap_data_get_struct(obj: Tvalue) : Pointer;
#define Data_Wrap_Struct(klass,mark,free,sval) (\
rb_data_object_alloc(klass,sval,mark,free)\
)
#define Data_Get_Struct(obj,type,sval) {\
Check_Type(obj, T_DATA); \
sval = (type*)DATA_PTR(obj);\
}
type
PRect = ^TRect;
function Rect_new(argc: integer; argv: Pointer; this: Tvalue): Tvalue; cdecl;
var
args: array of Tvalue;
p: PRect;
begin
SetLength(args, argc);
args := argv;
new(p);
result := rb_data_object_alloc(this, p, nil, @ap_dispose);
case argc of
0:
; // nothing
4:
begin
p^.left := FIX2INT(args[0]);
p^.top := FIX2INT(args[1]);
p^.right := FIX2INT(args[2]);
p^.bottom := FIX2INT(args[3]);
end;
else
ap_raise(ap_eArgError, sWrong_num_of_args);
end;
rb_funcall2(result, id_init, argc, argv);
end;
procedure ap_dispose(p: Pointer); begin Dispose(p); end;
procedure ObjFree(real: TObject); begin PhiObjectList.Remove(real); end; function ObjAlloc(klass: Tvalue; real: TObject): Tvalue; begin if real = nil then begin result := Qnil; exit; end; PhiObjectList.Add(real); result := rb_data_object_alloc(klass, real, nil, @ObjFree); end;
function TmpAlloc(klass: Tvalue; real: TObject): Tvalue; begin if real = nil then begin result := Qnil; exit; end; result := rb_data_object_alloc(klass, real, nil, @ObjFree); end;
procedure CompoFree(real: TComponent); begin real.tag := 0; if real.Owner <> nil then real.Owner.RemoveComponent(real); PhiObjectList.Remove(real); end; function CompoAlloc(klass: Tvalue; real: TComponent): Tvalue; begin if real = nil then begin result := Qnil; exit; end; PhiObjectList.Add(real); result := rb_data_object_alloc(klass, real, nil, @CompoFree); rb_iv_set(result, '@events', rb_hash_new); real.tag := result; end;
procedure ChildFree(real: TComponent); begin real.tag := 0; end; function ChildAlloc(klass: Tvalue; real: TComponent): Tvalue; begin if real = nil then begin result := Qnil; exit; end; result := rb_data_object_alloc(klass, real, nil, @ChildFree); rb_iv_set(result, '@events', rb_hash_new); real.tag := result; end;
procedure FormRelease(real: TForm); begin real.tag := 0; PhiObjectList.Extract(real); real.Release; end; function FormAlloc(klass: Tvalue; real: TComponent): Tvalue; begin if real = nil then begin result := Qnil; exit; end; PhiObjectList.Add(real); result := rb_data_object_alloc(klass, real, nil, @FormRelease); rb_iv_set(result, '@events', rb_hash_new); real.tag := result; end;
function NewMenu(Owner: TComponent; const AName: string; Items: array of TMenuItem): TMainMenu;
if real.Owner <> nil then real.Owner.RemoveComponent(real);
procedure TPhiHandle.doClick(Sender: TObject);
var
recv, data: Tvalue;
errno: Integer;
begin
recv := TComponent(Sender).tag;
if recv = 0 then Exit;
data := rb_ary_new;
rb_ary_push(data, rb_intern('on_click'));
rb_ary_push(data, recv);
rb_protect(PhiCall, data, @errno);
if errno <> 0 then PhiFail;
end;
procedure Button_setup(this: Tvalue; real: TButton); begin ... if @real.OnClick = nil then real.OnClick := Handle.doClick; ... end;
real.OnClick := Handle.doClick;
if @real.OnClick = nil then real.OnClick := Handle.doClick;
Handle.doClick(Sender);
function rb_eval_string(const str: PChar): Tvalue;
function RubyEvalStrings(src, args, ret: TStrings): Tvalue;
procedure PhiExport(module_name: string);
p Apollo::Form1.panel1.btn_save
procedure PhiSetInitProc(proc: TProcedure); begin init_proc := proc; end;
procedure init;
begin
PhiExport('Apollo');
end;
begin
...
PhiSetInitProc(init);
...
end;
require 'phi'
VALUE
rb_io_write(io, str)
VALUE io, str;
{
return rb_funcall(io, id_write, 1, str);
}
var name: PChar; state: Integer; begin ruby_init; ... ruby_script(name); rb_load_protect(rb_str_new2(name), 1, @state); if state <> 0 then rb_p(ap_errinfo); ... end;
unit Unit1;
interface
uses
...;
type
TForm1 = class(TForm)
Edit1: TEdit;
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
uses Ruby, PhiExtension;
{$R *.DFM}
procedure stdout(S: string);
begin
with Form1.Memo1 do
begin
with Lines do Text := Text + S;
SelStart := Length(Text);
end;
end;
procedure init;
begin
PhiExport('Foo');
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
ruby_init;
PhiInit(self);
PhiSetStdoutProc(stdout);
PhiSetInitProc(init);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
PhiHandle.Free;
end;
end.
program Foo;
uses
Forms,
PhiExtension,
Unit1 in 'Unit1.pas' {Form1};
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
PhiLoadProtect('foo.rb', nil);
Application.Run;
end.
object Form1: TForm1 OnCreate = FormCreate OnDestroy = FormDestroy object Edit1: TEdit end object Memo1: TMemo end end
require 'phi' Foo::Form1.edit1.font.color = Phi::CL_RED