library pngobject;

(*
needs for compile
http://pngdelphi.sourceforge.net/
http://pngdelphi.sourceforge.net/pngimage143.zip

author's credit:
Gustavo Huffenbacher Daud
Currently, contact me at: gubadaud@terra.com.br
http://pngdelphi.sourceforge.net

This is the best place to get the latest version. TPNGImage took me lots of hours programming, and it's free even for commercial projects (read license).
*)

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

{$E so}
var
  cPNGObject: Tvalue;

const
  NL = #$d+#$a ;
  AuthorCredit = ''+
  '"pngobject.so" is a wrapper of TPNGImage 1.4'+NL+
  'Author''s Credit of TPNGImage 1.4 is as follows;'+NL+NL+
  'Gustavo Huffenbacher Daud' + NL+
  'Currently, contact me at: gubadaud@terra.com.br'+NL+
  'http://pngdelphi.sourceforge.net'+NL+NL+
  'This is the best place to get the latest version.'+NL+
  'TPNGImage took me lots of hours programming,'+NL+
  'and it''s free even for commercial projects (read license).' ;

function ap_cPNGObject: Tvalue;
begin
  result := cPNGObject;
end;

function PNGObject_alloc(This: Tvalue; real: TPNGObject): Tvalue;
begin
  result := TmpAlloc(This, real);
end;

function ap_iPNGObject(real: TPNGObject; owner: Tvalue): Tvalue;
begin
  result := PNGObject_alloc(cPNGObject, real);
  ap_owner(result, owner);
end;

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

function PNGObject_load(This, v: Tvalue): Tvalue; cdecl;
var
  real: TPNGObject;
  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 PNGObject_save(This, v: Tvalue): Tvalue; cdecl;
var
  real: TPNGObject;
  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 PNGObject_assign(This, v: Tvalue): Tvalue; cdecl;
var
  real: TPNGObject;
  source: TPersistent;
begin
  real := ap_data_get_struct(This);
  ap_data_get_object(v, TPersistent, source);
  real.Assign(source);
  result := v;
end;

function PNGObject_author_credit(This: Tvalue): Tvalue; cdecl;
begin
  result := ap_String(AuthorCredit);
end;

procedure Init_pngobject;
begin
  PhiStart;

  cPNGObject := rb_define_class_under(ap_mPhi, 'PNGObject', ap_cPersistent);
  DefineProp(cPNGObject, TPNGObject);

  rb_define_singleton_method(cPNGObject, 'new', @PNGObject_new, 0);
  rb_define_method(cPNGObject, 'load', @PNGObject_load, 1);
  rb_define_method(cPNGObject, 'save', @PNGObject_save, 1);
  rb_define_method(cPNGObject, 'assign', @PNGObject_assign, 1);
  rb_define_singleton_method(cPNGObject, 'author_credit', @PNGObject_author_credit, 0);
end;

exports
  ap_cPNGObject,
  ap_iPNGObject,
  Init_pngobject;

end.
