path: root/src/fltk-widgets-groups-browsers-check.adb

--  Programmed by Jedidiah Barber
--  Released into the public domain


with

    Interfaces.C.Strings;

use type

    Interfaces.C.int;


package body FLTK.Widgets.Groups.Browsers.Check is


    ------------------------
    --  Functions From C  --
    ------------------------

    function new_fl_check_browser
           (X, Y, W, H : in Interfaces.C.int;
            Text       : in Interfaces.C.char_array)
        return Storage.Integer_Address;
    pragma Import (C, new_fl_check_browser, "new_fl_check_browser");
    pragma Inline (new_fl_check_browser);

    procedure free_fl_check_browser
           (C : in Storage.Integer_Address);
    pragma Import (C, free_fl_check_browser, "free_fl_check_browser");
    pragma Inline (free_fl_check_browser);




    function fl_check_browser_add
           (C : in Storage.Integer_Address;
            S : in Interfaces.C.char_array;
            B : in Interfaces.C.int)
        return Interfaces.C.int;
    pragma Import (C, fl_check_browser_add, "fl_check_browser_add");
    pragma Inline (fl_check_browser_add);

    function fl_check_browser_remove
           (C : in Storage.Integer_Address;
            I : in Interfaces.C.int)
        return Interfaces.C.int;
    pragma Import (C, fl_check_browser_remove, "fl_check_browser_remove");
    pragma Inline (fl_check_browser_remove);

    procedure fl_check_browser_clear
           (C : in Storage.Integer_Address);
    pragma Import (C, fl_check_browser_clear, "fl_check_browser_clear");
    pragma Inline (fl_check_browser_clear);

    function fl_check_browser_nitems
           (C : in Storage.Integer_Address)
        return Interfaces.C.int;
    pragma Import (C, fl_check_browser_nitems, "fl_check_browser_nitems");
    pragma Inline (fl_check_browser_nitems);




    procedure fl_check_browser_check_all
           (C : in Storage.Integer_Address);
    pragma Import (C, fl_check_browser_check_all, "fl_check_browser_check_all");
    pragma Inline (fl_check_browser_check_all);

    procedure fl_check_browser_check_none
           (C : in Storage.Integer_Address);
    pragma Import (C, fl_check_browser_check_none, "fl_check_browser_check_none");
    pragma Inline (fl_check_browser_check_none);

    function fl_check_browser_get_checked
           (C : in Storage.Integer_Address;
            I : in Interfaces.C.int)
        return Interfaces.C.int;
    pragma Import (C, fl_check_browser_get_checked, "fl_check_browser_get_checked");
    pragma Inline (fl_check_browser_get_checked);

    procedure fl_check_browser_set_checked
           (C    : in Storage.Integer_Address;
            I, B : in Interfaces.C.int);
    pragma Import (C, fl_check_browser_set_checked, "fl_check_browser_set_checked");
    pragma Inline (fl_check_browser_set_checked);

    function fl_check_browser_nchecked
           (C : in Storage.Integer_Address)
        return Interfaces.C.int;
    pragma Import (C, fl_check_browser_nchecked, "fl_check_browser_nchecked");
    pragma Inline (fl_check_browser_nchecked);




    function fl_check_browser_text
           (C : in Storage.Integer_Address;
            I : in Interfaces.C.int)
        return Interfaces.C.Strings.chars_ptr;
    pragma Import (C, fl_check_browser_text, "fl_check_browser_text");
    pragma Inline (fl_check_browser_text);

    function fl_check_browser_value
           (C : in Storage.Integer_Address)
        return Interfaces.C.int;
    pragma Import (C, fl_check_browser_value, "fl_check_browser_value");
    pragma Inline (fl_check_browser_value);




    function fl_check_browser_full_width
           (B : in Storage.Integer_Address)
        return Interfaces.C.int;
    pragma Import (C, fl_check_browser_full_width, "fl_check_browser_full_width");
    pragma Inline (fl_check_browser_full_width);

    function fl_check_browser_full_height
           (B : in Storage.Integer_Address)
        return Interfaces.C.int;
    pragma Import (C, fl_check_browser_full_height, "fl_check_browser_full_height");
    pragma Inline (fl_check_browser_full_height);

    function fl_check_browser_incr_height
           (B : in Storage.Integer_Address)
        return Interfaces.C.int;
    pragma Import (C, fl_check_browser_incr_height, "fl_check_browser_incr_height");
    pragma Inline (fl_check_browser_incr_height);

    function fl_check_browser_item_quick_height
           (B, I : in Storage.Integer_Address)
        return Interfaces.C.int;
    pragma Import (C, fl_check_browser_item_quick_height, "fl_check_browser_item_quick_height");
    pragma Inline (fl_check_browser_item_quick_height);




    function fl_check_browser_item_width
           (C, I : in Storage.Integer_Address)
        return Interfaces.C.int;
    pragma Import (C, fl_check_browser_item_width, "fl_check_browser_item_width");
    pragma Inline (fl_check_browser_item_width);

    function fl_check_browser_item_height
           (C, I : in Storage.Integer_Address)
        return Interfaces.C.int;
    pragma Import (C, fl_check_browser_item_height, "fl_check_browser_item_height");
    pragma Inline (fl_check_browser_item_height);

    function fl_check_browser_item_first
           (C : in Storage.Integer_Address)
        return Storage.Integer_Address;
    pragma Import (C, fl_check_browser_item_first, "fl_check_browser_item_first");
    pragma Inline (fl_check_browser_item_first);

    --  Missing item_last

    function fl_check_browser_item_next
           (C, I : in Storage.Integer_Address)
        return Storage.Integer_Address;
    pragma Import (C, fl_check_browser_item_next, "fl_check_browser_item_next");
    pragma Inline (fl_check_browser_item_next);

    function fl_check_browser_item_prev
           (C, I : in Storage.Integer_Address)
        return Storage.Integer_Address;
    pragma Import (C, fl_check_browser_item_prev, "fl_check_browser_item_prev");
    pragma Inline (fl_check_browser_item_prev);

    --  Missing item_at

    procedure fl_check_browser_item_select
           (C, I : in Storage.Integer_Address;
            V    : in Interfaces.C.int);
    pragma Import (C, fl_check_browser_item_select, "fl_check_browser_item_select");
    pragma Inline (fl_check_browser_item_select);

    function fl_check_browser_item_selected
           (C, I : in Storage.Integer_Address)
        return Interfaces.C.int;
    pragma Import (C, fl_check_browser_item_selected, "fl_check_browser_item_selected");
    pragma Inline (fl_check_browser_item_selected);

    --  Missing item_swap and item_text

    procedure fl_check_browser_item_draw
           (C, I       : in Storage.Integer_Address;
            X, Y, W, H : in Interfaces.C.int);
    pragma Import (C, fl_check_browser_item_draw, "fl_check_browser_item_draw");
    pragma Inline (fl_check_browser_item_draw);




    procedure fl_check_browser_draw
           (B : in Storage.Integer_Address);
    pragma Import (C, fl_check_browser_draw, "fl_check_browser_draw");
    pragma Inline (fl_check_browser_draw);

    function fl_check_browser_handle
           (B : in Storage.Integer_Address;
            E : in Interfaces.C.int)
        return Interfaces.C.int;
    pragma Import (C, fl_check_browser_handle, "fl_check_browser_handle");
    pragma Inline (fl_check_browser_handle);




    -------------------
    --  Destructors  --
    -------------------

    procedure Extra_Final
           (This : in out Check_Browser) is
    begin
        Extra_Final (Browser (This));
    end Extra_Final;


    procedure Finalize
           (This : in out Check_Browser) is
    begin
        Extra_Final (This);
        if This.Void_Ptr /= Null_Pointer and This.Needs_Dealloc then
            free_fl_check_browser (This.Void_Ptr);
            This.Void_Ptr := Null_Pointer;
        end if;
    end Finalize;




    --------------------
    --  Constructors  --
    --------------------

    procedure Extra_Init
           (This       : in out Check_Browser;
            X, Y, W, H : in     Integer;
            Text       : in     String) is
    begin
        Extra_Init (Browser (This), X, Y, W, H, Text);
    end Extra_Init;


    procedure Initialize
           (This : in out Check_Browser) is
    begin
        This.Wide_High_Ptrs :=
           (Full_List_Width_Ptr     => fl_check_browser_full_width'Address,
            Full_List_Height_Ptr    => fl_check_browser_full_height'Address,
            Average_Item_Height_Ptr => fl_check_browser_incr_height'Address,
            Item_Quick_Height_Ptr   => fl_check_browser_item_quick_height'Address);
        This.Draw_Ptr   := fl_check_browser_draw'Address;
        This.Handle_Ptr := fl_check_browser_handle'Address;
    end Initialize;


    package body Forge is

        function Create
               (X, Y, W, H : in Integer;
                Text       : in String := "")
            return Check_Browser is
        begin
            return This : Check_Browser do
                This.Void_Ptr := new_fl_check_browser
                   (Interfaces.C.int (X),
                    Interfaces.C.int (Y),
                    Interfaces.C.int (W),
                    Interfaces.C.int (H),
                    Interfaces.C.To_C (Text));
                Extra_Init (This, X, Y, W, H, Text);
            end return;
        end Create;

    end Forge;




    -------------------------
    --  Check_Browser API  --
    -------------------------

    procedure Add
           (This    : in out Check_Browser;
            Text    : in     String;
            Checked : in     Boolean := False)
    is
        Code : Interfaces.C.int := fl_check_browser_add
           (This.Void_Ptr,
            Interfaces.C.To_C (Text),
            Boolean'Pos (Checked));
    begin
        null;
    end Add;


    procedure Remove
           (This  : in out Check_Browser;
            Index : in     Positive)
    is
        Code : Interfaces.C.int := fl_check_browser_remove
           (This.Void_Ptr,
            Interfaces.C.int (Index));
    begin
        null;
    end Remove;


    procedure Clear
           (This : in out Check_Browser) is
    begin
        fl_check_browser_clear (This.Void_Ptr);
    end Clear;


    function Number_Of_Items
           (This : in Check_Browser)
        return Natural is
    begin
        return Natural (fl_check_browser_nitems (This.Void_Ptr));
    end Number_Of_Items;




    procedure Check_All
           (This : in out Check_Browser) is
    begin
        fl_check_browser_check_all (This.Void_Ptr);
    end Check_All;


    procedure Check_None
           (This : in out Check_Browser) is
    begin
        fl_check_browser_check_none (This.Void_Ptr);
    end Check_None;


    function Is_Checked
           (This  : in Check_Browser;
            Index : in Positive)
        return Boolean is
    begin
        return fl_check_browser_get_checked (This.Void_Ptr, Interfaces.C.int (Index)) /= 0;
    end Is_Checked;


    procedure Set_Checked
           (This  : in out Check_Browser;
            Index : in     Positive;
            State : in     Boolean) is
    begin
        fl_check_browser_set_checked
           (This.Void_Ptr,
            Interfaces.C.int (Index),
            Boolean'Pos (State));
    end Set_Checked;


    function Number_Checked
           (This : in Check_Browser)
        return Natural is
    begin
        return Natural (fl_check_browser_nchecked (This.Void_Ptr));
    end Number_Checked;




    function Item_Text
           (This  : in Check_Browser;
            Index : in Positive)
        return String is
    begin
        return Interfaces.C.Strings.Value
            (fl_check_browser_text (This.Void_Ptr, Interfaces.C.int (Index)));
    end Item_Text;


    function Selected_Index
           (This : in Check_Browser)
        return Positive is
    begin
        return Positive (fl_check_browser_value (This.Void_Ptr));
    end Selected_Index;




    function Item_Width
           (This : in Check_Browser;
            Item : in Item_Cursor)
        return Integer is
    begin
        return Integer (fl_check_browser_item_width
           (This.Void_Ptr,
            Cursor_To_Address (Item)));
    end Item_Width;


    function Item_Height
           (This : in Check_Browser;
            Item : in Item_Cursor)
        return Integer is
    begin
        return Integer (fl_check_browser_item_height
           (This.Void_Ptr,
            Cursor_To_Address (Item)));
    end Item_Height;


    function Item_First
           (This : in Check_Browser)
        return Item_Cursor is
    begin
        return Address_To_Cursor (fl_check_browser_item_first (This.Void_Ptr));
    end Item_First;


    --  Note that Item_Last is not implemented


    function Item_Next
           (This : in Check_Browser;
            Item : in Item_Cursor)
        return Item_Cursor is
    begin
        return Address_To_Cursor (fl_check_browser_item_next
           (This.Void_Ptr,
            Cursor_To_Address (Item)));
    end Item_Next;


    function Item_Previous
           (This : in Check_Browser;
            Item : in Item_Cursor)
        return Item_Cursor is
    begin
        return Address_To_Cursor (fl_check_browser_item_prev
           (This.Void_Ptr,
            Cursor_To_Address (Item)));
    end Item_Previous;


    --  Note that Item_At is not implemented


    procedure Item_Select
           (This  : in out Check_Browser;
            Item  : in     Item_Cursor;
            State : in     Boolean := True) is
    begin
        fl_check_browser_item_select
           (This.Void_Ptr,
            Cursor_To_Address (Item),
            Boolean'Pos (State));
    end Item_Select;


    function Item_Selected
           (This : in Check_Browser;
            Item : in Item_Cursor)
        return Boolean is
    begin
        return fl_check_browser_item_selected (This.Void_Ptr, Cursor_To_Address (Item)) /= 0;
    end Item_Selected;


    --  Note that Item_Swap and Item_Text are not implemented


    procedure Item_Draw
           (This       : in Check_Browser;
            Item       : in Item_Cursor;
            X, Y, W, H : in Integer) is
    begin
        fl_check_browser_item_draw
           (This.Void_Ptr,
            Cursor_To_Address (Item),
            Interfaces.C.int (X),
            Interfaces.C.int (Y),
            Interfaces.C.int (W),
            Interfaces.C.int (H));
    end Item_Draw;


end FLTK.Widgets.Groups.Browsers.Check;