unit uGrid;

interface

uses
{$IFDEF VCL}
  Grids,
{$ELSE}
  QGrids,
{$ENDIF}
  Rubies;

type
  TGridDrawStateKind = (gdSelected, gdFocused, gdFixed);

var
  cCustomGrid, cDrawGrid, cStringGrid: Tvalue;

function ap_cCustomGrid: Tvalue;
function ap_cDrawGrid: Tvalue;
function ap_cStringGrid: Tvalue;
function ap_DrawGrid(real: TDrawGrid; owner: Tvalue): Tvalue;
function ap_StringGrid(real: TStringGrid; owner: Tvalue): Tvalue;
procedure Init_Grid;

implementation

uses
{$IFDEF LINUX}
  Types,
{$ENDIF}
{$IFDEF MSWINDOWS}
  Windows,
{$ENDIF}
  Classes,
  uDefUtils, uIntern, uHandle, uAlloc, uProp, uPhi, uConv, uIndexer,
  uSizeConstraints, uRect, uBrush, uCanvas, uFont,
  uPersistent, uComponent, uControl, uStrings;

function ap_cCustomGrid: Tvalue;
begin
  result := cCustomGrid;
end;

function CustomGrid_cell_rect(This, col, row: Tvalue): Tvalue; cdecl;
var
  real: TCustomGrid;
  rect: TRect;
begin
  real := ap_data_get_struct(This);
  rect := TDrawGrid(real).CellRect(NUM2INT(col), NUM2INT(row));
  result := ap_iRect(rect, This);
end;

function CustomGrid_mouse_coord(This, x, y: Tvalue): Tvalue; cdecl;
var
  real: TCustomGrid;
  coord: TGridCoord;
begin
  real  := ap_data_get_struct(This);
  coord := real.MouseCoord(NUM2INT(x), NUM2INT(y));
  result := rb_ary_new;
  rb_ary_push(result, INT2FIX(coord.x));
  rb_ary_push(result, INT2FIX(coord.y));
end;

function ap_cDrawGrid: Tvalue;
begin
  result := cDrawGrid;
end;

function ap_cStringGrid: Tvalue;
begin
  result := cStringGrid;
end;

procedure DrawGrid_setup(obj: Tvalue; real: TDrawGrid);
begin
  rb_iv_set(obj, '@brush', ap_iBrush(real.Brush, obj));
  rb_iv_set(obj, '@canvas', ap_iCanvas(real.Canvas, obj));
  rb_iv_set(obj, '@font', ap_iFont(real.Font, obj));
//    AssignPropMethod(real, [Handle]);
end;

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

function DrawGrid_alloc(This: Tvalue; real: TDrawGrid): Tvalue;
begin
  result := ChildAlloc(This, real);
  DrawGrid_setup(result, real);
end;

function ap_DrawGrid(real: TDrawGrid; owner: Tvalue): Tvalue;
begin
  result := DrawGrid_alloc(cDrawGrid, real);
  ap_owner(result, owner);
end;

function ap_DrawGrid_v(var AControl; owner: Tvalue): Tvalue;
begin
  result := ap_DrawGrid(TDrawGrid(AControl), owner)
end;

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

function DrawGrid_mouse_to_cell(This, x, y: Tvalue): Tvalue; cdecl;
var
  real: TDrawGrid;
  col, row: Longint;
begin
  real := ap_data_get_struct(This);
  real.MouseToCell(NUM2INT(x), NUM2INT(y), col, row);
  result := rb_ary_new;
  rb_ary_push(result, INT2FIX(col));
  rb_ary_push(result, INT2FIX(row));
end;

function DrawGrid_select_cell(This, cv, rv: Tvalue): Tvalue; cdecl;
var
  real: TDrawGrid;
  col, row: Longint;
  rect: TGridRect;
begin
  real := ap_data_get_struct(This);
  col := FIX2INT(cv);
  row := FIX2INT(rv);
  if (col < 0) or (col >= real.ColCount) then
    ap_raise(ap_eArgError, sOut_of_range);
  if (row < 0) or (row >= real.RowCount) then
    ap_raise(ap_eArgError, sOut_of_range);
  rect.Top := row;
  rect.Bottom := row;
  rect.Left := col;
  rect.Right := col;
  real.Selection := rect;

  result := This;
end;

function DrawGrid_get_editor_mode(This: Tvalue): Tvalue; cdecl;
var
  real: TDrawGrid;
begin
  real := ap_data_get_struct(This);
  result := ap_bool(real.EditorMode);
end;

function DrawGrid_set_editor_mode(This, v: Tvalue): Tvalue; cdecl;
var
  real: TDrawGrid;
begin
  real := ap_data_get_struct(This);
  real.EditorMode := dl_Boolean(v);
  result := v;
end;

function DrawGrid_get_col(This: Tvalue): Tvalue; cdecl;
var
  real: TDrawGrid;
begin
  real := ap_data_get_struct(This);
  result := INT2FIX(real.Col);
end;

