unit uParameter;

interface

uses Rubies, ADODB;

var
  cParameter, cParameters: Tvalue;

function ap_iParameter(real: TParameter; owner: Tvalue): Tvalue;
function ap_iParameters(real: TParameters; owner: Tvalue): Tvalue;
procedure Init_Parameter;

implementation

uses SysUtils, Classes, uDefUtils, Pythia, uRDBExt;

function Parameter_alloc(This: Tvalue; real: TParameter): Tvalue;
begin
  result := TmpAlloc(This, real);
end;

function ap_iParameter(real: TParameter; owner: Tvalue): Tvalue;
begin
  result := Parameter_alloc(cParameter, real);
  ap_owner(result, owner);
end;

function ap_iParameter_v(var obj; owner: Tvalue): Tvalue;
begin
  result := ap_iParameter(TParameter(obj), owner);
end;

function Parameter_assign(This, v: Tvalue): Tvalue; cdecl;
var
  real: TParameter;
  source: TPersistent;
begin
  real := ap_data_get_struct(This);
  ap_data_get_object(v, TPersistent, source);
  real.Assign(source);
  result := This;
end;

function Parameter_load(This, v, data_t: Tvalue): Tvalue; cdecl;
var
  real: TParameter;
  stream: TStream;
  DataType: TDataType;
begin
  real := ap_data_get_struct(This);
  DataType := TDataType(dl_Integer(data_t));
  case RTYPE(v) of
  T_STRING:
    try
      real.LoadFromFile(dl_String(v), DataType);
    except
      on E: EFOpenError do
        ap_raise(ap_eIOError, E.message);
    end;
  T_DATA:
    try
      ap_data_get_object(v, TStream, stream);
      real.LoadFromStream(stream, DataType);
    except
      on E: EReadError do;
    end;
  else
    ap_raise(ap_eArgError, sWrong_arg_type);
  end;
  result := This;
end;

function Parameter_get_name_path(This: Tvalue): Tvalue; cdecl;
var
  real: TParameter;
begin
  real := ap_data_get_struct(This);
  result := rb_str_new2(PChar(real.GetNamePath));
end;

function Parameter_get_value(This: Tvalue): Tvalue; cdecl;
var
  real: TParameter;
begin
  real := ap_data_get_struct(This);
  result := ap_variant(real.Value);
end;

function Parameter_set_value(This, v: Tvalue): Tvalue; cdecl;
var
  real: TParameter;
begin
  real := ap_data_get_struct(This);
  real.Value := dl_variant(v);
  result := v;
end;

//// Parameters ////

procedure Parameters_setup(obj: Tvalue; real: TParameters);
begin
  Collection_setup(obj, real);
end;

function Parameters_alloc(This: Tvalue; real: TParameters): Tvalue;
begin
  result := TmpAlloc(This, real);
  Parameters_setup(result, real);
end;

function ap_iParameters(real: TParameters; owner: Tvalue): Tvalue;
begin
  result := Parameters_alloc(cParameters, real);
  ap_owner(result, owner);
end;

function ap_iParameters_v(var obj; owner: Tvalue): Tvalue;
begin
  result := ap_iParameters(TParameters(obj), owner);
end;

function Parameters_aref(This, p: Tvalue): Tvalue; cdecl;
var
  real: TParameters;
  Parameter: TParameter;
  n: Integer;
begin
  real := ap_data_get_struct(This);
  Parameter := nil;

  case RTYPE(p) of
  T_STRING:
    begin
      Parameter := real.ParamByName(dl_String(p));
    end;
  T_FIXNUM:
    begin
      n := FIX2INT(p);
      if (n < 0) or (real.Count <= n) then
        ap_raise(ap_eIndexError, sOut_of_range);
      Parameter := real[n];
    end;
  else
    ap_raise(ap_eArgError, sWrong_arg_type);
  end;

  if Parameter = nil then
    result := Qnil
  else
    result := Collection_aref(This, ap_Fixnum(Parameter.Index));
end;

function Parameters_aset(This, p, v: Tvalue): Tvalue; cdecl;
var
  n: Integer;
  real: TParameters;
  Parameter: TParameter;
begin
  real := ap_data_get_struct(This);
  Parameter := nil;

  case RTYPE(p) of
  T_STRING:
    begin
      Parameter := real.ParamByName(dl_String(p));
    end;
  T_FIXNUM:
    begin
      n := FIX2INT(p);
      if (n < 0) or (real.Count <= n) then
        ap_raise(ap_eIndexError, sOut_of_range);
      Parameter := real[n];
    end;
  else
    ap_raise(ap_eArgError, sWrong_arg_type);
  end;

  if Parameter = nil then
    result := Qnil
  else
  begin
    Parameter.Value := dl_Variant(v);
    result := ap_iParameter(Parameter, This);
    Collection_aset(This, ap_Fixnum(Parameter.Index), result);
  end;
end;


procedure Init_Parameter;
begin
//  DefineConstSetType(mRDB, TypeInfo(TDataType));

  cParameter := DefinePersistentClass(ap_mRDB, TParameter, ap_cCollectionItem, ap_iParameter_v);
  rb_define_method(cParameter, 'assign', @Parameter_assign, 1);
  rb_define_method(cParameter, 'load', @Parameter_load, 1); // vcl: load_from_file, load_from_stream
  DefineAttrGet(cParameter, 'name_path', Parameter_get_name_path);
  DefineAttrGet(cParameter, 'value', Parameter_get_value);
  DefineAttrSet(cParameter, 'value', Parameter_set_value);

  cParameters := DefinePersistentClass(ap_mRDB, TParameters, ap_cCollection, ap_iParameters_v);
  SetCollectionItemClass(cParameters, 'TParameter');
  rb_define_method(cParameters, '[]', @Parameters_aref, 1);
  rb_define_method(cParameters, '[]=', @Parameters_aset, 2);
end;

end.
