Download as
Browse Code »

Commit 75cde9c90e95d9417737fb184074d7829b4c4736

Authored by Carlos Picanco
1 parent 34a0576d
Exists in master

network refactoring, unfinished login logout logic and dumps

Showing 12 changed files with 743 additions and 409 deletions   Show diff stats
cultural_matrix.lpi
  Diff comments   View file @75cde9c
@@ -38,7 +38,7 @@ @@ -38,7 +38,7 @@
38 <PackageName Value="LCL"/> 38 <PackageName Value="LCL"/>
39 </Item3> 39 </Item3>
40 </RequiredPackages> 40 </RequiredPackages>
41 - <Units Count="15"> 41 + <Units Count="19">
42 <Unit0> 42 <Unit0>
43 <Filename Value="cultural_matrix.lpr"/> 43 <Filename Value="cultural_matrix.lpr"/>
44 <IsPartOfProject Value="True"/> 44 <IsPartOfProject Value="True"/>
@@ -76,7 +76,7 @@ @@ -76,7 +76,7 @@
76 <Unit7> 76 <Unit7>
77 <Filename Value="form_chooseactor.pas"/> 77 <Filename Value="form_chooseactor.pas"/>
78 <IsPartOfProject Value="True"/> 78 <IsPartOfProject Value="True"/>
79 - <ComponentName Value="Form1"/> 79 + <ComponentName Value="FormChooseActor"/>
80 <HasResources Value="True"/> 80 <HasResources Value="True"/>
81 <ResourceBaseClass Value="Form"/> 81 <ResourceBaseClass Value="Form"/>
82 </Unit7> 82 </Unit7>
@@ -108,6 +108,22 @@ @@ -108,6 +108,22 @@
108 <Filename Value="units/game_actors_point.pas"/> 108 <Filename Value="units/game_actors_point.pas"/>
109 <IsPartOfProject Value="True"/> 109 <IsPartOfProject Value="True"/>
110 </Unit14> 110 </Unit14>
  111 + <Unit15>
  112 + <Filename Value="units/game_visual_elements.pas"/>
  113 + <IsPartOfProject Value="True"/>
  114 + </Unit15>
  115 + <Unit16>
  116 + <Filename Value="units/zmq_network.pas"/>
  117 + <IsPartOfProject Value="True"/>
  118 + </Unit16>
  119 + <Unit17>
  120 + <Filename Value="units/zmq_network3.pas"/>
  121 + <IsPartOfProject Value="True"/>
  122 + </Unit17>
  123 + <Unit18>
  124 + <Filename Value="units/game_zmq_actors.pas"/>
  125 + <IsPartOfProject Value="True"/>
  126 + </Unit18>
111 </Units> 127 </Units>
112 </ProjectOptions> 128 </ProjectOptions>
113 <CompilerOptions> 129 <CompilerOptions>
cultural_matrix.lpr
  Diff comments   View file @75cde9c
@@ -70,19 +70,22 @@ begin @@ -70,19 +70,22 @@ begin
70 end 70 end
71 else 71 else
72 begin 72 begin
73 - Form1 := TForm1.Create(nil);  
74 - if Form1.ShowModal = 1 then  
75 - begin  
76 - case Form1.GameActor of  
77 - gaAdmin:FormMatrixGame.SetGameActor(gaAdmin);  
78 - gaPlayer: FormMatrixGame.SetGameActor(gaPlayer);  
79 - gaWatcher: FormMatrixGame.SetGameActor(gaWatcher);  
80 - end;  
81 - end  
82 - else Exit;  
83 - Form1.Free; 73 + FormChooseActor := TFormChooseActor.Create(nil);
  74 + FormChooseActor.Style := '.Arrived';
  75 + try
  76 + if FormChooseActor.ShowModal = 1 then
  77 + begin
  78 + case FormChooseActor.GameActor of
  79 + gaAdmin:FormMatrixGame.SetGameActor(gaAdmin);
  80 + gaPlayer: FormMatrixGame.SetGameActor(gaPlayer);
  81 + gaWatcher: FormMatrixGame.SetGameActor(gaWatcher);
  82 + end;
  83 + end
  84 + else Exit;
  85 + finally
  86 + FormChooseActor.Free;
  87 + end;
84 end; 88 end;
85 -  
86 Application.Run; 89 Application.Run;
87 end. 90 end.
88 91
form_chooseactor.lfm
  Diff comments   View file @75cde9c
1 -object Form1: TForm1 1 +object FormChooseActor: TFormChooseActor
2 Left = 416 2 Left = 416
3 Height = 240 3 Height = 240
4 Top = 194 4 Top = 194
5 Width = 320 5 Width = 320
6 BorderStyle = bsNone 6 BorderStyle = bsNone
7 - Caption = 'Form1' 7 + Caption = 'FormChooseActor'
8 ClientHeight = 240 8 ClientHeight = 240
9 ClientWidth = 320 9 ClientWidth = 320
10 FormStyle = fsStayOnTop 10 FormStyle = fsStayOnTop
  11 + OnCloseQuery = FormCloseQuery
  12 + OnCreate = FormCreate
11 Position = poScreenCenter 13 Position = poScreenCenter
12 LCLVersion = '1.6.0.4' 14 LCLVersion = '1.6.0.4'
13 object btnAdmin: TButton 15 object btnAdmin: TButton
@@ -28,4 +30,15 @@ object Form1: TForm1 @@ -28,4 +30,15 @@ object Form1: TForm1
28 OnClick = btnPlayerClick 30 OnClick = btnPlayerClick
29 TabOrder = 1 31 TabOrder = 1
30 end 32 end
  33 + object btnPlayerResume: TButton
  34 + Left = 50
  35 + Height = 140
  36 + Top = 50
  37 + Width = 220
  38 + Align = alClient
  39 + BorderSpacing.Around = 50
  40 + Caption = 'ENTRAR'
  41 + OnClick = btnPlayerResumeClick
  42 + TabOrder = 2
  43 + end
31 end 44 end
form_chooseactor.pas
  Diff comments   View file @75cde9c
@@ -5,52 +5,83 @@ unit form_chooseactor; @@ -5,52 +5,83 @@ unit form_chooseactor;
5 interface 5 interface
6 6
7 uses 7 uses
8 - Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,  
9 - game_actors 8 + Classes, SysUtils, FileUtil, Forms, Controls,
  9 + Graphics, Dialogs, StdCtrls,ExtCtrls, LCLType
  10 + , game_actors
10 ; 11 ;
11 12
12 type 13 type
13 14
14 - { TForm1 } 15 + { TFormChooseActor }
15 16
16 - TForm1 = class(TForm) 17 + TFormChooseActor = class(TForm)
17 btnAdmin: TButton; 18 btnAdmin: TButton;
18 btnPlayer: TButton; 19 btnPlayer: TButton;
  20 + btnPlayerResume: TButton;
19 procedure btnAdminClick(Sender: TObject); 21 procedure btnAdminClick(Sender: TObject);
20 procedure btnPlayerClick(Sender: TObject); 22 procedure btnPlayerClick(Sender: TObject);
  23 + procedure btnPlayerResumeClick(Sender: TObject);
  24 + procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
  25 + procedure FormCreate(Sender: TObject);
21 private 26 private
22 FGameActor: TGameActor; 27 FGameActor: TGameActor;
23 - procedure SetGameActor(AValue: TGameActor); 28 + FCanClose : Boolean;
  29 + FStyle: string;
  30 + procedure SetStyle(AValue: string);
24 { private declarations } 31 { private declarations }
25 public 32 public
26 - property GameActor : TGameActor read FGameActor write SetGameActor; 33 + property GameActor : TGameActor read FGameActor;
  34 + property Style : string read FStyle write SetStyle;
27 end; 35 end;
28 36
29 var 37 var
30 - Form1: TForm1; 38 + FormChooseActor: TFormChooseActor;
31 39
32 implementation 40 implementation
33 41
34 {$R *.lfm} 42 {$R *.lfm}
35 43
36 -{ TForm1 } 44 +{ TFormChooseActor }
37 45
38 -procedure TForm1.btnAdminClick(Sender: TObject); 46 +procedure TFormChooseActor.btnAdminClick(Sender: TObject);
39 begin 47 begin
40 - GameActor:=gaAdmin; 48 + FGameActor:=gaAdmin;
  49 + FCanClose := True;
41 ModalResult:=1; 50 ModalResult:=1;
42 end; 51 end;
43 52
44 -procedure TForm1.btnPlayerClick(Sender: TObject); 53 +procedure TFormChooseActor.btnPlayerClick(Sender: TObject);
45 begin 54 begin
46 - GameActor:=gaPlayer; 55 + FGameActor:=gaPlayer;
  56 + FCanClose := True;
47 ModalResult:=1; 57 ModalResult:=1;
48 end; 58 end;
49 59
50 -procedure TForm1.SetGameActor(AValue: TGameActor); 60 +procedure TFormChooseActor.btnPlayerResumeClick(Sender: TObject);
51 begin 61 begin
52 - if FGameActor=AValue then Exit;  
53 - FGameActor:=AValue; 62 + FCanClose := True;
  63 + ModalResult:=1;
  64 +end;
  65 +
  66 +procedure TFormChooseActor.FormCloseQuery(Sender: TObject; var CanClose: boolean
  67 + );
  68 +begin
  69 + CanClose := FCanClose;
  70 +end;
  71 +
  72 +procedure TFormChooseActor.FormCreate(Sender: TObject);
  73 +begin
  74 + FCanClose := False
  75 +end;
  76 +
  77 +procedure TFormChooseActor.SetStyle(AValue: string);
  78 +begin
  79 + if FStyle=AValue then Exit;
  80 + case AValue of
  81 + '.Arrived': btnPlayerResume.Visible:=False;
  82 + '.Left': btnPlayerResume.Visible:=True;
  83 + end;
  84 + FStyle:=AValue;
54 end; 85 end;
55 86
56 87
form_matrixgame.lfm
  Diff comments   View file @75cde9c
1 object FormMatrixGame: TFormMatrixGame 1 object FormMatrixGame: TFormMatrixGame
2 - Left = 190 2 + Left = 0
3 Height = 657 3 Height = 657
4 - Top = 94  
5 - Width = 1518  
6 - HorzScrollBar.Page = 1492 4 + Top = 62
  5 + Width = 1278
  6 + HorzScrollBar.Page = 1278
7 VertScrollBar.Page = 542 7 VertScrollBar.Page = 542
8 AutoScroll = True 8 AutoScroll = True
9 Caption = 'FormMatrixGame' 9 Caption = 'FormMatrixGame'
10 - ClientHeight = 657  
11 - ClientWidth = 1518 10 + ClientHeight = 647
  11 + ClientWidth = 1278
12 Font.Name = 'Monospace' 12 Font.Name = 'Monospace'
13 OnActivate = FormActivate 13 OnActivate = FormActivate
14 LCLVersion = '1.6.0.4' 14 LCLVersion = '1.6.0.4'
@@ -151,178 +151,18 @@ object FormMatrixGame: TFormMatrixGame @@ -151,178 +151,18 @@ object FormMatrixGame: TFormMatrixGame
151 AnchorSideBottom.Control = Owner 151 AnchorSideBottom.Control = Owner
152 AnchorSideBottom.Side = asrBottom 152 AnchorSideBottom.Side = asrBottom
153 Left = 0 153 Left = 0
154 - Height = 124  
155 - Top = 533  
156 - Width = 1518 154 + Height = 17
  155 + Top = 630
  156 + Width = 1492
