diff options
author | Jedidiah Barber <contact@jedbarber.id.au> | 2025-01-21 21:04:54 +1300 |
---|---|---|
committer | Jedidiah Barber <contact@jedbarber.id.au> | 2025-01-21 21:04:54 +1300 |
commit | b4438b2fbe895694be98e6e8426103deefc51448 (patch) | |
tree | 760d86cd7c06420a91dad102cc9546aee73146fc /spec/fltk-widgets-groups-browsers.ads | |
parent | a4703a65b015140cd4a7a985db66264875ade734 (diff) |
Split public API and private implementation files into different directories
Diffstat (limited to 'spec/fltk-widgets-groups-browsers.ads')
-rw-r--r-- | spec/fltk-widgets-groups-browsers.ads | 465 |
1 files changed, 465 insertions, 0 deletions
diff --git a/spec/fltk-widgets-groups-browsers.ads b/spec/fltk-widgets-groups-browsers.ads new file mode 100644 index 0000000..d7b0498 --- /dev/null +++ b/spec/fltk-widgets-groups-browsers.ads @@ -0,0 +1,465 @@ + + +-- Programmed by Jedidiah Barber +-- Released into the public domain + + +with + + FLTK.Widgets.Valuators.Sliders.Scrollbars, + System; + +private with + + Ada.Unchecked_Conversion, + Interfaces.C.Strings; + + +package FLTK.Widgets.Groups.Browsers is + + + type Browser is new Group with private; + + type Browser_Reference (Data : not null access 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 Browser; + + function Create + (Parent : in out Group'Class; + X, Y, W, H : in Integer; + Text : in String := "") + return Browser; + + end Forge; + + + + + -- Access to the Browser's self contained scrollbars + + function H_Bar + (This : in out Browser) + return Valuators.Sliders.Scrollbars.Scrollbar_Reference; + + function V_Bar + (This : in out Browser) + return Valuators.Sliders.Scrollbars.Scrollbar_Reference; + + + + + -- Item related settings + + function Set_Select + (This : in out Browser; + Item : in Item_Cursor; + State : in Boolean := True; + Do_Callbacks : in Boolean := False) + return Boolean; + + procedure Set_Select + (This : in out Browser; + Item : in Item_Cursor; + State : in Boolean := True; + Do_Callbacks : in Boolean := False); + + function Select_Only + (This : in out Browser; + Item : in Item_Cursor; + Do_Callbacks : in Boolean := False) + return Boolean; + + procedure Select_Only + (This : in out Browser; + Item : in Item_Cursor; + Do_Callbacks : in Boolean := False); + + function Current_Selection + (This : in Browser) + return Item_Cursor; + + function Deselect + (This : in out Browser; + Do_Callbacks : in Boolean := False) + return Boolean; + + procedure Deselect + (This : in out Browser; + Do_Callbacks : in Boolean := False); + + procedure Display + (This : in out Browser; + Item : in Item_Cursor); + + function Is_Displayed + (This : in Browser; + Item : in Item_Cursor) + return Boolean; + + function Find_Item + (This : in Browser; + Y_Pos : in Integer) + return Item_Cursor; + + function Top_Item + (This : in 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 Browser; + Order : in Sort_Order); + + + + + -- Scrollbar related settings + + function Get_Scrollbar_Mode + (This : in Browser) + return Scrollbar_Mode; + + procedure Set_Scrollbar_Mode + (This : in out Browser; + Mode : in Scrollbar_Mode); + + function Get_H_Position + (This : in Browser) + return Integer; + + procedure Set_H_Position + (This : in out Browser; + Value : in Integer); + + function Get_V_Position + (This : in Browser) + return Integer; + + procedure Set_V_Position + (This : in out Browser; + Value : in Integer); + + procedure Set_Vertical_Left + (This : in out Browser); + + procedure Set_Vertical_Right + (This : in out Browser); + + function Get_Scrollbar_Size + (This : in Browser) + return Integer; + + procedure Set_Scrollbar_Size + (This : in out Browser; + Value : in Integer); + + + + + -- Text related settings + + function Get_Text_Color + (This : in Browser) + return Color; + + procedure Set_Text_Color + (This : in out Browser; + Value : in Color); + + function Get_Text_Font + (This : in Browser) + return Font_Kind; + + procedure Set_Text_Font + (This : in out Browser; + Font : in Font_Kind); + + function Get_Text_Size + (This : in Browser) + return Font_Size; + + procedure Set_Text_Size + (This : in out Browser; + Size : in Font_Size); + + + + + -- Graphical dimensions and redrawing + + procedure Resize + (This : in out Browser; + X, Y, W, H : in Integer); + + procedure Bounding_Box + (This : in Browser; + X, Y, W, H : out Integer); + + function Left_Edge + (This : in Browser) + return Integer; + + procedure Redraw_Line + (This : in out Browser; + Item : in Item_Cursor); + + procedure Redraw_List + (This : in out 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 Browser) + return Integer; + + function Full_List_Height + (This : in Browser) + return Integer; + + function Average_Item_Height + (This : in Browser) + return Integer; + + function Item_Quick_Height + (This : in Browser; + Item : in Item_Cursor) + return Integer; + + + + + -- You MUST override these subprograms if deriving a type from 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 Browser; + Item : in Item_Cursor) + return Integer; + + function Item_Height + (This : in Browser; + Item : in Item_Cursor) + return Integer; + + function Item_First + (This : in Browser) + return Item_Cursor; + + function Item_Last + (This : in Browser) + return Item_Cursor; + + function Item_Next + (This : in Browser; + Item : in Item_Cursor) + return Item_Cursor; + + function Item_Previous + (This : in Browser; + Item : in Item_Cursor) + return Item_Cursor; + + function Item_At + (This : in Browser; + Index : in Positive) + return Item_Cursor; + + procedure Item_Select + (This : in out Browser; + Item : in Item_Cursor; + State : in Boolean := True); + + function Item_Selected + (This : in Browser; + Item : in Item_Cursor) + return Boolean; + + procedure Item_Swap + (This : in out Browser; + A, B : in Item_Cursor); + + function Item_Text + (This : in Browser; + Item : in Item_Cursor) + return String; + + procedure Item_Draw + (This : in Browser; + Item : in Item_Cursor; + X, Y, W, H : in Integer); + + + + + -- Cache invalidation + + procedure New_List + (This : in out Browser); + + procedure Inserting + (This : in out Browser; + A, B : in Item_Cursor); + + procedure Deleting + (This : in out Browser; + Item : in Item_Cursor); + + procedure Replacing + (This : in out Browser; + A, B : in Item_Cursor); + + procedure Swapping + (This : in out 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 Browser); + + function Handle + (This : in out Browser; + Event : in Event_Kind) + return Event_Outcome; + + +private + + + type Wide_High_Fun is + (Full_List_Width_Ptr, Full_List_Height_Ptr, + Average_Item_Height_Ptr, Item_Quick_Height_Ptr); + type Wide_High_Fun_Ptr_Array is array (Wide_High_Fun) of System.Address; + + + type Browser is new Group with record + Horizon : aliased Valuators.Sliders.Scrollbars.Scrollbar; + Vertigo : aliased Valuators.Sliders.Scrollbars.Scrollbar; + Text_Store : Interfaces.C.Strings.chars_ptr_array (1 .. 2); + Current : Interfaces.C.size_t := 1; + Wide_High_Ptrs : Wide_High_Fun_Ptr_Array; + end record; + + overriding procedure Initialize + (This : in out Browser); + + overriding procedure Finalize + (This : in out Browser); + + procedure Extra_Init + (This : in out Browser; + X, Y, W, H : in Integer; + Text : in String); + + procedure Extra_Final + (This : in out 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); + + +end FLTK.Widgets.Groups.Browsers; + + |