unit uMenu;

interface

uses
{$IFDEF VCL}
  Menus,
{$ELSE}
  QMenus,
{$ENDIF}
  Rubies;

var
  cMenu, cMainMenu, cPopupMenu: Tvalue;

function ap_cMainMenu: Tvalue;
function ap_iMainMenu(real: TMainMenu; owner: Tvalue): Tvalue;
function ap_cPopupMenu: Tvalue;
function ap_iPopupMenu(real: TPopupMenu; owner: Tvalue): Tvalue;
procedure Init_Menu;

implementation

uses
  SysUtils, Classes, uStrUtils, uDefUtils,
  uImage, uConv, uIntern, uHandle, uAlloc, uProp, uPhi, uPoint,
  uPersistent, uComponent, uMenuItem;

{ Menu building functions }

procedure InitMenuItems(AMenu: TMenu; Items: array of TMenuItem);
var
  I: Integer;
begin
  for I := Low(Items) to High(Items) do
    AMenu.Items.Add(Items[I]);
end;

function NewMenu(Owner: TComponent; const AName: string; Items: array of TMenuItem): TMainMenu;
begin
  Result := TMainMenu.Create(Owner);
  Result.Name := AName;
  InitMenuItems(Result, Items);
end;

function NewPopupMenu(Owner: TComponent; const AName: string; Alignment: TPopupAlignment; AutoPopup: Boolean; Items: array of TMenuItem): TPopupMenu;
begin
  Result := TPopupMenu.Create(Owner);
  Result.Name := AName;
  Result.AutoPopup := AutoPopup;
  Result.Alignment := Alignment;
  InitMenuItems(Result, Items);
end;

function ap_cMainMenu: Tvalue;
begin
  result := cMainMenu;
end;

procedure MainMenu_setup(obj: Tvalue; real: TMainMenu);
begin
  rb_iv_set(obj, '@items', ap_iMenuItem(real.items, obj));
  rb_iv_set(obj, '@merged', rb_ary_new());
//    AssignPropMethod(real, [Handle]);
end;

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

function MainMenu_alloc(This: Tvalue; real: TMainMenu): Tvalue;
begin
  result := ChildAlloc(This, real);
  MainMenu_setup(result, real);
end;

function ap_iMainMenu(real: TMainMenu; owner: Tvalue): Tvalue;
begin
  result := MainMenu_alloc(cMainMenu, real);
  ap_owner(result, owner);
end;

function ap_iMainMenu_v(var obj; owner: Tvalue): Tvalue;
begin
  result := ap_iMainMenu(TMainMenu(obj), owner);
end;

function MainMenu_allocate(This: Tvalue): Tvalue; cdecl;
var
  real: TMainMenu;
begin
  real := TMainMenu.Create(nil);
  result := CompoAlloc(This, real);
  MainMenu_setup(result, real);
end;