157 Anchors = [akLeft, akRight, akBottom] 157 Anchors = [akLeft, akRight, akBottom]
158 AutoSize = True 158 AutoSize = True
159 Caption = 'Escolhas na última jogada' 159 Caption = 'Escolhas na última jogada'
160 ChildSizing.LeftRightSpacing = 10 160 ChildSizing.LeftRightSpacing = 10
161 ChildSizing.TopBottomSpacing = 5 161 ChildSizing.TopBottomSpacing = 5
162 ChildSizing.HorizontalSpacing = 10 162 ChildSizing.HorizontalSpacing = 10
  163 + ChildSizing.Layout = cclLeftToRightThenTopToBottom
163 ChildSizing.ControlsPerLine = 6 164 ChildSizing.ControlsPerLine = 6
164 - ClientHeight = 107  
165 - ClientWidth = 1514  
166 TabOrder = 3 165 TabOrder = 3
167 - object GBLastChoiceP0: TGroupBox  
168 - Left = 10  
169 - Height = 97  
170 - Top = 5  
171 - Width = 138  
172 - AutoSize = True  
173 - Caption = 'Você'  
174 - ChildSizing.LeftRightSpacing = 20  
175 - ChildSizing.TopBottomSpacing = 20  
176 - ChildSizing.HorizontalSpacing = 30  
177 - ChildSizing.VerticalSpacing = 10  
178 - ChildSizing.EnlargeHorizontal = crsHomogenousChildResize  
179 - ChildSizing.Layout = cclLeftToRightThenTopToBottom  
180 - ChildSizing.ControlsPerLine = 2  
181 - ClientHeight = 80  
182 - ClientWidth = 134  
183 - TabOrder = 0  
184 - object LabelCurrentColor1: TLabel  
185 - Left = 20  
186 - Height = 15  
187 - Top = 20  
188 - Width = 48  
189 - AutoSize = False  
190 - Caption = 'Cor:'  
191 - ParentColor = False  
192 - end  
193 - object PanelCurrentColor1: TPanel  
194 - Left = 98  
195 - Height = 15  
196 - Top = 20  
197 - Width = 16  
198 - Color = clBlack  
199 - ParentColor = False  
200 - TabOrder = 0  
201 - end  
202 - object LabelCurrentLine1: TLabel  
203 - Left = 20  
204 - Height = 15  
205 - Top = 45  
206 - Width = 48  
207 - AutoSize = False  
208 - Caption = 'Linha:'  
209 - ParentColor = False  
210 - end  
211 - object LabelCurrentLineNumber1: TLabel  
212 - Left = 98  
213 - Height = 15  
214 - Top = 45  
215 - Width = 16  
216 - Caption = 'NA'  
217 - ParentColor = False  
218 - end  
219 - end  
220 - object GBLastChoiceP1: TGroupBox  
221 - Left = 170  
222 - Height = 97  
223 - Top = 5  
224 - Width = 138  
225 - AutoSize = True  
226 - Caption = 'João'  
227 - ChildSizing.LeftRightSpacing = 20  
228 - ChildSizing.TopBottomSpacing = 20  
229 - ChildSizing.HorizontalSpacing = 30  
230 - ChildSizing.VerticalSpacing = 10  
231 - ChildSizing.EnlargeHorizontal = crsHomogenousChildResize  
232 - ChildSizing.Layout = cclLeftToRightThenTopToBottom  
233 - ChildSizing.ControlsPerLine = 2  
234 - ClientHeight = 80  
235 - ClientWidth = 134  
236 - TabOrder = 1  
237 - object LabelYouLastChoiceColor3: TLabel  
238 - Left = 20  
239 - Height = 15  
240 - Top = 20  
241 - Width = 48  
242 - AutoSize = False  
243 - Caption = 'Cor:'  
244 - ParentColor = False  
245 - end  
246 - object Panel4: TPanel  
247 - Left = 98  
248 - Height = 15  
249 - Top = 20  
250 - Width = 16  
251 - Color = clBlack  
252 - ParentColor = False  
253 - TabOrder = 0  
254 - end  
255 - object Label10: TLabel  
256 - Left = 20  
257 - Height = 15  
258 - Top = 45  
259 - Width = 48  
260 - AutoSize = False  
261 - Caption = 'Linha:'  
262 - ParentColor = False  
263 - end  
264 - object Label11: TLabel  
265 - Left = 98  
266 - Height = 15  
267 - Top = 45  
268 - Width = 16  
269 - Caption = 'NA'  
270 - ParentColor = False  
271 - end  
272 - end  
273 - object GBLastChoiceP2: TGroupBox  
274 - Left = 322  
275 - Height = 97  
276 - Top = 5  
277 - Width = 138  
278 - AutoSize = True  
279 - Caption = 'Maria'  
280 - ChildSizing.LeftRightSpacing = 20  
281 - ChildSizing.TopBottomSpacing = 20  
282 - ChildSizing.HorizontalSpacing = 30  
283 - ChildSizing.VerticalSpacing = 10  
284 - ChildSizing.EnlargeHorizontal = crsHomogenousChildResize  
285 - ChildSizing.Layout = cclLeftToRightThenTopToBottom  
286 - ChildSizing.ControlsPerLine = 2  
287 - ClientHeight = 80  
288 - ClientWidth = 134  
289 - TabOrder = 2  
290 - object LabelYouLastChoiceColor4: TLabel  
291 - Left = 20  
292 - Height = 15  
293 - Top = 20  
294 - Width = 48  
295 - AutoSize = False  
296 - Caption = 'Cor:'  
297 - ParentColor = False  
298 - end  
299 - object Panel5: TPanel  
300 - Left = 98  
301 - Height = 15  
302 - Top = 20  
303 - Width = 16  
304 - Color = clBlack  
305 - ParentColor = False  
306 - TabOrder = 0  
307 - end  
308 - object Label12: TLabel  
309 - Left = 20  
310 - Height = 15  
311 - Top = 45  
312 - Width = 48  
313 - AutoSize = False  
314 - Caption = 'Linha:'  
315 - ParentColor = False  
316 - end  
317 - object Label13: TLabel  
318 - Left = 98  
319 - Height = 15  
320 - Top = 45  
321 - Width = 16  
322 - Caption = 'NA'  
323 - ParentColor = False  
324 - end  
325 - end  
326 end 166 end
327 object GBAdmin: TGroupBox 167 object GBAdmin: TGroupBox
328 AnchorSideLeft.Control = GBGrupo 168 AnchorSideLeft.Control = GBGrupo
@@ -543,4 +383,31 @@ object FormMatrixGame: TFormMatrixGame @@ -543,4 +383,31 @@ object FormMatrixGame: TFormMatrixGame
543 Transparent = False 383 Transparent = False
544 end 384 end
545 end 385 end
  386 + object Button1: TButton
  387 + Left = 216
  388 + Height = 25
  389 + Top = 432
  390 + Width = 75
  391 + Caption = 'Button1'
  392 + OnClick = Button1Click
  393 + TabOrder = 8
  394 + end
  395 + object Button2: TButton
  396 + Left = 312
  397 + Height = 25
  398 + Top = 432
  399 + Width = 75
  400 + Caption = 'Button2'
  401 + OnClick = Button2Click
  402 + TabOrder = 9
  403 + end
  404 + object Button3: TButton
  405 + Left = 504
  406 + Height = 91
  407 + Top = 440
  408 + Width = 141
  409 + Caption = 'Button3'
  410 + OnClick = Button3Click
  411 + TabOrder = 10
  412 + end
546 end 413 end
form_matrixgame.pas
  Diff comments   View file @75cde9c
@@ -29,19 +29,15 @@ type @@ -29,19 +29,15 @@ type
29 29
30 TFormMatrixGame = class(TForm) 30 TFormMatrixGame = class(TForm)
31 btnConfirmRow: TButton; 31 btnConfirmRow: TButton;
  32 + Button1: TButton;
  33 + Button2: TButton;
  34 + Button3: TButton;
32 GBIndividual: TGroupBox; 35 GBIndividual: TGroupBox;
33 GBLastChoice: TGroupBox; 36 GBLastChoice: TGroupBox;
34 GBIndividualAB: TGroupBox; 37 GBIndividualAB: TGroupBox;
35 GBGrupo: TGroupBox; 38 GBGrupo: TGroupBox;
36 GBAdmin: TGroupBox; 39 GBAdmin: TGroupBox;
37 - GBLastChoiceP0: TGroupBox;  
38 - GBLastChoiceP1: TGroupBox;  
39 - GBLastChoiceP2: TGroupBox;  
40 GBExperiment: TGroupBox; 40 GBExperiment: TGroupBox;
41 - Label10: TLabel;  
42 - Label11: TLabel;  
43 - Label12: TLabel;  
44 - Label13: TLabel;  
45 LabelExpCondCount: TLabel; 41 LabelExpCondCount: TLabel;
46 LabelExpGen: TLabel; 42 LabelExpGen: TLabel;
47 LabelExpGenCount: TLabel; 43 LabelExpGenCount: TLabel;
@@ -54,24 +50,19 @@ type @@ -54,24 +50,19 @@ type
54 LabelIndCount: TLabel; 50 LabelIndCount: TLabel;
55 LabelIndACount: TLabel; 51 LabelIndACount: TLabel;
56 LabelIndBCount: TLabel; 52 LabelIndBCount: TLabel;
57 - LabelCurrentColor1: TLabel;  
58 - LabelCurrentLine1: TLabel;  
59 LabelIndA: TLabel; 53 LabelIndA: TLabel;
60 LabelGroupCount: TLabel; 54 LabelGroupCount: TLabel;
61 LabelIndB: TLabel; 55 LabelIndB: TLabel;
62 - LabelCurrentLineNumber1: TLabel;  
63 - LabelYouLastChoiceColor3: TLabel;  
64 - LabelYouLastChoiceColor4: TLabel;  
65 LabelExpCond: TLabel; 56 LabelExpCond: TLabel;
66 ChatMemoRecv: TMemo; 57 ChatMemoRecv: TMemo;
67 ChatMemoSend: TMemo; 58 ChatMemoSend: TMemo;
68 ChatPanel: TPanel; 59 ChatPanel: TPanel;
69 - Panel4: TPanel;  
70 - Panel5: TPanel;  
71 - PanelCurrentColor1: TPanel;  
72 ChatSplitter: TSplitter; 60 ChatSplitter: TSplitter;
73 StringGridMatrix: TStringGrid; 61 StringGridMatrix: TStringGrid;
74 procedure btnConfirmRowClick(Sender: TObject); 62 procedure btnConfirmRowClick(Sender: TObject);
  63 + procedure Button1Click(Sender: TObject);
  64 + procedure Button2Click(Sender: TObject);
  65 + procedure Button3Click(Sender: TObject);