function DrawGrid_set_col(This, v: Tvalue): Tvalue; cdecl;
var
  real: TDrawGrid;
  n: Integer;
begin
  real := ap_data_get_struct(This);
  n := FIX2INT(v);
  if (n < 0) or (n >= real.ColCount) then
    ap_raise(ap_eArgError, sOut_of_range);
  real.Col := n;
  result := v;
end;

function DrawGrid_get_row(This: Tvalue): Tvalue; cdecl;
var
  real: TDrawGrid;
begin
  real := ap_data_get_struct(This);
  result := INT2FIX(real.Row);
end;

function DrawGrid_set_row(This, v: Tvalue): Tvalue; cdecl;
var
  real: TDrawGrid;
  n: Integer;
begin
  real := ap_data_get_struct(This);
  n := FIX2INT(v);
  if (n < 0) or (n >= real.RowCount) then
    ap_raise(ap_eArgError, sOut_of_range);
  real.Row := n;
  result := v;
end;

function DrawGrid_get_top_row(This: Tvalue): Tvalue; cdecl;
var
  real: TDrawGrid;
begin
  real := ap_data_get_struct(This);
  result := INT2FIX(real.TopRow);
end;

function DrawGrid_set_top_row(This, v: Tvalue): Tvalue; cdecl;
var
  real: TDrawGrid;
  n: Integer;
begin
  real := ap_data_get_struct(This);
  n := FIX2INT(v);
  if (n < 0) or (n >= real.RowCount) then
    ap_raise(ap_eArgError, sOut_of_range);
  real.TopRow := n;
  result := v;
end;

