Fl_Browser_ binding added

1 files changed, 447 insertions, 0 deletions

diff --git a/src/fltk-widgets-groups-browsers.ads b/src/fltk-widgets-groups-browsers.ads
new file mode 100644
index 0000000..c93506f
--- /dev/null
+++ b/src/fltk-widgets-groups-browsers.ads
@@ -0,0 +1,447 @@
+
+
+--  Programmed by Jedidiah Barber
+--  Released into the public domain
+
+
+with
+
+    FLTK.Widgets.Valuators.Sliders.Scrollbars,
+    System;
+
+private with
+
+    Ada.Finalization,
+    Ada.Unchecked_Conversion,
+    Interfaces.C;
+
+
+package FLTK.Widgets.Groups.Browsers is
+
+
+    type Abstract_Browser is new Group with private;
+
+    type Abstract_Browser_Reference (Data : not null access Abstract_Browser'Class) is
+        limited null record with Implicit_Dereference => Data;
+
+    type Item_Cursor is mod System.Memory_Size;
+
+    No_Item : constant Item_Cursor;
+
+    type Sort_Order is (Ascending, Descending);
+
+    type Scrollbar_Mode is record
+        Horizontal : Boolean := True;
+        Vertical   : Boolean := True;
+        Always_On  : Boolean := False;
+    end record;
+
+
+
+
+    package Forge is
+
+        function Create
+               (X, Y, W, H : in Integer;
+                Text       : in String := "")
+            return Abstract_Browser;
+
+    end Forge;
+
+
+
+
+    --  Access to the Browser's self contained scrollbars
+
+    function H_Bar
+           (This : in out Abstract_Browser)
+        return Valuators.Sliders.Scrollbars.Scrollbar_Reference;
+
+    function V_Bar
+           (This : in out Abstract_Browser)
+        return Valuators.Sliders.Scrollbars.Scrollbar_Reference;
+
+
+
+
+    --  Item related settings
+
+    function Set_Select
+           (This         : in out Abstract_Browser;
+            Item         : in     Item_Cursor;
+            State        : in     Boolean := True;
+            Do_Callbacks : in     Boolean := False)
+        return Boolean;
+
+    function Select_Only
+           (This         : in out Abstract_Browser;
+            Item         : in     Item_Cursor;
+            Do_Callbacks : in     Boolean := False)
+        return Boolean;
+
+    function Current_Selection
+           (This : in Abstract_Browser)
+        return Item_Cursor;
+
+    function Deselect
+           (This         : in out Abstract_Browser;
+            Do_Callbacks : in     Boolean := False)
+        return Boolean;
+
+    procedure Display
+           (This : in out Abstract_Browser;
+            Item : in     Item_Cursor);
+
+    function Is_Displayed
+           (This : in Abstract_Browser;
+            Item : in Item_Cursor)
+        return Boolean;
+
+    function Find_Item
+           (This  : in Abstract_Browser;
+            Y_Pos : in Integer)
+        return Item_Cursor;
+
+    function Top_Item
+           (This : in Abstract_Browser)
+        return Item_Cursor;
+
+    --  Not task safe due to internal issues with converting Ada Strings to char* in C.
+    --  Unsure how much that matters since unsure how task safe FLTK is anyway.
+    procedure Sort
+           (This  : in out Abstract_Browser;
+            Order : in     Sort_Order);
+
+
+
+
+    --  Scrollbar related settings
+
+    function Get_Scrollbar_Mode
+           (This : in Abstract_Browser)
+        return Scrollbar_Mode;
+
+    procedure Set_Scrollbar_Mode
+           (This : in out Abstract_Browser;
+            Mode : in     Scrollbar_Mode);
+
+    function Get_H_Position
+           (This : in Abstract_Browser)
+        return Integer;
+
+    procedure Set_H_Position
+           (This  : in out Abstract_Browser;
+            Value : in     Integer);
+
+    function Get_V_Position
+           (This : in Abstract_Browser)
+        return Integer;
+
+    procedure Set_V_Position
+           (This  : in out Abstract_Browser;
+            Value : in     Integer);
+
+    procedure Set_Vertical_Left
+           (This : in out Abstract_Browser);
+
+    procedure Set_Vertical_Right
+           (This : in out Abstract_Browser);
+
+    function Get_Scrollbar_Size
+           (This : in Abstract_Browser)
+        return Integer;
+
+    procedure Set_Scrollbar_Size
+           (This  : in out Abstract_Browser;
+            Value : in     Integer);
+
+
+
+
+    --  Text related settings
+
+    function Get_Text_Color
+           (This : in Abstract_Browser)
+        return Color;
+
+    procedure Set_Text_Color
+           (This  : in out Abstract_Browser;
+            Value : in     Color);
+
+    function Get_Text_Font
+           (This : in Abstract_Browser)
+        return Font_Kind;
+
+    procedure Set_Text_Font
+           (This : in out Abstract_Browser;
+            Font : in     Font_Kind);
+
+    function Get_Text_Size
+           (This : in Abstract_Browser)
+        return Font_Size;
+
+    procedure Set_Text_Size
+           (This : in out Abstract_Browser;
+            Size : in     Font_Size);
+
+
+
+
+    --  Graphical dimensions and redrawing
+
+    procedure Resize
+           (This       : in out Abstract_Browser;
+            X, Y, W, H : in     Integer);
+
+    procedure Bounding_Box
+           (This       : in     Abstract_Browser;
+            X, Y, W, H :    out Integer);
+
+    function Left_Edge
+           (This : in Abstract_Browser)
+        return Integer;
+
+    procedure Redraw_Line
+           (This : in out Abstract_Browser;
+            Item : in     Item_Cursor);
+
+    procedure Redraw_List
+           (This : in out Abstract_Browser);
+
+
+
+
+    --  You may override these subprograms to change the behaviour of the widget
+    --  even though these are called from within FLTK.
+
+    function Full_List_Width
+           (This : in Abstract_Browser)
+        return Integer;
+
+    function Full_List_Height
+           (This : in Abstract_Browser)
+        return Integer;
+
+    function Average_Item_Height
+           (This : in Abstract_Browser)
+        return Integer;
+
+    function Item_Quick_Height
+           (This : in Abstract_Browser;
+            Item : in Item_Cursor)
+        return Integer;
+
+
+
+
+    --  You MUST override these subprograms if deriving a type from Abstract_Browser
+    --  or your program will crash, since they are called from within FLTK and do not
+    --  have any implementations given. By default here they will raise an exception.
+
+    function Item_Width
+           (This : in Abstract_Browser;
+            Item : in Item_Cursor)
+        return Integer;
+
+    function Item_Height
+           (This : in Abstract_Browser;
+            Item : in Item_Cursor)
+        return Integer;
+
+    function Item_First
+           (This : in Abstract_Browser)
+        return Item_Cursor;
+
+    function Item_Last
+           (This : in Abstract_Browser)
+        return Item_Cursor;
+
+    function Item_Next
+           (This : in Abstract_Browser;
+            Item : in Item_Cursor)
+        return Item_Cursor;
+
+    function Item_Previous
+           (This : in Abstract_Browser;
+            Item : in Item_Cursor)
+        return Item_Cursor;
+
+    function Item_At
+           (This  : in Abstract_Browser;
+            Index : in Positive)
+        return Item_Cursor;
+
+    procedure Item_Select
+           (This  : in out Abstract_Browser;
+            Item  : in     Item_Cursor;
+            State : in     Boolean := True);
+
+    function Item_Selected
+           (This : in Abstract_Browser;
+            Item : in Item_Cursor)
+        return Boolean;
+
+    procedure Item_Swap
+           (This : in out Abstract_Browser;
+            A, B : in     Item_Cursor);
+
+    function Item_Text
+           (This : in Abstract_Browser;
+            Item : in Item_Cursor)
+        return String;
+
+    procedure Item_Draw
+           (This       : in Abstract_Browser;
+            Item       : in Item_Cursor;
+            X, Y, W, H : in Integer);
+
+
+
+
+    --  Cache invalidation
+
+    procedure New_List
+           (This : in out Abstract_Browser);
+
+    procedure Inserting
+           (This : in out Abstract_Browser;
+            A, B : in     Item_Cursor);
+
+    procedure Deleting
+           (This : in out Abstract_Browser;
+            Item : in     Item_Cursor);
+
+    procedure Replacing
+           (This : in out Abstract_Browser;
+            A, B : in     Item_Cursor);
+
+    procedure Swapping
+           (This : in out Abstract_Browser;
+            A, B : in     Item_Cursor);
+
+
+
+
+    --  You may override these subprograms to change the behaviour of the widget
+    --  even though these are called from within FLTK.
+
+    procedure Draw
+           (This : in out Abstract_Browser);
+
+    function Handle
+           (This  : in out Abstract_Browser;
+            Event : in     Event_Kind)
+        return Event_Outcome;
+
+
+private
+
+
+    type Abstract_Browser is new Group with record
+        Horizon : aliased Valuators.Sliders.Scrollbars.Scrollbar;
+        Vertigo : aliased Valuators.Sliders.Scrollbars.Scrollbar;
+    end record;
+
+    overriding procedure Finalize
+           (This : in out Abstract_Browser);
+
+
+    pragma Assert
+       (Item_Cursor'Size = Storage.Integer_Address'Size,
+        "Size of Browser Item_Cursor does not match Ada address values");
+
+    function Address_To_Cursor is
+        new Ada.Unchecked_Conversion (Storage.Integer_Address, Item_Cursor);
+    function Cursor_To_Address is
+        new Ada.Unchecked_Conversion (Item_Cursor, Storage.Integer_Address);
+
+    No_Item : constant Item_Cursor := Address_To_Cursor (Null_Pointer);
+
+
+    for Scrollbar_Mode use record
+        Horizontal at 0 range 0 .. 0;
+        Vertical   at 0 range 1 .. 1;
+        Always_On  at 0 range 2 .. 2;
+    end record;
+
+    for Scrollbar_Mode'Size use Interfaces.C.unsigned_char'Size;
+
+    function Mode_To_Uchar is
+        new Ada.Unchecked_Conversion (Scrollbar_Mode, Interfaces.C.unsigned_char);
+    function Uchar_To_Mode is
+        new Ada.Unchecked_Conversion (Interfaces.C.unsigned_char, Scrollbar_Mode);
+
+
+    pragma Inline (H_Bar);
+    pragma Inline (V_Bar);
+
+    pragma Inline (Current_Selection);
+    pragma Inline (Display);
+    pragma Inline (Find_Item);
+    pragma Inline (Top_Item);
+    pragma Inline (Sort);
+
+    pragma Inline (Get_Scrollbar_Mode);
+    pragma Inline (Set_Scrollbar_Mode);
+    pragma Inline (Get_H_Position);
+    pragma Inline (Set_H_Position);
+    pragma Inline (Get_V_Position);
+    pragma Inline (Set_V_Position);
+    pragma Inline (Set_Vertical_Left);
+    pragma Inline (Set_Vertical_Right);
+    pragma Inline (Get_Scrollbar_Size);
+    pragma Inline (Set_Scrollbar_Size);
+
+    pragma Inline (Get_Text_Color);
+    pragma Inline (Set_Text_Color);
+    pragma Inline (Get_Text_Font);
+    pragma Inline (Set_Text_Font);
+    pragma Inline (Get_Text_Size);
+    pragma Inline (Set_Text_Size);
+
+    pragma Inline (Resize);
+    pragma Inline (Bounding_Box);
+    pragma Inline (Left_Edge);
+    pragma Inline (Redraw_Line);
+    pragma Inline (Redraw_List);
+
+    pragma Inline (Full_List_Width);
+    pragma Inline (Full_List_Height);
+    pragma Inline (Average_Item_Height);
+    pragma Inline (Item_Quick_Height);
+
+    pragma Inline (New_List);
+    pragma Inline (Inserting);
+    pragma Inline (Deleting);
+    pragma Inline (Replacing);
+    pragma Inline (Swapping);
+
+    pragma Inline (Draw);
+    pragma Inline (Handle);
+
+
+    function fl_abstract_browser_hscrollbar
+           (B : in Storage.Integer_Address)
+        return Storage.Integer_Address;
+    pragma Import (C, fl_abstract_browser_hscrollbar, "fl_abstract_browser_hscrollbar");
+    pragma Inline (fl_abstract_browser_hscrollbar);
+
+    function fl_abstract_browser_scrollbar
+           (B : in Storage.Integer_Address)
+        return Storage.Integer_Address;
+    pragma Import (C, fl_abstract_browser_scrollbar, "fl_abstract_browser_scrollbar");
+    pragma Inline (fl_abstract_browser_scrollbar);
+
+
+    --  Needed to ensure chars_ptr storage is properly cleaned up
+    type Item_Text_Hook_Final_Controller is new Ada.Finalization.Controlled with null record;
+
+    overriding procedure Finalize
+           (This : in out Item_Text_Hook_Final_Controller);
+
+    Cleanup : Item_Text_Hook_Final_Controller;
+
+
+end FLTK.Widgets.Groups.Browsers;
+
+