unit uThread;

interface

uses Rubies, Classes;

var
  cThread: Tvalue;

function ap_cPhiThread: Tvalue;
function ap_iPhiThread(real: TThread; owner: Tvalue): Tvalue;
procedure Init_Thread;

implementation

uses
  PhiThread,
  uStrUtils, uDefUtils, uIntern, uHandle, uAlloc, uProp, uPhi, uConv;

function ap_cPhiThread: Tvalue;
begin
  result := cThread;
end;

function Thread_alloc(This: Tvalue; real: TThread): Tvalue;
begin
  result := TmpAlloc(This, real);
end;

function ap_iPhiThread(real: TThread; owner: Tvalue): Tvalue;
begin
  result := Thread_alloc(cThread, real);
  ap_owner(result, owner);
end;

function Thread_new(This: Tvalue): Tvalue; cdecl;
var
  real: TPhiThread;
begin
  real := TPhiThread.Create(True);
  result := ObjAlloc(This, real);
  real.set_this(result);
  rb_obj_call_init(result, 0, nil);
  real.Resume;
end;

function Thread_get_priority(This: Tvalue): Tvalue; cdecl;
var
  real: TPhiThread;
begin
  real := ap_data_get_struct(This);
  result := INT2FIX(Ord(real.Priority));
end;

{$IFDEF MSWINDOWS}
function Thread_set_priority(This, v: Tvalue): Tvalue; cdecl;
var
  real: TPhiThread;
begin
  real := ap_data_get_struct(This);
  try
    real.Priority := TThreadPriority(dl_Integer(v));
  except
    ap_raise(ap_eArgError, sOut_of_range);
  end;
  result := v;
end;
{$ENDIF}

function Thread_alive_p(This: Tvalue): Tvalue; cdecl;
var
  real: TPhiThread;
begin
  real := ap_data_get_struct(This);
  result := ap_bool(real.alive_p);
end;

function Thread_terminate(This: Tvalue): Tvalue; cdecl;
var
  real: TPhiThread;
begin
  real := ap_data_get_struct(This);
  real.Terminate;
  result := This;
end;

function Thread_sync(This: Tvalue): Tvalue; cdecl;
var
  real: TPhiThread;
begin
  real := ap_data_get_struct(This);
  real.SyncProc := rb_f_lambda;
  real.Sync;
  result := This;
end;

procedure Init_Thread;
begin
{$IFDEF MSWINDOWS}
  ap_define_const(mPhi, 'tpIdle', INT2FIX(Ord(tpIdle)));
  ap_define_const(mPhi, 'tpLowest', INT2FIX(Ord(tpLowest)));
  ap_define_const(mPhi, 'tpLower', INT2FIX(Ord(tpLower)));
  ap_define_const(mPhi, 'tpNormal', INT2FIX(Ord(tpNormal)));
  ap_define_const(mPhi, 'tpHigher', INT2FIX(Ord(tpHigher)));
  ap_define_const(mPhi, 'tpHighest', INT2FIX(Ord(tpHighest)));
  ap_define_const(mPhi, 'tpTimeCritical', INT2FIX(Ord(tpTimeCritical)));
{$ENDIF}

  cThread := rb_define_class_under(mPhi, 'Thread', ap_cObject);
  OutputClassName(cThread);
  rb_define_singleton_method(cThread, 'new', @Thread_new, 0);
  DefineAttrGet(cThread, 'priority', Thread_get_priority);
{$IFDEF MSWINDOWS}
  DefineAttrSet(cThread, 'priority', Thread_set_priority);
{$ENDIF}
  DefineAttrGet(cThread, 'alive?', Thread_alive_p);
  rb_define_method(cThread, 'terminate', @Thread_terminate, 0);
  rb_define_method(cThread, 'sync', @Thread_sync, 0);
end;

end.