function DrawGrid_set_row_heights(argc: Integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
  real: TDrawGrid;
  args: array of Tvalue;
begin
  if argc < 2 then ap_raise(ap_eArgError, sToo_few_args);
  SetLength(args, argc);
  args := argv;
  real := ap_data_get_struct(This);
  real.RowHeights[dl_Integer(args[0])] := dl_Integer(args[1]);
  result := args[1];
end;

function DrawGrid_get_row_heights(argc: Integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
  real: TDrawGrid;
  args: array of Tvalue;
begin
  if argc < 1 then ap_raise(ap_eArgError, sToo_few_args);
  SetLength(args, argc);
  args := argv;
  real := ap_data_get_struct(This);
  result := ap_Integer(real.RowHeights[dl_Integer(args[0])]);
end;

//// StringGrid ////

procedure StringGrid_setup(obj: Tvalue; real: TStringGrid);
begin
  rb_iv_set(obj, '@brush', ap_iBrush(real.Brush, obj));
  rb_iv_set(obj, '@canvas', ap_iCanvas(real.Canvas, obj));
  rb_iv_set(obj, '@font', ap_iFont(real.Font, obj));
//    AssignPropMethod(real, [Handle]);
end;

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

function StringGrid_alloc(This: Tvalue; real: TStringGrid): Tvalue;
begin
  result := ChildAlloc(This, real);
  StringGrid_setup(result, real);
end;

function ap_StringGrid(real: TStringGrid; owner: Tvalue): Tvalue;
begin
  result := StringGrid_alloc(cStringGrid, real);
  ap_owner(result, owner);
end;

function ap_StringGrid_v(var AControl; owner: Tvalue): Tvalue;
begin
  result := ap_StringGrid(TStringGrid(AControl), owner)
end;

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

function StringGrid_get_cells(argc: Integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
  real: TStringGrid;
  args: Rubies.Pvalue;
  Col, Row: Integer;
begin
  if argc < 2 then ap_raise(ap_eArgError, sToo_few_args);
  args := Rubies.Pvalue(argv);
  real := ap_data_get_struct(This);
  Col := FIX2INT(args^);
  dec(argc);
  inc(args);
  Row := FIX2INT(args^);
  dec(argc);
  inc(args);
  result := rb_str_new2(PChar(real.Cells[Col, Row]));
end;

function StringGrid_set_cells(argc: Integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
  real: TStringGrid;
  args: Rubies.Pvalue;
  Col, Row: Integer;
  v: Tvalue;
begin
  if argc < 3 then ap_raise(ap_eArgError, sToo_few_args);
  args := Rubies.Pvalue(argv);
  real := ap_data_get_struct(This);
  Col := FIX2INT(args^);
  dec(argc);
  inc(args);
  Row := FIX2INT(args^);
  dec(argc);
  inc(args);
  v := args^;
  real.Cells[Col, Row] := dl_String(v);
  result := v;
end;

function StringGrid_get_col_widths(argc: Integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
  real: TStringGrid;
  args: array of Tvalue;
begin
  if argc < 1 then ap_raise(ap_eArgError, sToo_few_args);
  SetLength(args, argc);
  args := argv;
  real := ap_data_get_struct(This);
  result := ap_Integer(real.ColWidths[FIX2INT(args[0])]); // [ap-dev:1424] 
end;

function StringGrid_set_col_widths(argc: Integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
  real: TStringGrid;
  args: array of Tvalue;
begin
  if argc < 2 then ap_raise(ap_eArgError, sToo_few_args);
  SetLength(args, argc);
  args := argv;
  real := ap_data_get_struct(This);
  real.ColWidths[FIX2INT(args[0])] := dl_Integer(args[1]);
  result := args[1];
end;

// [ap-dev:1402] Morita Keisuke (morita@asobitari.nu)
function StringGrid_get_cols(argc: Integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
  real: TStringGrid;
  args: Rubies.Pvalue;
begin
  if argc < 1 then ap_raise(ap_eArgError, sToo_few_args);
  args := Rubies.Pvalue(argv);
  real := ap_data_get_struct(This);
  result := ap_iStrings(real.Cols[FIX2INT(args^)], This);
end;

function StringGrid_set_cols(argc: Integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
  real: TStringGrid;
  args: Rubies.Pvalue;
  Col: Integer;
  v: Tvalue;
begin
  if argc < 2 then ap_raise(ap_eArgError, sToo_few_args);
  args := Rubies.Pvalue(argv);
  real := ap_data_get_struct(This);
  Col := FIX2INT(args^);
  dec(argc);
  inc(args);
  v := args^;
  real.Cols[Col] := dl_Strings(v);
  result := v;
end;

function StringGrid_get_rows(argc: Integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
  real: TStringGrid;
  args: Rubies.Pvalue;
begin
  if argc < 1 then ap_raise(ap_eArgError, sToo_few_args);
  args := Rubies.Pvalue(argv);
  real := ap_data_get_struct(This);
  result := ap_iStrings(real.Rows[FIX2INT(args^)], This);
end;

function StringGrid_set_rows(argc: Integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
  real: TStringGrid;
  args: Rubies.Pvalue;
  Row: Integer;
  v: Tvalue;
begin
  if argc < 2 then ap_raise(ap_eArgError, sToo_few_args);
  args := Rubies.Pvalue(argv);
  real := ap_data_get_struct(This);
  Row := FIX2INT(args^);
  dec(argc);
  inc(args);
  v := args^;
  real.Rows[Row] := dl_Strings(v);
  result := v;
end;

procedure Init_Grid;
begin
  OutputConstSetType(mPhi, TypeInfo(TGridDrawStateKind));
  OutputConstSetType(mPhi, TypeInfo(TGridOption));

  cCustomGrid := OutputPersistentClass(mPhi, TCustomGrid, cWinControl, nil);
  rb_define_method(cCustomGrid, 'cell_rect', @CustomGrid_cell_rect, 2);
  rb_define_method(cCustomGrid, 'mouse_coord', @CustomGrid_mouse_coord, 2);
  rb_define_attr(cCustomGrid, 'canvas', 1, 0);

  cDrawGrid := OutputPersistentClass(mPhi, TDrawGrid, cCustomGrid, ap_DrawGrid_v);
  rb_define_method(cDrawGrid, 'event_handle', @DrawGrid_event_handle, 1);
  DefineSingletonMethod(cDrawGrid, 'new', DrawGrid_new);
  rb_define_method(cDrawGrid, 'mouse_to_cell', @DrawGrid_mouse_to_cell, 2);
  rb_define_method(cDrawGrid, 'select_cell', @DrawGrid_select_cell, 2);
  DefineAttrGet(cDrawGrid, 'editor_mode', DrawGrid_get_editor_mode);
  DefineAttrSet(cDrawGrid, 'editor_mode', DrawGrid_set_editor_mode);
  DefineAttrGet(cDrawGrid, 'col', DrawGrid_get_col);
  DefineAttrSet(cDrawGrid, 'col', DrawGrid_set_col);
  DefineAttrGet(cDrawGrid, 'row', DrawGrid_get_row);
  DefineAttrSet(cDrawGrid, 'row', DrawGrid_set_row);
  DefineAttrGet(cDrawGrid, 'top_row', DrawGrid_get_top_row);
  DefineAttrSet(cDrawGrid, 'top_row', DrawGrid_set_top_row);
  // [ap-dev:1474] 
  DefineIndexer(cDrawGrid, 'row_heights', @DrawGrid_get_row_heights, @DrawGrid_set_row_heights);

  cStringGrid := OutputPersistentClass(mPhi, TStringGrid, cDrawGrid, ap_StringGrid_v);
  rb_define_method(cStringGrid, 'event_handle', @StringGrid_event_handle, 1);
  DefineSingletonMethod(cStringGrid, 'new', StringGrid_new);
  DefineIndexer(cStringGrid, 'cells', @StringGrid_get_cells, @StringGrid_set_cells);
  DefineIndexer(cStringGrid, 'col_widths', @StringGrid_get_col_widths, @StringGrid_set_col_widths);
  // [ap-dev:1402] Morita Keisuke (morita@asobitari.nu)
  DefineIndexer(cStringGrid, 'cols', @StringGrid_get_cols, @StringGrid_set_cols);
  DefineIndexer(cStringGrid, 'rows', @StringGrid_get_rows, @StringGrid_set_rows);
end;

end.