75 procedure ChatMemoSendKeyPress(Sender: TObject; var Key: char); 66 procedure ChatMemoSendKeyPress(Sender: TObject; var Key: char);
76 procedure CheckBoxDrawDotsChange(Sender: TObject); 67 procedure CheckBoxDrawDotsChange(Sender: TObject);
77 procedure FormActivate(Sender: TObject); 68 procedure FormActivate(Sender: TObject);
@@ -81,9 +72,6 @@ type @@ -81,9 +72,6 @@ type
81 private 72 private
82 FGameControl : TGameControl; 73 FGameControl : TGameControl;
83 FID: string; 74 FID: string;
84 - FMustDrawDots: Boolean;  
85 - FMustDrawDotsClear: Boolean;  
86 - FRowBase: integer;  
87 public 75 public
88 procedure SetID(S : string); 76 procedure SetID(S : string);
89 procedure SetGameActor(AValue: TGameActor); 77 procedure SetGameActor(AValue: TGameActor);
@@ -95,7 +83,7 @@ var @@ -95,7 +83,7 @@ var
95 83
96 implementation 84 implementation
97 85
98 -uses LCLType, game_resources; 86 +uses form_chooseactor, LCLType, game_resources;
99 87
100 // uses datamodule; 88 // uses datamodule;
101 var 89 var
@@ -176,7 +164,6 @@ begin @@ -176,7 +164,6 @@ begin
176 try 164 try
177 //if (aRow >= RowBase) and (aCol = 10) then 165 //if (aRow >= RowBase) and (aCol = 10) then
178 // DrawLines(clWhite); 166 // DrawLines(clWhite);
179 -  
180 if (aCol <> 0) and (aRow > (RowBase-1)) then 167 if (aCol <> 0) and (aRow > (RowBase-1)) then
181 begin 168 begin
182 DrawLines(GetRowColor(aRow,RowBase)); 169 DrawLines(GetRowColor(aRow,RowBase));
@@ -225,22 +212,21 @@ procedure TFormMatrixGame.SetGameActor(AValue: TGameActor); @@ -225,22 +212,21 @@ procedure TFormMatrixGame.SetGameActor(AValue: TGameActor);
225 212
226 procedure SetZMQAdmin; 213 procedure SetZMQAdmin;
227 begin 214 begin
228 - FGameControl := TGameControl.Create(TZMQAdmin.Create(Self)); 215 +
  216 + FGameControl := TGameControl.Create(TZMQAdmin.Create(Self),FID);
229 GBAdmin.Visible:= True; 217 GBAdmin.Visible:= True;
230 end; 218 end;
231 219
232 procedure SetZMQPlayer; 220 procedure SetZMQPlayer;
233 begin 221 begin
234 - FGameControl := TGameControl.Create(TZMQPlayer.Create(Self)); 222 + FGameControl := TGameControl.Create(TZMQPlayer.Create(Self),FID);
235 btnConfirmRow.Visible := True; 223 btnConfirmRow.Visible := True;
236 StringGridMatrix.Enabled := True; 224 StringGridMatrix.Enabled := True;
237 -  
238 - FGameControl.SendMessage(K_ARRIVED);  
239 end; 225 end;
240 226
241 procedure SetZMQWatcher; 227 procedure SetZMQWatcher;
242 begin 228 begin
243 - FGameControl := TGameControl.Create(TZMQWatcher.Create(Self)); 229 + FGameControl := TGameControl.Create(TZMQWatcher.Create(Self),FID);
244 end; 230 end;
245 231
246 begin 232 begin
@@ -249,7 +235,6 @@ begin @@ -249,7 +235,6 @@ begin
249 gaPlayer: SetZMQPlayer; 235 gaPlayer: SetZMQPlayer;
250 gaWatcher: SetZMQWatcher; 236 gaWatcher: SetZMQWatcher;
251 end; 237 end;
252 - FGameControl.SetID(FID);  
253 end; 238 end;
254 239
255 procedure TFormMatrixGame.SetID(S: string); 240 procedure TFormMatrixGame.SetID(S: string);
@@ -266,6 +251,7 @@ procedure TFormMatrixGame.FormActivate(Sender: TObject); @@ -266,6 +251,7 @@ procedure TFormMatrixGame.FormActivate(Sender: TObject);
266 begin 251 begin
267 StringGridMatrix.ClearSelections; 252 StringGridMatrix.ClearSelections;
268 StringGridMatrix.FocusRectVisible := False; 253 StringGridMatrix.FocusRectVisible := False;
  254 + FGameControl.SetMatrix;
269 end; 255 end;
270 256
271 procedure TFormMatrixGame.StringGridMatrixBeforeSelection(Sender: TObject; aCol, aRow: integer); 257 procedure TFormMatrixGame.StringGridMatrixBeforeSelection(Sender: TObject; aCol, aRow: integer);
@@ -299,4 +285,29 @@ begin @@ -299,4 +285,29 @@ begin
299 FGameControl.SendMessage(K_CHOICE); 285 FGameControl.SendMessage(K_CHOICE);
300 end; 286 end;
301 287
  288 +procedure TFormMatrixGame.Button1Click(Sender: TObject);
  289 +begin
  290 +
  291 +end;
  292 +
  293 +procedure TFormMatrixGame.Button2Click(Sender: TObject);
  294 +begin
  295 +
  296 +end;
  297 +
  298 +procedure TFormMatrixGame.Button3Click(Sender: TObject);
  299 +begin
  300 + FGameControl.SendMessage(K_LEFT);
  301 + FormMatrixGame.Visible := False;
  302 + FormChooseActor := TFormChooseActor.Create(nil);
  303 + FormChooseActor.Style := K_LEFT;
  304 + if FormChooseActor.ShowModal = 1 then
  305 + begin
  306 + FGameControl.SendMessage(K_RESUME);
  307 + FormMatrixGame.Visible := True;
  308 + end
  309 + else Close;
  310 + FormChooseActor.Free;
  311 +end;
  312 +
302 end. 313 end.
units/game_control.pas
  Diff comments   View file @75cde9c
@@ -11,6 +11,7 @@ uses @@ -11,6 +11,7 @@ uses
11 , game_zmq_actors 11 , game_zmq_actors
12 , game_experiment 12 , game_experiment
13 , game_actors 13 , game_actors
  14 + , game_visual_elements
14 ; 15 ;
15 16
16 type 17 type
@@ -26,20 +27,26 @@ type @@ -26,20 +27,26 @@ type
26 FActor : TGameActor; 27 FActor : TGameActor;
27 FZMQActor : TZMQActor; 28 FZMQActor : TZMQActor;
28 FExperiment : TExperiment; 29 FExperiment : TExperiment;
29 - function GetActorNicname(AID:string; Brackets : Boolean = False) : string; 30 + function CanStartCycle : Boolean;
  31 + function GetPlayerBox(AID:string) : TPlayerBox;
  32 + function GetActorNicname(AID:string) : string;
  33 + function GetSelectedColorF(AStringGrid : TStringGrid) : UTF8string;
  34 + function GetSelectedRowF(AStringGrid : TStringGrid) : UTF8string;
30 function MessageHas(const A_CONST : string; AMessage : TStringList): Boolean; 35 function MessageHas(const A_CONST : string; AMessage : TStringList): Boolean;
31 procedure SetMatrixType(AStringGrid : TStringGrid; AMatrixType:TGameMatrixType; 36 procedure SetMatrixType(AStringGrid : TStringGrid; AMatrixType:TGameMatrixType;
32 var ARowBase:integer; var ADrawDots, ADrawClear : Boolean); 37 var ARowBase:integer; var ADrawDots, ADrawClear : Boolean);
33 procedure ReceiveMessage(AMessage : TStringList); 38 procedure ReceiveMessage(AMessage : TStringList);
34 - function GetSelectedColorF(AStringGrid : TStringGrid) : UTF8string;  
35 - function GetSelectedRowF(AStringGrid : TStringGrid) : UTF8string; 39 + procedure ReceiveRequest(var ARequest : TStringList);
  40 + procedure ReceiveReply(AReply : TStringList);
36 procedure SetMustDrawDots(AValue: Boolean); 41 procedure SetMustDrawDots(AValue: Boolean);
37 procedure SetMustDrawDotsClear(AValue: Boolean); 42 procedure SetMustDrawDotsClear(AValue: Boolean);
38 procedure SetRowBase(AValue: integer); 43 procedure SetRowBase(AValue: integer);
  44 + procedure SendSystemMessage(AMessage: array of UTF8String);
39 public 45 public
40 - constructor Create(AZMQActor : TZMQActor); reintroduce; 46 + constructor Create(AZMQActor : TZMQActor;AID : string);overload;
41 destructor Destroy; override; 47 destructor Destroy; override;
42 - procedure SetID(S:string); 48 + procedure SetMatrix;
  49 + procedure SendRequest(ARequest : UTF8string);
43 procedure SendMessage(AMessage : UTF8string); 50 procedure SendMessage(AMessage : UTF8string);
44 property ID : string read FID; 51 property ID : string read FID;
45 property RowBase : integer read FRowBase write SetRowBase; 52 property RowBase : integer read FRowBase write SetRowBase;
@@ -53,6 +60,15 @@ const @@ -53,6 +60,15 @@ const
53 K_ARRIVED = '.Arrived'; 60 K_ARRIVED = '.Arrived';
54 K_CHAT_M = '.ChatM'; 61 K_CHAT_M = '.ChatM';
55 K_CHOICE = '.Choice'; 62 K_CHOICE = '.Choice';
  63 + K_LEFT = '.Left';
  64 + K_RESUME = '.Resume';
  65 + K_DATA_A = '.Data';
  66 + K_LOGIN = '.login';
  67 +
  68 + //
  69 + K_STATUS = '.Status';
  70 + K_CYCLES = '.OnCycleStart';
  71 +
56 //K_RESPONSE = 72 //K_RESPONSE =
57 73
58 implementation 74 implementation
@@ -82,26 +98,33 @@ end; @@ -82,26 +98,33 @@ end;
82 98
83 { TGameControl } 99 { TGameControl }
84 100
85 -function TGameControl.GetActorNicname(AID: string; Brackets: Boolean): string; 101 +function TGameControl.CanStartCycle: Boolean;
  102 +begin
  103 + Result := FExperiment.PlayersPlaying.Count = FExperiment.Condition[FExperiment.CurrentCondition].Turn.Value;
  104 +end;
  105 +
  106 +function TGameControl.GetPlayerBox(AID: string): TPlayerBox;
86 var i : integer; 107 var i : integer;
87 begin 108 begin
88 - if FExperiment.PlayersCount > -1 then  
89 - begin  
90 - for i:= 0 to FExperiment.PlayersCount do  
91 - if FExperiment.Player[i].ID = AID then  
92 - begin  
93 - if Brackets then  
94 - Result := '['+FExperiment.Player[i].Nicname+']'  
95 - else  
96 - Result := FExperiment.Player[i].Nicname;  
97 - Break;  
98 - end  
99 - end  
100 - else  
101 - begin  
102 - WriteLn('TGameControl.GetActorNicname:Using Harcoded Nicame');  
103 - Result := '[UNKNOWN]'; 109 + for i := 0 to FormMatrixGame.GBLastChoice.ComponentCount-1 do
  110 + if TPlayerBox(FormMatrixGame.GBLastChoice.Components[i]).ID = AID then
  111 + begin
  112 + Result := TPlayerBox(FormMatrixGame.GBLastChoice.Components[i]);
  113 + Break;
  114 + end;
  115 +end;
  116 +
  117 +function TGameControl.GetActorNicname(AID: string): string;
  118 +begin
  119 + case FActor of
  120 + gaPlayer: begin
  121 + Result := 'UNKNOWN';
  122 + if FExperiment.Player[AID].ID <> '' then
  123 + Result := FExperiment.Player[AID].Nicname;
