From f419b275ee91792e08f211a588d891c4aa6bedac Mon Sep 17 00:00:00 2001 From: Jed Barber 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.ads | 53 +++++++++++++++++++++++++++++-------------------- 1 file changed, 31 insertions(+), 22 deletions(-) (limited to 'fltk-widgets-groups.ads') diff --git a/fltk-widgets-groups.ads b/fltk-widgets-groups.ads index d38bb54..aa52083 100644 --- a/fltk-widgets-groups.ads +++ b/fltk-widgets-groups.ads @@ -1,64 +1,73 @@ --- need to add a Vector to keep track of the children added to a group, and --- to change their Void_Ptrs to null addresses if Clear or Finalize are --- called, otherwise bad things will happen - --- similarly, Widgets need to keep track of their parent so that Insert --- will work correctly +private with Ada.Containers.Vectors; package FLTK.Widgets.Groups is type Group is new Widget with private; - type Group_Access is access all Group; - - - type Index is new Integer; + type Index is new Positive; function Create (X, Y, W, H : in Integer; - Label : in String) + Text : in String) return Group; procedure Add - (This : in out Group'Class; - Item : in Widget'Class); + (This : in out Group; + Item : in out Widget'Class); + + + function Child + (This : in Group; + Place : in Index) + return Widget_Cursor; procedure Clear - (This : in out Group'Class); + (This : in out Group); function Find - (This : in Group'Class; - Item : in Widget'Class) + (This : in Group; + Item : in out Widget'Class) return Index; procedure Insert - (This : in out Group'Class; - Item : in Widget'Class; + (This : in out Group; + Item : in out Widget'Class; Place : in Index); procedure Remove - (This : in out Group'Class; - Item : in Widget'Class); + (This : in out Group; + Item : in out Widget'Class); procedure Remove - (This : in out Group'Class; + (This : in out Group; Place : in Index); private - type Group is new Widget with null record; + type Widget_Access is access all Widget'Class; + package Widget_Vectors is new Ada.Containers.Vectors (Index, Widget_Access); + + + type Group is new Widget with + record + Widget_List : Widget_Vectors.Vector; + end record; + + + overriding procedure Initialize + (This : in out Group); overriding procedure Finalize -- cgit