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 38 <PackageName Value="LCL"/>
39 39 </Item3>
40 40 </RequiredPackages>
41   - <Units Count="15">
  41 + <Units Count="19">
42 42 <Unit0>
43 43 <Filename Value="cultural_matrix.lpr"/>
44 44 <IsPartOfProject Value="True"/>
... ... @@ -76,7 +76,7 @@
76 76 <Unit7>
77 77 <Filename Value="form_chooseactor.pas"/>
78 78 <IsPartOfProject Value="True"/>
79   - <ComponentName Value="Form1"/>
  79 + <ComponentName Value="FormChooseActor"/>
80 80 <HasResources Value="True"/>
81 81 <ResourceBaseClass Value="Form"/>
82 82 </Unit7>
... ... @@ -108,6 +108,22 @@
108 108 <Filename Value="units/game_actors_point.pas"/>
109 109 <IsPartOfProject Value="True"/>
110 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 127 </Units>
112 128 </ProjectOptions>
113 129 <CompilerOptions>
... ...
cultural_matrix.lpr
  Diff comments   View file @75cde9c
... ... @@ -70,19 +70,22 @@ begin
70 70 end
71 71 else
72 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 88 end;
85   -
86 89 Application.Run;
87 90 end.
88 91  
... ...
form_chooseactor.lfm
  Diff comments   View file @75cde9c
1   -object Form1: TForm1
  1 +object FormChooseActor: TFormChooseActor
2 2 Left = 416
3 3 Height = 240
4 4 Top = 194
5 5 Width = 320
6 6 BorderStyle = bsNone
7   - Caption = 'Form1'
  7 + Caption = 'FormChooseActor'
8 8 ClientHeight = 240
9 9 ClientWidth = 320
10 10 FormStyle = fsStayOnTop
  11 + OnCloseQuery = FormCloseQuery
  12 + OnCreate = FormCreate
11 13 Position = poScreenCenter
12 14 LCLVersion = '1.6.0.4'
13 15 object btnAdmin: TButton
... ... @@ -28,4 +30,15 @@ object Form1: TForm1
28 30 OnClick = btnPlayerClick
29 31 TabOrder = 1
30 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 44 end
... ...
form_chooseactor.pas
  Diff comments   View file @75cde9c
... ... @@ -5,52 +5,83 @@ unit form_chooseactor;
5 5 interface
6 6  
7 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 13 type
13 14  
14   - { TForm1 }
  15 + { TFormChooseActor }
15 16  
16   - TForm1 = class(TForm)
  17 + TFormChooseActor = class(TForm)
17 18 btnAdmin: TButton;
18 19 btnPlayer: TButton;
  20 + btnPlayerResume: TButton;
19 21 procedure btnAdminClick(Sender: TObject);
20 22 procedure btnPlayerClick(Sender: TObject);
  23 + procedure btnPlayerResumeClick(Sender: TObject);
  24 + procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
  25 + procedure FormCreate(Sender: TObject);
21 26 private
22 27 FGameActor: TGameActor;
23   - procedure SetGameActor(AValue: TGameActor);
  28 + FCanClose : Boolean;
  29 + FStyle: string;
  30 + procedure SetStyle(AValue: string);
24 31 { private declarations }
25 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 35 end;
28 36  
29 37 var
30   - Form1: TForm1;
  38 + FormChooseActor: TFormChooseActor;
31 39  
32 40 implementation
33 41  
34 42 {$R *.lfm}
35 43  
36   -{ TForm1 }
  44 +{ TFormChooseActor }
37 45  
38   -procedure TForm1.btnAdminClick(Sender: TObject);
  46 +procedure TFormChooseActor.btnAdminClick(Sender: TObject);
39 47 begin
40   - GameActor:=gaAdmin;
  48 + FGameActor:=gaAdmin;
  49 + FCanClose := True;
41 50 ModalResult:=1;
42 51 end;
43 52  
44   -procedure TForm1.btnPlayerClick(Sender: TObject);
  53 +procedure TFormChooseActor.btnPlayerClick(Sender: TObject);
45 54 begin
46   - GameActor:=gaPlayer;
  55 + FGameActor:=gaPlayer;
  56 + FCanClose := True;
47 57 ModalResult:=1;
48 58 end;
49 59  
50   -procedure TForm1.SetGameActor(AValue: TGameActor);
  60 +procedure TFormChooseActor.btnPlayerResumeClick(Sender: TObject);
51 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 85 end;
55 86  
56 87  
... ...
form_matrixgame.lfm
  Diff comments   View file @75cde9c
1 1 object FormMatrixGame: TFormMatrixGame
2   - Left = 190
  2 + Left = 0
