summaryrefslogtreecommitdiff
path: root/src/fltk_binding/fltk-widgets-groups.adb
diff options
context:
space:
mode:
Diffstat (limited to 'src/fltk_binding/fltk-widgets-groups.adb')
-rw-r--r--src/fltk_binding/fltk-widgets-groups.adb96
1 files changed, 70 insertions, 26 deletions
diff --git a/src/fltk_binding/fltk-widgets-groups.adb b/src/fltk_binding/fltk-widgets-groups.adb
index 0098842..b515cc5 100644
--- a/src/fltk_binding/fltk-widgets-groups.adb
+++ b/src/fltk_binding/fltk-widgets-groups.adb
@@ -3,6 +3,8 @@
with Interfaces.C;
with System;
use type System.Address;
+with Ada.Containers.Vectors;
+use type Ada.Containers.Count_Type;
package body FLTK.Widgets.Groups is
@@ -10,7 +12,7 @@ package body FLTK.Widgets.Groups is
function new_fl_group
(X, Y, W, H : in Interfaces.C.int;
- Label : in Interfaces.C.char_array)
+ Text : in Interfaces.C.char_array)
return System.Address;
pragma Import (C, new_fl_group, "new_fl_group");
@@ -30,10 +32,10 @@ package body FLTK.Widgets.Groups is
(G : in System.Address);
pragma Import (C, fl_group_clear, "fl_group_clear");
- function fl_group_find
- (G, W : in System.Address)
- return Interfaces.C.int;
- pragma Import (C, fl_group_find, "fl_group_find");
+ -- function fl_group_find
+ -- (G, W : in System.Address)
+ -- return Interfaces.C.int;
+ -- pragma Import (C, fl_group_find, "fl_group_find");
procedure fl_group_insert
(G, W : in System.Address;
@@ -52,11 +54,27 @@ package body FLTK.Widgets.Groups is
+ procedure Initialize
+ (This : in out Group) is
+ begin
+ Initialize (Widget (This));
+ This.Widget_List := Widget_Vectors.Empty_Vector;
+ end Initialize;
+
+
+
+
procedure Finalize
(This : in out Group) is
begin
- if (This.Void_Ptr /= System.Null_Address) then
- free_fl_group (This.Void_Ptr);
+ Finalize (Widget (This));
+ if This.Void_Ptr /= System.Null_Address then
+ while This.Widget_List.Length > 0 loop
+ This.Remove (This.Widget_List.Last_Index);
+ end loop;
+ if This in Group then
+ free_fl_group (This.Void_Ptr);
+ end if;
end if;
end Finalize;
@@ -65,38 +83,55 @@ package body FLTK.Widgets.Groups is
function Create
(X, Y, W, H : in Integer;
- Label : in String)
+ Text : in String)
return Group is
-
- VP : System.Address;
-
begin
- VP := new_fl_group
+ return This : Group do
+ This.Void_Ptr := new_fl_group
(Interfaces.C.int (X),
Interfaces.C.int (Y),
Interfaces.C.int (W),
Interfaces.C.int (H),
- Interfaces.C.To_C (Label));
- fl_group_end (VP);
- return (Ada.Finalization.Limited_Controlled with Void_Ptr => VP);
+ Interfaces.C.To_C (Text));
+ fl_group_end (This.Void_Ptr);
+ end return;
end Create;
procedure Add
- (This : in out Group'Class;
- Item : in Widget'Class) is
+ (This : in out Group;
+ Item : in out Widget'Class) is
begin
+ if Item.Parent /= null then
+ Item.Parent.Remove (Item);
+ end if;
+ This.Widget_List.Append (Item'Unchecked_Access);
+ Item.Parent := This'Unchecked_Access;
fl_group_add (This.Void_Ptr, Item.Void_Ptr);
end Add;
+ function Child
+ (This : in Group;
+ Place : in Index)
+ return Widget_Cursor is
+ begin
+ return Ref : Widget_Cursor (This.Widget_List.Element (Place));
+ end Child;
+
+
+
+
procedure Clear
- (This : in out Group'Class) is
+ (This : in out Group) is
begin
+ while This.Widget_List.Length > 0 loop
+ This.Remove (This.Widget_List.Last_Index);
+ end loop;
fl_group_clear (This.Void_Ptr);
end Clear;
@@ -104,21 +139,26 @@ package body FLTK.Widgets.Groups is
function Find
- (This : in Group'Class;
- Item : in Widget'Class)
+ (This : in Group;
+ Item : in out Widget'Class)
return Index is
begin
- return Index (fl_group_find (This.Void_Ptr, Item.Void_Ptr));
+ return This.Widget_List.Find_Index (Item'Unchecked_Access);
end Find;
procedure Insert
- (This : in out Group'Class;
- Item : in Widget'Class;
+ (This : in out Group;
+ Item : in out Widget'Class;
Place : in Index) is
begin
+ if Item.Parent /= null then
+ Item.Parent.Remove (Item);
+ end if;
+ This.Widget_List.Insert (Place, Item'Unchecked_Access);
+ Item.Parent := This'Unchecked_Access;
fl_group_insert
(This.Void_Ptr,
Item.Void_Ptr,
@@ -129,9 +169,11 @@ package body FLTK.Widgets.Groups is
procedure Remove
- (This : in out Group'Class;
- Item : in Widget'Class) is
+ (This : in out Group;
+ Item : in out Widget'Class) is
begin
+ Item.Parent := null;
+ This.Widget_List.Delete (This.Find (Item));
fl_group_remove (This.Void_Ptr, Item.Void_Ptr);
end Remove;
@@ -139,9 +181,11 @@ package body FLTK.Widgets.Groups is
procedure Remove
- (This : in out Group'Class;
+ (This : in out Group;
Place : in Index) is
begin
+ This.Widget_List.Element (Place).Parent := null;
+ This.Widget_List.Delete (Place);
fl_group_remove2 (This.Void_Ptr, Interfaces.C.int (Place));
end Remove;