diff options
Diffstat (limited to 'src/fltk-widgets-groups-browsers-check.adb')
| -rw-r--r-- | src/fltk-widgets-groups-browsers-check.adb | 394 |
1 files changed, 68 insertions, 326 deletions
diff --git a/src/fltk-widgets-groups-browsers-check.adb b/src/fltk-widgets-groups-browsers-check.adb index 3c9dd90..b377a25 100644 --- a/src/fltk-widgets-groups-browsers-check.adb +++ b/src/fltk-widgets-groups-browsers-check.adb @@ -112,59 +112,6 @@ package body FLTK.Widgets.Groups.Browsers.Check is - function fl_check_browser_selection - (B : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_check_browser_selection, "fl_check_browser_selection"); - pragma Inline (fl_check_browser_selection); - - function fl_check_browser_displayed - (B, I : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_check_browser_displayed, "fl_check_browser_displayed"); - pragma Inline (fl_check_browser_displayed); - - function fl_check_browser_find_item - (B : in Storage.Integer_Address; - Y : in Interfaces.C.int) - return Storage.Integer_Address; - pragma Import (C, fl_check_browser_find_item, "fl_check_browser_find_item"); - pragma Inline (fl_check_browser_find_item); - - function fl_check_browser_top - (B : in Storage.Integer_Address) - return Storage.Integer_Address; - pragma Import (C, fl_check_browser_top, "fl_check_browser_top"); - pragma Inline (fl_check_browser_top); - - - - - procedure fl_check_browser_bbox - (B : in Storage.Integer_Address; - X, Y, W, H : out Interfaces.C.int); - pragma Import (C, fl_check_browser_bbox, "fl_check_browser_bbox"); - pragma Inline (fl_check_browser_bbox); - - function fl_check_browser_leftedge - (B : in Storage.Integer_Address) - return Interfaces.C.int; - pragma Import (C, fl_check_browser_leftedge, "fl_check_browser_leftedge"); - pragma Inline (fl_check_browser_leftedge); - - procedure fl_check_browser_redraw_line - (B, I : in Storage.Integer_Address); - pragma Import (C, fl_check_browser_redraw_line, "fl_check_browser_redraw_line"); - pragma Inline (fl_check_browser_redraw_line); - - procedure fl_check_browser_redraw_lines - (B : in Storage.Integer_Address); - pragma Import (C, fl_check_browser_redraw_lines, "fl_check_browser_redraw_lines"); - pragma Inline (fl_check_browser_redraw_lines); - - - - function fl_check_browser_full_width (B : in Storage.Integer_Address) return Interfaces.C.int; @@ -249,34 +196,6 @@ package body FLTK.Widgets.Groups.Browsers.Check is - procedure fl_check_browser_new_list - (B : in Storage.Integer_Address); - pragma Import (C, fl_check_browser_new_list, "fl_check_browser_new_list"); - pragma Inline (fl_check_browser_new_list); - - procedure fl_check_browser_inserting - (B, A1, A2 : in Storage.Integer_Address); - pragma Import (C, fl_check_browser_inserting, "fl_check_browser_inserting"); - pragma Inline (fl_check_browser_inserting); - - procedure fl_check_browser_deleting - (B, I : in Storage.Integer_Address); - pragma Import (C, fl_check_browser_deleting, "fl_check_browser_deleting"); - pragma Inline (fl_check_browser_deleting); - - procedure fl_check_browser_replacing - (B, A1, A2 : in Storage.Integer_Address); - pragma Import (C, fl_check_browser_replacing, "fl_check_browser_replacing"); - pragma Inline (fl_check_browser_replacing); - - procedure fl_check_browser_swapping - (B, A1, A2 : in Storage.Integer_Address); - pragma Import (C, fl_check_browser_swapping, "fl_check_browser_swapping"); - pragma Inline (fl_check_browser_swapping); - - - - procedure fl_check_browser_draw (B : in Storage.Integer_Address); pragma Import (C, fl_check_browser_draw, "fl_check_browser_draw"); @@ -329,6 +248,19 @@ package body FLTK.Widgets.Groups.Browsers.Check is 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 @@ -464,291 +396,101 @@ package body FLTK.Widgets.Groups.Browsers.Check is - function Current_Selection - (This : in Check_Browser) - return Item_Cursor is - begin - return Address_To_Cursor (fl_check_browser_selection (This.Void_Ptr)); - end Current_Selection; - - - function Is_Displayed + function Item_Width (This : in Check_Browser; Item : in Item_Cursor) - return Boolean - is - Code : Interfaces.C.int := fl_check_browser_displayed - (This.Void_Ptr, - Cursor_To_Address (Item)); - begin - if Code not in 0 .. 1 then - raise Internal_FLTK_Error; - end if; - return Boolean'Val (Code); - end Is_Displayed; - - - function Find_Item - (This : in Check_Browser; - Y_Pos : in Integer) - return Item_Cursor is - begin - return Address_To_Cursor - (fl_check_browser_find_item (This.Void_Ptr, Interfaces.C.int (Y_Pos))); - end Find_Item; - - - function Top_Item - (This : in Check_Browser) - return Item_Cursor is - begin - return Address_To_Cursor (fl_check_browser_top (This.Void_Ptr)); - end Top_Item; - - - - - procedure Bounding_Box - (This : in Check_Browser; - X, Y, W, H : out Integer) is + return Integer is begin - fl_check_browser_bbox + return Integer (fl_check_browser_item_width (This.Void_Ptr, - Interfaces.C.int (X), - Interfaces.C.int (Y), - Interfaces.C.int (W), - Interfaces.C.int (H)); - end Bounding_Box; + Cursor_To_Address (Item))); + end Item_Width; - function Left_Edge - (This : in Check_Browser) + function Item_Height + (This : in Check_Browser; + Item : in Item_Cursor) return Integer is begin - return Integer (fl_check_browser_leftedge (This.Void_Ptr)); - end Left_Edge; - - - procedure Redraw_Line - (This : in out Check_Browser; - Item : in Item_Cursor) is - begin - fl_check_browser_redraw_line (This.Void_Ptr, Cursor_To_Address (Item)); - end Redraw_Line; - - - procedure Redraw_List - (This : in out Check_Browser) is - begin - fl_check_browser_redraw_lines (This.Void_Ptr); - end Redraw_List; - - + return Integer (fl_check_browser_item_height + (This.Void_Ptr, + Cursor_To_Address (Item))); + end Item_Height; - function Full_List_Width + function Item_First (This : in Check_Browser) - return Integer is + return Item_Cursor is begin - return Integer (fl_check_browser_full_width (This.Void_Ptr)); - end Full_List_Width; + return Address_To_Cursor (fl_check_browser_item_first (This.Void_Ptr)); + end Item_First; - function Full_List_Height - (This : in Check_Browser) - return Integer is - begin - return Integer (fl_check_browser_full_height (This.Void_Ptr)); - end Full_List_Height; + -- Note that Item_Last is not implemented - function Average_Item_Height - (This : in Check_Browser) - return Integer is + function Item_Next + (This : in Check_Browser; + Item : in Item_Cursor) + return Item_Cursor is begin - return Integer (fl_check_browser_incr_height (This.Void_Ptr)); - end Average_Item_Height; + return Address_To_Cursor (fl_check_browser_item_next + (This.Void_Ptr, + Cursor_To_Address (Item))); + end Item_Next; - function Item_Quick_Height + function Item_Previous (This : in Check_Browser; Item : in Item_Cursor) - return Integer is + return Item_Cursor is begin - return Integer (fl_check_browser_item_quick_height + return Address_To_Cursor (fl_check_browser_item_prev (This.Void_Ptr, Cursor_To_Address (Item))); - end Item_Quick_Height; - - - - - -- 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; + 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_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; - - - - - procedure New_List - (This : in out Check_Browser) is - begin - fl_check_browser_new_list (This.Void_Ptr); - end New_List; - - - procedure Inserting - (This : in out Check_Browser; - A, B : in Item_Cursor) is + procedure Item_Select + (This : in out Check_Browser; + Item : in Item_Cursor; + State : in Boolean := True) is begin - fl_check_browser_inserting + fl_check_browser_item_select (This.Void_Ptr, - Cursor_To_Address (A), - Cursor_To_Address (B)); - end Inserting; + Cursor_To_Address (Item), + Boolean'Pos (State)); + end Item_Select; - procedure Deleting - (This : in out Check_Browser; - Item : in Item_Cursor) is + function Item_Selected + (This : in Check_Browser; + Item : in Item_Cursor) + return Boolean is begin - fl_check_browser_deleting - (This.Void_Ptr, - Cursor_To_Address (Item)); - end Deleting; + return fl_check_browser_item_selected (This.Void_Ptr, Cursor_To_Address (Item)) /= 0; + end Item_Selected; - procedure Replacing - (This : in out Check_Browser; - A, B : in Item_Cursor) is - begin - fl_check_browser_replacing - (This.Void_Ptr, - Cursor_To_Address (A), - Cursor_To_Address (B)); - end Replacing; + -- Note that Item_Swap and Item_Text are not implemented - procedure Swapping - (This : in out Check_Browser; - A, B : in Item_Cursor) is + procedure Item_Draw + (This : in Check_Browser; + Item : in Item_Cursor; + X, Y, W, H : in Integer) is begin - fl_check_browser_swapping + fl_check_browser_item_draw (This.Void_Ptr, - Cursor_To_Address (A), - Cursor_To_Address (B)); - end Swapping; - - - - - procedure Draw - (This : in out Check_Browser) is - begin - fl_check_browser_draw (This.Void_Ptr); - end Draw; - - - function Handle - (This : in out Check_Browser; - Event : in Event_Kind) - return Event_Outcome is - begin - return Event_Outcome'Val - (fl_check_browser_handle (This.Void_Ptr, Event_Kind'Pos (Event))); - end Handle; + 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; |