From f419b275ee91792e08f211a588d891c4aa6bedac Mon Sep 17 00:00:00 2001
From: Jed Barber <jjbarber@y7mail.com>
Date: Fri, 15 Jul 2016 22:20:30 +1000
Subject: Groups and Widgets should now keep track of themselves properly, also
 all named access types removed

---
 fltk-widgets-groups.adb | 96 +++++++++++++++++++++++++++++++++++--------------
 1 file changed, 70 insertions(+), 26 deletions(-)

(limited to 'fltk-widgets-groups.adb')

diff --git a/fltk-widgets-groups.adb b/fltk-widgets-groups.adb
index 0098842..b515cc5 100644
--- a/fltk-widgets-groups.adb
+++ b/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;
 
-- 
cgit