1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119 | with
lace.Event;
private
with
ada.Containers.indefinite_Vectors,
ada.Containers.indefinite_hashed_Maps,
ada.Strings.Hash;
generic
type T is abstract new lace.make_Observer.item with private;
package lace.make_Observer.deferred
--
-- Makes a user class T into a deferred event Observer.
--
is
pragma remote_Types;
type Item is abstract limited new T with private;
type View is access all Item'Class;
overriding
procedure destroy (Self : in out Item);
-------------
-- Operations
--
overriding
procedure receive (Self : access Item; the_Event : in Event.item'Class := Event.null_Event;
from_Subject : in Event.subject_Name);
overriding
procedure respond (Self : access Item);
private
----------------
-- Event Vectors
--
use type Event.item;
package event_Vectors is new ada.Containers.indefinite_Vectors (Positive, Event.item'Class);
subtype event_Vector is event_Vectors.Vector;
type event_Vector_view is access all event_Vector;
--------------
-- Safe Events
--
protected
type safe_Events
is
procedure add (the_Event : in Event.item'Class);
procedure fetch (all_Events : out event_Vector);
private
the_Events : event_Vector;
end safe_Events;
type safe_Events_view is access all safe_Events;
------------------------------
-- Subject Maps of safe Events
--
use type event_Vector;
package subject_Maps_of_safe_events is new ada.Containers.indefinite_hashed_Maps (Key_type => Event.subject_Name,
Element_type => safe_Events_view,
Hash => ada.Strings.Hash,
equivalent_Keys => "=");
subtype subject_Map_of_safe_events is subject_Maps_of_safe_events.Map;
-----------------------
-- Subject Events Pairs
--
type String_view is access all String;
type subject_events_Pair is
record
Subject : String_view;
Events : event_Vector;
end record;
type subject_events_Pairs is array (Positive range <>) of subject_events_Pair;
----------------------------------
-- safe Subject Map of safe Events
--
protected
type safe_subject_Map_of_safe_events
is
procedure add (the_Event : in Event.item'Class;
from_Subject : in String);
procedure fetch (all_Events : out subject_events_Pairs;
Count : out Natural);
procedure free;
private
the_Map : subject_Map_of_safe_events;
end safe_subject_Map_of_safe_events;
----------------
-- Observer Item
--
type Item is abstract limited new T with
record
pending_Events : safe_subject_Map_of_safe_events;
end record;
end lace.make_Observer.deferred;
|