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
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245 | -- Chattanooga: a simple chat program
-- Copyright (C) 2015 by PragmAda Software Engineering. All rights reserved.
-- **************************************************************************
--
-- Database: the data stored by the program; currently all in memory
--
-- V1.0B 2015 Jan 05 1st beta release
--
with Ada.Containers.Hashed_Maps;
with Chattanooga.UI;
package body Chattanooga.DB is
package User_Maps is new Ada.Containers.Hashed_Maps
(Key_Type => String, Element_Type => User_Data, Hash => UXStrings.Hash, Equivalent_Keys => "=");
protected Control is
procedure Add
(User : in String;
App_Data : in App_Ptr);
function Exists
(User : String)
return Boolean;
procedure Remove (User : in String);
function Send
(From : String;
Message : String)
return Natural;
procedure Add_Friend
(User : in String;
Friend : in String);
procedure Remove_Friend
(User : in String;
Friend : in String);
private -- Control
Map : User_Maps.Map;
end Control;
procedure Add
(User : in String;
App_Data : in App_Ptr)
is
-- Empty declarative part
begin -- Add
Control.Add (User => User, App_Data => App_Data);
end Add;
function Exists
(User : String)
return Boolean
is
-- Empty declarative part
begin -- Exists
return Control.Exists (User);
end Exists;
procedure Remove (User : in String) is
-- Empty declarative part
begin -- Remove
Control.Remove (User => User);
end Remove;
function Send
(From : String;
Message : String)
return Natural
is
-- Empty declarative part
begin -- Send
return Control.Send (From, Message);
end Send;
procedure Add_Friend
(User : in String;
Friend : in String)
is
-- Empty declarative part
begin -- Add_Friend
Control.Add_Friend (User => User, Friend => Friend);
end Add_Friend;
procedure Remove_Friend
(User : in String;
Friend : in String)
is
-- Empty declarative part
begin -- Remove_Friend
Control.Remove_Friend (User => User, Friend => Friend);
end Remove_Friend;
protected body Control is
procedure Add
(User : in String;
App_Data : in App_Ptr)
is
procedure Check_One (Position : in User_Maps.Cursor);
-- if the Contact set for the user at Position contains User, adds the user at Position to Data.Contact
-- Changes the display of User for the user at Position to indicate that User is connected
Data : User_Data;
procedure Check_One (Position : in User_Maps.Cursor) is
Key : constant String := User_Maps.Key (Position);
Value : constant User_Data := User_Maps.Element (Position);
begin -- Check_One
if Value.Contact.Contains (User) then
Data.Contact.Include (New_Item => Key);
UI.New_Friend (Friend => Key, App_Data => App_Data, Connected => True);
UI.Change_Status (Friend => User, App_Data => Value.App_Data, Connected => True);
end if;
end Check_One;
begin -- Add
if Map.Contains (User) then
raise Constraint_Error;
end if;
Data.App_Data := App_Data;
Map.Iterate (Process => Check_One'Access);
Map.Insert (Key => User, New_Item => Data);
end Add;
function Exists
(User : String)
return Boolean
is
-- Empty declarative part
begin -- Exists
return Map.Contains (User);
end Exists;
procedure Remove (User : in String) is
procedure Check_One (Position : in User_Maps.Cursor);
-- if the Contact set for the user at Position contains User, changes the user at Position's friend list to show User as
-- not connected
procedure Check_One (Position : in User_Maps.Cursor) is
Key : constant String := User_Maps.Key (Position);
Value : constant User_Data := User_Maps.Element (Position);
begin -- Check_One
if Value.Contact.Contains (User) then
UI.Change_Status (Friend => User, App_Data => Value.App_Data, Connected => False);
end if;
end Check_One;
begin -- Remove
Map.Exclude (Key => User);
Map.Iterate (Process => Check_One'Access);
end Remove;
function Send
(From : String;
Message : String)
return Natural
is
Data : constant User_Data := Map.Element (From);
procedure Send_One (Position : in Contact_Sets.Cursor);
-- Sends Message to the user at Position, using the user's App_Data
Count : Natural := 0;
procedure Send_One (Position : in Contact_Sets.Cursor) is
Key : constant String := Contact_Sets.Element (Position);
Value : User_Data;
begin -- Send_One
if Map.Contains (Key) then
Count := Count + 1;
Value := Map.Element (Key);
UI.Show (From => From, Message => Message, App_Data => Value.App_Data);
end if;
end Send_One;
begin -- Send
Data.Contact.Iterate (Process => Send_One'Access);
return Count;
end Send;
procedure Add_Friend
(User : in String;
Friend : in String)
is
Data : User_Data;
begin -- Add_Friend
if not Map.Contains (User) then
return;
end if;
Data := Map.Element (User);
if not Data.Contact.Contains (Friend) then
Data.Contact.Include (New_Item => Friend);
Map.Replace (Key => User, New_Item => Data);
UI.New_Friend (Friend => Friend, App_Data => Data.App_Data, Connected => Map.Contains (Friend));
end if;
if Map.Contains (Friend) then
Data := Map.Element (Friend);
if not Data.Contact.Contains (User) then
Data.Contact.Include (New_Item => User);
Map.Replace (Key => Friend, New_Item => Data);
UI.New_Friend (Friend => User, App_Data => Data.App_Data, Connected => True);
end if;
end if;
end Add_Friend;
procedure Remove_Friend
(User : in String;
Friend : in String)
is
Data : User_Data;
begin -- Remove_Friend
if not Map.Contains (User) then
return;
end if;
Data := Map.Element (User);
if Data.Contact.Contains (Friend) then
Data.Contact.Exclude (Item => Friend);
Map.Replace (Key => User, New_Item => Data);
UI.Remove_Friend (Friend => Friend, App_Data => Data.App_Data);
end if;
if Map.Contains (Friend) then
Data := Map.Element (Friend);
if Data.Contact.Contains (User) then
Data.Contact.Exclude (Item => User);
Map.Replace (Key => Friend, New_Item => Data);
UI.Remove_Friend (Friend => User, App_Data => Data.App_Data);
end if;
end if;
end Remove_Friend;
end Control;
end Chattanooga.DB;
--
-- This is free software; you can redistribute it and/or modify it under
-- terms of the GNU General Public License as published by the Free Software
-- Foundation; version 2.
-- This software is distributed in the hope that it will be useful, but WITH
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
-- for more details. Free Software Foundation, 59 Temple Place - Suite
-- 330, Boston, MA 02111-1307, USA.
|