104 end; 124 end;
  125 +
  126 + gaAdmin: Result := FExperiment.Researcher;
  127 + end;
105 end; 128 end;
106 129
107 function TGameControl.MessageHas(const A_CONST: string; AMessage: TStringList): Boolean; 130 function TGameControl.MessageHas(const A_CONST: string; AMessage: TStringList): Boolean;
@@ -185,12 +208,18 @@ begin @@ -185,12 +208,18 @@ begin
185 FRowBase:=AValue; 208 FRowBase:=AValue;
186 end; 209 end;
187 210
188 -constructor TGameControl.Create(AZMQActor: TZMQActor); 211 +procedure TGameControl.SendSystemMessage(AMessage: array of UTF8String);
  212 +begin
  213 + TZMQAdmin(FZMQActor).SendMessage(AMessage);
  214 +end;
  215 +
  216 +constructor TGameControl.Create(AZMQActor: TZMQActor; AID: string);
189 begin 217 begin
190 inherited Create(AZMQActor.Owner); 218 inherited Create(AZMQActor.Owner);
191 FZMQActor := AZMQActor; 219 FZMQActor := AZMQActor;
192 - FZMQActor.SetID(ID);  
193 FZMQActor.OnMessageReceived:=@ReceiveMessage; 220 FZMQActor.OnMessageReceived:=@ReceiveMessage;
  221 + FZMQActor.OnRequestReceived:=@ReceiveRequest;
  222 + FZMQActor.OnReplyReceived:=@ReceiveReply;
194 FZMQActor.Start; 223 FZMQActor.Start;
195 224
196 if FZMQActor.ClassType = TZMQAdmin then 225 if FZMQActor.ClassType = TZMQAdmin then
@@ -204,16 +233,11 @@ begin @@ -204,16 +233,11 @@ begin
204 MustDrawDots:=False; 233 MustDrawDots:=False;
205 MustDrawDotsClear:=False; 234 MustDrawDotsClear:=False;
206 235
207 - {$IFDEF DEBUG}  
208 - case FActor of  
209 - gaAdmin:begin  
210 - FExperiment := TExperiment.Create(AZMQActor.Owner);  
211 - end;  
212 - gaPlayer:begin 236 + FZMQActor.SetID(AID);
  237 + FID := AID;
213 238
214 - end;  
215 - end;  
216 - {$ENDIF} 239 + FExperiment := TExperiment.Create(AZMQActor.Owner);
  240 + SendRequest(K_LOGIN);
217 end; 241 end;
218 242
219 destructor TGameControl.Destroy; 243 destructor TGameControl.Destroy;
@@ -221,11 +245,17 @@ begin @@ -221,11 +245,17 @@ begin
221 inherited Destroy; 245 inherited Destroy;
222 end; 246 end;
223 247
224 -procedure TGameControl.SetID(S: string); 248 +procedure TGameControl.SetMatrix;
225 begin 249 begin
226 - FID := S; 250 + SetMatrixType(FormMatrixGame.StringGridMatrix, FExperiment.MatrixType,FRowBase,FMustDrawDots,FMustDrawDotsClear);
  251 +end;
  252 +
  253 +procedure TGameControl.SendRequest(ARequest: UTF8string);
  254 +begin
  255 +
227 end; 256 end;
228 257
  258 +
229 procedure TGameControl.SendMessage(AMessage: UTF8string); 259 procedure TGameControl.SendMessage(AMessage: UTF8string);
230 var 260 var
231 {$IFDEF DEBUG} 261 {$IFDEF DEBUG}
@@ -246,6 +276,8 @@ begin @@ -246,6 +276,8 @@ begin
246 K_ARRIVED : SetM([ 276 K_ARRIVED : SetM([
247 AMessage 277 AMessage
248 , FZMQActor.ID 278 , FZMQActor.ID
  279 + //, FZMQActor.ClassType.ClassName;
  280 + //,
249 ]); 281 ]);
250 282
251 K_CHOICE : SetM([ 283 K_CHOICE : SetM([
@@ -255,28 +287,37 @@ begin @@ -255,28 +287,37 @@ begin
255 , GetSelectedColorF(FormMatrixGame.StringGridMatrix) 287 , GetSelectedColorF(FormMatrixGame.StringGridMatrix)
256 ]); 288 ]);
257 289
258 - K_CHAT_M : SetM([ 290 + K_CHAT_M : begin
  291 + //if (FActor = gaAdmin) and (not FExperiment.ResearcherCanChat) then Exit;
  292 + SetM([
  293 + AMessage
  294 + , GetActorNicname(FZMQActor.ID)
  295 + , FormMatrixGame.ChatMemoSend.Lines.Text
  296 + ]);
  297 + end;
  298 +
  299 + K_LEFT : SetM([
259 AMessage 300 AMessage
260 - , GetActorNicname(FZMQActor.ID, True)  
261 - , FormMatrixGame.ChatMemoSend.Lines.Text 301 + , FZMQActor.ID
262 ]); 302 ]);
263 303
  304 + K_RESUME : SetM([
  305 + AMessage
  306 + , FZMQActor.ID
  307 + ]);
264 end; 308 end;
265 309
266 case FActor of 310 case FActor of
267 gaAdmin: begin 311 gaAdmin: begin
268 - if not FExperiment.ResearcherCanChat then Exit;  
269 M[0] := GA_ADMIN+M[0]; 312 M[0] := GA_ADMIN+M[0];
270 - TZMQAdmin(FZMQActor).SendMessage(M);  
271 end; 313 end;
272 gaPlayer:begin 314 gaPlayer:begin
273 M[0] := GA_PLAYER+M[0]; 315 M[0] := GA_PLAYER+M[0];
274 - TZMQPlayer(FZMQActor).SendMessage(M);  
275 end; 316 end;
276 - //gaWatcher:begin // Cannot SendMessages 317 + //gaWatcher:begin // for now cannot SendMessages
277 // M[0] := GA_WATCHER+M[0]; 318 // M[0] := GA_WATCHER+M[0];
278 - // TZMQWatcher(FZMQActor).SendMessage(M);  
279 end; 319 end;
  320 + FZMQActor.SendMessage(M);
280 321
281 {$IFDEF DEBUG} 322 {$IFDEF DEBUG}
282 for i := 0 to Length(M)-1 do 323 for i := 0 to Length(M)-1 do
@@ -292,20 +333,115 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList); @@ -292,20 +333,115 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
292 end; 333 end;
293 334
294 procedure ReceiveActor; 335 procedure ReceiveActor;
295 - var Data: TStringList; 336 + var i : integer;
  337 + P : TPlayer;
296 begin 338 begin
297 - Data := TStringList.Create;  
298 - try  
299 - WriteLn('arrived'); 339 + //if FExperiment.PlayerIsPlaying[AMessage[1]] then Exit;
  340 + //if FExperiment.PlayersPlaying.Count < FExperiment.Condition[FExperiment.CurrentCondition].Turn.Value then
  341 + // begin
  342 + // if FExperiment.GenPlayersAsNeeded then
  343 + // if FExperiment.PlayerFromID[AMessage[1]].ID = '' then
  344 + // begin
  345 + // TPlayerBox.Create(FormMatrixGame.GBLastChoice,AMessage[1]).Parent := FormMatrixGame.GBLastChoice;
  346 + // i := FExperiment.AppendPlayer;
  347 + // end;
  348 + //
  349 + // case FActor of
  350 + // gaPlayer:begin
  351 + // // nothing special
  352 + // end;
  353 + //
  354 + // gaAdmin:begin
  355 + // P.ID := AMessage[1];
  356 + // P.Nicname := GenResourceName(i);
  357 + // P.Turn := FExperiment.NextTurn;
  358 + // FExperiment.Player[i] := P;
  359 + //
  360 + // with GetPlayerBox(P.ID) do
  361 + // begin
  362 + // ID := P.ID;
  363 + // if FExperiment.PlayerFromID[ID].ID <> '' then
  364 + // begin
  365 + // Caption := FExperiment.PlayerFromID[ID].Nicname;
  366 + // Parent := FormMatrixGame.GBLastChoice;
  367 + // SendSystemMessage([ // here we need to use admin as a repeater/switch, because it is acting as a resource generator
  368 + // GA_ADMIN+K_STATUS
  369 + // , ID
  370 + // , Caption
  371 + // , IntToStr(P.Turn)
  372 + // , IntToStr(i)
  373 + // ]);
  374 + // end;
  375 + // end;
  376 + // end;
  377 + // end;
  378 + // end
  379 + //else
  380 + // WriteLn('Room is full, Player must wait someone''s leaving.');
  381 +end;
300 382
301 - finally  
302 - Data.Free;  
303 - end; 383 +
  384 + procedure ReceiveStatus;
  385 + var P : PPlayer;
  386 + i : integer;
  387 + begin
  388 + //P := New(PPlayer);
  389 + //case FActor of
  390 + // gaPlayer:begin
  391 + // with P^ do
  392 + // begin // local asignment of the admin's generated data
  393 + // ID := AMessage[1];
  394 + // Nicname:=AMessage[2];
  395 + // Turn:= StrToInt(AMessage[3]);
  396 + // end;
  397 + // i := StrToInt(AMessage[4]);
  398 + // FExperiment.Player[i] := P^;
  399 + // with GetPlayerBox(P^.ID) do
  400 + // begin
  401 + // if Self.ID = ID then
  402 + // begin
  403 + // Caption := P^.Nicname + ' (Você)';
  404 + // WriteLn(P^.Nicname +' Said: I am ready.');
  405 + // end
  406 + // else
  407 + // begin
  408 + // Caption := P^.Nicname;
  409 + // WriteLn(Self.ID +' said '+ P^.Nicname +' is ready.');
  410 + // end;
  411 + // Enabled := True;
  412 + // end;
  413 + //
  414 + // end;
  415 + //
  416 + // gaAdmin:begin
  417 + // P^ := FExperiment.PlayerFromID[AMessage[1]];
  418 + // // turns by entrance order
  419 + // //P^.Turn := FExperiment.PlayersPlaying.Count;
  420 + // FExperiment.PlayersPlaying.Add(P);
  421 + // with GetPlayerBox(AMessage[1]) do
  422 + // Enabled := True;
  423 + //
  424 + // WriteLn(AMessage[2]+' is ready.');
  425 + // if CanStartCycle then
  426 + // SendSystemMessage([
  427 + // GA_ADMIN+K_CYCLES
  428 + // , FExperiment.NextTurnPlayerID
  429 + // ]);
  430 + // end;
  431 + //end;
  432 + //Dispose(P);
