diff options
Diffstat (limited to 'src/fltk-widgets-groups.adb')
| -rw-r--r-- | src/fltk-widgets-groups.adb | 144 |
1 files changed, 140 insertions, 4 deletions
diff --git a/src/fltk-widgets-groups.adb b/src/fltk-widgets-groups.adb index 268f3ad..973dabb 100644 --- a/src/fltk-widgets-groups.adb +++ b/src/fltk-widgets-groups.adb @@ -16,10 +16,12 @@ package body FLTK.Widgets.Groups is procedure group_set_draw_hook (W, D : in System.Address); pragma Import (C, group_set_draw_hook, "group_set_draw_hook"); + pragma Inline (group_set_draw_hook); procedure group_set_handle_hook (W, H : in System.Address); pragma Import (C, group_set_handle_hook, "group_set_handle_hook"); + pragma Inline (group_set_handle_hook); @@ -29,10 +31,12 @@ package body FLTK.Widgets.Groups is Text : in Interfaces.C.char_array) return System.Address; pragma Import (C, new_fl_group, "new_fl_group"); + pragma Inline (new_fl_group); procedure free_fl_group (G : in System.Address); pragma Import (C, free_fl_group, "free_fl_group"); + pragma Inline (free_fl_group); @@ -40,24 +44,29 @@ package body FLTK.Widgets.Groups is procedure fl_group_add (G, W : in System.Address); pragma Import (C, fl_group_add, "fl_group_add"); + pragma Inline (fl_group_add); procedure fl_group_insert (G, W : in System.Address; P : in Interfaces.C.int); pragma Import (C, fl_group_insert, "fl_group_insert"); + pragma Inline (fl_group_insert); procedure fl_group_insert2 (G, W, B : in System.Address); pragma Import (C, fl_group_insert2, "fl_group_insert2"); + pragma Inline (fl_group_insert2); procedure fl_group_remove (G, W : in System.Address); pragma Import (C, fl_group_remove, "fl_group_remove"); + pragma Inline (fl_group_remove); procedure fl_group_remove2 (G : in System.Address; P : in Interfaces.C.int); pragma Import (C, fl_group_remove2, "fl_group_remove2"); + pragma Inline (fl_group_remove2); @@ -67,16 +76,19 @@ package body FLTK.Widgets.Groups is I : in Interfaces.C.int) return System.Address; pragma Import (C, fl_group_child, "fl_group_child"); + pragma Inline (fl_group_child); function fl_group_find (G, W : in System.Address) return Interfaces.C.int; pragma Import (C, fl_group_find, "fl_group_find"); + pragma Inline (fl_group_find); function fl_group_children (G : in System.Address) return Interfaces.C.int; pragma Import (C, fl_group_children, "fl_group_children"); + pragma Inline (fl_group_children); @@ -85,11 +97,13 @@ package body FLTK.Widgets.Groups is -- (G : in System.Address) -- return Interfaces.C.unsigned; -- pragma Import (C, fl_group_get_clip_children, "fl_group_get_clip_children"); + -- pragma Inline (fl_group_get_clip_children); -- procedure fl_group_set_clip_children -- (G : in System.Address; -- C : in Interfaces.C.unsigned); -- pragma Import (C, fl_group_set_clip_children, "fl_group_set_clip_children"); + -- pragma Inline (fl_group_set_clip_children); @@ -98,14 +112,30 @@ package body FLTK.Widgets.Groups is (G : in System.Address) return System.Address; pragma Import (C, fl_group_get_resizable, "fl_group_get_resizable"); + pragma Inline (fl_group_get_resizable); procedure fl_group_set_resizable (G, W : in System.Address); pragma Import (C, fl_group_set_resizable, "fl_group_set_resizable"); + pragma Inline (fl_group_set_resizable); procedure fl_group_init_sizes (G : in System.Address); pragma Import (C, fl_group_init_sizes, "fl_group_init_sizes"); + pragma Inline (fl_group_init_sizes); + + + + + function fl_group_get_current + return System.Address; + pragma Import (C, fl_group_get_current, "fl_group_get_current"); + pragma Inline (fl_group_get_current); + + procedure fl_group_set_current + (G : in System.Address); + pragma Import (C, fl_group_set_current, "fl_group_set_current"); + pragma Inline (fl_group_set_current); @@ -113,12 +143,14 @@ package body FLTK.Widgets.Groups is procedure fl_group_draw (W : in System.Address); pragma Import (C, fl_group_draw, "fl_group_draw"); + pragma Inline (fl_group_draw); function fl_group_handle (W : in System.Address; E : in Interfaces.C.int) return Interfaces.C.int; pragma Import (C, fl_group_handle, "fl_group_handle"); + pragma Inline (fl_group_handle); @@ -226,18 +258,43 @@ package body FLTK.Widgets.Groups is + function Has_Child + (This : in Group; + Place : in Index) + return Boolean is + begin + return Place in 1 .. This.Number_Of_Children; + end Has_Child; + + + function Has_Child + (Place : in Cursor) + return Boolean is + begin + return Place.My_Container.Has_Child (Place.My_Index); + end Has_Child; + + function Child (This : in Group; Place : in Index) - return access Widget'Class + return Widget_Reference is Widget_Ptr : System.Address := fl_group_child (This.Void_Ptr, Interfaces.C.int (Place - 1)); - Actual_Widget : access Widget'Class := Widget_Convert.To_Pointer (fl_widget_get_user_data (Widget_Ptr)); begin - return Actual_Widget; + return (Data => Actual_Widget); + end Child; + + + function Child + (This : in Group; + Place : in Cursor) + return Widget_Reference is + begin + return This.Child (Place.My_Index); end Child; @@ -261,6 +318,64 @@ package body FLTK.Widgets.Groups is + function Iterate + (This : in Group) + return Group_Iterators.Reversible_Iterator'Class is + begin + return It : Iterator := (My_Container => This'Unrestricted_Access); + end Iterate; + + + function First + (Object : in Iterator) + return Cursor is + begin + return Cu : Cursor := + (My_Container => Object.My_Container, + My_Index => 1); + end First; + + + function Next + (Object : in Iterator; + Place : in Cursor) + return Cursor is + begin + if Object.My_Container /= Place.My_Container then + raise Program_Error; + end if; + return Cu : Cursor := + (My_Container => Place.My_Container, + My_Index => Place.My_Index + 1); + end Next; + + + function Last + (Object : in Iterator) + return Cursor is + begin + return Cu : Cursor := + (My_Container => Object.My_Container, + My_Index => Object.My_Container.Number_Of_Children); + end Last; + + + function Previous + (Object : in Iterator; + Place : in Cursor) + return Cursor is + begin + if Object.My_Container /= Place.My_Container then + raise Program_Error; + end if; + return Cu : Cursor := + (My_Container => Place.My_Container, + My_Index => Place.My_Index - 1); + end Previous; + + + + -- function Get_Clip_Mode -- (This : in Group) -- return Clip_Mode is @@ -285,7 +400,6 @@ package body FLTK.Widgets.Groups is is Widget_Ptr : System.Address := fl_group_get_resizable (This.Void_Ptr); - Actual_Widget : access Widget'Class := Widget_Convert.To_Pointer (fl_widget_get_user_data (Widget_Ptr)); begin @@ -310,6 +424,28 @@ package body FLTK.Widgets.Groups is + function Get_Current + return access Group'Class + is + Group_Ptr : System.Address := fl_group_get_current; + Actual_Group : access Group'Class; + begin + if Group_Ptr /= System.Null_Address then + Actual_Group := Group_Convert.To_Pointer (Group_Ptr); + end if; + return Actual_Group; + end Get_Current; + + + procedure Set_Current + (To : in Group'Class) is + begin + fl_group_set_current (To.Void_Ptr); + end Set_Current; + + + + procedure Draw (This : in out Group) is begin |