library Comm;

(*
needs for compile
  http://www.moriq.com/delphi/CommX106.lzh
cf.
  [ap-list:1547]
*)

uses
{$IFDEF WIN32} FastShareMem, {$ENDIF}
  SysUtils, Classes, Controls, Rubies, Pythia, CommX, CommHandle;

{$E so}

function Comm_new(This: Tvalue): Tvalue; cdecl;
var
  real: TCommX;
begin
  real := TCommX.Create(nil);
  result := CompoAlloc(This, real);

  if @real.OnReceive = nil then real.OnReceive := Handle.doReceive;
  if @real.OnBreak = nil then real.OnBreak := Handle.doBreak;
  if @real.OnError = nil then real.OnError := Handle.doError;

  ap_obj_call_init(result, 0, nil);
end;

function Comm_send_break(This: Tvalue): Tvalue; cdecl;
var
  real: TCommX;
begin
  real := ap_data_get_struct(This);
  real.SendBreak;
  result := This;
end;

function Comm_open(This: Tvalue): Tvalue; cdecl;
var
  real: TCommX;
begin
  real := ap_data_get_struct(This);
  try
    real.PortOpen;
  except
    on E: ECommError do ap_raise(ap_eIOError, E.message);
  end;
  result := This;
end;

function Comm_close(This: Tvalue): Tvalue; cdecl;
var
  real: TCommX;
begin
  real := ap_data_get_struct(This);
  try
    real.PortClose;
  except
    on E: ECommError do ap_raise(ap_eIOError, E.message);
  end;
  result := This;
end;

function Comm_clear_receive_buf(This: Tvalue): Tvalue; cdecl;
var
  real: TCommX;
begin
  real := ap_data_get_struct(This);
  real.ClearReceiveBuf;
  result := This;
end;

function Comm_clear_send_buf(This: Tvalue): Tvalue; cdecl;
var
  real: TCommX;
begin
  real := ap_data_get_struct(This);
  real.ClearTransBuf;
  result := This;
end;

function Comm_send_char(This, c: Tvalue): Tvalue; cdecl;
var
  real: TCommX;
begin
  real := ap_data_get_struct(This);
  result := ap_bool(real.TransChar(NUM2CHR(c)));
end;

function Comm_receive_char(This: Tvalue): Tvalue; cdecl;
var
  real: TCommX;
begin
  real := ap_data_get_struct(This);
  result := INT2FIX(real.ReceiveChar);
end;

function Comm_receive(This, str: Tvalue): Tvalue; cdecl;
var
  real: TCommX;
begin
  Check_Type(str, T_STRING);
  real := ap_data_get_struct(This);
  result := INT2FIX(real.ReceiveBlock(ap_str_ptr(str), ap_str_len(str)));
end;

function Comm_send(This, str: Tvalue): Tvalue; cdecl;
var
  real: TCommX;
begin
  Check_Type(str, T_STRING);
  real := ap_data_get_struct(This);
  result := ap_bool(real.TransBlock(ap_str_ptr(str)^, ap_str_len(str)));
end;

function Comm_get_send_length(This: Tvalue): Tvalue; cdecl;
var
  real: TCommX;
begin
  real := ap_data_get_struct(This);
  result := INT2FIX(real.GetTransLength);
end;

function Comm_get_receive_length(This: Tvalue): Tvalue; cdecl;
var
  real: TCommX;
begin
  real := ap_data_get_struct(This);
  result := INT2FIX(real.GetReceiveLength);
end;

function Comm_set_rts_signal(This, signal: Tvalue): Tvalue; cdecl;
var
  real: TCommX;
begin
  real := ap_data_get_struct(This);
  real.SetRtsSignal(RTEST(signal));
  result := This;
end;

function Comm_set_dtr_signal(This, signal: Tvalue): Tvalue; cdecl;
var
  real: TCommX;
begin
  real := ap_data_get_struct(This);
  real.SetDtrSignal(RTEST(signal));
  result := This;
end;

function Comm_is_cts_signal(This: Tvalue): Tvalue; cdecl;
var
  real: TCommX;
begin
  real := ap_data_get_struct(This);
  result := ap_bool(real.IsCtsSignal);
end;

function Comm_is_dsr_signal(This: Tvalue): Tvalue; cdecl;
var
  real: TCommX;
begin
  real := ap_data_get_struct(This);
  result := ap_bool(real.IsDsrSignal);
end;

function Comm_is_Ring_signal(This: Tvalue): Tvalue; cdecl;
var
  real: TCommX;
begin
  real := ap_data_get_struct(This);
  result := ap_bool(real.IsRingSignal);
end;

function Comm_is_rlsd_signal(This: Tvalue): Tvalue; cdecl;
var
  real: TCommX;
begin
  real := ap_data_get_struct(This);
  result := ap_bool(real.IsRlsdSignal);
end;

procedure Init_comm; cdecl;
begin
  PhiStart;

  rb_eCommError := rb_define_class_under(ap_mPhi, 'CommError', ap_eStandardError);

  cComm := DefinePersistentClass(ap_mPhi, TCommX, ap_cPersistent, nil);

  DefineConstSetType(cComm, TypeInfo(TCommParityBits));
  DefineConstSetType(cComm, TypeInfo(TCommStopBits));
  DefineConstSetType(cComm, TypeInfo(TCommFlowCtrls));

  rb_define_singleton_method(cComm, 'new', @Comm_new, 0);

  rb_define_method(cComm, 'send_break', @Comm_send_break, 0);
  rb_define_method(cComm, 'open', @Comm_open, 0);
  rb_define_method(cComm, 'close', @Comm_close, 0);
  rb_define_method(cComm, 'clear_receive_buf', @Comm_clear_receive_buf, 0);
  rb_define_method(cComm, 'clear_send_buf', @Comm_clear_send_buf, 0);

  rb_define_method(cComm, 'get_send_length', @Comm_get_send_length, 0);
  rb_define_method(cComm, 'get_receive_length', @Comm_get_receive_length, 0);
  rb_define_method(cComm, 'set_rts_signal', @Comm_set_rts_signal, 1);
  rb_define_method(cComm, 'set_dtr_signal', @Comm_set_dtr_signal, 1);
  rb_define_method(cComm, 'cts_signal?', @Comm_is_cts_signal, 0);
  rb_define_method(cComm, 'dsr_signal?', @Comm_is_dsr_signal, 0);
  rb_define_method(cComm, 'ring_signal?', @Comm_is_ring_signal, 0);
  rb_define_method(cComm, 'rlsd_signal?', @Comm_is_rlsd_signal, 0);

  rb_define_method(cComm, 'send_char', @Comm_send_char, 1);
  rb_define_method(cComm, 'send', @Comm_send, 1);
  rb_define_method(cComm, 'receive_char', @Comm_receive_char, 0);
  rb_define_method(cComm, 'receive', @Comm_receive, 1);

  rb_define_alias(cComm, 'time_out_send', 'time_out_trans');
  rb_define_alias(cComm, 'time_out_send=', 'time_out_trans=');
  rb_define_alias(cComm, 'buf_len_send', 'buf_len_trans');
  rb_define_alias(cComm, 'buf_len_send=', 'buf_len_trans=');
end;

exports
  Init_comm;

end.
