From 49f2a539cdc77b504ddef00162625531b659c767 Mon Sep 17 00:00:00 2001 From: Jedidiah Barber Date: Mon, 6 Jan 2025 23:46:40 +1300 Subject: Revised Browser subhierarchy, mostly protected method bindings --- src/fltk-widgets-groups-browsers.adb | 156 +++++++++-------------------------- 1 file changed, 38 insertions(+), 118 deletions(-) (limited to 'src/fltk-widgets-groups-browsers.adb') diff --git a/src/fltk-widgets-groups-browsers.adb b/src/fltk-widgets-groups-browsers.adb index ea38b67..360c4f5 100644 --- a/src/fltk-widgets-groups-browsers.adb +++ b/src/fltk-widgets-groups-browsers.adb @@ -622,9 +622,9 @@ package body FLTK.Widgets.Groups.Browsers is - ----------------------------------- - -- Controlled Type Subprograms -- - ----------------------------------- + ------------------- + -- Destructors -- + ------------------- procedure Extra_Final (This : in out Browser) is @@ -651,9 +651,9 @@ package body FLTK.Widgets.Groups.Browsers is - --------------------------- - -- Abstract Browser API -- - --------------------------- + -------------------- + -- Constructors -- + -------------------- procedure Extra_Init (This : in out Browser; @@ -685,27 +685,11 @@ package body FLTK.Widgets.Groups.Browsers is procedure Initialize (This : in out Browser) is begin - This.Item_Inherit_Ptrs := - (Current_Selection_Ptr => fl_abstract_browser_selection'Address, - Is_Displayed_Ptr => fl_abstract_browser_displayed'Address, - Find_Item_Ptr => fl_abstract_browser_find_item'Address, - Top_Item_Ptr => fl_abstract_browser_top'Address); - This.Redrawing_Ptrs := - (Bounding_Box_Ptr => fl_abstract_browser_bbox'Address, - Left_Edge_Ptr => fl_abstract_browser_leftedge'Address, - Redraw_Line_Ptr => fl_abstract_browser_redraw_line'Address, - Redraw_List_Ptr => fl_abstract_browser_redraw_lines'Address); This.Wide_High_Ptrs := (Full_List_Width_Ptr => fl_abstract_browser_full_width'Address, Full_List_Height_Ptr => fl_abstract_browser_full_height'Address, Average_Item_Height_Ptr => fl_abstract_browser_incr_height'Address, Item_Quick_Height_Ptr => fl_abstract_browser_item_quick_height'Address); - This.Cache_Ptrs := - (New_List_Ptr => fl_abstract_browser_new_list'Address, - Inserting_Ptr => fl_abstract_browser_inserting'Address, - Deleting_Ptr => fl_abstract_browser_deleting'Address, - Replacing_Ptr => fl_abstract_browser_replacing'Address, - Swapping_Ptr => fl_abstract_browser_swapping'Address); This.Draw_Ptr := fl_abstract_browser_draw'Address; This.Handle_Ptr := fl_abstract_browser_handle'Address; end Initialize; @@ -734,6 +718,10 @@ package body FLTK.Widgets.Groups.Browsers is + ----------------------- + -- API Subprograms -- + ----------------------- + -- Access to the Browser's self contained scrollbars function H_Bar @@ -830,15 +818,9 @@ package body FLTK.Widgets.Groups.Browsers is function Current_Selection (This : in Browser) - return Item_Cursor - is - function my_selection - (V : in Storage.Integer_Address) - return Storage.Integer_Address; - for my_selection'Address use This.Item_Inherit_Ptrs (Current_Selection_Ptr); - pragma Import (Ada, my_selection); + return Item_Cursor is begin - return Address_To_Cursor (my_selection (This.Void_Ptr)); + return Address_To_Cursor (fl_abstract_browser_selection (This.Void_Ptr)); end Current_Selection; @@ -885,12 +867,8 @@ package body FLTK.Widgets.Groups.Browsers is Item : in Item_Cursor) return Boolean is - function my_displayed - (V, I : in Storage.Integer_Address) - return Interfaces.C.int; - for my_displayed'Address use This.Item_Inherit_Ptrs (Is_Displayed_Ptr); - pragma Import (Ada, my_displayed); - Code : Interfaces.C.int := my_displayed (This.Void_Ptr, Cursor_To_Address (Item)); + Code : Interfaces.C.int := fl_abstract_browser_displayed + (This.Void_Ptr, Cursor_To_Address (Item)); begin if Code not in 0 .. 1 then raise Internal_FLTK_Error; @@ -902,30 +880,19 @@ package body FLTK.Widgets.Groups.Browsers is function Find_Item (This : in Browser; Y_Pos : in Integer) - return Item_Cursor - is - function my_find_item - (V : in Storage.Integer_Address; - N : in Interfaces.C.int) - return Storage.Integer_Address; - for my_find_item'Address use This.Item_Inherit_Ptrs (Find_Item_Ptr); - pragma Import (Ada, my_find_item); + return Item_Cursor is begin - return Address_To_Cursor (my_find_item (This.Void_Ptr, Interfaces.C.int (Y_Pos))); + return Address_To_Cursor (fl_abstract_browser_find_item + (This.Void_Ptr, + Interfaces.C.int (Y_Pos))); end Find_Item; function Top_Item (This : in Browser) - return Item_Cursor - is - function my_top - (V : in Storage.Integer_Address) - return Storage.Integer_Address; - for my_top'Address use This.Item_Inherit_Ptrs (Top_Item_Ptr); - pragma Import (Ada, my_top); + return Item_Cursor is begin - return Address_To_Cursor (my_top (This.Void_Ptr)); + return Address_To_Cursor (fl_abstract_browser_top (This.Void_Ptr)); end Top_Item; @@ -1101,15 +1068,9 @@ package body FLTK.Widgets.Groups.Browsers is procedure Bounding_Box (This : in Browser; - X, Y, W, H : out Integer) - is - procedure my_bbox - (V : in Storage.Integer_Address; - X, Y, W, H : out Interfaces.C.int); - for my_bbox'Address use This.Redrawing_Ptrs (Bounding_Box_Ptr); - pragma Import (Ada, my_bbox); + X, Y, W, H : out Integer) is begin - my_bbox + fl_abstract_browser_bbox (This.Void_Ptr, Interfaces.C.int (X), Interfaces.C.int (Y), @@ -1120,40 +1081,24 @@ package body FLTK.Widgets.Groups.Browsers is function Left_Edge (This : in Browser) - return Integer - is - function my_leftedge - (V : in Storage.Integer_Address) - return Interfaces.C.int; - for my_leftedge'Address use This.Redrawing_Ptrs (Left_Edge_Ptr); - pragma Import (Ada, my_leftedge); + return Integer is begin - return Integer (my_leftedge (This.Void_Ptr)); + return Integer (fl_abstract_browser_leftedge (This.Void_Ptr)); end Left_Edge; procedure Redraw_Line (This : in out Browser; - Item : in Item_Cursor) - is - procedure my_redraw_line - (V, I : in Storage.Integer_Address); - for my_redraw_line'Address use This.Redrawing_Ptrs (Redraw_Line_Ptr); - pragma Import (Ada, my_redraw_line); + Item : in Item_Cursor) is begin - my_redraw_line (This.Void_Ptr, Cursor_To_Address (Item)); + fl_abstract_browser_redraw_line (This.Void_Ptr, Cursor_To_Address (Item)); end Redraw_Line; procedure Redraw_List - (This : in out Browser) - is - procedure my_redraw_lines - (V : in Storage.Integer_Address); - for my_redraw_lines'Address use This.Redrawing_Ptrs (Redraw_List_Ptr); - pragma Import (Ada, my_redraw_lines); + (This : in out Browser) is begin - my_redraw_lines (This.Void_Ptr); + fl_abstract_browser_redraw_lines (This.Void_Ptr); end Redraw_List; @@ -1323,27 +1268,17 @@ package body FLTK.Widgets.Groups.Browsers is -- Cache invalidation procedure New_List - (This : in out Browser) - is - procedure my_new_list - (V : in Storage.Integer_Address); - for my_new_list'Address use This.Cache_Ptrs (New_List_Ptr); - pragma Import (Ada, my_new_list); + (This : in out Browser) is begin - my_new_list (This.Void_Ptr); + fl_abstract_browser_new_list (This.Void_Ptr); end New_List; procedure Inserting (This : in out Browser; - A, B : in Item_Cursor) - is - procedure my_inserting - (V, A, B : in Storage.Integer_Address); - for my_inserting'Address use This.Cache_Ptrs (Inserting_Ptr); - pragma Import (Ada, my_inserting); + A, B : in Item_Cursor) is begin - my_inserting + fl_abstract_browser_inserting (This.Void_Ptr, Cursor_To_Address (A), Cursor_To_Address (B)); @@ -1352,14 +1287,9 @@ package body FLTK.Widgets.Groups.Browsers is procedure Deleting (This : in out Browser; - Item : in Item_Cursor) - is - procedure my_deleting - (V, I : in Storage.Integer_Address); - for my_deleting'Address use This.Cache_Ptrs (Deleting_Ptr); - pragma Import (Ada, my_deleting); + Item : in Item_Cursor) is begin - my_deleting + fl_abstract_browser_deleting (This.Void_Ptr, Cursor_To_Address (Item)); end Deleting; @@ -1367,14 +1297,9 @@ package body FLTK.Widgets.Groups.Browsers is procedure Replacing (This : in out Browser; - A, B : in Item_Cursor) - is - procedure my_replacing - (V, A, B : in Storage.Integer_Address); - for my_replacing'Address use This.Cache_Ptrs (Replacing_Ptr); - pragma Import (Ada, my_replacing); + A, B : in Item_Cursor) is begin - my_replacing + fl_abstract_browser_replacing (This.Void_Ptr, Cursor_To_Address (A), Cursor_To_Address (B)); @@ -1383,14 +1308,9 @@ package body FLTK.Widgets.Groups.Browsers is procedure Swapping (This : in out Browser; - A, B : in Item_Cursor) - is - procedure my_swapping - (V, A, B : in Storage.Integer_Address); - for my_swapping'Address use This.Cache_Ptrs (Swapping_Ptr); - pragma Import (Ada, my_swapping); + A, B : in Item_Cursor) is begin - my_swapping + fl_abstract_browser_swapping (This.Void_Ptr, Cursor_To_Address (A), Cursor_To_Address (B)); -- cgit