library libpng;

(*
needs for compile
  http://www.phoenix-c.or.jp/~taki/
  http://www.phoenix-c.or.jp/~taki/library/delphi/GLDPNG343.lzh
*)

uses
{$IFDEF WIN32} FastShareMem, {$ENDIF}
  Classes, Rubies, uDefUtils, Pythia, GLDPNG;

{$E so}
var
  cPng: Tvalue;

function ap_cPng: Tvalue;
begin
  result := cPng;
end;

function Png_alloc(This: Tvalue; real: TGLDPNG): Tvalue;
begin
  result := TmpAlloc(This, real);
end;

function ap_iPng(real: TGLDPNG; owner: Tvalue): Tvalue;
begin
  result := Png_alloc(cPng, real);
  ap_owner(result, owner);
end;

function Png_new(This: Tvalue): Tvalue; cdecl;
var
  real: TGLDPNG;
begin
  real := TGLDPNG.Create;
  result := ObjAlloc(This, real);
  ap_obj_call_init(result, 0, nil);
end;

function Png_load(This, v: Tvalue): Tvalue; cdecl;
var
  real: TGLDPNG;
  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;
  else
    ap_raise(ap_eArgError, sWrong_arg_type);
  end;
  result := This;
end;

function Png_save(This, v: Tvalue): Tvalue; cdecl;
var
  real: TGLDPNG;
  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;
  else
    ap_raise(ap_eArgError, sWrong_arg_type);
  end;
  result := v;
end;

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

procedure Init_png;
begin
  PhiStart;

  cPng := rb_define_class_under(ap_mPhi, 'Png', ap_cObject);
  DefineProp(cPng, TGLDPNG);

  rb_define_singleton_method(cPng, 'new', @Png_new, 0);
  rb_define_method(cPng, 'load', @Png_load, 1);
  rb_define_method(cPng, 'save', @Png_save, 1);
  rb_define_method(cPng, 'assign', @Png_assign, 1);
end;

exports
  ap_cPng,
  ap_iPng,
  Init_png;

end.