304 end; 433 end;
305 434
306 procedure ReceiveChoice; 435 procedure ReceiveChoice;
307 begin 436 begin
  437 + case FActor of
  438 + gaPlayer:begin
308 439
  440 + end;
  441 + gaAdmin:begin
  442 +
  443 + end;
  444 + end;
309 end; 445 end;
310 446
311 procedure ReceiveChat; 447 procedure ReceiveChat;
@@ -313,20 +449,75 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList); @@ -313,20 +449,75 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
313 FormMatrixGame.ChatMemoRecv.Lines.Append(('['+AMessage[1]+']: ')+AMessage[2]); 449 FormMatrixGame.ChatMemoRecv.Lines.Append(('['+AMessage[1]+']: ')+AMessage[2]);
314 end; 450 end;
315 451
  452 + procedure SayGoodBye;
  453 + begin
  454 + case FActor of
  455 + gaPlayer:begin
  456 +
  457 + end;
  458 + gaAdmin:begin
  459 +
  460 + end;
  461 + end;
  462 + WriteLn('Good Bye');
  463 + end;
  464 +
  465 + procedure ResumeActor;
  466 + begin
  467 + case FActor of
  468 + gaPlayer:begin
  469 +
  470 + end;
  471 + gaAdmin:begin
  472 +
  473 + end;
  474 + end;
  475 + WriteLn('Resumed.');
  476 + end;
  477 +
316 procedure ReceiveLogin; 478 procedure ReceiveLogin;
317 begin 479 begin
  480 + case FActor of
  481 + gaPlayer:begin
  482 +
  483 + end;
  484 + gaAdmin:begin
  485 +
  486 + end;
  487 + end;
318 WriteLn('login'); 488 WriteLn('login');
319 end; 489 end;
320 490
321 procedure ReceiveLogout; 491 procedure ReceiveLogout;
322 begin 492 begin
  493 + case FActor of
  494 + gaPlayer:begin
  495 +
  496 + end;
  497 + gaAdmin:begin
  498 +
  499 + end;
  500 + end;
323 WriteLn('logout'); 501 WriteLn('logout');
324 end; 502 end;
325 503
326 begin 504 begin
327 if MHas(K_ARRIVED) then ReceiveActor; 505 if MHas(K_ARRIVED) then ReceiveActor;
328 - if MHas(K_CHAT_M) then ReceiveChat;  
329 - if MHas(K_CHOICE) then ReceiveChoice; 506 + if MHas(K_CHAT_M) then ReceiveChat;
  507 + if MHas(K_CHOICE) then ReceiveChoice;
  508 + if MHas(K_LEFT) then SayGoodBye;
  509 + if MHas(K_RESUME) then ResumeActor;
  510 + if MHas(K_STATUS) then ReceiveStatus;
  511 +end;
  512 +
  513 +procedure TGameControl.ReceiveRequest(var ARequest: TStringList);
  514 +begin
  515 +
  516 +end;
  517 +
  518 +procedure TGameControl.ReceiveReply(AReply: TStringList);
  519 +begin
  520 +
330 end; 521 end;
331 522
332 end. 523 end.
units/game_experiment.pas
  Diff comments   View file @75cde9c
@@ -31,19 +31,26 @@ type @@ -31,19 +31,26 @@ type
31 FCurrentCondition : integer; 31 FCurrentCondition : integer;
32 FConditions : TConditions; 32 FConditions : TConditions;
33 FResearcherCanChat: Boolean; 33 FResearcherCanChat: Boolean;
  34 + FResearcherCanPlay: Boolean;
34 FShowChat: Boolean; 35 FShowChat: Boolean;
35 function GetCondition(I : Integer): TCondition; 36 function GetCondition(I : Integer): TCondition;
36 function GetConditionsCount: integer; 37 function GetConditionsCount: integer;
37 function GetContingency(ACondition, I : integer): TContingency; 38 function GetContingency(ACondition, I : integer): TContingency;
38 - function GetPlayer(I : integer): TPlayer; 39 + function GetNextTurn: integer;
  40 + function GetNextTurnPlayerID: UTF8string;
  41 + function GetPlayer(I : integer): TPlayer; overload;
  42 + function GetPlayer(AID : string): TPlayer; overload;
  43 + function GetPlayerIsPlaying(AID : string): Boolean;
39 function GetPlayersCount: integer; 44 function GetPlayersCount: integer;
40 function GetPlayersPlaying: TList; 45 function GetPlayersPlaying: TList;
41 procedure SetCondition(I : Integer; AValue: TCondition); 46 procedure SetCondition(I : Integer; AValue: TCondition);
42 procedure SetContingency(ACondition, I : integer; AValue: TContingency); 47 procedure SetContingency(ACondition, I : integer; AValue: TContingency);
43 procedure SetMatrixType(AValue: TGameMatrixType); 48 procedure SetMatrixType(AValue: TGameMatrixType);
44 - procedure SetPlayer(I : integer; AValue: TPlayer); 49 + procedure SetPlayer(I : integer; AValue: TPlayer); overload;
  50 + procedure SetPlayer(S : string ; AValue: TPlayer); overload;
45 procedure SetPlayersPlaying(AValue: TList); 51 procedure SetPlayersPlaying(AValue: TList);
46 procedure SetResearcherCanChat(AValue: Boolean); 52 procedure SetResearcherCanChat(AValue: Boolean);
  53 + procedure SetResearcherCanPlay(AValue: Boolean);
47 public 54 public
48 constructor Create(AOwner:TComponent);override; 55 constructor Create(AOwner:TComponent);override;
49 constructor Create(AFilename: string; AOwner:TComponent); overload; 56 constructor Create(AFilename: string; AOwner:TComponent); overload;
@@ -58,7 +65,8 @@ type @@ -58,7 +65,8 @@ type
58 function AppendPlayer(APlayer : TPlayer) : integer; overload; 65 function AppendPlayer(APlayer : TPlayer) : integer; overload;
59 procedure SaveToFile(AFilename: string); overload; 66 procedure SaveToFile(AFilename: string); overload;
60 procedure SaveToFile; overload; 67 procedure SaveToFile; overload;
61 - property ResearcherCanChat : Boolean read FResearcherCanChat write SetResearcherCanChat ; 68 + property ResearcherCanPlay : Boolean read FResearcherCanPlay write SetResearcherCanPlay;
  69 + property ResearcherCanChat : Boolean read FResearcherCanChat write SetResearcherCanChat;
62 property Researcher : string read FResearcher write FResearcher; 70 property Researcher : string read FResearcher write FResearcher;
63 property Condition[I : Integer]: TCondition read GetCondition write SetCondition; 71 property Condition[I : Integer]: TCondition read GetCondition write SetCondition;
64 property ConditionsCount : integer read GetConditionsCount; 72 property ConditionsCount : integer read GetConditionsCount;
@@ -68,10 +76,14 @@ type @@ -68,10 +76,14 @@ type
68 property ExperimentName : string read FExperimentName write FExperimentName; 76 property ExperimentName : string read FExperimentName write FExperimentName;
69 property GenPlayersAsNeeded : Boolean read FGenPlayersAsNeeded write FGenPlayersAsNeeded; 77 property GenPlayersAsNeeded : Boolean read FGenPlayersAsNeeded write FGenPlayersAsNeeded;
70 property Player[I : integer] : TPlayer read GetPlayer write SetPlayer; 78 property Player[I : integer] : TPlayer read GetPlayer write SetPlayer;
  79 + property PlayerFromID[S : string ] : TPlayer read GetPlayer write SetPlayer;
71 property PlayersCount : integer read GetPlayersCount; // how many players per turn? 80 property PlayersCount : integer read GetPlayersCount; // how many players per turn?
72 property PlayersPlaying : TList read GetPlayersPlaying write SetPlayersPlaying; // how many players are playing? 81 property PlayersPlaying : TList read GetPlayersPlaying write SetPlayersPlaying; // how many players are playing?
  82 + property PlayerIsPlaying[s : string] : Boolean read GetPlayerIsPlaying; // is
73 property ShowChat : Boolean read FShowChat write FShowChat; 83 property ShowChat : Boolean read FShowChat write FShowChat;
74 property MatrixType : TGameMatrixType read FMatrixType write SetMatrixType; 84 property MatrixType : TGameMatrixType read FMatrixType write SetMatrixType;
  85 + property NextTurnPlayerID : UTF8string read GetNextTurnPlayerID;
  86 + property NextTurn : integer read GetNextTurn;
75 end; 87 end;
76 88
77 resourcestring 89 resourcestring
@@ -98,17 +110,59 @@ begin @@ -98,17 +110,59 @@ begin
98 Result := FConditions[ACondition].Contingencies[I]; 110 Result := FConditions[ACondition].Contingencies[I];
99 end; 111 end;
100 112
  113 +function TExperiment.GetNextTurn: integer; // used during player arriving
  114 +begin
  115 + Result := FConditions[CurrentCondition].Turn.Count;
  116 + if FConditions[CurrentCondition].Turn.Count = FConditions[CurrentCondition].Turn.Value then
  117 + FConditions[CurrentCondition].Turn.Count := 0
  118 + else Inc(FConditions[CurrentCondition].Turn.Count);
  119 +end;
  120 +
  121 +function TExperiment.GetNextTurnPlayerID: UTF8string; // used during cycles
  122 +var
  123 + P : PPlayer;
  124 +begin
  125 + Result := '';
  126 + P := New(PPlayer);
  127 + P := PlayersPlaying[FConditions[CurrentCondition].Turn.Count];
  128 + Result := P^.ID;
  129 + GetNextTurn;
  130 + Dispose(P);
  131 +end;
  132 +
101 function TExperiment.GetPlayer(I : integer): TPlayer; 133 function TExperiment.GetPlayer(I : integer): TPlayer;
102 begin 134 begin
103 Result := FPlayers[i]; 135 Result := FPlayers[i];
104 end; 136 end;
105 137
  138 +function TExperiment.GetPlayer(AID: string): TPlayer;
  139 +var
  140 + i : integer;
  141 +begin
  142 + Result.ID := '';
  143 + if PlayersCount > 0 then
  144 + for i:= 0 to PlayersCount do
  145 + if FPlayers[i].ID = AID then
  146 + begin
  147 + Result := FPlayers[i];
  148 + Break;
  149 + end;
  150 +end;
  151 +
  152 +function TExperiment.GetPlayerIsPlaying(AID: string): Boolean;
  153 +var i : integer;
  154 +begin
  155 + Result := PlayersPlaying.Count > 0;
  156 + if Result then
  157 + for i := 0 to PlayersPlaying.Count -1 do
  158 + if PPlayer(PlayersPlaying[i])^.ID = AID then
  159 + Exit;
  160 + Result:= False;
  161 +end;
  162 +