function MainMenu_initialize(argc: integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
  args: array of Tvalue;
  ceo: Tvalue;
begin
  SetLength(args, argc);
  args := argv;
  if argc > 0 then
  begin
    ceo := args[0];
    if ap_kind_of(ceo, cComponent) then
      rb_iv_set(This, '@parent', ceo);
  end;
  result := This;
end;

function Phi_new_menu(argc: integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
  args: array of Tvalue;
  ceo: Tvalue;
  parent: TComponent;
  aname: String;
  vtems: array of Tvalue;
  items: array of TMenuItem;
  ary: Tvalue;
  ptr: Pvalue;
  len: Integer;
  i: Integer;
  real: TMainMenu;
  item: TMenuItem;
begin
  if argc < 3 then ap_raise(ap_eArgError, sToo_few_args);
  SetLength(args, argc);
  args := argv;

  ceo := args[0];
  ap_data_get_object(ceo, TComponent, parent);
  aname := dl_caption(args[1]);
  ary := args[2];
  Check_Type(ary, T_ARRAY);
  ptr := ap_ary_ptr(ary);
  len := ap_ary_len(ary);
  SetLength(items, len);
  SetLength(vtems, len);
  for i := 0 to len-1 do
  begin
    vtems[i] := ptr^;
    ap_data_get_object(ptr^, TMenuItem, item);
    items[i] := item;
    Inc(ptr);
  end;

  real := NewMenu(parent, aname, items);
  result := ChildAlloc(cMainMenu, real);

  MainMenu_setup(result, real);

  SetParentAttr(result, ceo, aname);
  rb_iv_set(result, '@parent', ceo);
  DefineMenuItem(real, real.items);
end;

function MainMenu_merge(This, item: Tvalue): Tvalue; cdecl;

  procedure loop_merge(This, item: Tvalue);
  var
    ary: Tvalue;
    ptr: Pvalue;
    len: Integer;
  begin
    if item = This then
      ap_raise(ap_eArgError, 'loop merge');

    ary := rb_iv_get(This, '@merged');
    ptr := ap_ary_ptr(ary);
    len := ap_ary_len(ary);
    while len > 0 do
    begin
      loop_merge(ptr^, item);
      Inc(ptr);
      Dec(len);
    end;
  end;

var
  real, menu: TMainMenu;
  ary, includes: Tvalue;
begin
  loop_merge(This, item);

  real := ap_data_get_struct(This);
  ap_data_get_object(item, TMainMenu, menu);
  ary := rb_iv_get(item, '@merged');
  includes := rb_ary_includes(ary, This);
  if not RTEST(includes) then rb_ary_push(ary, This);
  real.Merge(menu);

  result := This;
end;

function MainMenu_unmerge(This, item: Tvalue): Tvalue; cdecl;
var
  real, menu: TMainMenu;
begin
  real := ap_data_get_struct(This);
  ap_data_get_object(item, TMainMenu, menu);
  rb_ary_delete(rb_iv_get(item, '@merged'), This);
  real.Unmerge(menu);

  result := This;
end;

function ap_cPopupMenu: Tvalue;
begin
  result := cPopupMenu;
end;

procedure PopupMenu_setup(obj: Tvalue; real: TPopupMenu);
begin
  rb_iv_set(obj, '@items', ap_iMenuItem(real.items, obj));
//    AssignPropMethod(real, [Handle]);
end;

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

function PopupMenu_alloc(This: Tvalue; real: TPopupMenu): Tvalue;
begin
  result := ChildAlloc(cPopupMenu, real);
  PopupMenu_setup(result, real);
end;

function ap_iPopupMenu(real: TPopupMenu; owner: Tvalue): Tvalue;
begin
  result := PopupMenu_alloc(cPopupMenu, real);
  ap_owner(result, owner);
end;

function ap_iPopupMenu_v(var obj; owner: Tvalue): Tvalue;
begin
  result := ap_iPopupMenu(TPopupMenu(obj), owner);
end;

function PopupMenu_allocate(This: Tvalue): Tvalue; cdecl;
var
  real: TPopupMenu;
begin
  real := TPopupMenu.Create(nil);
  result := ChildAlloc(This, real);
  PopupMenu_setup(result, real);
end;

function Phi_new_popup_menu(argc: integer; argv: Pointer; This: Tvalue): Tvalue; cdecl;
var
  args: array of Tvalue;
  ceo: Tvalue;
  parent: TComponent;
  aname: String;
  vtems: array of Tvalue;
  items: array of TMenuItem;
  ary: Tvalue;
  ptr: Pvalue;
  len: Integer;
  i: Integer;
  real: TPopupMenu;
begin
  if argc < 3 then ap_raise(ap_eArgError, sToo_few_args);
  SetLength(args, argc);
  args := argv;

  ceo := args[0];
  ap_data_get_object(ceo, TComponent, parent);
  aname := dl_caption(args[1]);
  ary := args[2];
  ptr := ap_ary_ptr(ary);
  len := ap_ary_len(ary);
  SetLength(items, len);
  SetLength(vtems, len);
  for i := 0 to len-1 do
  begin
    vtems[i] := ptr^;
    items[i] := TMenuItem(ap_data_get_struct(ptr^));
    Inc(ptr);
  end;

  real := NewPopupMenu(parent, aname, paCenter, True, items);
  result := CompoAlloc(cPopupMenu, real);

  PopupMenu_setup(result, real);

  SetParentAttr(result, ceo, aname);
  rb_iv_set(result, '@parent', ceo);
  DefineMenuItem(real, real.items);
end;

function PopupMenu_popup(This, x, y: Tvalue): Tvalue; cdecl;
var
  real: TPopupMenu;
begin
  real := ap_data_get_struct(This);
  real.Popup(FIX2INT(x), FIX2INT(y));
  result := This;
end;
{$IFDEF VCL}
function PopupMenu_get_popup_point(This: Tvalue): Tvalue; cdecl;
var
  real: TPopupMenu;
begin
  real := ap_data_get_struct(This);
  result := ap_iPoint(real.PopupPoint, This);
end;
{$ENDIF}
function PopupMenu_get_popup_component(This: Tvalue): Tvalue; cdecl;
var
  real: TPopupMenu;
  Component: TComponent;
begin
  real := ap_data_get_struct(This);
  Component := real.PopupComponent;
  if Component = nil then
    result := Qnil
  else
    result := Component.tag
  ;
end;

function PopupMenu_set_popup_component(This, v: Tvalue): Tvalue; cdecl;
var
  real: TPopupMenu;
  Component: TComponent;
begin
  real := ap_data_get_struct(This);
  ap_data_get_object(v, TComponent, Component);
  real.PopupComponent := Component;
  result := v;
end;

type
  TPhi_Menu = class(TMenu)
  published
    property OnChange;
  end;
(**** str_method made by ap_src_maker ****)

function Menu_adjust_bi_di_behavior(This : Tvalue): Tvalue; cdecl;
var
  real: TPhi_Menu;
begin
  real := ap_data_get_struct(This);
  real.AdjustBiDiBehavior;
  result := This;
end;

function Menu_do_change(This, Source, Rebuild : Tvalue): Tvalue; cdecl;
var
  real: TPhi_Menu;
  dlv_Source : TMenuItem;
  dlv_Rebuild : Boolean;
begin
  real := ap_data_get_struct(This);
  dlv_Source := ap_data_get_struct(Source);
  dlv_Rebuild := dl_Boolean(Rebuild);
  real.DoChange( dlv_Source, dlv_Rebuild );
  result := This;
end;

function Menu_do_bi_di_mode_changed(This : Tvalue): Tvalue; cdecl;
var
  real: TPhi_Menu;
begin
  real := ap_data_get_struct(This);
  real.DoBiDiModeChanged;
  result := This;
end;

function Menu_is_owner_draw(This : Tvalue): Tvalue; cdecl;
var
  real: TPhi_Menu;
begin
  real := ap_data_get_struct(This);
  result := ap_Bool(real.IsOwnerDraw);
end;

function Menu_loaded(This : Tvalue): Tvalue; cdecl;
var
  real: TPhi_Menu;
begin
  real := ap_data_get_struct(This);
  real.Loaded;
  result := This;
end;

function Menu_menu_changed(This, Sender, Source, Rebuild : Tvalue): Tvalue; cdecl;
var
  real: TPhi_Menu;
  dlv_Sender : TObject;
  dlv_Source : TMenuItem;
  dlv_Rebuild : Boolean;
begin
  real := ap_data_get_struct(This);
  dlv_Sender := ap_data_get_struct(Sender);
  dlv_Source := ap_data_get_struct(Source);
  dlv_Rebuild := dl_Boolean(Rebuild);
  real.MenuChanged( dlv_Sender, dlv_Source, dlv_Rebuild );
  result := This;
end;

function Menu_set_child_order(This, Child, Order : Tvalue): Tvalue; cdecl;
var
  real: TPhi_Menu;
  dlv_Child : TComponent;
  dlv_Order : Integer;
begin
  real := ap_data_get_struct(This);
  dlv_Child := ap_data_get_struct(Child);
  dlv_Order := dl_Integer(Order);
  real.SetChildOrder( dlv_Child, dlv_Order );
  result := This;
end;

function Menu_update_items(This : Tvalue): Tvalue; cdecl;
var
  real: TPhi_Menu;
begin
  real := ap_data_get_struct(This);
  real.UpdateItems;
  result := This;
end;

function Menu_dispatch_command(This, ACommand : Tvalue): Tvalue; cdecl;
var
  real: TPhi_Menu;
  dlv_ACommand : Word;
begin
  real := ap_data_get_struct(This);
  dlv_ACommand := dl_Integer(ACommand);
  result := ap_Bool(real.DispatchCommand( dlv_ACommand ));
end;

function Menu_set_images(This, v: Tvalue): Tvalue; cdecl;
var
  real: TPhi_Menu;
begin
  real := ap_data_get_struct(This);
  real.Images := ap_data_get_struct(v);
  result := v;
end;

function Menu_is_right_to_left(This : Tvalue): Tvalue; cdecl;
var
  real: TPhi_Menu;
begin
  real := ap_data_get_struct(This);
  result := ap_Bool(real.IsRightToLeft);
end;

function Menu_parent_bi_di_mode_changed(This : Tvalue): Tvalue; cdecl;
var
  real: TPhi_Menu;
begin
  real := ap_data_get_struct(This);
  real.ParentBiDiModeChanged;
  result := This;
end;

function Menu_get_owner_draw(This: Tvalue): Tvalue; cdecl;
var
  real: TPhi_Menu;
begin
  real := ap_data_get_struct(This);
  result := ap_Bool(real.OwnerDraw);
end;

function Menu_set_owner_draw(This, v: Tvalue): Tvalue; cdecl;
var
  real: TPhi_Menu;
begin
  real := ap_data_get_struct(This);
  real.OwnerDraw := dl_Boolean(v);
  result := v;
end;

function Menu_get_parent_bi_di_mode(This: Tvalue): Tvalue; cdecl;
var
  real: TPhi_Menu;
begin
  real := ap_data_get_struct(This);
  result := ap_Bool(real.ParentBiDiMode);
end;

function Menu_set_parent_bi_di_mode(This, v: Tvalue): Tvalue; cdecl;
var
  real: TPhi_Menu;
begin
  real := ap_data_get_struct(This);
  real.ParentBiDiMode := dl_Boolean(v);
  result := v;
end;

function Menu_get_window_handle(This: Tvalue): Tvalue; cdecl;
var
  real: TPhi_Menu;
begin
  real := ap_data_get_struct(This);
  result := ap_Handle(ord(real.WindowHandle));
end;

function Menu_get_handle(This : Tvalue): Tvalue; cdecl;
var
  real: TPhi_Menu;
begin
  real := ap_data_get_struct(This);
  result := ap_Handle(real.GetHandle);
end;

function Menu_notification(This, AComponent, Operation : Tvalue): Tvalue; cdecl;
var
  real: TPhi_Menu;
  dlv_AComponent : TComponent;
  dlv_Operation : TOperation;
begin
  real := ap_data_get_struct(This);
  dlv_AComponent := ap_data_get_struct(AComponent);
  dlv_Operation := TOperation(ap_Integer(ord(Operation)));
  real.Notification( dlv_AComponent, dlv_Operation );
  result := This;
end;

function Menu_find_item(This, Value, Kind : Tvalue): Tvalue; cdecl;
var
  real: TPhi_Menu;
  dlv_Value : Integer;
  dlv_Kind : TFindItemKind;
begin
  real := ap_data_get_struct(This);
  dlv_Value := dl_Integer(Value);
  dlv_Kind := TFindItemKind(ap_Integer(Kind));
  result := ap_iMenuItem(real.FindItem( dlv_Value, dlv_Kind ),This);
end;

function Menu_get_auto_hotkeys(This: Tvalue): Tvalue; cdecl;
var
  real: TPhi_Menu;
begin
  real := ap_data_get_struct(This);
  result := ap_Integer(ord(real.AutoHotkeys));
end;

function Menu_set_auto_hotkeys(This, v: Tvalue): Tvalue; cdecl;
var
  real: TPhi_Menu;
begin
  real := ap_data_get_struct(This);
  real.AutoHotkeys := TMenuAutoFlag(ap_Integer(v));
  result := v;
end;

function Menu_get_auto_line_reduction(This: Tvalue): Tvalue; cdecl;
var
  real: TPhi_Menu;
begin
  real := ap_data_get_struct(This);
  result := ap_Integer(ord(real.AutoLineReduction));
end;

function Menu_set_auto_line_reduction(This, v: Tvalue): Tvalue; cdecl;
var
  real: TPhi_Menu;
begin
  real := ap_data_get_struct(This);
  real.AutoLineReduction := TMenuAutoFlag(ap_Integer(v));
  result := v;
end;

function Menu_get_bi_di_mode(This: Tvalue): Tvalue; cdecl;
var
  real: TPhi_Menu;
begin
  real := ap_data_get_struct(This);
  result := ap_Integer(ord(real.BiDiMode));
end;

function Menu_set_bi_di_mode(This, v: Tvalue): Tvalue; cdecl;
var
  real: TPhi_Menu;
begin
  real := ap_data_get_struct(This);
  real.BiDiMode := TBiDiMode(ap_Integer(v));
  result := v;
end;

procedure Init_Menu;
begin
  OutputConstSetType(mPhi, TypeInfo(TMenuItemAutoFlag));

  cMenu := OutputPersistentClass(mPhi, TPhi_Menu, cComponent, nil);

  rb_undef_method(CLASS_OF(cMenu), 'new');

  cMainMenu := OutputPersistentClass(mPhi, TMainMenu, cMenu, ap_iMainMenu_v);
  rb_define_method(cMainMenu, 'event_handle', @MainMenu_event_handle, 1);
  rb_define_alloc_func(cMainMenu, @MainMenu_allocate);
  rb_define_private_method(cMainMenu, 'initialize', @MainMenu_initialize, -1);
  DefineModuleFunction(mPhi, 'new_menu', Phi_new_menu);
  rb_define_method(cMainMenu, 'merge', @MainMenu_merge, 1);
  rb_define_method(cMainMenu, 'unmerge', @MainMenu_unmerge, 1);
  rb_define_attr(cMainMenu, 'parent', 1, 0);

  cPopupMenu := OutputPersistentClass(mPhi, TPopupMenu, cMenu, ap_iPopupMenu_v);
  rb_define_method(cPopupMenu, 'event_handle', @PopupMenu_event_handle, 1);
  rb_define_alloc_func(cPopupMenu, @PopupMenu_allocate);
  DefineModuleFunction(mPhi, 'new_popup_menu', Phi_new_popup_menu);
  rb_define_attr(cPopupMenu, 'parent', 1, 0);
  rb_define_method(cPopupMenu, 'popup', @PopupMenu_popup, 2);
{$IFDEF VCL}
  DefineAttrGet(cPopupMenu, 'popup_point', PopupMenu_get_popup_point);
{$ENDIF}
  DefineAttrGet(cPopupMenu, 'popup_component', PopupMenu_get_popup_component);
  DefineAttrSet(cPopupMenu, 'popup_component', PopupMenu_set_popup_component);
  (**** str_init made by ap_src_maker ****)
  rb_define_method(cMenu, 'adjust_bi_di_behavior', @Menu_adjust_bi_di_behavior, 0);
  rb_define_method(cMenu, 'do_change', @Menu_do_change, 2);
  rb_define_method(cMenu, 'do_bi_di_mode_changed', @Menu_do_bi_di_mode_changed, 0);
  rb_define_method(cMenu, 'is_owner_draw', @Menu_is_owner_draw, 0);
  rb_define_method(cMenu, 'loaded', @Menu_loaded, 0);
  rb_define_method(cMenu, 'menu_changed', @Menu_menu_changed, 3);
  rb_define_method(cMenu, 'set_child_order', @Menu_set_child_order, 2);
  rb_define_method(cMenu, 'update_items', @Menu_update_items, 0);
  rb_define_method(cMenu, 'dispatch_command', @Menu_dispatch_command, 1);
  rb_define_method(cMenu, 'is_right_to_left', @Menu_is_right_to_left, 0);
  rb_define_method(cMenu, 'parent_bi_di_mode_changed', @Menu_parent_bi_di_mode_changed, 0);
  rb_define_method(cMenu, 'parent_bi_di_mode_changed', @Menu_parent_bi_di_mode_changed, 1);
  DefineAttrGet(cMenu, 'owner_draw', Menu_get_owner_draw);
  DefineAttrGet(cMenu, 'owner_draw?', Menu_get_owner_draw);
  DefineAttrSet(cMenu, 'owner_draw', Menu_set_owner_draw);
  DefineAttrGet(cMenu, 'parent_bi_di_mode', Menu_get_parent_bi_di_mode);
  DefineAttrGet(cMenu, 'parent_bi_di_mode?', Menu_get_parent_bi_di_mode);
  DefineAttrSet(cMenu, 'parent_bi_di_mode', Menu_set_parent_bi_di_mode);
  DefineAttrGet(cMenu, 'window_handle', Menu_get_window_handle);
(**** made by ap_src_maker ****)
(**** str_init made by ap_src_maker ****)
  rb_define_method(cMenu, 'get_handle', @Menu_get_handle, 0);
  rb_define_method(cMenu, 'notification', @Menu_notification, 2);
  rb_define_method(cMenu, 'find_item', @Menu_find_item, 2);
  DefineAttrSet(cMenu, 'images', Menu_set_images);
  DefineAttrGet(cMenu, 'auto_hotkeys', Menu_get_auto_hotkeys);
  DefineAttrSet(cMenu, 'auto_hotkeys', Menu_set_auto_hotkeys);
  DefineAttrGet(cMenu, 'auto_line_reduction', Menu_get_auto_line_reduction);
  DefineAttrSet(cMenu, 'auto_line_reduction', Menu_set_auto_line_reduction);
  DefineAttrGet(cMenu, 'bi_di_mode', Menu_get_bi_di_mode);
  DefineAttrSet(cMenu, 'bi_di_mode', Menu_set_bi_di_mode);
  DefineAttrGet(cMenu, 'handle', Menu_get_handle);
(**** made by ap_src_maker ****)
end;

end.
