summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/c_fl_menuitem.cpp133
-rw-r--r--src/c_fl_menuitem.h49
-rw-r--r--src/fltk-menu_items.adb441
-rw-r--r--src/fltk-menu_items.ads174
-rw-r--r--src/fltk-widgets-menus.adb10
-rw-r--r--src/fltk-widgets-menus.ads27
-rw-r--r--src/fltk.adb10
-rw-r--r--src/fltk.ads24
8 files changed, 806 insertions, 62 deletions
diff --git a/src/c_fl_menuitem.cpp b/src/c_fl_menuitem.cpp
index 631fdd4..342f98b 100644
--- a/src/c_fl_menuitem.cpp
+++ b/src/c_fl_menuitem.cpp
@@ -1,23 +1,150 @@
#include <FL/Fl_Menu_Item.H>
+#include <FL/Fl_Widget.H>
#include "c_fl_menuitem.h"
-int fl_menuitem_value(MENUITEM mi) {
+void * new_fl_menu_item(char * t, void * c, unsigned long s, unsigned long f) {
+ Fl_Menu_Item *mi = new Fl_Menu_Item;
+ mi->callback(reinterpret_cast<Fl_Callback*>(c));
+ mi->flags = static_cast<int>(f);
+ mi->shortcut(static_cast<int>(s));
+ mi->label(t);
+ return mi;
+}
+
+void free_fl_menu_item(MENU_ITEM mi) {
+ delete reinterpret_cast<Fl_Menu_Item*>(mi);
+}
+
+
+
+
+void * fl_menu_item_get_user_data(MENU_ITEM mi) {
+ return reinterpret_cast<Fl_Menu_Item*>(mi)->user_data();
+}
+
+void fl_menu_item_set_user_data(MENU_ITEM mi, void * c) {
+ reinterpret_cast<Fl_Menu_Item*>(mi)->user_data(c);
+}
+
+void fl_menu_item_do_callback(MENU_ITEM mi, void * w) {
+ reinterpret_cast<Fl_Menu_Item*>(mi)->do_callback(reinterpret_cast<Fl_Widget*>(w));
+}
+
+
+
+
+int fl_menu_item_checkbox(MENU_ITEM mi) {
+ return reinterpret_cast<Fl_Menu_Item*>(mi)->checkbox();
+}
+
+int fl_menu_item_radio(MENU_ITEM mi) {
+ return reinterpret_cast<Fl_Menu_Item*>(mi)->radio();
+}
+
+int fl_menu_item_value(MENU_ITEM mi) {
return reinterpret_cast<Fl_Menu_Item*>(mi)->value();
}
+void fl_menu_item_set(MENU_ITEM mi) {
+ reinterpret_cast<Fl_Menu_Item*>(mi)->set();
+}
+
+void fl_menu_item_clear(MENU_ITEM mi) {
+ reinterpret_cast<Fl_Menu_Item*>(mi)->clear();
+}
+
+void fl_menu_item_setonly(MENU_ITEM mi) {
+ reinterpret_cast<Fl_Menu_Item*>(mi)->setonly();
+}
+
-void fl_menuitem_activate(MENUITEM mi) {
+const char * fl_menu_item_get_label(MENU_ITEM mi) {
+ return reinterpret_cast<Fl_Menu_Item*>(mi)->label();
+}
+
+void fl_menu_item_set_label(MENU_ITEM mi, const char *t) {
+ reinterpret_cast<Fl_Menu_Item*>(mi)->label(t);
+}
+
+unsigned int fl_menu_item_get_labelcolor(MENU_ITEM mi) {
+ return reinterpret_cast<Fl_Menu_Item*>(mi)->labelcolor();
+}
+
+void fl_menu_item_set_labelcolor(MENU_ITEM mi, unsigned int c) {
+ reinterpret_cast<Fl_Menu_Item*>(mi)->labelcolor(c);
+}
+
+int fl_menu_item_get_labelfont(MENU_ITEM mi) {
+ return reinterpret_cast<Fl_Menu_Item*>(mi)->labelfont();
+}
+
+void fl_menu_item_set_labelfont(MENU_ITEM mi, int f) {
+ reinterpret_cast<Fl_Menu_Item*>(mi)->labelfont(f);
+}
+
+int fl_menu_item_get_labelsize(MENU_ITEM mi) {
+ return reinterpret_cast<Fl_Menu_Item*>(mi)->labelsize();
+}
+
+void fl_menu_item_set_labelsize(MENU_ITEM mi, int s) {
+ reinterpret_cast<Fl_Menu_Item*>(mi)->labelsize(s);
+}
+
+int fl_menu_item_get_labeltype(MENU_ITEM mi) {
+ return reinterpret_cast<Fl_Menu_Item*>(mi)->labeltype();
+}
+
+void fl_menu_item_set_labeltype(MENU_ITEM mi, int t) {
+ reinterpret_cast<Fl_Menu_Item*>(mi)->labeltype(static_cast<Fl_Labeltype>(t));
+}
+
+
+
+
+int fl_menu_item_get_shortcut(MENU_ITEM mi) {
+ return reinterpret_cast<Fl_Menu_Item*>(mi)->shortcut();
+}
+
+void fl_menu_item_set_shortcut(MENU_ITEM mi, int s) {
+ reinterpret_cast<Fl_Menu_Item*>(mi)->shortcut(s);
+}
+
+
+
+
+void fl_menu_item_activate(MENU_ITEM mi) {
reinterpret_cast<Fl_Menu_Item*>(mi)->activate();
}
-void fl_menuitem_deactivate(MENUITEM mi) {
+void fl_menu_item_deactivate(MENU_ITEM mi) {
reinterpret_cast<Fl_Menu_Item*>(mi)->deactivate();
}
+void fl_menu_item_show(MENU_ITEM mi) {
+ reinterpret_cast<Fl_Menu_Item*>(mi)->show();
+}
+
+void fl_menu_item_hide(MENU_ITEM mi) {
+ reinterpret_cast<Fl_Menu_Item*>(mi)->hide();
+}
+
+int fl_menu_item_active(MENU_ITEM mi) {
+ return reinterpret_cast<Fl_Menu_Item*>(mi)->active();
+}
+
+int fl_menu_item_visible(MENU_ITEM mi) {
+ return reinterpret_cast<Fl_Menu_Item*>(mi)->visible();
+}
+
+int fl_menu_item_activevisible(MENU_ITEM mi) {
+ return reinterpret_cast<Fl_Menu_Item*>(mi)->activevisible();
+}
+
+
diff --git a/src/c_fl_menuitem.h b/src/c_fl_menuitem.h
index c720557..2e7127c 100644
--- a/src/c_fl_menuitem.h
+++ b/src/c_fl_menuitem.h
@@ -1,21 +1,58 @@
-#ifndef FL_MENUITEM_GUARD
-#define FL_MENUITEM_GUARD
+#ifndef FL_MENU_ITEM_GUARD
+#define FL_MENU_ITEM_GUARD
-typedef void* MENUITEM;
+typedef void* MENU_ITEM;
-extern "C" int fl_menuitem_value(MENUITEM mi);
+extern "C" inline void * new_fl_menu_item(char * t, void * c, unsigned long s, unsigned long f);
+extern "C" inline void free_fl_menu_item(MENU_ITEM mi);
-extern "C" void fl_menuitem_activate(MENUITEM mi);
-extern "C" void fl_menuitem_deactivate(MENUITEM mi);
+
+
+extern "C" inline void * fl_menu_item_get_user_data(MENU_ITEM mi);
+extern "C" inline void fl_menu_item_set_user_data(MENU_ITEM mi, void * c);
+extern "C" inline void fl_menu_item_do_callback(MENU_ITEM mi, void * w);
+
+
+extern "C" inline int fl_menu_item_checkbox(MENU_ITEM mi);
+extern "C" inline int fl_menu_item_radio(MENU_ITEM mi);
+extern "C" inline int fl_menu_item_value(MENU_ITEM mi);
+extern "C" inline void fl_menu_item_set(MENU_ITEM mi);
+extern "C" inline void fl_menu_item_clear(MENU_ITEM mi);
+extern "C" inline void fl_menu_item_setonly(MENU_ITEM mi);
+
+
+extern "C" inline const char * fl_menu_item_get_label(MENU_ITEM mi);
+extern "C" inline void fl_menu_item_set_label(MENU_ITEM mi, const char *t);
+extern "C" inline unsigned int fl_menu_item_get_labelcolor(MENU_ITEM mi);
+extern "C" inline void fl_menu_item_set_labelcolor(MENU_ITEM mi, unsigned int c);
+extern "C" inline int fl_menu_item_get_labelfont(MENU_ITEM mi);
+extern "C" inline void fl_menu_item_set_labelfont(MENU_ITEM mi, int f);
+extern "C" inline int fl_menu_item_get_labelsize(MENU_ITEM mi);
+extern "C" inline void fl_menu_item_set_labelsize(MENU_ITEM mi, int s);
+extern "C" inline int fl_menu_item_get_labeltype(MENU_ITEM mi);
+extern "C" inline void fl_menu_item_set_labeltype(MENU_ITEM mi, int t);
+
+
+extern "C" inline int fl_menu_item_get_shortcut(MENU_ITEM mi);
+extern "C" inline void fl_menu_item_set_shortcut(MENU_ITEM mi, int s);
+
+
+extern "C" inline void fl_menu_item_activate(MENU_ITEM mi);
+extern "C" inline void fl_menu_item_deactivate(MENU_ITEM mi);
+extern "C" inline void fl_menu_item_show(MENU_ITEM mi);
+extern "C" inline void fl_menu_item_hide(MENU_ITEM mi);
+extern "C" inline int fl_menu_item_active(MENU_ITEM mi);
+extern "C" inline int fl_menu_item_visible(MENU_ITEM mi);
+extern "C" inline int fl_menu_item_activevisible(MENU_ITEM mi);
#endif
diff --git a/src/fltk-menu_items.adb b/src/fltk-menu_items.adb
index 80bcea7..a94293f 100644
--- a/src/fltk-menu_items.adb
+++ b/src/fltk-menu_items.adb
@@ -2,58 +2,471 @@
with
- Interfaces.C;
+ System,
+ Interfaces.C.Strings,
+ Ada.Unchecked_Conversion;
use type
+ System.Address,
Interfaces.C.int;
package body FLTK.Menu_Items is
- function fl_menuitem_value
+ function new_fl_menu_item
+ (T : in Interfaces.C.char_array;
+ C : in System.Address;
+ S, F : in Interfaces.C.unsigned_long)
+ return System.Address;
+ pragma Import (C, new_fl_menu_item, "new_fl_menu_item");
+ pragma Inline (new_fl_menu_item);
+
+ procedure free_fl_menu_item
+ (MI : in System.Address);
+ pragma Import (C, free_fl_menu_item, "free_fl_menu_item");
+ pragma Inline (free_fl_menu_item);
+
+
+
+
+ function fl_menu_item_get_user_data
+ (MI : in System.Address)
+ return System.Address;
+ pragma Import (C, fl_menu_item_get_user_data, "fl_menu_item_get_user_data");
+ pragma Inline (fl_menu_item_get_user_data);
+
+ procedure fl_menu_item_set_user_data
+ (MI, C : in System.Address);
+ pragma Import (C, fl_menu_item_set_user_data, "fl_menu_item_set_user_data");
+ pragma Inline (fl_menu_item_set_user_data);
+
+ procedure fl_menu_item_do_callback
+ (MI, W : in System.Address);
+ pragma Import (C, fl_menu_item_do_callback, "fl_menu_item_do_callback");
+ pragma Inline (fl_menu_item_do_callback);
+
+
+
+
+ function fl_menu_item_checkbox
+ (MI : in System.Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_item_checkbox, "fl_menu_item_checkbox");
+ pragma Inline (fl_menu_item_checkbox);
+
+ function fl_menu_item_radio
+ (MI : in System.Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_item_radio, "fl_menu_item_radio");
+ pragma Inline (fl_menu_item_radio);
+
+ function fl_menu_item_value
+ (MI : in System.Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_item_value, "fl_menu_item_value");
+ pragma Inline (fl_menu_item_value);
+
+ procedure fl_menu_item_set
+ (MI : in System.Address);
+ pragma Import (C, fl_menu_item_set, "fl_menu_item_set");
+ pragma Inline (fl_menu_item_set);
+
+ procedure fl_menu_item_clear
+ (MI : in System.Address);
+ pragma Import (C, fl_menu_item_clear, "fl_menu_item_clear");
+ pragma Inline (fl_menu_item_clear);
+
+ procedure fl_menu_item_setonly
+ (MI : in System.Address);
+ pragma Import (C, fl_menu_item_setonly, "fl_menu_item_setonly");
+ pragma Inline (fl_menu_item_setonly);
+
+
+
+
+ function fl_menu_item_get_label
+ (MI : in System.Address)
+ return Interfaces.C.Strings.chars_ptr;
+ pragma Import (C, fl_menu_item_get_label, "fl_menu_item_get_label");
+ pragma Inline (fl_menu_item_get_label);
+
+ procedure fl_menu_item_set_label
+ (MI : in System.Address;
+ T : in Interfaces.C.char_array);
+ pragma Import (C, fl_menu_item_set_label, "fl_menu_item_set_label");
+ pragma Inline (fl_menu_item_set_label);
+
+ function fl_menu_item_get_labelcolor
+ (MI : in System.Address)
+ return Interfaces.C.unsigned;
+ pragma Import (C, fl_menu_item_get_labelcolor, "fl_menu_item_get_labelcolor");
+ pragma Inline (fl_menu_item_get_labelcolor);
+
+ procedure fl_menu_item_set_labelcolor
+ (MI : in System.Address;
+ C : in Interfaces.C.unsigned);
+ pragma Import (C, fl_menu_item_set_labelcolor, "fl_menu_item_set_labelcolor");
+ pragma Inline (fl_menu_item_set_labelcolor);
+
+ function fl_menu_item_get_labelfont
+ (MI : in System.Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_item_get_labelfont, "fl_menu_item_get_labelfont");
+ pragma Inline (fl_menu_item_get_labelfont);
+
+ procedure fl_menu_item_set_labelfont
+ (MI : in System.Address;
+ F : in Interfaces.C.int);
+ pragma Import (C, fl_menu_item_set_labelfont, "fl_menu_item_set_labelfont");
+ pragma Inline (fl_menu_item_set_labelfont);
+
+ function fl_menu_item_get_labelsize
(MI : in System.Address)
return Interfaces.C.int;
- pragma Import (C, fl_menuitem_value, "fl_menuitem_value");
+ pragma Import (C, fl_menu_item_get_labelsize, "fl_menu_item_get_labelsize");
+ pragma Inline (fl_menu_item_get_labelsize);
+ procedure fl_menu_item_set_labelsize
+ (MI : in System.Address;
+ S : in Interfaces.C.int);
+ pragma Import (C, fl_menu_item_set_labelsize, "fl_menu_item_set_labelsize");
+ pragma Inline (fl_menu_item_set_labelsize);
+
+ function fl_menu_item_get_labeltype
+ (MI : in System.Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_item_get_labeltype, "fl_menu_item_get_labeltype");
+ pragma Inline (fl_menu_item_get_labeltype);
+
+ procedure fl_menu_item_set_labeltype
+ (MI : in System.Address;
+ T : in Interfaces.C.int);
+ pragma Import (C, fl_menu_item_set_labeltype, "fl_menu_item_set_labeltype");
+ pragma Inline (fl_menu_item_set_labeltype);
+
+
+
+
+ function fl_menu_item_get_shortcut
+ (MI : in System.Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_item_get_shortcut, "fl_menu_item_get_shortcut");
+ pragma Inline (fl_menu_item_get_shortcut);
+
+ procedure fl_menu_item_set_shortcut
+ (MI : in System.Address;
+ S : in Interfaces.C.int);
+ pragma Import (C, fl_menu_item_set_shortcut, "fl_menu_item_set_shortcut");
+ pragma Inline (fl_menu_item_set_shortcut);
- procedure fl_menuitem_activate
+
+ procedure fl_menu_item_activate
+ (MI : in System.Address);
+ pragma Import (C, fl_menu_item_activate, "fl_menu_item_activate");
+ pragma Inline (fl_menu_item_activate);
+
+ procedure fl_menu_item_deactivate
+ (MI : in System.Address);
+ pragma Import (C, fl_menu_item_deactivate, "fl_menu_item_deactivate");
+ pragma Inline (fl_menu_item_deactivate);
+
+ procedure fl_menu_item_show
(MI : in System.Address);
- pragma Import (C, fl_menuitem_activate, "fl_menuitem_activate");
+ pragma Import (C, fl_menu_item_show, "fl_menu_item_show");
+ pragma Inline (fl_menu_item_show);
- procedure fl_menuitem_deactivate
+ procedure fl_menu_item_hide
(MI : in System.Address);
- pragma Import (C, fl_menuitem_deactivate, "fl_menuitem_deactivate");
+ pragma Import (C, fl_menu_item_hide, "fl_menu_item_hide");
+ pragma Inline (fl_menu_item_hide);
+
+ function fl_menu_item_active
+ (MI : in System.Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_item_active, "fl_menu_item_active");
+ pragma Inline (fl_menu_item_active);
+
+ function fl_menu_item_visible
+ (MI : in System.Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_item_visible, "fl_menu_item_visible");
+ pragma Inline (fl_menu_item_visible);
+
+ function fl_menu_item_activevisible
+ (MI : in System.Address)
+ return Interfaces.C.int;
+ pragma Import (C, fl_menu_item_activevisible, "fl_menu_item_activevisible");
+ pragma Inline (fl_menu_item_activevisible);
+
+
+
+
+ procedure Finalize
+ (This : in out Menu_Item) is
+ begin
+ if This.Void_Ptr /= System.Null_Address and then
+ This in Menu_Item'Class
+ then
+ if This.Needs_Dealloc then
+ free_fl_menu_item (This.Void_Ptr);
+ end if;
+ This.Void_Ptr := System.Null_Address;
+ end if;
+ end Finalize;
+
+
+
+
+ package Callback_Convert is
+ function To_Pointer is new Ada.Unchecked_Conversion
+ (System.Address, FLTK.Widgets.Widget_Callback);
+ function To_Address is new Ada.Unchecked_Conversion
+ (FLTK.Widgets.Widget_Callback, System.Address);
+ end Callback_Convert;
+
+
+
+
+ package body Forge is
+
+ function Create
+ (Text : in String;
+ Action : in FLTK.Widgets.Widget_Callback := null;
+ Shortcut : in Key_Combo := No_Key;
+ Flags : in Menu_Flag := Flag_Normal)
+ return Menu_Item is
+ begin
+ return Item : Menu_Item do
+ Item.Void_Ptr := new_fl_menu_item
+ (Interfaces.C.To_C (Text),
+ Callback_Convert.To_Address (Action),
+ To_C (Shortcut),
+ Interfaces.C.unsigned_long (Flags));
+ end return;
+ end Create;
+
+ pragma Inline (Create);
+
+ end Forge;
- function Value
+ function Get_Callback
+ (Item : in Menu_Item)
+ return FLTK.Widgets.Widget_Callback is
+ begin
+ return Callback_Convert.To_Pointer
+ (fl_menu_item_get_user_data (Item.Void_Ptr));
+ end Get_Callback;
+
+
+ procedure Set_Callback
+ (Item : in out Menu_Item;
+ Func : in FLTK.Widgets.Widget_Callback) is
+ begin
+ fl_menu_item_set_user_data
+ (Item.Void_Ptr,
+ Callback_Convert.To_Address (Func));
+ end Set_Callback;
+
+
+ procedure Do_Callback
+ (Item : in out Menu_Item;
+ Widget : in out FLTK.Widgets.Widget'Class) is
+ begin
+ fl_menu_item_do_callback (Item.Void_Ptr, Wrapper (Widget).Void_Ptr);
+ end Do_Callback;
+
+
+
+
+ function Has_Checkbox
+ (Item : in Menu_Item)
+ return Boolean is
+ begin
+ return fl_menu_item_checkbox (Item.Void_Ptr) /= 0;
+ end Has_Checkbox;
+
+ function Is_Radio
(Item : in Menu_Item)
return Boolean is
begin
- return fl_menuitem_value (Item.Void_Ptr) /= 0;
- end Value;
+ return fl_menu_item_radio (Item.Void_Ptr) /= 0;
+ end Is_Radio;
+
+ function Get_State
+ (Item : in Menu_Item)
+ return Boolean is
+ begin
+ return fl_menu_item_value (Item.Void_Ptr) /= 0;
+ end Get_State;
+
+ procedure Set_State
+ (Item : in out Menu_Item;
+ To : in Boolean) is
+ begin
+ if To then
+ fl_menu_item_set (Item.Void_Ptr);
+ else
+ fl_menu_item_clear (Item.Void_Ptr);
+ end if;
+ end Set_State;
+
+ procedure Set_Only
+ (Item : in out Menu_Item) is
+ begin
+ fl_menu_item_setonly (Item.Void_Ptr);
+ end Set_Only;
+
+
+
+
+ function Get_Label
+ (Item : in Menu_Item)
+ return String is
+ begin
+ return Interfaces.C.Strings.Value (fl_menu_item_get_label (Item.Void_Ptr));
+ end Get_Label;
+
+ procedure Set_Label
+ (Item : in out Menu_Item;
+ Text : in String) is
+ begin
+ fl_menu_item_set_label (Item.Void_Ptr, Interfaces.C.To_C (Text));
+ end Set_Label;
+
+ function Get_Label_Color
+ (Item : in Menu_Item)
+ return Color is
+ begin
+ return Color (fl_menu_item_get_labelcolor (Item.Void_Ptr));
+ end Get_Label_Color;
+
+ procedure Set_Label_Color
+ (Item : in out Menu_Item;
+ To : in Color) is
+ begin
+ fl_menu_item_set_labelcolor (Item.Void_Ptr, Interfaces.C.unsigned (To));
+ end Set_Label_Color;
+
+ function Get_Label_Font
+ (Item : in Menu_Item)
+ return Font_Kind is
+ begin
+ return Font_Kind'Val (fl_menu_item_get_labelfont (Item.Void_Ptr));
+ end Get_Label_Font;
+
+ procedure Set_Label_Font
+ (Item : in out Menu_Item;
+ To : in Font_Kind) is
+ begin
+ fl_menu_item_set_labelfont (Item.Void_Ptr, Font_Kind'Pos (To));
+ end Set_Label_Font;
+
+ function Get_Label_Size
+ (Item : in Menu_Item)
+ return Font_Size is
+ begin
+ return Font_Size (fl_menu_item_get_labelsize (Item.Void_Ptr));
+ end Get_Label_Size;
+
+ procedure Set_Label_Size
+ (Item : in out Menu_Item;
+ To : in Font_Size) is
+ begin
+ fl_menu_item_set_labelsize (Item.Void_Ptr, Interfaces.C.int (To));
+ end Set_Label_Size;
+
+ function Get_Label_Type
+ (Item : in Menu_Item)
+ return Label_Kind is
+ begin
+ return Label_Kind'Val (fl_menu_item_get_labeltype (Item.Void_Ptr));
+ end Get_Label_Type;
+
+ procedure Set_Label_Type
+ (Item : in out Menu_Item;
+ To : in Label_Kind) is
+ begin
+ fl_menu_item_set_labeltype (Item.Void_Ptr, Label_Kind'Pos (To));
+ end Set_Label_Type;
+
+
+
+
+ function Get_Shortcut
+ (Item : in Menu_Item)
+ return Key_Combo is
+ begin
+ return To_Ada (Interfaces.C.unsigned_long (fl_menu_item_get_shortcut (Item.Void_Ptr)));
+ end Get_Shortcut;
+
+ procedure Set_Shortcut
+ (Item : in out Menu_Item;
+ To : in Key_Combo) is
+ begin
+ fl_menu_item_set_shortcut (Item.Void_Ptr, Interfaces.C.int (To_C (To)));
+ end Set_Shortcut;
procedure Activate
- (Item : in Menu_Item) is
+ (Item : in out Menu_Item) is
begin
- fl_menuitem_activate (Item.Void_Ptr);
+ fl_menu_item_activate (Item.Void_Ptr);
end Activate;
procedure Deactivate
- (Item : in Menu_Item) is
+ (Item : in out Menu_Item) is
begin
- fl_menuitem_deactivate (Item.Void_Ptr);
+ fl_menu_item_deactivate (Item.Void_Ptr);
end Deactivate;
+ procedure Show
+ (Item : in out Menu_Item) is
+ begin
+ fl_menu_item_show (Item.Void_Ptr);
+ end Show;
+
+
+ procedure Hide
+ (Item : in out Menu_Item) is
+ begin
+ fl_menu_item_hide (Item.Void_Ptr);
+ end Hide;
+
+
+ function Is_Active
+ (Item : in Menu_Item)
+ return Boolean is
+ begin
+ return fl_menu_item_active (Item.Void_Ptr) /= 0;
+ end Is_Active;
+
+
+ function Is_Visible
+ (Item : in Menu_Item)
+ return Boolean is
+ begin
+ return fl_menu_item_visible (Item.Void_Ptr) /= 0;
+ end Is_Visible;
+
+
+ function Is_Active_And_Visible
+ (Item : in Menu_Item)
+ return Boolean is
+ begin
+ return fl_menu_item_activevisible (Item.Void_Ptr) /= 0;
+ end Is_Active_And_Visible;
+
+
end FLTK.Menu_Items;
diff --git a/src/fltk-menu_items.ads b/src/fltk-menu_items.ads
index 51aba8b..9f02d27 100644
--- a/src/fltk-menu_items.ads
+++ b/src/fltk-menu_items.ads
@@ -1,25 +1,151 @@
+with
+
+ FLTK.Widgets;
+
package FLTK.Menu_Items is
type Menu_Item is new Wrapper with private;
+ type Menu_Item_Reference (Data : not null access Menu_Item'Class) is limited null record
+ with Implicit_Dereference => Data;
+
+
+
+
+ package Forge is
+
+ -- Usually you don't bother with this and just add items
+ -- to Menus directly using the Add subprograms in that package.
+
+ function Create
+ (Text : in String;
+ Action : in FLTK.Widgets.Widget_Callback := null;
+ Shortcut : in Key_Combo := No_Key;
+ Flags : in Menu_Flag := Flag_Normal)
+ return Menu_Item;
+
+ end Forge;
+
- function Value
+ function Get_Callback
+ (Item : in Menu_Item)
+ return FLTK.Widgets.Widget_Callback;
+
+ procedure Set_Callback
+ (Item : in out Menu_Item;
+ Func : in FLTK.Widgets.Widget_Callback);
+
+ procedure Do_Callback
+ (Item : in out Menu_Item;
+ Widget : in out FLTK.Widgets.Widget'Class);
+
+
+
+
+ function Has_Checkbox
(Item : in Menu_Item)
return Boolean;
+ function Is_Radio
+ (Item : in Menu_Item)
+ return Boolean;
+
+ function Get_State
+ (Item : in Menu_Item)
+ return Boolean;
+
+ procedure Set_State
+ (Item : in out Menu_Item;
+ To : in Boolean);
+
+ procedure Set_Only
+ (Item : in out Menu_Item);
+
+
+
+
+ function Get_Label
+ (Item : in Menu_Item)
+ return String;
+
+ procedure Set_Label
+ (Item : in out Menu_Item;
+ Text : in String);
+
+ function Get_Label_Color
+ (Item : in Menu_Item)
+ return Color;
+
+ procedure Set_Label_Color
+ (Item : in out Menu_Item;
+ To : in Color);
+
+ function Get_Label_Font
+ (Item : in Menu_Item)
+ return Font_Kind;
+
+ procedure Set_Label_Font
+ (Item : in out Menu_Item;
+ To : in Font_Kind);
+
+ function Get_Label_Size
+ (Item : in Menu_Item)
+ return Font_Size;
+
+ procedure Set_Label_Size
+ (Item : in out Menu_Item;
+ To : in Font_Size);
+
+ function Get_Label_Type
+ (Item : in Menu_Item)
+ return Label_Kind;
+
+ procedure Set_Label_Type
+ (Item : in out Menu_Item;
+ To : in Label_Kind);
+
+
+
+
+ function Get_Shortcut
+ (Item : in Menu_Item)
+ return Key_Combo;
+
+ procedure Set_Shortcut
+ (Item : in out Menu_Item;
+ To : in Key_Combo);
+
procedure Activate
- (Item : in Menu_Item);
+ (Item : in out Menu_Item);
procedure Deactivate
- (Item : in Menu_Item);
+ (Item : in out Menu_Item);
+
+ procedure Show
+ (Item : in out Menu_Item);
+
+ procedure Hide
+ (Item : in out Menu_Item);
+
+ function Is_Active
+ (Item : in Menu_Item)
+ return Boolean;
+
+ function Is_Visible
+ (Item : in Menu_Item)
+ return Boolean;
+
+ function Is_Active_And_Visible
+ (Item : in Menu_Item)
+ return Boolean;
private
@@ -27,6 +153,48 @@ private
type Menu_Item is new Wrapper with null record;
+ overriding procedure Finalize
+ (This : in out Menu_Item);
+
+
+
+
+ pragma Inline (Get_Callback);
+ pragma Inline (Set_Callback);
+ pragma Inline (Do_Callback);
+
+
+ pragma Inline (Has_Checkbox);
+ pragma Inline (Is_Radio);
+ pragma Inline (Get_State);
+ pragma Inline (Set_State);
+ pragma Inline (Set_Only);
+
+
+ pragma Inline (Get_Label);
+ pragma Inline (Set_Label);
+ pragma Inline (Get_Label_Color);
+ pragma Inline (Set_Label_Color);
+ pragma Inline (Get_Label_Font);
+ pragma Inline (Set_Label_Font);
+ pragma Inline (Get_Label_Size);
+ pragma Inline (Set_Label_Size);
+ pragma Inline (Get_Label_Type);
+ pragma Inline (Set_Label_Type);
+
+
+ pragma Inline (Get_Shortcut);
+ pragma Inline (Set_Shortcut);
+
+
+ pragma Inline (Activate);
+ pragma Inline (Deactivate);
+ pragma Inline (Show);
+ pragma Inline (Hide);
+ pragma Inline (Is_Active);
+ pragma Inline (Is_Visible);
+ pragma Inline (Is_Active_And_Visible);
+
end FLTK.Menu_Items;
diff --git a/src/fltk-widgets-menus.adb b/src/fltk-widgets-menus.adb
index 0947003..3d8ea0c 100644
--- a/src/fltk-widgets-menus.adb
+++ b/src/fltk-widgets-menus.adb
@@ -16,16 +16,6 @@ use type
package body FLTK.Widgets.Menus is
- function "+"
- (Left, Right : in Menu_Flag)
- return Menu_Flag is
- begin
- return Left or Right;
- end "+";
-
-
-
-
procedure menu_set_draw_hook
(W, D : in System.Address);
pragma Import (C, menu_set_draw_hook, "menu_set_draw_hook");
diff --git a/src/fltk-widgets-menus.ads b/src/fltk-widgets-menus.ads
index 2d36fc9..5d3e599 100644
--- a/src/fltk-widgets-menus.ads
+++ b/src/fltk-widgets-menus.ads
@@ -18,18 +18,7 @@ package FLTK.Widgets.Menus is
type Menu_Cursor (Data : access Menu'Class) is limited null record
with Implicit_Dereference => Data;
- type Index is new Positive;
-
- type Menu_Flag is private;
- function "+" (Left, Right : in Menu_Flag) return Menu_Flag;
- Flag_Normal : constant Menu_Flag;
- Flag_Inactive : constant Menu_Flag;
- Flag_Toggle : constant Menu_Flag;
- Flag_Value : constant Menu_Flag;
- Flag_Radio : constant Menu_Flag;
- Flag_Invisible : constant Menu_Flag;
- Flag_Submenu : constant Menu_Flag;
- Flag_Divider : constant Menu_Flag;
+ subtype Index is Positive;
@@ -89,19 +78,5 @@ private
pragma Convention (C, Item_Hook);
-
-
- type Menu_Flag is new Interfaces.Unsigned_8;
- Flag_Normal : constant Menu_Flag := 2#00000000#;
- Flag_Inactive : constant Menu_Flag := 2#00000001#;
- Flag_Toggle : constant Menu_Flag := 2#00000010#;
- Flag_Value : constant Menu_Flag := 2#00000100#;
- Flag_Radio : constant Menu_Flag := 2#00001000#;
- Flag_Invisible : constant Menu_Flag := 2#00010000#;
- -- Flag_Submenu_Pointer unlikely to be used
- Flag_Submenu : constant Menu_Flag := 2#01000000#;
- Flag_Divider : constant Menu_Flag := 2#10000000#;
-
-
end FLTK.Widgets.Menus;
diff --git a/src/fltk.adb b/src/fltk.adb
index 6bfd6d6..66a4060 100644
--- a/src/fltk.adb
+++ b/src/fltk.adb
@@ -232,5 +232,15 @@ package body FLTK is
end To_Ada;
+
+
+ function "+"
+ (Left, Right : in Menu_Flag)
+ return Menu_Flag is
+ begin
+ return Left or Right;
+ end "+";
+
+
end FLTK;
diff --git a/src/fltk.ads b/src/fltk.ads
index df4967f..81a3763 100644
--- a/src/fltk.ads
+++ b/src/fltk.ads
@@ -205,6 +205,18 @@ package FLTK is
type Event_Outcome is (Not_Handled, Handled);
+ type Menu_Flag is private;
+ function "+" (Left, Right : in Menu_Flag) return Menu_Flag;
+ Flag_Normal : constant Menu_Flag;
+ Flag_Inactive : constant Menu_Flag;
+ Flag_Toggle : constant Menu_Flag;
+ Flag_Value : constant Menu_Flag;
+ Flag_Radio : constant Menu_Flag;
+ Flag_Invisible : constant Menu_Flag;
+ Flag_Submenu : constant Menu_Flag;
+ Flag_Divider : constant Menu_Flag;
+
+
private
@@ -307,5 +319,17 @@ private
Escape_Key : constant Keypress := 16#ff1b#;
+ type Menu_Flag is new Interfaces.Unsigned_8;
+ Flag_Normal : constant Menu_Flag := 2#00000000#;
+ Flag_Inactive : constant Menu_Flag := 2#00000001#;
+ Flag_Toggle : constant Menu_Flag := 2#00000010#;
+ Flag_Value : constant Menu_Flag := 2#00000100#;
+ Flag_Radio : constant Menu_Flag := 2#00001000#;
+ Flag_Invisible : constant Menu_Flag := 2#00010000#;
+ -- Flag_Submenu_Pointer unlikely to be used
+ Flag_Submenu : constant Menu_Flag := 2#01000000#;
+ Flag_Divider : constant Menu_Flag := 2#10000000#;
+
+
end FLTK;