106 function TExperiment.GetPlayersCount: integer; 163 function TExperiment.GetPlayersCount: integer;
107 begin 164 begin
108 - if Length(FPlayers) = 0 then  
109 - Result := High(FPlayers)  
110 - else  
111 - Result := -1; 165 + Result := Length(FPlayers)
112 end; 166 end;
113 167
114 function TExperiment.GetPlayersPlaying: TList; 168 function TExperiment.GetPlayersPlaying: TList;
@@ -116,31 +170,28 @@ var @@ -116,31 +170,28 @@ var
116 i:integer; 170 i:integer;
117 P:PPlayer; 171 P:PPlayer;
118 begin 172 begin
  173 + P := New(PPlayer);
119 if FPlayersPlaying.Count > 0 then 174 if FPlayersPlaying.Count > 0 then
120 FPlayersPlaying.Clear; 175 FPlayersPlaying.Clear;
121 176
122 for i := Low(FPlayers) to High(FPlayers) do 177 for i := Low(FPlayers) to High(FPlayers) do
123 - if Player[i].Status = gpsPlaying then 178 + if FPlayers[i].Status = gpsPlaying then
124 begin 179 begin
125 - P := nil;  
126 - P^ := Player[i]; 180 + P := @FPlayers[i];
127 FPlayersPlaying.Add(P); 181 FPlayersPlaying.Add(P);
128 end; 182 end;
129 - 183 + Dispose(P);
130 Result := FPlayersPlaying; 184 Result := FPlayersPlaying;
131 end; 185 end;
132 186
133 procedure TExperiment.SetCondition(I : Integer; AValue: TCondition); 187 procedure TExperiment.SetCondition(I : Integer; AValue: TCondition);
134 begin 188 begin
135 - if (I >= Low(FConditions)) and (I <= High(FConditions)) then  
136 - FConditions[I] := AValue; 189 + FConditions[I] := AValue;
137 end; 190 end;
138 191
139 procedure TExperiment.SetContingency(ACondition, I : integer; AValue: TContingency); 192 procedure TExperiment.SetContingency(ACondition, I : integer; AValue: TContingency);
140 begin 193 begin
141 - if (ACondition >= Low(FConditions)) and (ACondition <= High(FConditions)) then  
142 - if (I >= Low(FConditions[ACondition].Contingencies)) and (I <= High(FConditions[ACondition].Contingencies)) then  
143 - FConditions[ACondition].Contingencies[I] := AValue; 194 + FConditions[ACondition].Contingencies[I] := AValue;
144 end; 195 end;
145 196
146 procedure TExperiment.SetMatrixType(AValue: TGameMatrixType); 197 procedure TExperiment.SetMatrixType(AValue: TGameMatrixType);
@@ -152,8 +203,20 @@ end; @@ -152,8 +203,20 @@ end;
152 203
153 procedure TExperiment.SetPlayer(I : integer; AValue: TPlayer); 204 procedure TExperiment.SetPlayer(I : integer; AValue: TPlayer);
154 begin 205 begin
155 - if (I >= Low(FPlayers)) and (I <= High(FPlayers)) then  
156 - FPlayers[I] := AValue; 206 + FPlayers[I] := AValue;
  207 +end;
  208 +
  209 +procedure TExperiment.SetPlayer(S : string ; AValue: TPlayer);
  210 +var i : integer;
  211 +begin
  212 + if PlayersCount > 0 then
  213 + for i:= 0 to PlayersCount do
  214 + if FPlayers[i].ID = S then
  215 + begin
  216 + FPlayers[i] := AValue;
  217 + Exit;
  218 + end;
  219 + raise Exception.Create('TExperiment.SetPlayer: Could not set player.');
157 end; 220 end;
158 221
159 procedure TExperiment.SetPlayersPlaying(AValue: TList); 222 procedure TExperiment.SetPlayersPlaying(AValue: TList);
@@ -168,6 +231,12 @@ begin @@ -168,6 +231,12 @@ begin
168 FResearcherCanChat:=AValue; 231 FResearcherCanChat:=AValue;
169 end; 232 end;
170 233
  234 +procedure TExperiment.SetResearcherCanPlay(AValue: Boolean);
  235 +begin
  236 + if FResearcherCanPlay=AValue then Exit;
  237 + FResearcherCanPlay:=AValue;
  238 +end;
  239 +
171 constructor TExperiment.Create(AOwner: TComponent); 240 constructor TExperiment.Create(AOwner: TComponent);
172 begin 241 begin
173 inherited Create(AOwner); 242 inherited Create(AOwner);
@@ -231,7 +300,7 @@ end; @@ -231,7 +300,7 @@ end;
231 function TExperiment.AppendPlayer: integer; 300 function TExperiment.AppendPlayer: integer;
232 begin 301 begin
233 SetLength(FPlayers, Length(FPlayers)+1); 302 SetLength(FPlayers, Length(FPlayers)+1);
234 - Result := Length(FPlayers)-1; 303 + Result := High(FPlayers);
235 end; 304 end;
236 305
237 function TExperiment.AppendPlayer(APlayer: TPlayer): integer; 306 function TExperiment.AppendPlayer(APlayer: TPlayer): integer;
units/game_file_methods.pas
  Diff comments   View file @75cde9c
@@ -39,19 +39,21 @@ begin @@ -39,19 +39,21 @@ begin
39 with AExperiment do 39 with AExperiment do
40 begin 40 begin
41 Researcher := VAL_RESEARCHER; 41 Researcher := VAL_RESEARCHER;
  42 + ResearcherCanPlay:=False;
42 ResearcherCanChat:=True; 43 ResearcherCanChat:=True;
43 ExperimentName:='Test Experiment'; 44 ExperimentName:='Test Experiment';
44 ExperimentAim:='This is a test experiment.'; 45 ExperimentAim:='This is a test experiment.';
45 GenPlayersAsNeeded:=True; 46 GenPlayersAsNeeded:=True;
46 CurrentCondition := 0; 47 CurrentCondition := 0;
47 - AppendPlayer(C_PLAYER_TEMPLATE);  
48 - AppendPlayer(C_PLAYER_TEMPLATE); 48 + MatrixType:=[gmRows];
  49 + //AppendPlayer(C_PLAYER_TEMPLATE);
  50 + //AppendPlayer(C_PLAYER_TEMPLATE);
49 i := AppendCondition(C_CONDITION_TEMPLATE); 51 i := AppendCondition(C_CONDITION_TEMPLATE);
50 with Condition[i] do 52 with Condition[i] do
51 begin 53 begin
52 ConditionName := SEC_CONDITION+IntToStr(i+1); 54 ConditionName := SEC_CONDITION+IntToStr(i+1);
53 Turn.Count:=0; 55 Turn.Count:=0;
54 - Turn.Value:=0; 56 + Turn.Value:=2;
55 Turn.Random:=False; 57 Turn.Random:=False;
56 end; 58 end;
57 //j := AppendContingency(i,C_METACONTINGENCY_A1); 59 //j := AppendContingency(i,C_METACONTINGENCY_A1);
units/game_resources.pas
  Diff comments   View file @75cde9c
