library Prev;

(*
needs for compile
  http://www.moriq.com/delphi/PrevX112.lzh
cf.
  [ap-list:1547]
*)

uses
{$IFDEF WIN32} FastShareMem, {$ENDIF}
  Windows, SysUtils, Classes, Controls, Rubies, uDefUtils, Pythia, PrevX;

{$E so}

var
  rb_ePrevError, cPrev: Tvalue;

procedure Prev_setup(obj: Tvalue; real: TPrevX);
begin
//    AssignPropMethod(real, [PhiGetHandle]);
end;

function Prev_event_handle(This, name: Tvalue): Tvalue; cdecl;
begin
  EventHandle(This, name, [PhiGetHandle]);
  result := Qnil;
end;

function Prev_new(argc: integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
  real: TPrevX;
begin
  real := TPrevX.Create(nil);
  result := CompoAlloc(This, real);
  CompoSetup(argc, argv, real);
  Prev_setup(result, real);
  ap_obj_call_init(result, argc, argv);
end;

function Prev_alloc_canvas(This: Tvalue): Tvalue;
var
  real: TPrevX;
begin
  real := ap_data_get_struct(This);
  result := ap_iCanvas(real.Canvas, This);
  rb_iv_set(This, '@canvas', result);
end;

function Prev_get_canvas(This: Tvalue): Tvalue; cdecl;
var
  real: TPrevX;
begin
  real := ap_data_get_struct(This);
  if real.Canvas = nil then
  begin
    result := Qnil;
    rb_iv_set(This, '@canvas', result);
  end
  else
  begin
    result := rb_iv_get(This, '@canvas');
    if result = Qnil then result := Prev_alloc_canvas(This);
  end;
end;

function Prev_get_count(This: Tvalue): Tvalue; cdecl;
var
  real: TPrevX;
begin
  real := ap_data_get_struct(This);
  result := INT2FIX(real.PageCount);
end;

function Prev_get_index(This: Tvalue): Tvalue; cdecl;
var
  real: TPrevX;
begin
  real := ap_data_get_struct(This);
  result := INT2FIX(real.PageNumber);
end;

function Prev_set_index(This, v: Tvalue): Tvalue; cdecl;
var
  real: TPrevX;
begin
  real := ap_data_get_struct(This);
  real.PageNumber := FIX2INT(v);
  result := v;
end;

function Prev_get_range(This: Tvalue): Tvalue; cdecl;
var
  real: TPrevX;
  from, upto: Tvalue;
begin
  real := ap_data_get_struct(This);

  from := rb_iv_get(This, '@from');
  if from = Qnil then
  begin
    from := INT2FIX(real.FromPage);
    rb_iv_set(This, '@from', from);
  end;

  upto := rb_iv_get(This, '@to');
  if upto = Qnil then
  begin
    upto := INT2FIX(real.ToPage);
    rb_iv_set(This, '@to', upto);
  end;

  result := rb_range_new(from, upto, 0);
end;

function Prev_set_range(This, v: Tvalue): Tvalue; cdecl;
var
  real: TPrevX;
  from, upto: Tvalue;
begin
  real := ap_data_get_struct(This);
  from := rb_funcall2(v, rb_intern('begin'), 0, nil);
  upto := rb_funcall2(v, rb_intern('end'), 0, nil);
  real.FromPage := FIX2INT(from);
  real.ToPage := FIX2INT(upto);
  result := v;
end;

function Prev_get_width(This: Tvalue): Tvalue; cdecl;
var
  real: TPrevX;
begin
  real := ap_data_get_struct(This);
  result := INT2FIX(real.PageWidth);
end;

function Prev_get_height(This: Tvalue): Tvalue; cdecl;
var
  real: TPrevX;
begin
  real := ap_data_get_struct(This);
  result := INT2FIX(real.PageHeight);
end;

function Prev_doc(This: Tvalue): Tvalue; cdecl;
var
  real: TPrevX;
begin
  real := ap_data_get_struct(This);
  try
    real.BeginDoc;
    Prev_alloc_canvas(This);
    result := rb_yield(Qnil);
  finally
    real.EndDoc;
  end;
end;

function Prev_new_page(This: Tvalue): Tvalue; cdecl;
var
  real: TPrevX;
begin
  real := ap_data_get_struct(This);
  real.NewPage;
  Prev_alloc_canvas(This);
  result := This;
end;

function Prev_print(This: Tvalue): Tvalue; cdecl;
var
  real: TPrevX;
begin
  real := ap_data_get_struct(This);
  try
    real.Print;
  except
    on E: EPrevError do ap_raise(ap_eIOError, E.message);
  end;
  result := This;
end;

function Prev_save(This, v: Tvalue): Tvalue; cdecl;
var
  real: TPrevX;
begin
  real := ap_data_get_struct(This);
  try
    real.SaveToFile(dl_String(v));
  except
    on E: EPrevError do ap_raise(ap_eIOError, E.message);
  end;
  result := This;
end;

function Prev_xpos(This, x: Tvalue): Tvalue; cdecl;
var
  real: TPrevX;
begin
  real := ap_data_get_struct(This);
  result := INT2FIX(real.XPos(FIX2INT(x)));
end;

function Prev_ypos(This, y: Tvalue): Tvalue; cdecl;
var
  real: TPrevX;
begin
  real := ap_data_get_struct(This);
  result := INT2FIX(real.YPos(FIX2INT(y)));
end;

function Prev_pen_width(This, size: Tvalue): Tvalue; cdecl;
var
  real: TPrevX;
begin
  real := ap_data_get_struct(This);
  result := INT2FIX(real.PenWidth(FIX2INT(size)));
end;

function Prev_text_out(This, x, y, str: Tvalue): Tvalue; cdecl;
var
  real: TPrevX;
begin
  real := ap_data_get_struct(This);
  real.TextOut(FIX2INT(x), FIX2INT(y), dl_String(str));
  result := This;
end;

function Prev_move_to(This, x, y: Tvalue): Tvalue; cdecl;
var
  real: TPrevX;
begin
  real := ap_data_get_struct(This);
  real.MoveTo(FIX2INT(x), FIX2INT(y));
  result := This;
end;

function Prev_line_to(This, x, y: Tvalue): Tvalue; cdecl;
var
  real: TPrevX;
begin
  real := ap_data_get_struct(This);
  real.LineTo(FIX2INT(x), FIX2INT(y));
  result := This;
end;

function Prev_ellipse(argc: integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
  args: array of Tvalue;
  real: TPrevX;
  rect: TRect;
  x1, y1, x2, y2: Integer;
begin
  SetLength(args, argc);
  args := argv;
  real := ap_data_get_struct(This);
  case RTYPE(args[0]) of
  T_DATA:
    begin
      if argc <> 1 then ap_raise(ap_eArgError, sWrong_num_of_args);
      rect := PRect(ap_data_get_struct(args[0]))^;
      x1 := rect.Left;
      y1 := rect.Top;
      x2 := rect.Right;
      y2 := rect.Bottom;
    end;
  T_FIXNUM:
    begin
      if argc <> 4 then ap_raise(ap_eArgError, sWrong_num_of_args);
      x1 := FIX2INT(args[0]);
      y1 := FIX2INT(args[1]);
      x2 := FIX2INT(args[2]);
      y2 := FIX2INT(args[3]);
    end;
  else
    ap_raise(ap_eArgError, sWrong_arg_type);
    x1 := 0;
    y1 := 0;
    x2 := 0;
    y2 := 0;
  end;
  real.Ellipse(x1, y1, x2, y2);
  result := This;
end;

function Prev_rectangle(argc: integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
  args: array of Tvalue;
  real: TPrevX;
  rect: TRect;
  x1, y1, x2, y2: Integer;
begin
  SetLength(args, argc);
  args := argv;
  real := ap_data_get_struct(This);
  case RTYPE(args[0]) of
  T_DATA:
    begin
      if argc <> 1 then ap_raise(ap_eArgError, sWrong_num_of_args);
      rect := PRect(ap_data_get_struct(args[0]))^;
      x1 := rect.Left;
      y1 := rect.Top;
      x2 := rect.Right;
      y2 := rect.Bottom;
    end;
  T_FIXNUM:
    begin
      if argc <> 4 then ap_raise(ap_eArgError, sWrong_num_of_args);
      x1 := FIX2INT(args[0]);
      y1 := FIX2INT(args[1]);
      x2 := FIX2INT(args[2]);
      y2 := FIX2INT(args[3]);
    end;
  else
    ap_raise(ap_eArgError, sWrong_arg_type);
    x1 := 0;
    y1 := 0;
    x2 := 0;
    y2 := 0;
  end;
  real.Rectangle(x1, y1, x2, y2);
  result := This;
end;

function Prev_round_rect(argc: integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
  args: array of Tvalue;
  real: TPrevX;
  rect: TRect;
  x1, y1, x2, y2, x3, y3: Integer;
begin
  SetLength(args, argc);
  args := argv;
  real := ap_data_get_struct(This);
  case RTYPE(args[0]) of
  T_DATA:
    begin
      if argc <> 3 then ap_raise(ap_eArgError, sWrong_num_of_args);
      rect := PRect(ap_data_get_struct(args[0]))^;
      x1 := rect.Left;
      y1 := rect.Top;
      x2 := rect.Right;
      y2 := rect.Bottom;
      x3 := FIX2INT(args[1]);
      y3 := FIX2INT(args[2]);
    end;
  T_FIXNUM:
    begin
      if argc <> 6 then ap_raise(ap_eArgError, sWrong_num_of_args);
      x1 := FIX2INT(args[0]);
      y1 := FIX2INT(args[1]);
      x2 := FIX2INT(args[2]);
      y2 := FIX2INT(args[3]);
      x3 := FIX2INT(args[4]);
      y3 := FIX2INT(args[5]);
    end;
  else
    ap_raise(ap_eArgError, sWrong_arg_type);
    x1 := 0;
    y1 := 0;
    x2 := 0;
    y2 := 0;
    x3 := 0;
    y3 := 0;
  end;
  real.RoundRect(x1, y1, x2, y2, x3, y3);
  result := This;
end;

function Prev_set_printer_mode(This, paper, orient: Tvalue): Tvalue; cdecl;
var
  real: TPrevX;
begin
  real := ap_data_get_struct(This);
  rb_iv_set(This, '@pager', paper);
  rb_iv_set(This, '@orient', orient);
  real.SetPrinterMode(FIX2INT(paper), FIX2INT(orient));
  result := This;
end;

procedure Init_prev; cdecl;
begin
  PhiStart;

  rb_ePrevError := rb_define_class_under(ap_mPhi, 'PrevError', ap_eStandardError);

  cPrev := DefinePersistentClass(ap_mPhi, TPrevX, ap_cWinControl, nil);

  DefineConstSetType(cPrev, TypeInfo(TPrevMapModes));
//  ap_define_const(cPrev, 'ZoomScaleMin', INT2FIX(ZoomScaleMin));
//  ap_define_const(cPrev, 'ZoomScaleMax', INT2FIX(ZoomScaleMax));

  rb_define_method(cPrev, 'event_handle', @Prev_event_handle, 1);
  DefineSingletonMethod(cPrev, 'new', Prev_new);

  rb_define_method(cPrev, 'doc', @Prev_doc, 0);
  rb_define_method(cPrev, 'new_page', @Prev_new_page, 0);
  rb_define_method(cPrev, 'print', @Prev_print, 0);
  rb_define_method(cPrev, 'save', @Prev_save, 1);
  rb_define_method(cPrev, 'xpos', @Prev_xpos, 1);
  rb_define_method(cPrev, 'ypos', @Prev_ypos, 1);
  rb_define_method(cPrev, 'pen_width', @Prev_pen_width, 1);
  rb_define_method(cPrev, 'text_out', @Prev_text_out, 3);
  rb_define_method(cPrev, 'move_to', @Prev_move_to, 2);
  rb_define_method(cPrev, 'line_to', @Prev_line_to, 2);
  DefineMethod(cPrev, 'ellipse', Prev_ellipse);
  rb_define_alias(cPrev, 'draw_oval', 'ellipse');
  DefineMethod(cPrev, 'rectangle', Prev_rectangle);
  rb_define_alias(cPrev, 'draw_rect', 'rectangle');
  DefineMethod(cPrev, 'round_rect', Prev_round_rect);
  rb_define_method(cPrev, 'set_printer_mode', @Prev_set_printer_mode, 2);
  DefineAttrGet(cPrev, 'canvas', Prev_get_canvas);
  DefineAttrGet(cPrev, 'count', Prev_get_count);
  DefineAttrGet(cPrev, 'index', Prev_get_index);
  DefineAttrSet(cPrev, 'index', Prev_set_index);
  DefineAttrGet(cPrev, 'range', Prev_get_range);
  DefineAttrSet(cPrev, 'range', Prev_set_range);
  DefineAttrGet(cPrev, 'width', Prev_get_width);
  rb_define_alias(cPrev, 'page_width', 'width');
  DefineAttrGet(cPrev, 'height', Prev_get_height);
  rb_define_alias(cPrev, 'page_height', 'height');
end;

exports
  Init_prev;

end.
