path: root/src/fltk-menu_items.adb

with

    System,
    Interfaces.C.Strings,
    Ada.Unchecked_Conversion;

use type

    System.Address,
    Interfaces.C.int;


package body FLTK.Menu_Items is


    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_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_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_menu_item_show, "fl_menu_item_show");
    pragma Inline (fl_menu_item_show);

    procedure fl_menu_item_hide
           (MI : in System.Address);
    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 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_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 out Menu_Item) is
    begin
        fl_menu_item_activate (Item.Void_Ptr);
    end Activate;


    procedure Deactivate
           (Item : in out Menu_Item) is
    begin
        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;