@@ -74,10 +74,10 @@ resourcestring @@ -74,10 +74,10 @@ resourcestring
74 const 74 const
75 75
76 CPlayerNamesMale : array [0..49] of UTF8String = 76 CPlayerNamesMale : array [0..49] of UTF8String =
77 - ('João','Rodrigo','Francisco','Martim','Santiago', 77 + ('Junho','Rodrigo','Francisco','Martim','Santiago',
78 'Tomás','Afonso','Duarte','Miguel','Guilherme','Tiago', 78 'Tomás','Afonso','Duarte','Miguel','Guilherme','Tiago',
79 'Gonçalo','Diogo','Gabriel','Pedro','Rafael','Salvador', 79 'Gonçalo','Diogo','Gabriel','Pedro','Rafael','Salvador',
80 - 'Dinis','Lucas','Simão','Gustavo','David', 80 + 'Dinis','Lucas','Simael','Gustavo','David',
81 'José','Vicente','Lourenço','Diego','Daniel', 81 'José','Vicente','Lourenço','Diego','Daniel',
82 'António','André','Vasco','Manuel','Henrique', 82 'António','André','Vasco','Manuel','Henrique',
83 'Leonardo','Bernardo','Mateus','Luís','Eduardo', 83 'Leonardo','Bernardo','Mateus','Luís','Eduardo',
units/game_zmq_actors.pas
  Diff comments   View file @75cde9c
@@ -12,23 +12,27 @@ uses @@ -12,23 +12,27 @@ uses
12 12
13 type 13 type
14 14
15 - // Everything sent is received by everybody connected.  
16 -  
17 { TZMQActor } 15 { TZMQActor }
18 16
19 TZMQActor = class(TComponent) 17 TZMQActor = class(TComponent)
20 private 18 private
21 FID: UTF8string; 19 FID: UTF8string;
22 - FSubscriber: TZMQPollThread;  
23 FOnMessageReceived : TMessRecvProc; 20 FOnMessageReceived : TMessRecvProc;
  21 + FOnReplyReceived: TMessRecvProc;
  22 + FOnRequestReceived: TReqRecvProc;
24 protected 23 protected
25 procedure MessageReceived(AMultipartMessage : TStringList); 24 procedure MessageReceived(AMultipartMessage : TStringList);
  25 + procedure ReplyReceived(AMultipartMessage : TStringList); virtual;
  26 + procedure RequestReceived(var AMultipartMessage : TStringList); virtual;
26 public 27 public
27 constructor Create(AOwner : TComponent); override; 28 constructor Create(AOwner : TComponent); override;
28 - destructor Destroy; override;  
29 procedure Start; virtual; 29 procedure Start; virtual;
30 - procedure SetID(S:string); 30 + procedure SetID(S:string); virtual;
  31 + procedure SendMessage(AMessage : array of UTF8string);virtual;abstract;
  32 + procedure Request(ARequest : array of UTF8string);virtual;abstract;
31 property OnMessageReceived : TMessRecvProc read FOnMessageReceived write FOnMessageReceived; 33 property OnMessageReceived : TMessRecvProc read FOnMessageReceived write FOnMessageReceived;
  34 + property OnRequestReceived : TReqRecvProc read FOnRequestReceived write FOnRequestReceived;
  35 + property OnReplyReceived : TMessRecvProc read FOnReplyReceived write FOnReplyReceived;
32 property ID : UTF8string read FID; 36 property ID : UTF8string read FID;
33 end; 37 end;
34 38
@@ -36,23 +40,30 @@ type @@ -36,23 +40,30 @@ type
36 40
37 TZMQPlayer = class(TZMQActor) 41 TZMQPlayer = class(TZMQActor)
38 private 42 private
39 - FPusher : TZMQPusher; 43 + FZMQClient : TZMQClientThread;
  44 + protected
  45 + procedure ReplyReceived(AMultipartMessage: TStringList); override;
40 public 46 public
41 constructor Create(AOwner : TComponent); override; 47 constructor Create(AOwner : TComponent); override;
42 destructor Destroy; override; 48 destructor Destroy; override;
43 procedure Start; override; 49 procedure Start; override;
44 - procedure SendMessage(AMessage : array of UTF8string); 50 + procedure SendMessage(AMessage : array of UTF8string); override;
  51 + procedure Request(ARequest : array of UTF8string);override;
45 end; 52 end;
46 53
47 { TZMQAdmin } 54 { TZMQAdmin }
48 55
49 - TZMQAdmin = class(TZMQPlayer) 56 + TZMQAdmin = class(TZMQActor)
50 private 57 private
51 - FPublisher : TZMQPubThread; 58 + FZMQServer : TZMQServerThread;
  59 + protected
  60 + procedure RequestReceived(var AMultipartMessage: TStringList); override;
52 public 61 public
53 constructor Create(AOwner : TComponent); override; 62 constructor Create(AOwner : TComponent); override;
54 destructor Destroy; override; 63 destructor Destroy; override;
55 procedure Start; override; 64 procedure Start; override;
  65 + procedure SendMessage(AMessage: array of UTF8string); override;
  66 + procedure Request(ARequest: array of UTF8string); override;
56 end; 67 end;
57 68
58 { TZMQWatcher } 69 { TZMQWatcher }
@@ -68,7 +79,6 @@ implementation @@ -68,7 +79,6 @@ implementation
68 79
69 procedure TZMQWatcher.Start; 80 procedure TZMQWatcher.Start;
70 begin 81 begin
71 - AbstractError;  
72 inherited Start; 82 inherited Start;
73 WriteLn('TZMQWatcher.Start'); 83 WriteLn('TZMQWatcher.Start');
74 end; 84 end;
@@ -77,20 +87,36 @@ end; @@ -77,20 +87,36 @@ end;
77 87
78 constructor TZMQAdmin.Create(AOwner: TComponent); 88 constructor TZMQAdmin.Create(AOwner: TComponent);
79 begin 89 begin
80 - FPublisher := TZMQPubThread.Create;  
81 inherited Create(AOwner); 90 inherited Create(AOwner);
  91 + FZMQServer := TZMQServerThread.Create;
  92 + FZMQServer.OnMessageReceived:=@MessageReceived;
  93 + FZMQServer.OnRequestReceived:=@RequestReceived;
82 end; 94 end;
83 95
84 destructor TZMQAdmin.Destroy; 96 destructor TZMQAdmin.Destroy;
85 begin 97 begin
86 - FPublisher.Terminate; 98 + FZMQServer.Terminate;
87 inherited Destroy; 99 inherited Destroy;
88 end; 100 end;
89 101
  102 +procedure TZMQAdmin.SendMessage(AMessage: array of UTF8string);
  103 +begin
  104 + FZMQServer.Push(AMessage);
  105 +end;
  106 +
  107 +procedure TZMQAdmin.Request(ARequest: array of UTF8string);
  108 +begin
  109 + // do nothing, you are the server
  110 +end;
  111 +
  112 +procedure TZMQAdmin.RequestReceived(var AMultipartMessage: TStringList);
  113 +begin
  114 + if Assigned(FOnRequestReceived) then FOnRequestReceived(AMultipartMessage);
  115 +end;
  116 +
90 procedure TZMQAdmin.Start; 117 procedure TZMQAdmin.Start;
91 begin 118 begin
92 - FPublisher.Start;  
93 - inherited Start; 119 + FZMQServer.Start;
94 WriteLn('TZMQAdmin.Start'); 120 WriteLn('TZMQAdmin.Start');
95 end; 121 end;
96 122
@@ -98,24 +124,37 @@ end; @@ -98,24 +124,37 @@ end;
98 124
99 procedure TZMQPlayer.SendMessage(AMessage: array of UTF8string); 125 procedure TZMQPlayer.SendMessage(AMessage: array of UTF8string);
100 begin 126 begin
101 - FPusher.SendMessage(AMessage); 127 + FZMQClient.Push(AMessage);
  128 +end;
  129 +
  130 +procedure TZMQPlayer.Request(ARequest: array of UTF8string);
  131 +begin
  132 + FZMQClient.Request(ARequest);
  133 +end;
  134 +
  135 +procedure TZMQPlayer.ReplyReceived(AMultipartMessage: TStringList);
  136 +begin
  137 + if Assigned(FOnReplyReceived) then FOnReplyReceived(AMultipartMessage);
102 end; 138 end;
103 139
104 constructor TZMQPlayer.Create(AOwner: TComponent); 140 constructor TZMQPlayer.Create(AOwner: TComponent);
105 begin 141 begin
106 inherited Create(AOwner); 142 inherited Create(AOwner);
107 - FPusher := TZMQPusher.Create; 143 + FZMQClient := TZMQClientThread.Create;
  144 + FZMQClient.OnMessageReceived:=@MessageReceived;
  145 + FZMQClient.OnReplyReceived:=@ReplyReceived;
108 end; 146 end;
109 147
110 destructor TZMQPlayer.Destroy; 148 destructor TZMQPlayer.Destroy;
111 begin 149 begin
112 - FPusher.Free; 150 + FZMQClient.Terminate;
113 inherited Destroy; 151 inherited Destroy;
114 end; 152 end;
115 153
116 procedure TZMQPlayer.Start; 154 procedure TZMQPlayer.Start;
117 begin 155 begin
118 inherited Start; 156 inherited Start;
  157 + FZMQClient.Start;
119 WriteLn('TZMQPlayer.Start'); 158 WriteLn('TZMQPlayer.Start');
120 end; 159 end;
121 160
@@ -131,23 +170,23 @@ begin @@ -131,23 +170,23 @@ begin
131 if Assigned(FOnMessageReceived) then FOnMessageReceived(AMultipartMessage); 170 if Assigned(FOnMessageReceived) then FOnMessageReceived(AMultipartMessage);
132 end; 171 end;
133 172
134 -constructor TZMQActor.Create(AOwner: TComponent); 173 +procedure TZMQActor.ReplyReceived(AMultipartMessage: TStringList);
135 begin 174 begin
136 - inherited Create(AOwner);  
137 - FSubscriber := TZMQPollThread.Create;  
138 - FSubscriber.OnMessageReceived:=@MessageReceived; 175 + AbstractError;
139 end; 176 end;
140 177
141 -destructor TZMQActor.Destroy; 178 +procedure TZMQActor.RequestReceived(var AMultipartMessage: TStringList);
142 begin 179 begin
143 - OnMessageReceived := nil;  
144 - FSubscriber.Terminate;  
145 - inherited Destroy; 180 + AbstractError;
  181 +end;
  182 +
  183 +constructor TZMQActor.Create(AOwner: TComponent);
  184 +begin
  185 + inherited Create(AOwner);
146 end; 186 end;
147 187
148 procedure TZMQActor.Start; 188 procedure TZMQActor.Start;
149 begin 189 begin
150 - FSubscriber.Start;  
151 WriteLn('TZMQActor.Start'); 190 WriteLn('TZMQActor.Start');
152 end; 191 end;
153 192
units/zmq_network.pas
  Diff comments   View file @75cde9c
@@ -11,194 +11,286 @@ unit zmq_network; @@ -11,194 +11,286 @@ unit zmq_network;
11 11
12 {$mode objfpc}{$H+} 12 {$mode objfpc}{$H+}
13 13
  14 +{$DEFINE DEBUG}
  15 +
14 interface 16 interface
15 17
16 uses Classes, SysUtils, Process 18 uses Classes, SysUtils, Process
17 , zmqapi 19 , zmqapi
18 - //, zmq_client  
19 ; 20 ;
20 21
21 type 22 type
  23 + { TMessRecvProc }
22 24
23 - { TZMQPusher } 25 + TMessRecvProc = procedure(AResponse: TStringList) of object;
24 26
25 - TZMQPusher = class  
26 - private  
27 - FContext : TZMQContext;  
28 - FID: UTF8string;  
29 - FPusher : TZMQSocket;  
30 - public  
31 - constructor Create;  
32 - destructor Destroy; override;  
33 - procedure SendMessage(AMultipartMessage : array of UTF8string);  
34 - end; 27 + TReqRecvProc = procedure(var ARequest : TStringList) of object;
35 28
36 - { TZMQPubThread } 29 + { TZMQClientThread }
37 30
38 - TZMQPubThread = class(TThread) 31 + TZMQClientThread = class(TThread)
39 private 32 private
40 FContext : TZMQContext; 33 FContext : TZMQContext;
41 - FPublisher : TZMQSocket;  
42 - FPuller : TZMQSocket; 34 + FSubscriber,
  35 + FPusher,
  36 + FRequester : TZMQSocket;
  37 + FPoller : TZMQPoller;
  38 + FMessage : TStringList;
  39 + FOnReplyReceived: TMessRecvProc;
  40 + FOnMessageReceived: TMessRecvProc;
  41 + procedure MessageReceived;
43 protected 42 protected
44 procedure Execute; override; 43 procedure Execute; override;
45 public 44 public
46 constructor Create(CreateSuspended: Boolean = True); 45 constructor Create(CreateSuspended: Boolean = True);
47 destructor Destroy; override; 46 destructor Destroy; override;
  47 + procedure Request(AMultipartMessage : array of UTF8String);
  48 + procedure Push(AMultipartMessage : array of UTF8String);
  49 + property OnMessageReceived : TMessRecvProc read FOnMessageReceived write FOnMessageReceived;
  50 + property OnReplyReceived : TMessRecvProc read FOnReplyReceived write FOnReplyReceived;
48 end; 51 end;
49 52
50 - { TMessRecvProc }  
51 -  
52 - TMessRecvProc = procedure(AResponse: TStringList) of object;  
53 -  
54 - { TZMQPollThread } 53 + { TZMQServerThread }
55 54
56 - TZMQPollThread = class(TThread) 55 + TZMQServerThread = class(TThread)
57 private 56 private
58 - FMultipartMessage : TStringList; 57 + FOnMessageReceived: TMessRecvProc;
  58 + FOnRequestReceived: TReqRecvProc;
59 FContext : TZMQContext; 59 FContext : TZMQContext;
60 - FSubscriber : TZMQSocket; 60 + FPublisher,
  61 + FSubscriber,
  62 + FPuller,
  63 + FPusher,
  64 + FRouter,
  65 + FReplier : TZMQSocket;
61 FPoller : TZMQPoller; 66 FPoller : TZMQPoller;
62 - FOnMessageReceived: TMessRecvProc; 67 + FMessage : TStringList;
  68 + procedure Connect;
63 procedure MessageReceived; 69 procedure MessageReceived;
  70 + procedure RequestReceived;
64 protected 71 protected
65 procedure Execute; override; 72 procedure Execute; override;
66 public 73 public
67 constructor Create(CreateSuspended: Boolean = True); 74 constructor Create(CreateSuspended: Boolean = True);
68 destructor Destroy; override; 75 destructor Destroy; override;
  76 + procedure Push(AMultipartMessage: array of UTF8string);
69 property OnMessageReceived : TMessRecvProc read FOnMessageReceived write FOnMessageReceived; 77 property OnMessageReceived : TMessRecvProc read FOnMessageReceived write FOnMessageReceived;
  78 + property OnRequestReceived : TReqRecvProc read FOnRequestReceived write FOnRequestReceived;
70 end; 79 end;
71 80
72 -  
73 implementation 81 implementation
74 82
75 -{ TZMQSubscriber } 83 +const
  84 + CHost = 'tcp://*:';
  85 + CLocalHost = 'tcp://localhost:';
  86 + CPortPublisher = '5056';
  87 + CPortPuller = '5057';
  88 + CPortRouter = '5058';
  89 +
  90 +
  91 +{ TZMQClientThread }
  92 +
76 93
77 -procedure TZMQPollThread.MessageReceived; 94 +procedure TZMQClientThread.MessageReceived;
78 begin 95 begin
79 - if Assigned(OnMessageReceived) then OnMessageReceived(FMultipartMessage); 96 + if Assigned(FOnMessageReceived) then FOnMessageReceived(FMessage);
80 end; 97 end;
81 98
82 -procedure TZMQPollThread.Execute; 99 +procedure TZMQClientThread.Execute;
83 var 100 var
84 LMultipartMessage : TStringList; 101 LMultipartMessage : TStringList;
85 LPollEvent, 102 LPollEvent,
86 LMessagesCount : integer; 103 LMessagesCount : integer;
87 begin 104 begin
88 -{$IFDEF DEBUG}  
89 - WriteLn('SubThread.Execute');  
90 -{$ENDIF} 105 + LMultipartMessage := TStringList.Create;
91 while not Terminated do 106 while not Terminated do
92 begin 107 begin
  108 + LMultipartMessage.Clear;
93 LPollEvent := FPoller.poll(50000); 109 LPollEvent := FPoller.poll(50000);
94 if LPollEvent > 0 then 110 if LPollEvent > 0 then
95 begin 111 begin
96 - {$IFDEF DEBUG}  
97 - WriteLn('SubThread.Execute.PollMessageReceived');  
98 - {$ENDIF}  
99 - LMultipartMessage := TStringList.Create; 112 + WriteLn('Server4:FPoller:',FPoller.PollNumber);
100 LMessagesCount := FSubscriber.recv(LMultipartMessage); 113 LMessagesCount := FSubscriber.recv(LMultipartMessage);
101 if LMessagesCount > 0 then 114 if LMessagesCount > 0 then
102 - try  
103 - FMultipartMessage := LMultipartMessage; 115 + begin
  116 + FMessage := LMultipartMessage;
104 Synchronize(@MessageReceived); 117 Synchronize(@MessageReceived);
105 - finally  
106 - LMultipartMessage.Free;  
107 end; 118 end;
108 end; 119 end;
109 end; 120 end;
  121 + LMultipartMessage.Free;
110 end; 122 end;
111 123
112 -constructor TZMQPollThread.Create(CreateSuspended: Boolean); 124 +
  125 +constructor TZMQClientThread.Create(CreateSuspended: Boolean);
113 begin 126 begin
114 FreeOnTerminate := True; 127 FreeOnTerminate := True;
115 FContext := TZMQContext.create; 128 FContext := TZMQContext.create;
  129 +
  130 + // client subscribe to server, it receives from itself
116 FSubscriber := FContext.Socket( stSub ); 131 FSubscriber := FContext.Socket( stSub );
117 - FSubscriber.connect('tcp://localhost:5056');  
118 - FSubscriber.Subscribe(''); 132 + FSubscriber.connect(CLocalHost+CPortPublisher);FSubscriber.Subscribe('');
  133 + // pushes to server
  134 + FPusher := FContext.Socket( stPush );
  135 + FPusher.connect(CLocalHost+CPortPuller);
  136 +
  137 + // request from server
  138 + FRequester := FContext.Socket( stReq );
  139 + FRequester.connect(CLocalHost+CPortRouter);
119 140
  141 + // handle income messages
120 FPoller := TZMQPoller.Create(True, FContext); 142 FPoller := TZMQPoller.Create(True, FContext);
121 - // FPoller.onEvent := @PollerEvent; // async  
122 FPoller.Register(FSubscriber, [pePollIn], True); 143 FPoller.Register(FSubscriber, [pePollIn], True);
  144 +
123 inherited Create(CreateSuspended); 145 inherited Create(CreateSuspended);
124 end; 146 end;
125 147
126 -destructor TZMQPollThread.Destroy; 148 +destructor TZMQClientThread.Destroy;
127 begin 149 begin
128 - FContext.Free;  
129 FPoller.Terminate; 150 FPoller.Terminate;
130 FPoller.Free; 151 FPoller.Free;
  152 + FPusher.Free;
131 FSubscriber.Free; 153 FSubscriber.Free;
  154 + FContext.Free;
132 inherited Destroy; 155 inherited Destroy;
133 end; 156 end;
134 157
135 -{ TZmqPusher }  
136 -  
137 -constructor TZMQPusher.Create; 158 +procedure TZMQClientThread.Request(AMultipartMessage: array of UTF8String);
  159 +var AReply : TStringList;
138 begin 160 begin
139 - FContext := TZMQContext.create;  
140 - FPusher := FContext.Socket( stPush );  
141 - FPusher.connect('tcp://localhost:5057'); 161 + AReply:=TStringList.Create;
  162 + FRequester.send( AMultipartMessage );
  163 + FRequester.recv( AReply );
  164 + if Assigned(FOnReplyReceived) then FOnReplyReceived(AReply);
  165 + AReply.Free;
142 end; 166 end;
143 167
144 -destructor TZMQPusher.Destroy; 168 +procedure TZMQClientThread.Push(AMultipartMessage: array of UTF8String);
145 begin 169 begin
146 - FPusher.Free; // also can be freed by freeing the context  
147 - FContext.Free;  
148 - inherited Destroy; 170 + FPusher.send(AMultipartMessage);
149 end; 171 end;
150 172
151 -procedure TZMQPusher.SendMessage(AMultipartMessage: array of UTF8string); 173 +
  174 +
  175 +{ TZMQServerThread }
  176 +
  177 +
  178 +
  179 +procedure TZMQServerThread.Connect;
152 begin 180 begin
153 - FPusher.send(AMultipartMessage); 181 + {$IFDEF DEBUG}
  182 + WriteLn('TZMQServerThread.Started');
  183 + {$ENDIF}
154 end; 184 end;
155 185
  186 +procedure TZMQServerThread.MessageReceived;
  187 +begin
  188 + if Assigned(FOnMessageReceived) then FOnMessageReceived(FMessage);
  189 +end;
156 190
  191 +procedure TZMQServerThread.RequestReceived;
  192 +begin
  193 + if Assigned(FOnMessageReceived) then FOnMessageReceived(FMessage);
  194 +end;
157 195
158 -{ TZMQPubThread }  
159 -  
160 -procedure TZMQPubThread.Execute; 196 +procedure TZMQServerThread.Execute;
161 var 197 var
162 LMultipartMessage : TStringList; 198 LMultipartMessage : TStringList;
  199 + LPollCount,
163 LMessagesCount : integer; 200 LMessagesCount : integer;
164 begin 201 begin
165 -{$IFDEF DEBUG}  
166 - WriteLn('PubThread.Execute');  
167 -{$ENDIF} 202 + Synchronize(@Connect);
  203 + LPollCount := 0;
  204 + LMessagesCount := 0;
  205 + LMultipartMessage := TStringList.Create;
168 while not Terminated do 206 while not Terminated do
169 begin 207 begin
170 - LMultipartMessage := TStringList.Create;  
171 - LMessagesCount := FPuller.recv(LMultipartMessage);  
172 - if LMessagesCount > 0 then  
173 - begin  
174 - {$IFDEF DEBUG}  
175 - WriteLn('PubThread.Execute.MessageReceived');  
176 - {$ENDIF}  
177 - FPublisher.send(LMultiPartMessage); 208 + LMultipartMessage.Clear;
  209 + LPollCount := FPoller.poll(50000);
  210 + if LPollCount > 0 then
  211 + begin
  212 + case FPoller.PollNumber of
  213 + 2 : begin// puller
  214 + {$IFDEF DEBUG}
  215 + WriteLn('Server2:');
  216 + {$ENDIF}
  217 + LMessagesCount := FPuller.recv(LMultipartMessage);
  218 + if LMessagesCount > 0 then
  219 + begin
  220 + FMessage := LMultipartMessage;
  221 + Synchronize(@MessageReceived);
  222 + FPublisher.send(LMultiPartMessage);
  223 + end;
  224 + end;
  225 +
  226 + 1 : begin//router
  227 + {$IFDEF DEBUG}
  228 + WriteLn('Server1:');
  229 + {$ENDIF}
  230 + // Exit;
  231 + if LMessagesCount > 2 then
  232 + begin
  233 + FRouter.recv(LMultipartMessage);
  234 + FMessage := LMultipartMessage;
  235 + Synchronize(@RequestReceived);
  236 + LMultipartMessage := FMessage;
  237 + FRouter.send(LMultipartMessage);
  238 + end;
  239 + end;
178 end; 240 end;
179 - LMultipartMessage.Free; 241 +
  242 + end;
180 end; 243 end;
181 end; 244 end;
182 245
183 -constructor TZMQPubThread.Create(CreateSuspended: Boolean); 246 +constructor TZMQServerThread.Create(CreateSuspended: Boolean);
184 begin 247 begin
185 FreeOnTerminate := True; 248 FreeOnTerminate := True;
  249 + FContext := TZMQContext.create;
186 250
187 - FContext := TZMQContext.Create; 251 + // publishes for subscribers, server subscribe to itself
188 FPublisher := FContext.Socket( stPub ); 252 FPublisher := FContext.Socket( stPub );
189 - FPublisher.bind('tcp://*:5056'); 253 + FSubscriber := FContext.Socket( stSub );
  254 + FSubscriber.connect(CLocalHost+CPortPublisher);FSubscriber.Subscribe('');
190 255
  256 + // pushes from inside to outside
191 FPuller := FContext.Socket( stPull ); 257 FPuller := FContext.Socket( stPull );
192 - FPuller.bind('tcp://*:5057'); 258 + FPusher := FContext.Socket( stPush );
  259 + FPusher.connect(CLocalHost+CPortPuller);
  260 +
  261 + // reply requests from outside
  262 + FRouter := FContext.Socket( stRouter );
  263 +
  264 + // local setup
  265 + FPublisher.bind(CHost+CPortPublisher);
  266 + FPuller.bind(CHost+CPortPuller);
  267 + FRouter.bind(CHost+CPortRouter);
  268 +
  269 + // handle sockets
  270 + FPoller := TZMQPoller.Create(True, FContext);
  271 + FPoller.Register(FPuller,[pePollIn],True);
  272 + FPoller.Register(FRouter, [pePollIn], True);
  273 +
193 inherited Create(CreateSuspended); 274 inherited Create(CreateSuspended);
194 end; 275 end;
195 276
196 -destructor TZMQPubThread.Destroy; 277 +destructor TZMQServerThread.Destroy;
197 begin 278 begin
198 - FContext.Free; 279 + FPoller.Terminate;
  280 + FPoller.Free;
  281 + FRouter.Free;
  282 + FPusher.Free;
199 FPuller.Free; 283 FPuller.Free;
  284 + FSubscriber.Free;
200 FPublisher.Free; 285 FPublisher.Free;
  286 + FContext.Free;
201 inherited Destroy; 287 inherited Destroy;
202 end; 288 end;
203 289
  290 +procedure TZMQServerThread.Push(AMultipartMessage: array of UTF8string);
  291 +begin
  292 + FPusher.send(AMultipartMessage);
  293 +end;
  294 +
  295 +
204 end. 296 end.