unit uStream;

interface

uses Rubies, SysUtils, Classes;

var
  cStream, cFileStream, cStringStream, cMemoryStream: Tvalue;

function ap_cStream: Tvalue;
function ap_iStream(real: TStream; owner: Tvalue): Tvalue;
procedure Init_Stream;

implementation

uses uIntern, uAlloc, uStrUtils, uDefUtils, uPhi, uConv;

function ap_cStream: Tvalue;
begin
  result := cStream;
end;

procedure Stream_setup(obj: Tvalue; real: TStream);
begin
//
end;

function Stream_alloc(This: Tvalue; real: TStream): Tvalue;
begin
  result := TmpAlloc(This, real);
  Stream_setup(result, real);
end;

function ap_iStream(real: TStream; owner: Tvalue): Tvalue;
begin
  result := Stream_alloc(cStream, real);
  ap_owner(result, owner);
end;

function Stream_get_position(This: Tvalue): Tvalue; cdecl;
var
  real: TStream;
begin
  real := ap_data_get_struct(This);
  result := INT2FIX(real.Position);
end;

function Stream_set_position(This, v: Tvalue): Tvalue; cdecl;
var
  real: TStream;
begin
  real := ap_data_get_struct(This);
  real.Position := FIX2INT(v);
  result := v;
end;

function Stream_get_size(This: Tvalue): Tvalue; cdecl;
var
  real: TStream;
begin
  real := ap_data_get_struct(This);
  result := INT2FIX(real.size);
end;

function Stream_set_size(This, v: Tvalue): Tvalue; cdecl;
var
  real: TStream;
begin
  real := ap_data_get_struct(This);
  real.size := FIX2INT(v);
  result := v;
end;

function Stream_seek(argc: Integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
  args: array of Tvalue;
  offset: Longint;
  origin: Word;
  real: TStream;
begin
  if argc < 1 then ap_raise(ap_eArgError, sToo_few_args);
  SetLength(args, argc);
  args := argv;

  offset := FIX2INT(args[0]);

  if argc > 1 then
    origin := FIX2INT(args[1])
  else
    origin := soFromBeginning;

  real := ap_data_get_struct(This);
  result := real.Seek(offset, origin);
end;

function Stream_write_component(This, cmp: Tvalue): Tvalue; cdecl;
var
  real: TStream;
  Component: TComponent;
begin
  real := ap_data_get_struct(This);
  ap_data_get_object(cmp, TComponent, Component);
  try
    real.WriteComponent(Component);
  except
    on E: Exception do
      ap_raise(ap_eIOError, E.message);
  end;
  result := This;
end;

function FileStream_new(argc: Integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
  args: array of Tvalue;
  name: string;
  mode: Word;
  real: TFileStream;
begin
  if argc < 1 then ap_raise(ap_eArgError, sToo_few_args);
  SetLength(args, argc);
  args := argv;

  name := dl_String(args[0]);

  if argc > 1 then
    mode := FIX2INT(args[1])
  else
    mode := fmOpenReadWrite;

  real := TFileStream.Create(name, mode);
  result := ObjAlloc(This, real);

  ap_obj_call_init(result, argc, argv);
end;

function StringStream_new(argc: Integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
  args: array of Tvalue;
  S: string;
  real: TStringStream;
begin
  SetLength(args, argc);
  args := argv;

  if argc > 0 then
    S := dl_String(args[0]);

  real := TStringStream.Create(S);
  result := ObjAlloc(This, real);

  ap_obj_call_init(result, argc, argv);
end;

function StringStream_get_data_string(This: Tvalue): Tvalue; cdecl;
var
  real: TStringStream;
begin
  real := ap_data_get_struct(This);
  result := ap_String(real.DataString);
end;

function MemoryStream_new(This: Tvalue): Tvalue; cdecl;
var
  real: TMemoryStream;
begin
  real := TMemoryStream.Create;
  result := ObjAlloc(This, real);

  ap_obj_call_init(result, 0, nil);
end;

function MemoryStream_write(This,v: Tvalue): Tvalue; cdecl;
var
  real: TMemoryStream;
  str: Tvalue;
  ptr: Pointer;
  len: LongInt;
begin
  str := rb_str_to_str(v);
  ptr := ap_str_ptr(str);
  len := ap_str_len(str);
  real := ap_data_get_struct(This);
  result:= ap_Fixnum(real.Write(ptr^, len));
end;

function MemoryStream_load(This, v: Tvalue): Tvalue; cdecl;
var
  real: TMemoryStream;
  stream: TStream;
begin
  real := ap_data_get_struct(This);
  case RTYPE(v) of
  T_STRING:
    try
      real.LoadFromFile(dl_String(v));
    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);
    except
      on E: EReadError do;
    end;
  end;
  result := This;
end;

function MemoryStream_save(This, v: Tvalue): Tvalue; cdecl;
var
  real: TMemoryStream;
  stream: TStream;
begin
  real := ap_data_get_struct(This);
  case RTYPE(v) of
  T_STRING:
    try
      real.SaveToFile(dl_String(v));
    except
      on E: EFCreateError do
        ap_raise(ap_eIOError, E.message);
    end;
  T_DATA:
    try
      ap_data_get_object(v, TStream, stream);
      real.SaveToStream(stream);
    except
      on E: EWriteError do;
    end;
  end;
  result := v;
end;

procedure Init_Stream;
begin
  cStream := rb_define_class_under(mPhi, 'Stream', ap_cObject);
  DefineAttrGet(cStream, 'position', Stream_get_position);
  DefineAttrSet(cStream, 'position', Stream_set_position);
  DefineAttrGet(cStream, 'size', Stream_get_size);
  DefineAttrSet(cStream, 'size', Stream_set_size);
  DefineMethod(cStream, 'seek', Stream_seek);
  rb_define_method(cStream, 'write_component', @Stream_write_component, 1);

  ap_define_const(mPhi, 'fmCreate', INT2FIX(fmCreate));

  cFileStream := rb_define_class_under(mPhi, 'FileStream', ap_cStream);
  DefineSingletonMethod(cFileStream, 'new', FileStream_new);

  cStringStream := rb_define_class_under(mPhi, 'StringStream', ap_cStream);
  DefineSingletonMethod(cStringStream, 'new', StringStream_new);
  DefineAttrGet(cStringStream, 'data_string', StringStream_get_data_string);

  cMemoryStream := rb_define_class_under(mPhi, 'MemoryStream', ap_cStream);
  rb_define_singleton_method(cMemoryStream, 'new', @MemoryStream_new, 0);
  rb_define_method(cMemoryStream, 'write', @MemoryStream_write, 1);
  // vcl: load_from_file, load_form_stream
  rb_define_method(cMemoryStream, 'load', @MemoryStream_load, 1);
  // vcl: save_to_file, save_to_stream
  rb_define_method(cMemoryStream, 'save', @MemoryStream_save, 1);
end;

end.