3 3 Height = 657
4   - Top = 94
5   - Width = 1518
6   - HorzScrollBar.Page = 1492
  4 + Top = 62
  5 + Width = 1278
  6 + HorzScrollBar.Page = 1278
7 7 VertScrollBar.Page = 542
8 8 AutoScroll = True
9 9 Caption = 'FormMatrixGame'
10   - ClientHeight = 657
11   - ClientWidth = 1518
  10 + ClientHeight = 647
  11 + ClientWidth = 1278
12 12 Font.Name = 'Monospace'
13 13 OnActivate = FormActivate
14 14 LCLVersion = '1.6.0.4'
... ... @@ -151,178 +151,18 @@ object FormMatrixGame: TFormMatrixGame
151 151 AnchorSideBottom.Control = Owner
152 152 AnchorSideBottom.Side = asrBottom
153 153 Left = 0
154   - Height = 124
155   - Top = 533
156   - Width = 1518
  154 + Height = 17
  155 + Top = 630
  156 + Width = 1492
157 157 Anchors = [akLeft, akRight, akBottom]
158 158 AutoSize = True
159 159 Caption = 'Escolhas na última jogada'
160 160 ChildSizing.LeftRightSpacing = 10
161 161 ChildSizing.TopBottomSpacing = 5
162 162 ChildSizing.HorizontalSpacing = 10
  163 + ChildSizing.Layout = cclLeftToRightThenTopToBottom
163 164 ChildSizing.ControlsPerLine = 6
164   - ClientHeight = 107
165   - ClientWidth = 1514
166 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 166 end
327 167 object GBAdmin: TGroupBox
328 168 AnchorSideLeft.Control = GBGrupo
... ... @@ -543,4 +383,31 @@ object FormMatrixGame: TFormMatrixGame
543 383 Transparent = False
544 384 end
545 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 413 end
... ...
form_matrixgame.pas
  Diff comments   View file @75cde9c
... ... @@ -29,19 +29,15 @@ type
29 29  
30 30 TFormMatrixGame = class(TForm)
31 31 btnConfirmRow: TButton;
  32 + Button1: TButton;
  33 + Button2: TButton;
  34 + Button3: TButton;
32 35 GBIndividual: TGroupBox;
33 36 GBLastChoice: TGroupBox;
34 37 GBIndividualAB: TGroupBox;
35 38 GBGrupo: TGroupBox;
36 39 GBAdmin: TGroupBox;
37   - GBLastChoiceP0: TGroupBox;
38   - GBLastChoiceP1: TGroupBox;
39   - GBLastChoiceP2: TGroupBox;
40 40 GBExperiment: TGroupBox;
41   - Label10: TLabel;
42   - Label11: TLabel;
43   - Label12: TLabel;
44   - Label13: TLabel;
45 41 LabelExpCondCount: TLabel;
46 42 LabelExpGen: TLabel;
47 43 LabelExpGenCount: TLabel;
... ... @@ -54,24 +50,19 @@ type
54 50 LabelIndCount: TLabel;
55 51 LabelIndACount: TLabel;
56 52 LabelIndBCount: TLabel;
57   - LabelCurrentColor1: TLabel;
58   - LabelCurrentLine1: TLabel;
59 53 LabelIndA: TLabel;
60 54 LabelGroupCount: TLabel;
61 55 LabelIndB: TLabel;
62   - LabelCurrentLineNumber1: TLabel;
63   - LabelYouLastChoiceColor3: TLabel;
64   - LabelYouLastChoiceColor4: TLabel;
65 56 LabelExpCond: TLabel;
66 57 ChatMemoRecv: TMemo;
67 58 ChatMemoSend: TMemo;
68 59 ChatPanel: TPanel;
69   - Panel4: TPanel;
70   - Panel5: TPanel;
71   - PanelCurrentColor1: TPanel;
72 60 ChatSplitter: TSplitter;
73 61 StringGridMatrix: TStringGrid;
74 62 procedure btnConfirmRowClick(Sender: TObject);
  63 + procedure Button1Click(Sender: TObject);
  64 + procedure Button2Click(Sender: TObject);
  65 + procedure Button3Click(Sender: TObject);
75 66 procedure ChatMemoSendKeyPress(Sender: TObject; var Key: char);
76 67 procedure CheckBoxDrawDotsChange(Sender: TObject);
77 68 procedure FormActivate(Sender: TObject);
... ... @@ -81,9 +72,6 @@ type
81 72 private
82 73 FGameControl : TGameControl;
83 74 FID: string;
84   - FMustDrawDots: Boolean;
85   - FMustDrawDotsClear: Boolean;
86   - FRowBase: integer;
87 75 public
88 76 procedure SetID(S : string);
89 77 procedure SetGameActor(AValue: TGameActor);
... ... @@ -95,7 +83,7 @@ var
95 83  
96 84 implementation
97 85  
98   -uses LCLType, game_resources;
  86 +uses form_chooseactor, LCLType, game_resources;
