library libpath;

uses
{$IFDEF LINUX}
  Types,
{$ENDIF}
{$IFDEF MSWINDOWS}
  Windows,
{$ENDIF}
  Classes, SysUtils,
  Rubies, uDefUtils, Pythia, Graphics, PathUtils,
  uPointInfo;

{$E so}
var
  cPath: Tvalue;
  ap_ePathError: Tvalue;

function ap_cPath: Tvalue;
begin
  result := cPath;
end;

function Path_alloc(This: Tvalue; real: TPath): Tvalue;
begin
  result := TmpAlloc(This, real);
end;

function ap_iPath(real: TPath; owner: Tvalue): Tvalue;
begin
  result := Path_alloc(cPath, real);
  ap_owner(result, owner);
end;

function Path_new(argc: Integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
  real: TPath;
begin
  real := TPath.Create;
  result := ObjAlloc(This, real);
  ap_obj_call_init(result, argc, argv);
end;

function Path_load(This, v: Tvalue): Tvalue; cdecl;
var
  real: TPath;
  objv: TObject;
begin
  real := ap_data_get_struct(This);
  case RTYPE(v) of
  T_DATA:
    try
      ap_data_get_object(v, TObject, objv);
      if objv is TCanvas then
        real.LoadFromCanvas(TCanvas(objv))
      else
      if objv is TStream then
        real.LoadFromStream(TStream(objv))
      else
        ap_raise(ap_eArgError, sWrong_arg_type)
      ;
    except
      on E: EReadError do;
    end;
  else
    ap_raise(ap_eArgError, sWrong_arg_type);
  end;
  result := This;
end;

function Path_save(This, v: Tvalue): Tvalue; cdecl;
var
  real: TPath;
  stream: TStream;
begin
  real := ap_data_get_struct(This);
  case RTYPE(v) of
  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 Path_clear(This: Tvalue): Tvalue; cdecl;
var
  real: TPath;
begin
  real := ap_data_get_struct(This);
  real.Clear;
  result := This;
end;

function Path_add(This, v: Tvalue): Tvalue; cdecl;
var
  real: TPath;
  PointInfo: TPointInfo;
begin
  real := ap_data_get_struct(This);
  PointInfo_assign(PointInfo, v);
  real.Add(PointInfo);
  result := This;
end;

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

function Path_map_point(This, other: Tvalue): Tvalue; cdecl;
var
  real: TPath;
  real_other: TPath;
  point: Tvalue;
  PointInfo: TPointInfo;
  i: Integer;
begin
  real := ap_data_get_struct(This);
  ap_data_get_object(other, TPath, real_other);
  result := Qnil;
  try
    for i := 0 to real.Count-1 do
    begin
      point := PointInfo_alloc(real.Points[i]);
      rb_yield(point);
      PointInfo_assign(PointInfo, point);
      real_other.Points[i] := PointInfo;
    end;
  except
    on E: Exception do
      ap_raise(ap_ePathError, E.message);
  end;
end;

function Path_get_point(This, i: Tvalue): Tvalue; cdecl;
var
  real: TPath;
begin
  real := ap_data_get_struct(This);
  result := Qnil;
  try
    result := PointInfo_alloc(real.Points[dl_Integer(i)]);
  except
    on E: Exception do
      ap_raise(ap_ePathError, E.message);
  end;
end;

function Path_set_point(This, i, v: Tvalue): Tvalue; cdecl;
var
  real: TPath;
  PointInfo: TPointInfo;
begin
  real := ap_data_get_struct(This);
  PointInfo_assign(PointInfo, v);
  real.Points[dl_Integer(i)] := PointInfo;
  result := This;
end;

function Path_create_path(This, v: Tvalue): Tvalue; cdecl;
var
  real: TPath;
  canvas: TCanvas;
begin
  real := ap_data_get_struct(This);
  ap_data_get_object(v, TCanvas, canvas);
  real.CreatePath(canvas);
  result := This;
end;

function Path_open(This, v: Tvalue): Tvalue; cdecl;
var
  canvas: TCanvas;
begin
  ap_data_get_object(v, TCanvas, canvas);
  BeginPath(canvas.Handle);
  try
    rb_yield(v);
  finally
    EndPath(canvas.Handle);
  end;
  result := This;
end;

function Path_draw_stroke(This, v: Tvalue): Tvalue; cdecl;
var
  real: TPath;
  canvas: TCanvas;
begin
  real := ap_data_get_struct(This);
  ap_data_get_object(v, TCanvas, canvas);
  real.DrawStroke(canvas);
  result := This;
end;

function Path_draw_fill(This, v: Tvalue): Tvalue; cdecl;
var
  real: TPath;
  canvas: TCanvas;
begin
  real := ap_data_get_struct(This);
  ap_data_get_object(v, TCanvas, canvas);
  real.DrawFill(canvas);
  result := This;
end;

function Path_draw_stroke_and_fill(This, v: Tvalue): Tvalue; cdecl;
var
  real: TPath;
  canvas: TCanvas;
begin
  real := ap_data_get_struct(This);
  ap_data_get_object(v, TCanvas, canvas);
  real.DrawStrokeAndFill(canvas);
  result := This;
end;

function Win_stroke_and_fill_path(This, hdc: Tvalue): Tvalue; cdecl;
begin
  result := ap_bool(StrokeAndFillPath(FIX2INT(hdc)));
end;

function Win_flatten_path(This, hdc: Tvalue): Tvalue; cdecl;
begin
  result := ap_bool(FlattenPath(FIX2INT(hdc)));
end;

function Path_flatten(This, v: Tvalue): Tvalue; cdecl;
var
  canvas: TCanvas;
begin
  ap_data_get_object(v, TCanvas, canvas);
  FlattenPath(canvas.Handle);
  result := This;
end;

function Path_count(This: Tvalue): Tvalue; cdecl;
var
  real: TPath;
begin
  real := ap_data_get_struct(This);
  result := ap_Fixnum(real.Count);
end;

procedure dl_DoubleArray(v: Tvalue; var ret: array of Double);
var
  i: Integer;
begin
  if RType(v) <> T_ARRAY then
    ap_raise(ap_eArgError, sWrong_arg_type);
  for i := low(ret) to high(ret) do
    ret[i] := dl_Double(ap_ary_aref2(v, i-low(ret)));
end;

function ap_FloatArray(const v: array of Double): Tvalue;
var
  i: Integer;
begin
  result := rb_ary_new;
  for i := Low(v) to High(v) do
    rb_ary_push(result, ap_Float(v[i]));
end;

function Path_draw_path(argc: integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
  opts: Tvalue;

  function opt(key: PChar): Tvalue;
  var
    id: Tid;
  begin
    id := rb_intern(key);
    Result := rb_hash_aref(opts, ID2SYM(id));
  end;

var
  args: array of Tvalue;
  real: TPath;
  canvas: TCanvas;
  Color: TColor;
  Width: Integer;
  PenStyle: array of Double;
  CapStyle: TCapStyle;
  v: Tvalue;
begin
  if argc < 1 then ap_raise(ap_eArgError, sToo_few_args);
  SetLength(args, argc);
  args := argv;
  real := ap_data_get_struct(This);
  ap_data_get_object(args[0], TCanvas, canvas);
  if argc > 1 then
  begin
    opts := args[1];
    if RType(opts) <> T_HASH then
      ap_raise(ap_eArgError, sWrong_arg_type);
    v := opt('color');
    if v = Qnil then Color := clBlack else Color := dl_Integer(v);
    v := opt('width');
    if v = Qnil then Width := 1 else Width := dl_Integer(v);
    v := opt('pen_style');
    if v = Qnil then 
    begin
      SetLength(PenStyle, 2);
      PenStyle[0] := 1E+6;
      PenStyle[1] := 1;
    end else begin
      if RType(v) <> T_ARRAY then
        ap_raise(ap_eArgError, sWrong_arg_type);
      SetLength(PenStyle, ap_ary_len(v));
      dl_DoubleArray(v, PenStyle);
    end;
    v := opt('cap_style');
    if v = Qnil then CapStyle := csFlat else CapStyle := TCapStyle(dl_Integer(v));
  end else begin
    Color := clBlack;
    Width := 1;
    SetLength(PenStyle, 2);
    PenStyle[0] := 1E+6;
    PenStyle[1] := 1;
    CapStyle := csFlat;
  end;
  DrawPath(real, canvas, Color, Width, PenStyle, CapStyle);
  result := This;
end;

procedure Init_path;
begin
  PhiStart;
  DefineConstSetType(ap_mPhi, TypeInfo(TCapStyle));
  ap_ePathError := rb_define_class_under(ap_mPhi, 'PathError', ap_eStandardError);

  Init_PointInfo;
  cPath := rb_define_class_under(ap_mPhi, 'Path', ap_cPersistent);
  DefineProp(cPath, TPath);

  rb_define_singleton_method(cPath, 'new', @Path_new, -1);
  rb_define_method(cPath, 'load', @Path_load, 1);
  rb_define_method(cPath, 'save', @Path_save, 1);
  rb_define_method(cPath, 'clear', @Path_clear, 0);
  rb_define_method(cPath, 'add', @Path_add, 1);
  rb_define_method(cPath, 'assign', @Path_assign, 1);
  rb_define_method(cPath, 'map_point', @Path_map_point, 1);
  rb_define_method(cPath, 'get_point', @Path_get_point, 1);
  rb_define_method(cPath, 'set_point', @Path_set_point, 2);
  rb_define_method(cPath, 'create_path', @Path_create_path, 1);
  rb_define_singleton_method(cPath, 'open', @Path_open, 1);
  rb_define_method(cPath, 'draw_stroke', @Path_draw_stroke, 1);
  rb_define_method(cPath, 'draw_fill', @Path_draw_fill, 1);
  rb_define_method(cPath, 'draw_stroke_and_fill', @Path_draw_stroke_and_fill, 1);
//rb_define_module_function(ap_mPhi, 'flatten_path', @Win_flatten_path, 1);
  rb_define_singleton_method(cPath, 'flatten', @Path_flatten, 1);
  rb_define_method(cPath, 'count', @Path_count, 0);
  rb_define_method(cPath, 'draw_path', @Path_draw_path, -1);
end;

exports
  ap_cPath,
  ap_iPath,
  Init_path;

end.
