diff options
Diffstat (limited to 'body/fltk-menu_items.adb')
| -rw-r--r-- | body/fltk-menu_items.adb | 60 |
1 files changed, 51 insertions, 9 deletions
diff --git a/body/fltk-menu_items.adb b/body/fltk-menu_items.adb index d68eb60..d75dd4a 100644 --- a/body/fltk-menu_items.adb +++ b/body/fltk-menu_items.adb @@ -23,6 +23,12 @@ package body FLTK.Menu_Items is + ------------------------ + -- Functions From C -- + ------------------------ + + -- Allocation -- + function new_fl_menu_item (T : in Interfaces.C.char_array; C : in Storage.Integer_Address; @@ -39,6 +45,8 @@ package body FLTK.Menu_Items is + -- Callback -- + function fl_menu_item_get_user_data (MI : in Storage.Integer_Address) return Storage.Integer_Address; @@ -58,6 +66,8 @@ package body FLTK.Menu_Items is + -- Settings -- + function fl_menu_item_checkbox (MI : in Storage.Integer_Address) return Interfaces.C.int; @@ -100,6 +110,8 @@ package body FLTK.Menu_Items is + -- Label -- + function fl_menu_item_get_label (MI : in Storage.Integer_Address) return Interfaces.C.Strings.chars_ptr; @@ -170,6 +182,8 @@ package body FLTK.Menu_Items is + -- Shortcut and Flags -- + function fl_menu_item_get_shortcut (MI : in Storage.Integer_Address) return Interfaces.C.int; @@ -197,6 +211,8 @@ package body FLTK.Menu_Items is + -- Image -- + procedure fl_menu_item_image (MI, I : in Storage.Integer_Address); pragma Import (C, fl_menu_item_image, "fl_menu_item_image"); @@ -205,6 +221,8 @@ package body FLTK.Menu_Items is + -- Activity and Visibility -- + procedure fl_menu_item_activate (MI : in Storage.Integer_Address); pragma Import (C, fl_menu_item_activate, "fl_menu_item_activate"); @@ -246,6 +264,10 @@ package body FLTK.Menu_Items is + ------------------- + -- Destructors -- + ------------------- + procedure Finalize (This : in out Menu_Item) is begin @@ -258,6 +280,10 @@ package body FLTK.Menu_Items is + -------------------- + -- Constructors -- + -------------------- + package body Forge is function Create @@ -271,8 +297,8 @@ package body FLTK.Menu_Items is This.Void_Ptr := new_fl_menu_item (Interfaces.C.To_C (Text), Callback_Convert.To_Address (Action), - To_C (Shortcut), - Interfaces.C.int (Flags)); + Interfaces.C.int (To_C (Shortcut)), + MFlag_To_Cint (Flags)); end return; end Create; @@ -283,6 +309,12 @@ package body FLTK.Menu_Items is + ----------------------- + -- API Subprograms -- + ----------------------- + + -- Callback -- + function Get_Callback (This : in Menu_Item) return FLTK.Widgets.Widget_Callback is @@ -312,6 +344,8 @@ package body FLTK.Menu_Items is + -- Settings -- + function Has_Checkbox (This : in Menu_Item) return Boolean is @@ -379,11 +413,13 @@ package body FLTK.Menu_Items is + -- Label -- + function Get_Label (This : in Menu_Item) return String is - Ptr : Interfaces.C.Strings.chars_ptr := fl_menu_item_get_label (This.Void_Ptr); + Ptr : constant Interfaces.C.Strings.chars_ptr := fl_menu_item_get_label (This.Void_Ptr); begin if Ptr = Interfaces.C.Strings.Null_Ptr then return ""; @@ -430,7 +466,7 @@ package body FLTK.Menu_Items is (This : in Menu_Item) return Font_Kind is - Result : Interfaces.C.int := fl_menu_item_get_labelfont (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_menu_item_get_labelfont (This.Void_Ptr); begin return Font_Kind'Val (Result); exception @@ -452,7 +488,7 @@ package body FLTK.Menu_Items is (This : in Menu_Item) return Font_Size is - Result : Interfaces.C.int := fl_menu_item_get_labelsize (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_menu_item_get_labelsize (This.Void_Ptr); begin return Font_Size (Result); exception @@ -474,7 +510,7 @@ package body FLTK.Menu_Items is (This : in Menu_Item) return Label_Kind is - Result : Interfaces.C.int := fl_menu_item_get_labeltype (This.Void_Ptr); + Result : constant Interfaces.C.int := fl_menu_item_get_labeltype (This.Void_Ptr); begin return Label_Kind'Val (Result); exception @@ -494,11 +530,13 @@ package body FLTK.Menu_Items is + -- Shortcut and Flags -- + function Get_Shortcut (This : in Menu_Item) return Key_Combo is begin - return To_Ada (fl_menu_item_get_shortcut (This.Void_Ptr)); + return To_Ada (Interfaces.C.unsigned (fl_menu_item_get_shortcut (This.Void_Ptr))); end Get_Shortcut; @@ -514,7 +552,7 @@ package body FLTK.Menu_Items is (This : in Menu_Item) return Menu_Flag is begin - return Menu_Flag (fl_menu_item_get_flags (This.Void_Ptr)); + return Cint_To_MFlag (fl_menu_item_get_flags (This.Void_Ptr)); end Get_Flags; @@ -522,12 +560,14 @@ package body FLTK.Menu_Items is (This : in out Menu_Item; To : in Menu_Flag) is begin - fl_menu_item_set_flags (This.Void_Ptr, Interfaces.C.int (To)); + fl_menu_item_set_flags (This.Void_Ptr, MFlag_To_Cint (To)); end Set_Flags; + -- Image -- + function Get_Image (This : in Menu_Item) return access FLTK.Images.Image'Class is @@ -547,6 +587,8 @@ package body FLTK.Menu_Items is + -- Activity and Visibility -- + procedure Activate (This : in out Menu_Item) is begin |