source: trunk/design/ui/source/wcore/core-connectables.adb

Last change on this file was 5728, checked in by vadim.godunko, 11 months ago

Implement support of many slots connected to same emitter.

  • Property svn:keywords set to Author Date Revision
File size: 6.3 KB
Line 
1------------------------------------------------------------------------------
2--                                                                          --
3--                            Matreshka Project                             --
4--                                                                          --
5--                               Web Framework                              --
6--                                                                          --
7--                        Runtime Library Component                         --
8--                                                                          --
9------------------------------------------------------------------------------
10--                                                                          --
11-- Copyright © 2016-2017, Vadim Godunko <vgodunko@gmail.com>                --
12-- All rights reserved.                                                     --
13--                                                                          --
14-- Redistribution and use in source and binary forms, with or without       --
15-- modification, are permitted provided that the following conditions       --
16-- are met:                                                                 --
17--                                                                          --
18--  * Redistributions of source code must retain the above copyright        --
19--    notice, this list of conditions and the following disclaimer.         --
20--                                                                          --
21--  * Redistributions in binary form must reproduce the above copyright     --
22--    notice, this list of conditions and the following disclaimer in the   --
23--    documentation and/or other materials provided with the distribution.  --
24--                                                                          --
25--  * Neither the name of the Vadim Godunko, IE nor the names of its        --
26--    contributors may be used to endorse or promote products derived from  --
27--    this software without specific prior written permission.              --
28--                                                                          --
29-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS      --
30-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT        --
31-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR    --
32-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT     --
33-- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,   --
34-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED --
35-- TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR   --
36-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF   --
37-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING     --
38-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS       --
39-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.             --
40--                                                                          --
41------------------------------------------------------------------------------
42--  $Revision: 5728 $ $Date: 2017-01-25 21:48:05 +0000 (Wed, 25 Jan 2017) $
43------------------------------------------------------------------------------
44with Ada.Unchecked_Deallocation;
45
46package body Core.Connectables is
47
48   procedure Disconnect
49    (Signal : Signal_End_Access;
50     Slot   : Slot_End_Access);
51
52   ------------
53   -- Attach --
54   ------------
55
56   procedure Attach (Self : in out Signal_End_Base'Class) is
57   begin
58      if Self.Emitter.Head = null then
59         Self.Emitter.Head := Self'Unchecked_Access;
60         Self.Emitter.Tail := Self'Unchecked_Access;
61
62      else
63         Self.Previous := Self.Emitter.Tail;
64         Self.Emitter.Tail.Next := Self'Unchecked_Access;
65         Self.Emitter.Tail := Self'Unchecked_Access;
66      end if;
67   end Attach;
68
69   ------------
70   -- Attach --
71   ------------
72
73   procedure Attach (Self : in out Slot_End_Base'Class) is
74      Owner : constant not null Object_Access := Self.Owner;
75
76   begin
77      if Owner.Head = null then
78         Owner.Head := Self'Unchecked_Access;
79         Owner.Tail := Self'Unchecked_Access;
80
81      else
82         Self.Previous := Owner.Tail;
83         Owner.Tail.Next := Self'Unchecked_Access;
84         Owner.Tail := Self'Unchecked_Access;
85      end if;
86   end Attach;
87
88   ------------
89   -- Detach --
90   ------------
91
92   procedure Detach (Self : in out Signal_End_Base'Class) is
93   begin
94      if Self.Emitter.Head = Self'Unchecked_Access then
95         Self.Emitter.Head := Self.Next;
96      end if;
97
98      if Self.Emitter.Tail = Self'Unchecked_Access then
99         Self.Emitter.Tail := Self.Previous;
100      end if;
101
102      if Self.Next /= null then
103         Self.Next.Previous := Self.Previous;
104      end if;
105
106      if Self.Previous /= null then
107         Self.Previous.Next := Self.Next;
108      end if;
109   end Detach;
110
111   ------------
112   -- Detach --
113   ------------
114
115   procedure Detach (Self : in out Slot_End_Base'Class) is
116      Owner : constant not null Object_Access := Self.Owner;
117
118   begin
119      if Owner.Head = Self'Unchecked_Access then
120         Owner.Head := Self.Next;
121      end if;
122
123      if Owner.Tail = Self'Unchecked_Access then
124         Owner.Tail := Self.Previous;
125      end if;
126
127      if Self.Next /= null then
128         Self.Next.Previous := Self.Previous;
129      end if;
130
131      if Self.Previous /= null then
132         Self.Previous.Next := Self.Next;
133      end if;
134   end Detach;
135
136   ----------------
137   -- Disconnect --
138   ----------------
139
140   procedure Disconnect
141    (Signal : Signal_End_Access;
142     Slot   : Slot_End_Access)
143   is
144      procedure Free is
145        new Ada.Unchecked_Deallocation
146             (Signal_End_Base'Class, Signal_End_Access);
147
148      procedure Free is
149        new Ada.Unchecked_Deallocation (Slot_End_Base'Class, Slot_End_Access);
150
151     Aux_Signal : Signal_End_Access := Signal;
152     Aux_Slot   : Slot_End_Access   := Slot;
153
154   begin
155      Aux_Signal.Detach;
156      Aux_Slot.Detach;
157      Free (Aux_Signal);
158      Free (Aux_Slot);
159   end Disconnect;
160
161   --------------
162   -- Finalize --
163   --------------
164
165   not overriding procedure Finalize (Self : in out Connectable_Object) is
166   begin
167      while Self.Head /= null loop
168         Disconnect (Self.Head.Signal_End, Self.Head);
169      end loop;
170   end Finalize;
171
172end Core.Connectables;
Note: See TracBrowser for help on using the repository browser.