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
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138 | with
lace.Event,
lace.Response,
lace.Observer;
private
with
ada.Containers.indefinite_hashed_Maps,
ada.Strings.Hash;
generic
type T is abstract tagged limited private;
package lace.make_Observer
--
-- Makes a user class T into an event Observer.
--
is
pragma remote_Types;
type Item is abstract limited new T
and Observer.item with private;
type View is access all Item'Class;
procedure destroy (Self : in out Item);
------------
-- Responses
--
overriding
procedure add (Self : access Item; the_Response : in Response.view;
to_Kind : in Event.Kind;
from_Subject : in Event.subject_Name);
overriding
procedure rid (Self : access Item; the_Response : in Response.view;
to_Kind : in Event.Kind;
from_Subject : in Event.subject_Name);
overriding
procedure relay_responseless_Events (Self : in out Item; To : in Observer.view);
-------------
-- 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 response maps
--
use type event.Kind;
use type Response.view;
package event_response_Maps is new ada.Containers.indefinite_hashed_Maps (key_type => Event.Kind,
element_type => Response.view,
hash => Event.Hash,
equivalent_keys => "=");
subtype event_response_Map is event_response_Maps.Map;
type event_response_Map_view is access all event_response_Map;
----------------------------------
-- Subject maps of event responses
--
package subject_Maps_of_event_responses
is new ada.Containers.indefinite_hashed_Maps (key_type => Event.subject_Name,
element_type => event_response_Map_view,
hash => ada.Strings.Hash,
equivalent_keys => "=");
subtype subject_Map_of_event_responses is subject_Maps_of_event_responses.Map;
-----------------
-- Safe Responses
--
protected
type safe_Responses
is
procedure destroy;
------------
-- Responses
--
procedure add (Self : access Item'Class;
the_Response : in Response.view;
to_Kind : in Event.Kind;
from_Subject : in Event.subject_Name);
procedure rid (Self : access Item'Class;
the_Response : in Response.view;
to_Kind : in Event.Kind;
from_Subject : in Event.subject_Name);
procedure relay_responseless_Events (To : in Observer.view);
function relay_Target return Observer.view;
function Contains (Subject : in Event.subject_Name) return Boolean;
function Element (Subject : in Event.subject_Name) return event_response_Map;
-------------
-- Operations
--
procedure receive (Self : access Item'Class;
the_Event : in Event.item'Class := Event.null_Event;
from_Subject : in Event.subject_Name);
private
my_Responses : subject_Map_of_event_responses;
my_relay_Target : Observer.view;
end safe_Responses;
----------------
-- Observer Item
--
type Item is abstract limited new T
and Observer.item
with
record
Responses : safe_Responses;
end record;
end lace.make_Observer;
|