99 87  
100 88 // uses datamodule;
101 89 var
... ... @@ -176,7 +164,6 @@ begin
176 164 try
177 165 //if (aRow >= RowBase) and (aCol = 10) then
178 166 // DrawLines(clWhite);
179   -
180 167 if (aCol <> 0) and (aRow > (RowBase-1)) then
181 168 begin
182 169 DrawLines(GetRowColor(aRow,RowBase));
... ... @@ -225,22 +212,21 @@ procedure TFormMatrixGame.SetGameActor(AValue: TGameActor);
225 212  
226 213 procedure SetZMQAdmin;
227 214 begin
228   - FGameControl := TGameControl.Create(TZMQAdmin.Create(Self));
  215 +
  216 + FGameControl := TGameControl.Create(TZMQAdmin.Create(Self),FID);
229 217 GBAdmin.Visible:= True;
230 218 end;
231 219  
232 220 procedure SetZMQPlayer;
233 221 begin
234   - FGameControl := TGameControl.Create(TZMQPlayer.Create(Self));
  222 + FGameControl := TGameControl.Create(TZMQPlayer.Create(Self),FID);
235 223 btnConfirmRow.Visible := True;
236 224 StringGridMatrix.Enabled := True;
237   -
238   - FGameControl.SendMessage(K_ARRIVED);
239 225 end;
240 226  
241 227 procedure SetZMQWatcher;
242 228 begin
243   - FGameControl := TGameControl.Create(TZMQWatcher.Create(Self));
  229 + FGameControl := TGameControl.Create(TZMQWatcher.Create(Self),FID);
244 230 end;
245 231  
246 232 begin
... ... @@ -249,7 +235,6 @@ begin
249 235 gaPlayer: SetZMQPlayer;
250 236 gaWatcher: SetZMQWatcher;
251 237 end;
252   - FGameControl.SetID(FID);
253 238 end;
254 239  
255 240 procedure TFormMatrixGame.SetID(S: string);
... ... @@ -266,6 +251,7 @@ procedure TFormMatrixGame.FormActivate(Sender: TObject);
266 251 begin
267 252 StringGridMatrix.ClearSelections;
268 253 StringGridMatrix.FocusRectVisible := False;
  254 + FGameControl.SetMatrix;
269 255 end;
270 256  
271 257 procedure TFormMatrixGame.StringGridMatrixBeforeSelection(Sender: TObject; aCol, aRow: integer);
... ... @@ -299,4 +285,29 @@ begin
299 285 FGameControl.SendMessage(K_CHOICE);
300 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 313 end.
... ...
units/game_control.pas
  Diff comments   View file @75cde9c
... ... @@ -11,6 +11,7 @@ uses
11 11 , game_zmq_actors
12 12 , game_experiment
13 13 , game_actors
  14 + , game_visual_elements
14 15 ;
15 16  
16 17 type
... ... @@ -26,20 +27,26 @@ type
26 27 FActor : TGameActor;
27 28 FZMQActor : TZMQActor;
28 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 35 function MessageHas(const A_CONST : string; AMessage : TStringList): Boolean;
31 36 procedure SetMatrixType(AStringGrid : TStringGrid; AMatrixType:TGameMatrixType;
32 37 var ARowBase:integer; var ADrawDots, ADrawClear : Boolean);
33 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 41 procedure SetMustDrawDots(AValue: Boolean);
37 42 procedure SetMustDrawDotsClear(AValue: Boolean);
38 43 procedure SetRowBase(AValue: integer);
  44 + procedure SendSystemMessage(AMessage: array of UTF8String);
39 45 public
40   - constructor Create(AZMQActor : TZMQActor); reintroduce;
  46 + constructor Create(AZMQActor : TZMQActor;AID : string);overload;
41 47 destructor Destroy; override;
42   - procedure SetID(S:string);
  48 + procedure SetMatrix;
  49 + procedure SendRequest(ARequest : UTF8string);
43 50 procedure SendMessage(AMessage : UTF8string);
44 51 property ID : string read FID;
45 52 property RowBase : integer read FRowBase write SetRowBase;
... ... @@ -53,6 +60,15 @@ const
53 60 K_ARRIVED = '.Arrived';
54 61 K_CHAT_M = '.ChatM';
55 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 72 //K_RESPONSE =
57 73  
58 74 implementation
... ... @@ -82,26 +98,33 @@ end;
82 98  
83 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 107 var i : integer;
87 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 124 end;
  125 +
  126 + gaAdmin: Result := FExperiment.Researcher;
  127 + end;
