diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/c_fl_group.cpp | 90 | ||||
| -rw-r--r-- | src/c_fl_group.h | 11 | ||||
| -rw-r--r-- | src/fltk-widgets-groups.adb | 159 | ||||
| -rw-r--r-- | src/fltk-widgets-groups.ads | 50 |
4 files changed, 256 insertions, 54 deletions
diff --git a/src/c_fl_group.cpp b/src/c_fl_group.cpp index 890fd9a..62bee03 100644 --- a/src/c_fl_group.cpp +++ b/src/c_fl_group.cpp @@ -20,6 +20,19 @@ extern "C" int widget_handle_hook(void * ud, int e); +// Non-friend protected access + +class Friend_Group : Fl_Group { +public: + using Fl_Group::draw_child; + using Fl_Group::draw_children; + using Fl_Group::draw_outside_label; + using Fl_Group::update_child; +}; + + + + // Attaching all relevant hooks and friends class My_Group : public Fl_Group { @@ -52,78 +65,80 @@ GROUP new_fl_group(int x, int y, int w, int h, char* label) { } void free_fl_group(GROUP g) { - delete reinterpret_cast<My_Group*>(g); -} - - - - -void fl_group_end(GROUP g) { - reinterpret_cast<Fl_Group*>(g)->end(); + delete static_cast<My_Group*>(g); } void fl_group_add(GROUP g, WIDGET item) { - reinterpret_cast<Fl_Group*>(g)->add(reinterpret_cast<Fl_Widget*>(item)); + static_cast<Fl_Group*>(g)->add(static_cast<Fl_Widget*>(item)); } void fl_group_insert(GROUP g, WIDGET item, int place) { - reinterpret_cast<Fl_Group*>(g)->insert(*(reinterpret_cast<Fl_Widget*>(item)), place); + static_cast<Fl_Group*>(g)->insert(*(static_cast<Fl_Widget*>(item)), place); } void fl_group_insert2(GROUP g, WIDGET item, WIDGET before) { - reinterpret_cast<Fl_Group*>(g)->insert(*(reinterpret_cast<Fl_Widget*>(item)), reinterpret_cast<Fl_Widget*>(before)); + static_cast<Fl_Group*>(g)->insert(*(static_cast<Fl_Widget*>(item)), static_cast<Fl_Widget*>(before)); } void fl_group_remove(GROUP g, WIDGET item) { - reinterpret_cast<Fl_Group*>(g)->remove(reinterpret_cast<Fl_Widget*>(item)); + static_cast<Fl_Group*>(g)->remove(static_cast<Fl_Widget*>(item)); } void fl_group_remove2(GROUP g, int place) { - reinterpret_cast<Fl_Group*>(g)->remove(place); + static_cast<Fl_Group*>(g)->remove(place); } void * fl_group_child(GROUP g, int place) { - return reinterpret_cast<Fl_Group*>(g)->child(place); + return static_cast<Fl_Group*>(g)->child(place); } int fl_group_find(GROUP g, WIDGET item) { - return reinterpret_cast<Fl_Group*>(g)->find(reinterpret_cast<Fl_Widget*>(item)); + return static_cast<Fl_Group*>(g)->find(static_cast<Fl_Widget*>(item)); } int fl_group_children(GROUP g) { - return reinterpret_cast<Fl_Group*>(g)->children(); + return static_cast<Fl_Group*>(g)->children(); } unsigned int fl_group_get_clip_children(GROUP g) { - return reinterpret_cast<Fl_Group*>(g)->clip_children(); + return static_cast<Fl_Group*>(g)->clip_children(); } void fl_group_set_clip_children(GROUP g, int c) { - reinterpret_cast<Fl_Group*>(g)->clip_children(c); + static_cast<Fl_Group*>(g)->clip_children(c); } +void fl_group_add_resizable(GROUP g, WIDGET w) { + Fl_Widget &ref = *(static_cast<Fl_Widget*>(w)); + static_cast<Fl_Group*>(g)->add_resizable(ref); +} + void * fl_group_get_resizable(GROUP g) { - return reinterpret_cast<Fl_Group*>(g)->resizable(); + return static_cast<Fl_Group*>(g)->resizable(); } void fl_group_set_resizable(GROUP g, WIDGET item) { - reinterpret_cast<Fl_Group*>(g)->resizable(reinterpret_cast<Fl_Widget*>(item)); + static_cast<Fl_Group*>(g)->resizable(static_cast<Fl_Widget*>(item)); } void fl_group_init_sizes(GROUP g) { - reinterpret_cast<Fl_Group*>(g)->init_sizes(); + static_cast<Fl_Group*>(g)->init_sizes(); +} + +void fl_group_resize(GROUP g, int x, int y, int w, int h) { + static_cast<Fl_Group*>(g)->resize(x, y, w, h); } @@ -134,18 +149,45 @@ void * fl_group_get_current() { } void fl_group_set_current(GROUP g) { - Fl_Group::current(reinterpret_cast<Fl_Group*>(g)); + Fl_Group::current(static_cast<Fl_Group*>(g)); +} + +void fl_group_begin(GROUP g) { + static_cast<Fl_Group*>(g)->begin(); +} + +void fl_group_end(GROUP g) { + static_cast<Fl_Group*>(g)->end(); } void fl_group_draw(GROUP g) { - reinterpret_cast<My_Group*>(g)->Fl_Group::draw(); + static_cast<My_Group*>(g)->Fl_Group::draw(); +} + +void fl_group_draw_child(GROUP g, WIDGET w) { + Fl_Widget &ref = *(static_cast<Fl_Widget*>(w)); + (static_cast<Fl_Group*>(g)->*(&Friend_Group::draw_child))(ref); +} + +void fl_group_draw_children(GROUP g) { + (static_cast<Fl_Group*>(g)->*(&Friend_Group::draw_children))(); +} + +void fl_group_draw_outside_label(GROUP g, WIDGET w) { + Fl_Widget &ref = *(static_cast<Fl_Widget*>(w)); + (static_cast<Fl_Group*>(g)->*(&Friend_Group::draw_outside_label))(ref); +} + +void fl_group_update_child(GROUP g, WIDGET w) { + Fl_Widget &ref = *(static_cast<Fl_Widget*>(w)); + (static_cast<Fl_Group*>(g)->*(&Friend_Group::update_child))(ref); } int fl_group_handle(GROUP g, int e) { - return reinterpret_cast<My_Group*>(g)->Fl_Group::handle(e); + return static_cast<My_Group*>(g)->Fl_Group::handle(e); } diff --git a/src/c_fl_group.h b/src/c_fl_group.h index 57f5e4c..af4559d 100644 --- a/src/c_fl_group.h +++ b/src/c_fl_group.h @@ -17,9 +17,6 @@ extern "C" GROUP new_fl_group(int x, int y, int w, int h, char* label); extern "C" void free_fl_group(GROUP g); -extern "C" void fl_group_end(GROUP g); - - extern "C" void fl_group_add(GROUP g, WIDGET item); extern "C" void fl_group_insert(GROUP g, WIDGET item, int place); extern "C" void fl_group_insert2(GROUP g, WIDGET item, WIDGET before); @@ -36,16 +33,24 @@ extern "C" unsigned int fl_group_get_clip_children(GROUP g); extern "C" void fl_group_set_clip_children(GROUP g, int c); +extern "C" void fl_group_add_resizable(GROUP g, WIDGET w); extern "C" void * fl_group_get_resizable(GROUP g); extern "C" void fl_group_set_resizable(GROUP g, WIDGET item); extern "C" void fl_group_init_sizes(GROUP g); +extern "C" void fl_group_resize(GROUP g, int x, int y, int w, int h); extern "C" void * fl_group_get_current(); extern "C" void fl_group_set_current(GROUP g); +extern "C" void fl_group_begin(GROUP g); +extern "C" void fl_group_end(GROUP g); extern "C" void fl_group_draw(GROUP g); +extern "C" void fl_group_draw_child(GROUP g, WIDGET w); +extern "C" void fl_group_draw_children(GROUP g); +extern "C" void fl_group_draw_outside_label(GROUP g, WIDGET w); +extern "C" void fl_group_update_child(GROUP g, WIDGET w); extern "C" int fl_group_handle(GROUP g, int e); diff --git a/src/fltk-widgets-groups.adb b/src/fltk-widgets-groups.adb index 4641dd1..2c21533 100644 --- a/src/fltk-widgets-groups.adb +++ b/src/fltk-widgets-groups.adb @@ -6,6 +6,7 @@ with + Ada.Assertions, Interfaces.C; use type @@ -16,6 +17,11 @@ use type package body FLTK.Widgets.Groups is + package Chk renames Ada.Assertions; + + + + ------------------------ -- Functions From C -- ------------------------ @@ -35,14 +41,6 @@ package body FLTK.Widgets.Groups is - procedure fl_group_end - (G : in Storage.Integer_Address); - pragma Import (C, fl_group_end, "fl_group_end"); - pragma Inline (fl_group_end); - - - - procedure fl_group_add (G, W : in Storage.Integer_Address); pragma Import (C, fl_group_add, "fl_group_add"); @@ -110,6 +108,11 @@ package body FLTK.Widgets.Groups is + procedure fl_group_add_resizable + (G, W : in Storage.Integer_Address); + pragma Import (C, fl_group_add_resizable, "fl_group_add_resizable"); + pragma Inline (fl_group_add_resizable); + function fl_group_get_resizable (G : in Storage.Integer_Address) return Storage.Integer_Address; @@ -126,6 +129,12 @@ package body FLTK.Widgets.Groups is pragma Import (C, fl_group_init_sizes, "fl_group_init_sizes"); pragma Inline (fl_group_init_sizes); + procedure fl_group_resize + (G : in Storage.Integer_Address; + X, Y, W, H : in Interfaces.C.int); + pragma Import (C, fl_group_resize, "fl_group_resize"); + pragma Inline (fl_group_resize); + @@ -139,6 +148,16 @@ package body FLTK.Widgets.Groups is pragma Import (C, fl_group_set_current, "fl_group_set_current"); pragma Inline (fl_group_set_current); + procedure fl_group_begin + (G : in Storage.Integer_Address); + pragma Import (C, fl_group_begin, "fl_group_begin"); + pragma Inline (fl_group_begin); + + procedure fl_group_end + (G : in Storage.Integer_Address); + pragma Import (C, fl_group_end, "fl_group_end"); + pragma Inline (fl_group_end); + @@ -147,6 +166,26 @@ package body FLTK.Widgets.Groups is pragma Import (C, fl_group_draw, "fl_group_draw"); pragma Inline (fl_group_draw); + procedure fl_group_draw_child + (G, W : in Storage.Integer_Address); + pragma Import (C, fl_group_draw_child, "fl_group_draw_child"); + pragma Inline (fl_group_draw_child); + + procedure fl_group_draw_children + (G : in Storage.Integer_Address); + pragma Import (C, fl_group_draw_children, "fl_group_draw_children"); + pragma Inline (fl_group_draw_children); + + procedure fl_group_draw_outside_label + (G, W : in Storage.Integer_Address); + pragma Import (C, fl_group_draw_outside_label, "fl_group_draw_outside_label"); + pragma Inline (fl_group_draw_outside_label); + + procedure fl_group_update_child + (G, W : in Storage.Integer_Address); + pragma Import (C, fl_group_update_child, "fl_group_update_child"); + pragma Inline (fl_group_update_child); + function fl_group_handle (W : in Storage.Integer_Address; E : in Interfaces.C.int) @@ -282,6 +321,8 @@ package body FLTK.Widgets.Groups is procedure Clear (This : in out Group) is begin + -- We don't use the actual clear method here because + -- that would delete the children from memory. for I in reverse 1 .. This.Number_Of_Children loop This.Remove (Index (I)); end loop; @@ -314,10 +355,14 @@ package body FLTK.Widgets.Groups is is Widget_Ptr : Storage.Integer_Address := fl_group_child (This.Void_Ptr, Interfaces.C.int (Place) - 1); - Actual_Widget : access Widget'Class := - Widget_Convert.To_Pointer (Storage.To_Address (fl_widget_get_user_data (Widget_Ptr))); + Actual_Widget : access Widget'Class; begin + Widget_Ptr := fl_widget_get_user_data (Widget_Ptr); + pragma Assert (Widget_Ptr /= Null_Pointer); + Actual_Widget := Widget_Convert.To_Pointer (Storage.To_Address (Widget_Ptr)); return (Data => Actual_Widget); + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; end Child; @@ -335,13 +380,12 @@ package body FLTK.Widgets.Groups is Item : in out Widget'Class) return Extended_Index is - Ret : Interfaces.C.int; + Result : Interfaces.C.int := fl_group_find (This.Void_Ptr, Item.Void_Ptr); begin - Ret := fl_group_find (This.Void_Ptr, Item.Void_Ptr); - if Ret = fl_group_children (This.Void_Ptr) then + if Result = fl_group_children (This.Void_Ptr) then return No_Index; end if; - return Extended_Index (Ret + 1); + return Extended_Index (Result + 1); end Find; @@ -433,16 +477,29 @@ package body FLTK.Widgets.Groups is + procedure Add_Resizable + (This : in out Group; + Item : in out Widget'Class) is + begin + fl_group_add_resizable (This.Void_Ptr, Item.Void_Ptr); + end Add_Resizable; + + function Get_Resizable (This : in Group) return access Widget'Class is - Widget_Ptr : Storage.Integer_Address := - fl_group_get_resizable (This.Void_Ptr); - Actual_Widget : access Widget'Class := - Widget_Convert.To_Pointer (Storage.To_Address (fl_widget_get_user_data (Widget_Ptr))); + Widget_Ptr : Storage.Integer_Address := fl_group_get_resizable (This.Void_Ptr); + Actual_Widget : access Widget'Class; begin + if Widget_Ptr /= Null_Pointer then + Widget_Ptr := fl_widget_get_user_data (Widget_Ptr); + pragma Assert (Widget_Ptr /= Null_Pointer); + Actual_Widget := Widget_Convert.To_Pointer (Storage.To_Address (Widget_Ptr)); + end if; return Actual_Widget; + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; end Get_Resizable; @@ -454,11 +511,24 @@ package body FLTK.Widgets.Groups is end Set_Resizable; - procedure Reset_Initial_Sizes + procedure Reset_Sizes (This : in out Group) is begin fl_group_init_sizes (This.Void_Ptr); - end Reset_Initial_Sizes; + end Reset_Sizes; + + + procedure Resize + (This : in out Group; + X, Y, W, H : in Integer) is + begin + fl_group_resize + (This.Void_Ptr, + Interfaces.C.int (X), + Interfaces.C.int (Y), + Interfaces.C.int (W), + Interfaces.C.int (H)); + end Resize; @@ -470,9 +540,13 @@ package body FLTK.Widgets.Groups is Actual_Group : access Group'Class; begin if Group_Ptr /= Null_Pointer then + Group_Ptr := fl_widget_get_user_data (Group_Ptr); + pragma Assert (Group_Ptr /= Null_Pointer); Actual_Group := Group_Convert.To_Pointer (Storage.To_Address (Group_Ptr)); end if; return Actual_Group; + exception + when Chk.Assertion_Error => raise Internal_FLTK_Error; end Get_Current; @@ -483,6 +557,20 @@ package body FLTK.Widgets.Groups is end Set_Current; + procedure Begin_Current + (This : in out Group) is + begin + fl_group_begin (This.Void_Ptr); + end Begin_Current; + + + procedure End_Current + (This : in out Group) is + begin + fl_group_end (This.Void_Ptr); + end End_Current; + + procedure Draw @@ -492,6 +580,37 @@ package body FLTK.Widgets.Groups is end Draw; + procedure Draw_Child + (This : in out Group; + Item : in out Widget'Class) is + begin + fl_group_draw_child (This.Void_Ptr, Item.Void_Ptr); + end Draw_Child; + + + procedure Draw_Children + (This : in out Group) is + begin + fl_group_draw_children (This.Void_Ptr); + end Draw_Children; + + + procedure Draw_Outside_Label + (This : in out Group; + Item : in out Widget'Class) is + begin + fl_group_draw_outside_label (This.Void_Ptr, Item.Void_Ptr); + end Draw_Outside_Label; + + + procedure Update_Child + (This : in out Group; + Item : in out Widget'Class) is + begin + fl_group_update_child (This.Void_Ptr, Item.Void_Ptr); + end Update_Child; + + function Handle (This : in out Group; Event : in Event_Kind) diff --git a/src/fltk-widgets-groups.ads b/src/fltk-widgets-groups.ads index 9212085..960c7b6 100644 --- a/src/fltk-widgets-groups.ads +++ b/src/fltk-widgets-groups.ads @@ -87,7 +87,8 @@ package FLTK.Widgets.Groups is function Child (This : in Group; Place : in Index) - return Widget_Reference; + return Widget_Reference + with Pre => This.Has_Child (Place); function Child (This : in Group; @@ -127,6 +128,10 @@ package FLTK.Widgets.Groups is + procedure Add_Resizable + (This : in out Group; + Item : in out Widget'Class); + function Get_Resizable (This : in Group) return access Widget'Class; @@ -135,9 +140,13 @@ package FLTK.Widgets.Groups is (This : in out Group; Item : in Widget'Class); - procedure Reset_Initial_Sizes + procedure Reset_Sizes (This : in out Group); + procedure Resize + (This : in out Group; + X, Y, W, H : in Integer); + @@ -147,12 +156,33 @@ package FLTK.Widgets.Groups is procedure Set_Current (To : in Group'Class); + procedure Begin_Current + (This : in out Group); + + procedure End_Current + (This : in out Group); + procedure Draw (This : in out Group); + procedure Draw_Child + (This : in out Group; + Item : in out Widget'Class); + + procedure Draw_Children + (This : in out Group); + + procedure Draw_Outside_Label + (This : in out Group; + Item : in out Widget'Class); + + procedure Update_Child + (This : in out Group; + Item : in out Widget'Class); + function Handle (This : in out Group; Event : in Event_Kind) @@ -222,17 +252,23 @@ private pragma Inline (Iterate); - -- pragma Inline (Get_Clip_Mode); - -- pragma Inline (Set_Clip_Mode); + pragma Inline (Get_Clip_Mode); + pragma Inline (Set_Clip_Mode); - pragma Inline (Get_Resizable); + pragma Inline (Add_Resizable); pragma Inline (Set_Resizable); - pragma Inline (Reset_Initial_Sizes); + pragma Inline (Reset_Sizes); + pragma Inline (Resize); - pragma Inline (Get_Current); pragma Inline (Set_Current); + pragma Inline (Begin_Current); + pragma Inline (End_Current); pragma Inline (Draw); + pragma Inline (Draw_Child); + pragma Inline (Draw_Children); + pragma Inline (Draw_Outside_Label); + pragma Inline (Update_Child); pragma Inline (Handle); |