105 128 end;
106 129  
107 130 function TGameControl.MessageHas(const A_CONST: string; AMessage: TStringList): Boolean;
... ... @@ -185,12 +208,18 @@ begin
185 208 FRowBase:=AValue;
186 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 217 begin
190 218 inherited Create(AZMQActor.Owner);
191 219 FZMQActor := AZMQActor;
192   - FZMQActor.SetID(ID);
193 220 FZMQActor.OnMessageReceived:=@ReceiveMessage;
  221 + FZMQActor.OnRequestReceived:=@ReceiveRequest;
  222 + FZMQActor.OnReplyReceived:=@ReceiveReply;
194 223 FZMQActor.Start;
195 224  
196 225 if FZMQActor.ClassType = TZMQAdmin then
... ... @@ -204,16 +233,11 @@ begin
204 233 MustDrawDots:=False;
205 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 241 end;
218 242  
219 243 destructor TGameControl.Destroy;
... ... @@ -221,11 +245,17 @@ begin
221 245 inherited Destroy;
222 246 end;
223 247  
224   -procedure TGameControl.SetID(S: string);
  248 +procedure TGameControl.SetMatrix;
225 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 256 end;
228 257  
  258 +
229 259 procedure TGameControl.SendMessage(AMessage: UTF8string);
230 260 var
231 261 {$IFDEF DEBUG}
... ... @@ -246,6 +276,8 @@ begin
246 276 K_ARRIVED : SetM([
247 277 AMessage
248 278 , FZMQActor.ID
  279 + //, FZMQActor.ClassType.ClassName;
  280 + //,
249 281 ]);
250 282  
251 283 K_CHOICE : SetM([
... ... @@ -255,28 +287,37 @@ begin
255 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 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 308 end;
265 309  
266 310 case FActor of
267 311 gaAdmin: begin
268   - if not FExperiment.ResearcherCanChat then Exit;
269 312 M[0] := GA_ADMIN+M[0];
270   - TZMQAdmin(FZMQActor).SendMessage(M);
271 313 end;
272 314 gaPlayer:begin
273 315 M[0] := GA_PLAYER+M[0];
274   - TZMQPlayer(FZMQActor).SendMessage(M);
275 316 end;
276   - //gaWatcher:begin // Cannot SendMessages
  317 + //gaWatcher:begin // for now cannot SendMessages
277 318 // M[0] := GA_WATCHER+M[0];
278   - // TZMQWatcher(FZMQActor).SendMessage(M);
279 319 end;
  320 + FZMQActor.SendMessage(M);
280 321  
281 322 {$IFDEF DEBUG}
282 323 for i := 0 to Length(M)-1 do
... ... @@ -292,20 +333,115 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
292 333 end;
293 334  
294 335 procedure ReceiveActor;
295   - var Data: TStringList;
  336 + var i : integer;
  337 + P : TPlayer;
296 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 433 end;
305 434  
306 435 procedure ReceiveChoice;
307 436 begin
  437 + case FActor of
  438 + gaPlayer:begin
308 439  
  440 + end;
  441 + gaAdmin:begin
  442 +
  443 + end;
  444 + end;
309 445 end;
310 446  
311 447 procedure ReceiveChat;
... ... @@ -313,20 +449,75 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
313 449 FormMatrixGame.ChatMemoRecv.Lines.Append(('['+AMessage[1]+']: ')+AMessage[2]);
314 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 478 procedure ReceiveLogin;
317 479 begin
  480 + case FActor of
  481 + gaPlayer:begin
  482 +
  483 + end;
  484 + gaAdmin:begin
  485 +
  486 + end;
  487 + end;
318 488 WriteLn('login');
319 489 end;
320 490  
321 491 procedure ReceiveLogout;
322 492 begin
  493 + case FActor of
  494 + gaPlayer:begin
  495 +
  496 + end;
  497 + gaAdmin:begin
  498 +
  499 + end;
  500 + end;
323 501 WriteLn('logout');
324 502 end;
325 503  
326 504 begin
327 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 521 end;
331 522  
332 523 end.
... ...
units/game_experiment.pas
  Diff comments   View file @75cde9c
... ... @@ -31,19 +31,26 @@ type
31 31 FCurrentCondition : integer;
32 32 FConditions : TConditions;
33 33 FResearcherCanChat: Boolean;
  34 + FResearcherCanPlay: Boolean;
34 35 FShowChat: Boolean;
35 36 function GetCondition(I : Integer): TCondition;
36 37 function GetConditionsCount: integer;
37 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 44 function GetPlayersCount: integer;
40 45 function GetPlayersPlaying: TList;
41 46 procedure SetCondition(I : Integer; AValue: TCondition);
42 47 procedure SetContingency(ACondition, I : integer; AValue: TContingency);
43 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 51 procedure SetPlayersPlaying(AValue: TList);
46 52 procedure SetResearcherCanChat(AValue: Boolean);
  53 + procedure SetResearcherCanPlay(AValue: Boolean);
47 54 public
48 55 constructor Create(AOwner:TComponent);override;
49 56 constructor Create(AFilename: string; AOwner:TComponent); overload;
... ... @@ -58,7 +65,8 @@ type
58 65 function AppendPlayer(APlayer : TPlayer) : integer; overload;
59 66 procedure SaveToFile(AFilename: string); overload;
60 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 70 property Researcher : string read FResearcher write FResearcher;
63 71 property Condition[I : Integer]: TCondition read GetCondition write SetCondition;
64 72 property ConditionsCount : integer read GetConditionsCount;
... ... @@ -68,10 +76,14 @@ type
68 76 property ExperimentName : string read FExperimentName write FExperimentName;
69 77 property GenPlayersAsNeeded : Boolean read FGenPlayersAsNeeded write FGenPlayersAsNeeded;
70 78 property Player[I : integer] : TPlayer read GetPlayer write SetPlayer;
  79 + property PlayerFromID[S : string ] : TPlayer read GetPlayer write SetPlayer;
71 80 property PlayersCount : integer read GetPlayersCount; // how many players per turn?
72 81 property PlayersPlaying : TList read GetPlayersPlaying write SetPlayersPlaying; // how many players are playing?
  82 + property PlayerIsPlaying[s : string] : Boolean read GetPlayerIsPlaying; // is
73 83 property ShowChat : Boolean read FShowChat write FShowChat;
74 84 property MatrixType : TGameMatrixType read FMatrixType write SetMatrixType;
  85 + property NextTurnPlayerID : UTF8string read GetNextTurnPlayerID;
  86 + property NextTurn : integer read GetNextTurn;
75 87 end;
76 88  
77 89 resourcestring
... ... @@ -98,17 +110,59 @@ begin
98 110 Result := FConditions[ACondition].Contingencies[I];
99 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 133 function TExperiment.GetPlayer(I : integer): TPlayer;
102 134 begin
103 135 Result := FPlayers[i];
104 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 163 function TExperiment.GetPlayersCount: integer;
107 164 begin
108   - if Length(FPlayers) = 0 then
109   - Result := High(FPlayers)
110   - else
111   - Result := -1;
  165 + Result := Length(FPlayers)
112 166 end;
113 167  
114 168 function TExperiment.GetPlayersPlaying: TList;
... ... @@ -116,31 +170,28 @@ var
116 170 i:integer;
117 171 P:PPlayer;
118 172 begin
  173 + P := New(PPlayer);
119 174 if FPlayersPlaying.Count > 0 then
120 175 FPlayersPlaying.Clear;
121 176  
122 177 for i := Low(FPlayers) to High(FPlayers) do
123   - if Player[i].Status = gpsPlaying then
  178 + if FPlayers[i].Status = gpsPlaying then
124 179 begin
125   - P := nil;
126   - P^ := Player[i];
  180 + P := @FPlayers[i];
127 181 FPlayersPlaying.Add(P);
128 182 end;
129   -
  183 + Dispose(P);
130 184 Result := FPlayersPlaying;
131 185 end;
132 186  
133 187 procedure TExperiment.SetCondition(I : Integer; AValue: TCondition);
134 188 begin
135   - if (I >= Low(FConditions)) and (I <= High(FConditions)) then
136   - FConditions[I] := AValue;
  189 + FConditions[I] := AValue;
137 190 end;
138 191  
139 192 procedure TExperiment.SetContingency(ACondition, I : integer; AValue: TContingency);
140 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 195 end;
145 196  
146 197 procedure TExperiment.SetMatrixType(AValue: TGameMatrixType);
... ... @@ -152,8 +203,20 @@ end;
152 203  
153 204 procedure TExperiment.SetPlayer(I : integer; AValue: TPlayer);
154 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 220 end;
158 221  
159 222 procedure TExperiment.SetPlayersPlaying(AValue: TList);
... ... @@ -168,6 +231,12 @@ begin
168 231 FResearcherCanChat:=AValue;
169 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 240 constructor TExperiment.Create(AOwner: TComponent);
172 241 begin
173 242 inherited Create(AOwner);
... ... @@ -231,7 +300,7 @@ end;
231 300 function TExperiment.AppendPlayer: integer;
232 301 begin
233 302 SetLength(FPlayers, Length(FPlayers)+1);
234   - Result := Length(FPlayers)-1;
  303 + Result := High(FPlayers);
235 304 end;
236 305  
237 306 function TExperiment.AppendPlayer(APlayer: TPlayer): integer;
... ...
units/game_file_methods.pas
  Diff comments   View file @75cde9c
... ... @@ -39,19 +39,21 @@ begin
39 39 with AExperiment do
40 40 begin
41 41 Researcher := VAL_RESEARCHER;
  42 + ResearcherCanPlay:=False;
42 43 ResearcherCanChat:=True;
43 44 ExperimentName:='Test Experiment';
44 45 ExperimentAim:='This is a test experiment.';
45 46 GenPlayersAsNeeded:=True;
46 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 51 i := AppendCondition(C_CONDITION_TEMPLATE);
50 52 with Condition[i] do
51 53 begin
52 54 ConditionName := SEC_CONDITION+IntToStr(i+1);
53 55 Turn.Count:=0;
54   - Turn.Value:=0;
  56 + Turn.Value:=2;
55 57 Turn.Random:=False;
56 58 end;
57 59 //j := AppendContingency(i,C_METACONTINGENCY_A1);
... ...
units/game_resources.pas
  Diff comments   View file @75cde9c
... ... @@ -74,10 +74,10 @@ resourcestring
74 74 const
75 75  
76 76 CPlayerNamesMale : array [0..49] of UTF8String =
77   - ('João','Rodrigo','Francisco','Martim','Santiago',
  77 + ('Junho','Rodrigo','Francisco','Martim','Santiago',
78 78 'Tomás','Afonso','Duarte','Miguel','Guilherme','Tiago',
79 79 'Gonçalo','Diogo','Gabriel','Pedro','Rafael','Salvador',
80   - 'Dinis','Lucas','Simão','Gustavo','David',
  80 + 'Dinis','Lucas','Simael','Gustavo','David',
81 81 'José','Vicente','Lourenço','Diego','Daniel',
82 82 'António','André','Vasco','Manuel','Henrique',
83 83 'Leonardo','Bernardo','Mateus','Luís','Eduardo',
... ...
units/game_zmq_actors.pas
  Diff comments   View file @75cde9c
... ... @@ -12,23 +12,27 @@ uses
12 12  
13 13 type
14 14  
15   - // Everything sent is received by everybody connected.
16   -
17 15 { TZMQActor }
18 16  
19 17 TZMQActor = class(TComponent)
20 18 private
21 19 FID: UTF8string;
22   - FSubscriber: TZMQPollThread;
23 20 FOnMessageReceived : TMessRecvProc;
  21 + FOnReplyReceived: TMessRecvProc;
  22 + FOnRequestReceived: TReqRecvProc;
24 23 protected
25 24 procedure MessageReceived(AMultipartMessage : TStringList);
  25 + procedure ReplyReceived(AMultipartMessage : TStringList); virtual;
  26 + procedure RequestReceived(var AMultipartMessage : TStringList); virtual;
26 27 public
27 28 constructor Create(AOwner : TComponent); override;
28   - destructor Destroy; override;
29 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 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 36 property ID : UTF8string read FID;
33 37 end;
34 38  
... ... @@ -36,23 +40,30 @@ type
36 40  
37 41 TZMQPlayer = class(TZMQActor)
38 42 private
39   - FPusher : TZMQPusher;
  43 + FZMQClient : TZMQClientThread;
  44 + protected
  45 + procedure ReplyReceived(AMultipartMessage: TStringList); override;
40 46 public
41 47 constructor Create(AOwner : TComponent); override;
42 48 destructor Destroy; override;
43 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 52 end;
46 53  
47 54 { TZMQAdmin }
48 55  
49   - TZMQAdmin = class(TZMQPlayer)
  56 + TZMQAdmin = class(TZMQActor)
50 57 private
51   - FPublisher : TZMQPubThread;
  58 + FZMQServer : TZMQServerThread;
  59 + protected
  60 + procedure RequestReceived(var AMultipartMessage: TStringList); override;
52 61 public
53 62 constructor Create(AOwner : TComponent); override;
54 63 destructor Destroy; override;
55 64 procedure Start; override;
  65 + procedure SendMessage(AMessage: array of UTF8string); override;
  66 + procedure Request(ARequest: array of UTF8string); override;
56 67 end;
57 68  
58 69 { TZMQWatcher }
... ... @@ -68,7 +79,6 @@ implementation
68 79  
69 80 procedure TZMQWatcher.Start;
70 81 begin
71   - AbstractError;
72 82 inherited Start;
73 83 WriteLn('TZMQWatcher.Start');
74 84 end;
... ... @@ -77,20 +87,36 @@ end;
77 87  
78 88 constructor TZMQAdmin.Create(AOwner: TComponent);
79 89 begin
80   - FPublisher := TZMQPubThread.Create;
81 90 inherited Create(AOwner);
  91 + FZMQServer := TZMQServerThread.Create;
  92 + FZMQServer.OnMessageReceived:=@MessageReceived;
  93 + FZMQServer.OnRequestReceived:=@RequestReceived;
82 94 end;
83 95  
84 96 destructor TZMQAdmin.Destroy;
85 97 begin
86   - FPublisher.Terminate;
  98 + FZMQServer.Terminate;
87 99 inherited Destroy;
88 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 117 procedure TZMQAdmin.Start;
91 118 begin
92   - FPublisher.Start;
93   - inherited Start;
  119 + FZMQServer.Start;
94 120 WriteLn('TZMQAdmin.Start');
95 121 end;
96 122  
... ... @@ -98,24 +124,37 @@ end;
98 124  
99 125 procedure TZMQPlayer.SendMessage(AMessage: array of UTF8string);
100 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 138 end;
103 139  
104 140 constructor TZMQPlayer.Create(AOwner: TComponent);
105 141 begin
106 142 inherited Create(AOwner);
107   - FPusher := TZMQPusher.Create;
  143 + FZMQClient := TZMQClientThread.Create;
  144 + FZMQClient.OnMessageReceived:=@MessageReceived;
  145 + FZMQClient.OnReplyReceived:=@ReplyReceived;
108 146 end;
109 147  
110 148 destructor TZMQPlayer.Destroy;
111 149 begin
112   - FPusher.Free;
  150 + FZMQClient.Terminate;
113 151 inherited Destroy;
114 152 end;
115 153  
116 154 procedure TZMQPlayer.Start;
117 155 begin
118 156 inherited Start;
  157 + FZMQClient.Start;
119 158 WriteLn('TZMQPlayer.Start');
120 159 end;
121 160  
... ... @@ -131,23 +170,23 @@ begin
131 170 if Assigned(FOnMessageReceived) then FOnMessageReceived(AMultipartMessage);
132 171 end;
133 172  
134   -constructor TZMQActor.Create(AOwner: TComponent);
  173 +procedure TZMQActor.ReplyReceived(AMultipartMessage: TStringList);
135 174 begin
136   - inherited Create(AOwner);
137   - FSubscriber := TZMQPollThread.Create;
138   - FSubscriber.OnMessageReceived:=@MessageReceived;
  175 + AbstractError;
139 176 end;
140 177  
141   -destructor TZMQActor.Destroy;
  178 +procedure TZMQActor.RequestReceived(var AMultipartMessage: TStringList);
142 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 186 end;
147 187  
148 188 procedure TZMQActor.Start;
149 189 begin
150   - FSubscriber.Start;
151 190 WriteLn('TZMQActor.Start');
152 191 end;
153 192  
... ...
units/zmq_network.pas
  Diff comments   View file @75cde9c
... ... @@ -11,194 +11,286 @@ unit zmq_network;
11 11  
12 12 {$mode objfpc}{$H+}
13 13  
  14 +{$DEFINE DEBUG}
  15 +
14 16 interface
15 17  
16 18 uses Classes, SysUtils, Process
17 19 , zmqapi
18   - //, zmq_client
19 20 ;
20 21  
21 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 32 private
40 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 42 protected
44 43 procedure Execute; override;
45 44 public
46 45 constructor Create(CreateSuspended: Boolean = True);
47 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 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 56 private
58   - FMultipartMessage : TStringList;
  57 + FOnMessageReceived: TMessRecvProc;
  58 + FOnRequestReceived: TReqRecvProc;
59 59 FContext : TZMQContext;
60   - FSubscriber : TZMQSocket;
  60 + FPublisher,
  61 + FSubscriber,
  62 + FPuller,
  63 + FPusher,
  64 + FRouter,
  65 + FReplier : TZMQSocket;
61 66 FPoller : TZMQPoller;
62   - FOnMessageReceived: TMessRecvProc;
  67 + FMessage : TStringList;
  68 + procedure Connect;
63 69 procedure MessageReceived;
  70 + procedure RequestReceived;
64 71 protected
65 72 procedure Execute; override;
66 73 public
67 74 constructor Create(CreateSuspended: Boolean = True);
68 75 destructor Destroy; override;
  76 + procedure Push(AMultipartMessage: array of UTF8string);
69 77 property OnMessageReceived : TMessRecvProc read FOnMessageReceived write FOnMessageReceived;
  78 + property OnRequestReceived : TReqRecvProc read FOnRequestReceived write FOnRequestReceived;
70 79 end;
71 80  
72   -
73 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 95 begin
79   - if Assigned(OnMessageReceived) then OnMessageReceived(FMultipartMessage);
  96 + if Assigned(FOnMessageReceived) then FOnMessageReceived(FMessage);
80 97 end;
81 98  
82   -procedure TZMQPollThread.Execute;
  99 +procedure TZMQClientThread.Execute;
83 100 var
84 101 LMultipartMessage : TStringList;
85 102 LPollEvent,
86 103 LMessagesCount : integer;
87 104 begin
88   -{$IFDEF DEBUG}
89   - WriteLn('SubThread.Execute');
90   -{$ENDIF}
  105 + LMultipartMessage := TStringList.Create;
91 106 while not Terminated do
92 107 begin
  108 + LMultipartMessage.Clear;
93 109 LPollEvent := FPoller.poll(50000);
94 110 if LPollEvent > 0 then
95 111 begin
96   - {$IFDEF DEBUG}
97   - WriteLn('SubThread.Execute.PollMessageReceived');
98   - {$ENDIF}
99   - LMultipartMessage := TStringList.Create;
  112 + WriteLn('Server4:FPoller:',FPoller.PollNumber);
100 113 LMessagesCount := FSubscriber.recv(LMultipartMessage);
101 114 if LMessagesCount > 0 then
102   - try
103   - FMultipartMessage := LMultipartMessage;
  115 + begin
  116 + FMessage := LMultipartMessage;
104 117 Synchronize(@MessageReceived);
105   - finally
106   - LMultipartMessage.Free;
107 118 end;
108 119 end;
109 120 end;
  121 + LMultipartMessage.Free;
110 122 end;
111 123  
112   -constructor TZMQPollThread.Create(CreateSuspended: Boolean);
  124 +
  125 +constructor TZMQClientThread.Create(CreateSuspended: Boolean);
113 126 begin
114 127 FreeOnTerminate := True;
115 128 FContext := TZMQContext.create;
  129 +
  130 + // client subscribe to server, it receives from itself
116 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 142 FPoller := TZMQPoller.Create(True, FContext);
121   - // FPoller.onEvent := @PollerEvent; // async
122 143 FPoller.Register(FSubscriber, [pePollIn], True);
  144 +
123 145 inherited Create(CreateSuspended);
124 146 end;
125 147  
126   -destructor TZMQPollThread.Destroy;
  148 +destructor TZMQClientThread.Destroy;
127 149 begin
128   - FContext.Free;
129 150 FPoller.Terminate;
130 151 FPoller.Free;
  152 + FPusher.Free;
131 153 FSubscriber.Free;
  154 + FContext.Free;
132 155 inherited Destroy;
133 156 end;
134 157  
135   -{ TZmqPusher }
136   -
137   -constructor TZMQPusher.Create;
  158 +procedure TZMQClientThread.Request(AMultipartMessage: array of UTF8String);
  159 +var AReply : TStringList;
138 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 166 end;
143 167  
144   -destructor TZMQPusher.Destroy;
  168 +procedure TZMQClientThread.Push(AMultipartMessage: array of UTF8String);
145 169 begin
146   - FPusher.Free; // also can be freed by freeing the context
147   - FContext.Free;
148   - inherited Destroy;
  170 + FPusher.send(AMultipartMessage);
149 171 end;
150 172  
151   -procedure TZMQPusher.SendMessage(AMultipartMessage: array of UTF8string);
  173 +
  174 +
  175 +{ TZMQServerThread }
  176 +
  177 +
  178 +
  179 +procedure TZMQServerThread.Connect;
152 180 begin
153   - FPusher.send(AMultipartMessage);
  181 + {$IFDEF DEBUG}
  182 + WriteLn('TZMQServerThread.Started');
  183 + {$ENDIF}
154 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 197 var
162 198 LMultipartMessage : TStringList;
  199 + LPollCount,
163 200 LMessagesCount : integer;
164 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 206 while not Terminated do
169 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 240 end;
179   - LMultipartMessage.Free;
  241 +
  242 + end;
180 243 end;
181 244 end;
182 245  
183   -constructor TZMQPubThread.Create(CreateSuspended: Boolean);
  246 +constructor TZMQServerThread.Create(CreateSuspended: Boolean);
184 247 begin
185 248 FreeOnTerminate := True;
  249 + FContext := TZMQContext.create;
186 250  
187   - FContext := TZMQContext.Create;
  251 + // publishes for subscribers, server subscribe to itself
188 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 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 274 inherited Create(CreateSuspended);
194 275 end;
195 276  
196   -destructor TZMQPubThread.Destroy;
  277 +destructor TZMQServerThread.Destroy;
197 278 begin
198   - FContext.Free;
  279 + FPoller.Terminate;
  280 + FPoller.Free;
  281 + FRouter.Free;
  282 + FPusher.Free;
199 283 FPuller.Free;
  284 + FSubscriber.Free;
200 285 FPublisher.Free;
  286 + FContext.Free;
201 287 inherited Destroy;
202 288 end;
203 289  
  290 +procedure TZMQServerThread.Push(AMultipartMessage: array of UTF8string);
  291 +begin
  292 + FPusher.send(AMultipartMessage);
  293 +end;
  294 +
  295 +
204 296 end.
... ...