Download as
Browse Code »

Commit 5111a7e7f16ea8fb4385e0da0e9b7dc16835b3d2

Authored by Carlos Picanco
1 parent 226750d3
Exists in master

cleaning, simple loading gui and dump

Showing 12 changed files with 478 additions and 440 deletions   Show diff stats
cultural_matrix.lpi
  Diff comments   View file @5111a7e
... ... @@ -47,18 +47,15 @@
47 47 <FormatVersion Value="1"/>
48 48 </local>
49 49 </RunParams>
50   - <RequiredPackages Count="3">
  50 + <RequiredPackages Count="2">
51 51 <Item1>
52 52 <PackageName Value="FCL"/>
53 53 </Item1>
54 54 <Item2>
55   - <PackageName Value="SQLDBLaz"/>
56   - </Item2>
57   - <Item3>
58 55 <PackageName Value="LCL"/>
59   - </Item3>
  56 + </Item2>
60 57 </RequiredPackages>
61   - <Units Count="17">
  58 + <Units Count="14">
62 59 <Unit0>
63 60 <Filename Value="cultural_matrix.lpr"/>
64 61 <IsPartOfProject Value="True"/>
... ... @@ -71,71 +68,55 @@
71 68 <ResourceBaseClass Value="Form"/>
72 69 </Unit1>
73 70 <Unit2>
74   - <Filename Value="datamodule.pas"/>
  71 + <Filename Value="README.md"/>
75 72 <IsPartOfProject Value="True"/>
76   - <ComponentName Value="DataModule1"/>
77   - <HasResources Value="True"/>
78   - <ResourceBaseClass Value="DataModule"/>
79 73 </Unit2>
80 74 <Unit3>
81   - <Filename Value="README.md"/>
  75 + <Filename Value="units/zmq_network.pas"/>
82 76 <IsPartOfProject Value="True"/>
83 77 </Unit3>
84 78 <Unit4>
85   - <Filename Value="units/zmq_network.pas"/>
  79 + <Filename Value="units/game_zmq_actors.pas"/>
86 80 <IsPartOfProject Value="True"/>
87 81 </Unit4>
88 82 <Unit5>
89   - <Filename Value="units/game_zmq_actors.pas"/>
  83 + <Filename Value="units/game_actors.pas"/>
90 84 <IsPartOfProject Value="True"/>
91 85 </Unit5>
92 86 <Unit6>
93   - <Filename Value="units/game_actors.pas"/>
  87 + <Filename Value="units/game_experiment.pas"/>
94 88 <IsPartOfProject Value="True"/>
95 89 </Unit6>
96 90 <Unit7>
97   - <Filename Value="form_chooseactor.pas"/>
  91 + <Filename Value="units/game_file_methods.pas"/>
98 92 <IsPartOfProject Value="True"/>
99   - <ComponentName Value="FormChooseActor"/>
100   - <HasResources Value="True"/>
101   - <ResourceBaseClass Value="Form"/>
102 93 </Unit7>
103 94 <Unit8>
104   - <Filename Value="units/game_message.pas"/>
  95 + <Filename Value="units/game_resources.pas"/>
105 96 <IsPartOfProject Value="True"/>
106 97 </Unit8>
107 98 <Unit9>
108   - <Filename Value="units/game_experiment.pas"/>
  99 + <Filename Value="units/game_control.pas"/>
109 100 <IsPartOfProject Value="True"/>
110 101 </Unit9>
111 102 <Unit10>
112   - <Filename Value="units/game_file_methods.pas"/>
  103 + <Filename Value="units/string_methods.pas"/>
113 104 <IsPartOfProject Value="True"/>
114 105 </Unit10>
115 106 <Unit11>
116   - <Filename Value="units/game_resources.pas"/>
  107 + <Filename Value="units/game_actors_point.pas"/>
117 108 <IsPartOfProject Value="True"/>
118 109 </Unit11>
119 110 <Unit12>
120   - <Filename Value="units/game_control.pas"/>
  111 + <Filename Value="units/game_visual_elements.pas"/>
121 112 <IsPartOfProject Value="True"/>
122 113 </Unit12>
123 114 <Unit13>
124   - <Filename Value="units/string_methods.pas"/>
  115 + <Filename Value="form_chooseactor.pas"/>
125 116 <IsPartOfProject Value="True"/>
  117 + <ComponentName Value="FormChooseActor"/>
  118 + <ResourceBaseClass Value="Form"/>
126 119 </Unit13>
127   - <Unit14>
128   - <Filename Value="units/game_actors_point.pas"/>
129   - <IsPartOfProject Value="True"/>
130   - </Unit14>
131   - <Unit15>
132   - <Filename Value="units/game_visual_elements.pas"/>
133   - <IsPartOfProject Value="True"/>
134   - </Unit15>
135   - <Unit16>
136   - <Filename Value="units/zmq_network3.pas"/>
137   - <IsPartOfProject Value="True"/>
138   - </Unit16>
139 120 </Units>
140 121 </ProjectOptions>
141 122 <CompilerOptions>
... ... @@ -158,6 +139,9 @@
158 139 </Linking>
159 140 <Other>
160 141 <CustomOptions Value="-dUseCThreads"/>
  142 + <OtherDefines Count="1">
  143 + <Define0 Value="UseCThreads"/>
  144 + </OtherDefines>
161 145 </Other>
162 146 </CompilerOptions>
163 147 <Debugging>
... ...
cultural_matrix.lpr
  Diff comments   View file @5111a7e
... ... @@ -25,8 +25,8 @@ uses
25 25 {$ENDIF}
26 26 {$ENDIF}
27 27 , StrUtils, Forms, Classes, sysutils
28   - , form_matrixgame, form_chooseactor, game_actors
29   - , zhelpers
  28 + , form_matrixgame, game_actors
  29 + , zhelpers, form_chooseactor
30 30 ;
31 31  
32 32  
... ... @@ -86,7 +86,8 @@ begin
86 86 Exit;
87 87 end;
88 88 end;
89   - Application.CreateForm(TFormMatrixGame, FormMatrixGame);
  89 + Application.CreateForm(TFormMatrixGame, FormMatrixGame);
  90 +
90 91 FormMatrixGame.SetID(F);
91 92 if Paramcount > 0 then
92 93 begin
... ... @@ -96,24 +97,6 @@ begin
96 97 FormMatrixGame.SetGameActor(gaPlayer);
97 98 if AnsiMatchStr(lowercase(ParamStr(0)), PWatcher) then
98 99 FormMatrixGame.SetGameActor(gaWatcher);
99   - end
100   - else
101   - begin
102   - FormChooseActor := TFormChooseActor.Create(nil);
103   - FormChooseActor.Style := '.Arrived';
104   - try
105   - if FormChooseActor.ShowModal = 1 then
106   - begin
107   - case FormChooseActor.GameActor of
108   - gaAdmin:FormMatrixGame.SetGameActor(gaAdmin);
109   - gaPlayer: FormMatrixGame.SetGameActor(gaPlayer);
110   - gaWatcher: FormMatrixGame.SetGameActor(gaWatcher);
111   - end;
112   - end
113   - else Exit;
114   - finally
115   - FormChooseActor.Free;
116   - end;
117 100 end;
118 101 Application.Run;
119 102 end.
... ...
form_chooseactor.lfm
  Diff comments   View file @5111a7e
1 1 object FormChooseActor: TFormChooseActor
2   - Left = 416
  2 + Left = 396
3 3 Height = 240
4   - Top = 194
  4 + Top = 185
5 5 Width = 320
  6 + BorderIcons = [biSystemMenu]
6 7 BorderStyle = bsDialog
7 8 Caption = 'FormChooseActor'
8 9 ClientHeight = 240
9 10 ClientWidth = 320
10 11 FormStyle = fsStayOnTop
11   - OnCloseQuery = FormCloseQuery
12   - OnCreate = FormCreate
13 12 Position = poScreenCenter
14   - LCLVersion = '1.6.0.4'
15   - object btnAdmin: TButton
16   - Left = 64
17   - Height = 25
18   - Top = 70
19   - Width = 184
20   - Caption = 'Administrador'
21   - OnClick = btnAdminClick
22   - TabOrder = 0
23   - end
24   - object btnPlayer: TButton
25   - Left = 64
26   - Height = 25
27   - Top = 125
28   - Width = 179
29   - Caption = 'Jogador'
30   - OnClick = btnPlayerClick
31   - TabOrder = 1
32   - end
  13 + ShowInTaskBar = stNever
  14 + LCLVersion = '1.6.2.0'
33 15 object btnPlayerResume: TButton
  16 + AnchorSideLeft.Control = Owner
  17 + AnchorSideTop.Control = Owner
  18 + AnchorSideRight.Control = Owner
  19 + AnchorSideRight.Side = asrBottom
  20 + AnchorSideBottom.Control = Owner
  21 + AnchorSideBottom.Side = asrBottom
34 22 Left = 50
35 23 Height = 140
36 24 Top = 50
37 25 Width = 220
38   - Align = alClient
  26 + Align = alCustom
  27 + Anchors = [akTop, akLeft, akRight, akBottom]
39 28 BorderSpacing.Around = 50
40   - Caption = 'ENTRAR'
  29 + Caption = 'Entrar'
  30 + Font.Height = -53
  31 + Font.Name = 'Impact'
41 32 OnClick = btnPlayerResumeClick
  33 + ParentFont = False
42 34 TabOrder = 2
  35 + Visible = False
  36 + end
  37 + object btnAdmin: TButton
  38 + Left = 0
  39 + Height = 43
  40 + Top = 50
  41 + Width = 320
  42 + Align = alTop
  43 + AutoSize = True
  44 + BorderSpacing.Top = 50
  45 + Caption = 'Pesquisador'
  46 + Font.Height = -27
  47 + Font.Name = 'Impact'
  48 + OnClick = btnAdminClick
  49 + ParentFont = False
  50 + TabOrder = 0
  51 + end
  52 + object btnPlayer: TButton
  53 + Left = 0
  54 + Height = 43
  55 + Top = 143
  56 + Width = 320
  57 + Align = alTop
  58 + BorderSpacing.Top = 50
  59 + Caption = 'Jogador'
  60 + Font.Height = -27
  61 + Font.Name = 'Impact'
  62 + OnClick = btnPlayerClick
  63 + ParentFont = False
  64 + TabOrder = 1
43 65 end
44 66 end
... ...
form_chooseactor.pas
  Diff comments   View file @5111a7e
... ... @@ -5,8 +5,7 @@ unit form_chooseactor;
5 5 interface
6 6  
7 7 uses
8   - Classes, SysUtils, FileUtil, Forms, Controls,
9   - Graphics, Dialogs, StdCtrls,ExtCtrls, LCLType
  8 + Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls
10 9 , game_actors
11 10 ;
12 11  
... ... @@ -18,6 +17,9 @@ type
18 17 btnAdmin: TButton;
19 18 btnPlayer: TButton;
20 19 btnPlayerResume: TButton;
  20 + //btnAdmin: TButton;
  21 + //btnPlayer: TButton;
  22 + //btnPlayerResume: TButton;
21 23 procedure btnAdminClick(Sender: TObject);
22 24 procedure btnPlayerClick(Sender: TObject);
23 25 procedure btnPlayerResumeClick(Sender: TObject);
... ... @@ -63,8 +65,7 @@ begin
63 65 ModalResult:=1;
64 66 end;
65 67  
66   -procedure TFormChooseActor.FormCloseQuery(Sender: TObject; var CanClose: boolean
67   - );
  68 +procedure TFormChooseActor.FormCloseQuery(Sender: TObject; var CanClose: boolean );
68 69 begin
69 70 CanClose := FCanClose;
70 71 end;
... ... @@ -81,10 +82,10 @@ begin
81 82 '.Arrived': btnPlayerResume.Visible:=False;
82 83 '.Left': btnPlayerResume.Visible:=True;
83 84 end;
  85 + btnAdmin.Visible:= not btnPlayerResume.Visible;
  86 + btnPlayer.Visible:= not btnPlayerResume.Visible;
84 87 FStyle:=AValue;
85 88 end;
86 89  
87   -
88   -
89 90 end.
90 91  
... ...
form_matrixgame.lfm
  Diff comments   View file @5111a7e
1 1 object FormMatrixGame: TFormMatrixGame
2 2 Left = 0
3   - Height = 657
4   - Top = 62
  3 + Height = 560
  4 + Top = 70
5 5 Width = 1278
6 6 HorzScrollBar.Page = 1278
7 7 VertScrollBar.Page = 542
8 8 AutoScroll = True
9 9 Caption = 'FormMatrixGame'
10   - ClientHeight = 647
  10 + ClientHeight = 550
11 11 ClientWidth = 1278
12 12 Font.Name = 'Monospace'
13 13 OnActivate = FormActivate
14   - LCLVersion = '1.6.0.4'
  14 + LCLVersion = '1.6.2.0'
  15 + object GBIndividual: TGroupBox
  16 + AnchorSideLeft.Control = GBIndividualAB
  17 + AnchorSideTop.Control = GBIndividualAB
  18 + Left = 800
  19 + Height = 122
  20 + Top = 8
  21 + Width = 170
  22 + AutoSize = True
  23 + Caption = 'Pontuação Individual'
  24 + ChildSizing.LeftRightSpacing = 35
  25 + ChildSizing.TopBottomSpacing = 45
  26 + ChildSizing.Layout = cclLeftToRightThenTopToBottom
  27 + ChildSizing.ControlsPerLine = 1
  28 + ClientHeight = 105
  29 + ClientWidth = 166
  30 + TabOrder = 7
  31 + Visible = False
  32 + object LabelIndCount: TLabel
  33 + Left = 35
  34 + Height = 15
  35 + Top = 45
  36 + Width = 96
  37 + Align = alClient
  38 + Alignment = taCenter
  39 + AutoSize = False
  40 + Caption = '0'
  41 + Color = clDefault
  42 + Layout = tlCenter
  43 + ParentColor = False
  44 + Transparent = False
  45 + end
  46 + end
15 47 object StringGridMatrix: TStringGrid
16 48 AnchorSideLeft.Control = Owner
17 49 AnchorSideTop.Control = Owner
... ... @@ -30,17 +62,17 @@ object FormMatrixGame: TFormMatrixGame
30 62 DefaultRowHeight = 30
31 63 Enabled = False
32 64 FixedRows = 0
33   - Options = [goFixedHorzLine, goHorzLine, goDrawFocusSelected, goRowSelect, goSmoothScroll]
  65 + Options = []
34 66 RowCount = 10
35 67 TabOrder = 0
36 68 TitleFont.Name = 'Monospace'
37   - OnBeforeSelection = StringGridMatrixBeforeSelection
  69 + OnClick = StringGridMatrixClick
38 70 OnDrawCell = StringGridMatrixDrawCell
39 71 end
40 72 object GBIndividualAB: TGroupBox
41   - Left = 796
  73 + Left = 800
42 74 Height = 122
43   - Top = 0
  75 + Top = 8
44 76 Width = 170
45 77 AutoSize = True
46 78 Caption = 'Pontuação Individual'
... ... @@ -115,9 +147,9 @@ object FormMatrixGame: TFormMatrixGame
115 147 AnchorSideLeft.Control = GBIndividualAB
116 148 AnchorSideLeft.Side = asrBottom
117 149 AnchorSideTop.Control = GBIndividualAB
118   - Left = 976
  150 + Left = 980
119 151 Height = 122
120   - Top = 0
  152 + Top = 8
121 153 Width = 170
122 154 AutoSize = True
123 155 BorderSpacing.Left = 10
... ... @@ -152,8 +184,8 @@ object FormMatrixGame: TFormMatrixGame
152 184 AnchorSideBottom.Side = asrBottom
153 185 Left = 0
154 186 Height = 17
155   - Top = 630
156   - Width = 1492
  187 + Top = 533
  188 + Width = 1632
157 189 Anchors = [akLeft, akRight, akBottom]
158 190 AutoSize = True
159 191 Caption = 'Escolhas na última jogada'
... ... @@ -168,61 +200,59 @@ object FormMatrixGame: TFormMatrixGame
168 200 AnchorSideLeft.Control = GBGrupo
169 201 AnchorSideLeft.Side = asrBottom
170 202 AnchorSideTop.Control = GBGrupo
171   - Left = 1156
172   - Height = 208
173   - Top = 0
174   - Width = 336
  203 + Left = 1160
  204 + Height = 486
  205 + Top = 8
  206 + Width = 472
175 207 BorderSpacing.Left = 10
176   - Caption = 'Administrador'
177   - ClientHeight = 191
178   - ClientWidth = 332
  208 + Caption = 'Pesquisador'
  209 + ClientHeight = 469
  210 + ClientWidth = 468
179 211 TabOrder = 4
180 212 Visible = False
181 213 object GBExperiment: TGroupBox
182 214 Left = 8
183   - Height = 172
184   - Top = 8
185   - Width = 218
  215 + Height = 277
  216 + Top = 60
  217 + Width = 188
186 218 AutoSize = True
187 219 Caption = 'Experimento'
188   - ChildSizing.LeftRightSpacing = 20
  220 + ChildSizing.LeftRightSpacing = 10
189 221 ChildSizing.TopBottomSpacing = 20
190   - ChildSizing.HorizontalSpacing = 30
  222 + ChildSizing.HorizontalSpacing = 20
191 223 ChildSizing.VerticalSpacing = 10
192 224 ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
193 225 ChildSizing.Layout = cclLeftToRightThenTopToBottom
194 226 ChildSizing.ControlsPerLine = 2
195   - ClientHeight = 155
196   - ClientWidth = 214
  227 + ClientHeight = 260
  228 + ClientWidth = 184
197 229 TabOrder = 0
198 230 object LabelExpCond: TLabel
199   - Left = 20
  231 + Left = 10
200 232 Height = 15
201 233 Top = 20
202 234 Width = 128
203   - AutoSize = False
204 235 Caption = 'Condição:'
205 236 ParentColor = False
206 237 end
207   - object LabelExpCondCount: TLabel
208   - Left = 178
  238 + object LabelExpCountCondition: TLabel
  239 + Left = 158
209 240 Height = 15
210 241 Top = 20
211 242 Width = 16
212   - AutoSize = False
213 243 Caption = 'NA'
214 244 ParentColor = False
215 245 end
216 246 object LabelExpGen: TLabel
217   - Left = 20
  247 + Left = 10
218 248 Height = 15
219 249 Top = 45
220 250 Width = 128
221   - Caption = 'Generation:'
  251 + Caption = 'Generação:'
222 252 ParentColor = False
223 253 end
224   - object LabelExpGenCount: TLabel
225   - Left = 178
  254 + object LabelExpCountGeneration: TLabel
  255 + Left = 158
226 256 Height = 15
227 257 Top = 45
228 258 Width = 16
... ... @@ -230,15 +260,15 @@ object FormMatrixGame: TFormMatrixGame
230 260 ParentColor = False
231 261 end
232 262 object LabelExpCycle: TLabel
233   - Left = 20
  263 + Left = 10
234 264 Height = 15
235 265 Top = 70
236 266 Width = 128
237   - Caption = 'Cycle:'
  267 + Caption = 'Ciclo:'
238 268 ParentColor = False
239 269 end
240   - object LabelExpCycleCount: TLabel
241   - Left = 178
  270 + object LabelExpCountCycle: TLabel
  271 + Left = 158
242 272 Height = 15
243 273 Top = 70
244 274 Width = 16
... ... @@ -246,15 +276,15 @@ object FormMatrixGame: TFormMatrixGame
246 276 ParentColor = False
247 277 end
248 278 object LabelExpNxtPlayer: TLabel
249   - Left = 20
  279 + Left = 10
250 280 Height = 15
251 281 Top = 95
252 282 Width = 128
253 283 Caption = 'Prox. Jog.:'
254 284 ParentColor = False
255 285 end
256   - object LabelExpNxtPlayerCount: TLabel
257   - Left = 178
  286 + object LabelExpCountNxtPlayer: TLabel
  287 + Left = 158
258 288 Height = 15
259 289 Top = 95
260 290 Width = 16
... ... @@ -262,28 +292,78 @@ object FormMatrixGame: TFormMatrixGame
262 292 ParentColor = False
263 293 end
264 294 object LabelExpInterlocks: TLabel
265   - Left = 20
  295 + Left = 10
266 296 Height = 15
267 297 Top = 120
268 298 Width = 128
269 299 Caption = 'Entrelaçamentos:'
270 300 ParentColor = False
271 301 end
272   - object LabelExpInterlocksCount: TLabel
273   - Left = 178
  302 + object LabelExpCountInterlocks: TLabel
  303 + Left = 158
274 304 Height = 15
275 305 Top = 120
276 306 Width = 16
277 307 Caption = 'NA'
278 308 ParentColor = False
279 309 end
  310 + object ButtonExpStart: TButton
  311 + Left = 10
  312 + Height = 25
  313 + Top = 145
  314 + Width = 128
  315 + Caption = 'Começar'
  316 + OnClick = ButtonExpStartClick
  317 + TabOrder = 0
  318 + end
  319 + object LabelUnseen1: TLabel
  320 + Left = 158
  321 + Height = 25
  322 + Top = 145
  323 + Width = 16
  324 + ParentColor = False
  325 + end
  326 + object ButtonExpPause: TButton
  327 + Left = 10
  328 + Height = 25
  329 + Top = 180
  330 + Width = 128
  331 + Caption = 'Pausar'
  332 + Enabled = False
  333 + OnClick = ButtonExpPauseClick
  334 + TabOrder = 1
  335 + end
  336 + object LabelUnseen2: TLabel
  337 + Left = 158
  338 + Height = 25
  339 + Top = 180
  340 + Width = 16
  341 + ParentColor = False
  342 + end
  343 + object ButtonExpCancel: TButton
  344 + Left = 10
  345 + Height = 25
  346 + Top = 215
  347 + Width = 128
  348 + Caption = 'Cancelar'
  349 + Enabled = False
  350 + OnClick = ButtonExpCancelClick
  351 + TabOrder = 2
  352 + end
  353 + object LabelUnseen3: TLabel
  354 + Left = 158
  355 + Height = 25
  356 + Top = 215
  357 + Width = 16
  358 + ParentColor = False
  359 + end
280 360 end
281 361 end
282 362 object btnConfirmRow: TButton
283 363 Left = 712
284   - Height = 25
285   - Top = 320
286   - Width = 83
  364 + Height = 26
  365 + Top = 319
  366 + Width = 86
287 367 Caption = 'Confirmar'
288 368 OnClick = btnConfirmRowClick
289 369 TabOrder = 5
... ... @@ -295,9 +375,9 @@ object FormMatrixGame: TFormMatrixGame
295 375 AnchorSideTop.Side = asrBottom
296 376 AnchorSideRight.Control = GBGrupo
297 377 AnchorSideRight.Side = asrBottom
298   - Left = 796
  378 + Left = 800
299 379 Height = 354
300   - Top = 132
  380 + Top = 140
301 381 Width = 350
302 382 Anchors = [akTop, akLeft, akRight]
303 383 BorderSpacing.Top = 10
... ... @@ -351,63 +431,24 @@ object FormMatrixGame: TFormMatrixGame
351 431 WantTabs = True
352 432 end
353 433 end
354   - object GBIndividual: TGroupBox
355   - AnchorSideLeft.Control = GBIndividualAB
356   - AnchorSideTop.Control = GBIndividualAB
357   - Left = 796
358   - Height = 122
359   - Top = 0
360   - Width = 170
361   - AutoSize = True
362   - Caption = 'Pontuação Individual'
363   - ChildSizing.LeftRightSpacing = 35
364   - ChildSizing.TopBottomSpacing = 45
365   - ChildSizing.Layout = cclLeftToRightThenTopToBottom
366   - ChildSizing.ControlsPerLine = 1
367   - ClientHeight = 105
368   - ClientWidth = 166
369   - TabOrder = 7
370   - Visible = False
371   - object LabelIndCount: TLabel
372   - Left = 35
373   - Height = 15
374   - Top = 45
375   - Width = 96
376   - Align = alClient
377   - Alignment = taCenter
378   - AutoSize = False
379   - Caption = '0'
380   - Color = clDefault
381   - Layout = tlCenter
382   - ParentColor = False
383   - Transparent = False
384   - 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 434 object Button3: TButton
405   - Left = 504
  435 + Left = 568
406 436 Height = 91
407   - Top = 440
  437 + Top = 352
408 438 Width = 141
409 439 Caption = 'Button3'
410 440 OnClick = Button3Click
411   - TabOrder = 10
  441 + TabOrder = 8
  442 + end
  443 + object OpenDialog: TOpenDialog
  444 + Width = 862
  445 + Height = 434
  446 + Title = 'Abrir Experimento'
  447 + DefaultExt = '.txt'
  448 + Filter = 'txt|*.txt|ini|*.ini'
  449 + InitialDir = 'Pesquisadores'
  450 + Options = [ofNoChangeDir, ofFileMustExist, ofNoNetworkButton, ofEnableSizing, ofDontAddToRecent]
  451 + left = 24
  452 + top = 360
412 453 end
413 454 end
... ...
form_matrixgame.pas
  Diff comments   View file @5111a7e
... ... @@ -29,24 +29,28 @@ type
29 29  
30 30 TFormMatrixGame = class(TForm)
31 31 btnConfirmRow: TButton;
32   - Button1: TButton;
33   - Button2: TButton;
  32 + ButtonExpStart: TButton;
  33 + ButtonExpPause: TButton;
34 34 Button3: TButton;
  35 + ButtonExpCancel: TButton;
35 36 GBIndividual: TGroupBox;
36 37 GBLastChoice: TGroupBox;
37 38 GBIndividualAB: TGroupBox;
38 39 GBGrupo: TGroupBox;
39 40 GBAdmin: TGroupBox;
40 41 GBExperiment: TGroupBox;
41   - LabelExpCondCount: TLabel;
  42 + LabelUnseen1: TLabel;
  43 + LabelUnseen2: TLabel;
  44 + LabelUnseen3: TLabel;
  45 + LabelExpCountCondition: TLabel;
42 46 LabelExpGen: TLabel;
43   - LabelExpGenCount: TLabel;
  47 + LabelExpCountGeneration: TLabel;
44 48 LabelExpCycle: TLabel;
45   - LabelExpCycleCount: TLabel;
  49 + LabelExpCountCycle: TLabel;
46 50 LabelExpNxtPlayer: TLabel;
47   - LabelExpNxtPlayerCount: TLabel;
  51 + LabelExpCountNxtPlayer: TLabel;
48 52 LabelExpInterlocks: TLabel;
49   - LabelExpInterlocksCount: TLabel;
  53 + LabelExpCountInterlocks: TLabel;
50 54 LabelIndCount: TLabel;
51 55 LabelIndACount: TLabel;
52 56 LabelIndBCount: TLabel;
... ... @@ -58,15 +62,16 @@ type
58 62 ChatMemoSend: TMemo;
59 63 ChatPanel: TPanel;
60 64 ChatSplitter: TSplitter;
  65 + OpenDialog: TOpenDialog;
61 66 StringGridMatrix: TStringGrid;
62 67 procedure btnConfirmRowClick(Sender: TObject);
63   - procedure Button1Click(Sender: TObject);
64   - procedure Button2Click(Sender: TObject);
65 68 procedure Button3Click(Sender: TObject);
  69 + procedure ButtonExpCancelClick(Sender: TObject);
  70 + procedure ButtonExpPauseClick(Sender: TObject);
  71 + procedure ButtonExpStartClick(Sender: TObject);
66 72 procedure ChatMemoSendKeyPress(Sender: TObject; var Key: char);
67   - procedure CheckBoxDrawDotsChange(Sender: TObject);
68 73 procedure FormActivate(Sender: TObject);
69   - procedure StringGridMatrixBeforeSelection(Sender: TObject; aCol, aRow: integer);
  74 + procedure StringGridMatrixClick(Sender: TObject);
70 75 procedure StringGridMatrixDrawCell(Sender: TObject; aCol, aRow: integer;
71 76 aRect: TRect; aState: TGridDrawState);
72 77 private
... ... @@ -80,14 +85,14 @@ type
80 85  
81 86 var
82 87 FormMatrixGame: TFormMatrixGame;
  88 +resourcestring
  89 + RS_RESEARCHERS = 'Pesquisadores';
83 90  
84 91 implementation
85 92  
86   -uses form_chooseactor, LCLType, game_resources;
  93 +uses form_chooseactor, game_resources;
87 94  
88 95 // uses datamodule;
89   -var
90   - MustDrawSelection : Boolean; // work around until a bug fix for ClearSelection is released
91 96  
92 97 {$R *.lfm}
93 98  
... ... @@ -168,7 +173,7 @@ begin
168 173 begin
169 174 DrawLines(GetRowColor(aRow,RowBase));
170 175  
171   - if (gdSelected in aState) and MustDrawSelection then
  176 + if (gdSelected in aState) and (goRowSelect in TStringGrid(Sender).Options)then
172 177 begin
173 178 TStringGrid(Sender).Canvas.Pen.Width := 10;
174 179 TStringGrid(Sender).Canvas.Pen.Color := clWhite;
... ... @@ -195,11 +200,11 @@ begin
195 200 TStringGrid(Sender).Canvas.Font.Color := clBlack;
196 201 TStringGrid(Sender).Canvas.Brush.Style := bsClear;
197 202  
198   - if (aCol = 10) and (gdSelected in aState) and MustDrawSelection then
  203 + if (aCol = 10) and (gdSelected in aState) and (goRowSelect in TStringGrid(Sender).Options) then
199 204 if (aRow = TStringGrid(Sender).Selection.Top) and (aCol = TStringGrid(Sender).Selection.Right) then
200 205 begin
201   - btnConfirmRow.Top := aRect.Top+5;
202   - btnConfirmRow.Left := aRect.Right+5;
  206 + btnConfirmRow.Top := aRect.Top+4;
  207 + btnConfirmRow.Left := aRect.Right+8;
203 208 end;
204 209  
205 210 finally
... ... @@ -219,7 +224,6 @@ procedure TFormMatrixGame.SetGameActor(AValue: TGameActor);
219 224 procedure SetZMQPlayer;
220 225 begin
221 226 FGameControl := TGameControl.Create(TZMQPlayer.Create(Self,FID));
222   - btnConfirmRow.Visible := True;
223 227 StringGridMatrix.Enabled := True;
224 228 end;
225 229  
... ... @@ -241,27 +245,39 @@ begin
241 245 FID := S;
242 246 end;
243 247  
244   -procedure TFormMatrixGame.CheckBoxDrawDotsChange(Sender: TObject);
245   -begin
246   - StringGridMatrix.Invalidate;
247   -end;
248 248  
249 249 procedure TFormMatrixGame.FormActivate(Sender: TObject);
250 250 begin
251   - StringGridMatrix.ClearSelections;
252   - StringGridMatrix.FocusRectVisible := False;
253   - FGameControl.SetMatrix;
  251 + FormChooseActor := TFormChooseActor.Create(Self);
  252 + FormChooseActor.Style := '.Arrived';
  253 + try
  254 + if FormChooseActor.ShowModal = 1 then
  255 + begin
  256 + case FormChooseActor.GameActor of
  257 + gaAdmin:FormMatrixGame.SetGameActor(gaAdmin);
  258 + gaPlayer: FormMatrixGame.SetGameActor(gaPlayer);
  259 + gaWatcher: FormMatrixGame.SetGameActor(gaWatcher);
  260 + end;
  261 + StringGridMatrix.ClearSelections;
  262 + StringGridMatrix.FocusRectVisible := False;
  263 + FGameControl.SetMatrix;
  264 + end
  265 + else Close;
  266 + finally
  267 + FormChooseActor.Free;
  268 + end;
254 269 end;
255 270  
256   -procedure TFormMatrixGame.StringGridMatrixBeforeSelection(Sender: TObject; aCol, aRow: integer);
  271 +procedure TFormMatrixGame.StringGridMatrixClick(Sender: TObject);
257 272 begin
258   - if MustDrawSelection then Exit;
259   - MustDrawSelection := True;
  273 + if goRowSelect in StringGridMatrix.Options then Exit;
  274 + StringGridMatrix.Options := StringGridMatrix.Options+[goRowSelect];
  275 + btnConfirmRow.Visible := True;
260 276 end;
261 277  
262 278 procedure TFormMatrixGame.ChatMemoSendKeyPress(Sender: TObject; var Key: char);
263 279 begin
264   - if Key = Char(VK_RETURN) then
  280 + if Key = Char(13) then
265 281 begin
266 282 FGameControl.SendMessage(K_CHAT_M);
267 283 with ChatMemoSend do
... ... @@ -271,42 +287,61 @@ begin
271 287 SelLength:=0;
272 288 SetFocus;
273 289 end;
274   - Key := Char(VK_UNKNOWN);
  290 + Key := Char(0);
275 291 end;
276 292 end;
277 293  
278 294 procedure TFormMatrixGame.btnConfirmRowClick(Sender: TObject);
279 295 begin
280   - //StringGridMatrix.ClearSelections;
281   - //MustDrawSelection := False;
282 296 StringGridMatrix.Enabled:= False;
283   - btnConfirmRow.Visible:=False;
  297 + btnConfirmRow.Enabled:=False;
284 298 FGameControl.SendMessage(K_CHOICE);
285 299 end;
286 300  
287   -procedure TFormMatrixGame.Button1Click(Sender: TObject);
  301 +procedure TFormMatrixGame.Button3Click(Sender: TObject);
288 302 begin
289   -
  303 + FGameControl.Experiment.SaveToFile(OpenDialog.FileName+'.ini');
290 304 end;
291 305  
292   -procedure TFormMatrixGame.Button2Click(Sender: TObject);
  306 +procedure TFormMatrixGame.ButtonExpCancelClick(Sender: TObject);
293 307 begin
  308 + ButtonExpStart.Enabled := True;
  309 + ButtonExpStart.Caption := 'Começar';
  310 + ButtonExpCancel.Enabled := not ButtonExpStart.Enabled;
  311 + ButtonExpPause.Enabled := not ButtonExpStart.Enabled;
  312 + //FGameControl.Experiment.SaveToFile(SaveDialog.FileName'.canceled');
  313 + //FGameControl.Experiment.Clean;
  314 +end;
294 315  
  316 +procedure TFormMatrixGame.ButtonExpPauseClick(Sender: TObject);
  317 +begin
  318 + ButtonExpStart.Enabled := True;
  319 + ButtonExpStart.Caption := 'Recomeçar';
  320 + ButtonExpPause.Enabled := not ButtonExpStart.Enabled;
  321 + //FGameControl.Experiment.Pause;
295 322 end;
296 323  
297   -procedure TFormMatrixGame.Button3Click(Sender: TObject);
  324 +procedure TFormMatrixGame.ButtonExpStartClick(Sender: TObject);
298 325 begin
299   - FGameControl.SendMessage(K_LEFT);
300   - FormMatrixGame.Visible := False;
301   - FormChooseActor := TFormChooseActor.Create(nil);
302   - FormChooseActor.Style := K_LEFT;
303   - if FormChooseActor.ShowModal = 1 then
304   - begin
305   - FGameControl.SendMessage(K_RESUME);
306   - FormMatrixGame.Visible := True;
307   - end
308   - else Close;
309   - FormChooseActor.Free;
  326 + OpenDialog.InitialDir:=ExtractFilePath(Application.ExeName)+RS_RESEARCHERS;
  327 + if ButtonExpStart.Caption = 'Começar' then
  328 + if OpenDialog.Execute then
  329 + begin
  330 + ButtonExpStart.Enabled := False;
  331 + ButtonExpStart.Caption := 'Rodando';
  332 + ButtonExpCancel.Enabled := not ButtonExpStart.Enabled;
  333 + ButtonExpPause.Enabled := not ButtonExpStart.Enabled;
  334 + //FGameControl.Experiment.LoadFromFile(OpenDialog.FileName);
  335 + end;
  336 +
  337 + if ButtonExpStart.Caption = 'Recomeçar' then
  338 + begin
  339 + ButtonExpStart.Enabled := False;
  340 + ButtonExpStart.Caption := 'Rodando';
  341 + ButtonExpCancel.Enabled := not ButtonExpStart.Enabled;
  342 + ButtonExpPause.Enabled := not ButtonExpStart.Enabled;
  343 + //FGameControl.Experiment.Resume;
  344 + end;
310 345 end;
311 346  
312 347 end.
... ...
units/backup/game_dialogs.lfm 0 → 100644
  Diff comments   View file @5111a7e
... ... @@ -0,0 +1,18 @@
  1 +object DataModule2: TDataModule2
  2 + OldCreateOrder = False
  3 + Height = 210
  4 + HorizontalOffset = 375
  5 + VerticalOffset = 243
  6 + Width = 412
  7 + object OpenDialog: TOpenDialog
  8 + Width = 862
  9 + Height = 434
  10 + Title = 'Abrir Experimento'
  11 + DefaultExt = '.txt'
  12 + FileName = '/home/rafael/free-pascal/published'
  13 + Filter = 'txt|*.TXT|ini|*.INI'
  14 + InitialDir = '/home/rafael/free-pascal/'
  15 + left = 32
  16 + top = 8
  17 + end
  18 +end
... ...
units/game_actors.pas
  Diff comments   View file @5111a7e
... ... @@ -10,7 +10,6 @@ uses
10 10 ;
11 11 type
12 12  
13   -
14 13 TGameActor = ( gaNone, gaAdmin, gaPlayer, gaWatcher );
15 14 TGamePlayerStatus = (gpsWaiting, gpsPlaying, gpsPlayed);
16 15  
... ... @@ -38,6 +37,7 @@ type
38 37 TConsequenceStyle = set of TGameConsequenceStyle;
39 38  
40 39 TGamePromptStyle = (gsYes, gsNo, gsAll, gsMetacontingency, gsContingency, gsBasA, gsRevertPoints);
  40 +
41 41 TPromptStyle = set of TGamePromptStyle;
42 42  
43 43  
... ...
units/game_control.pas
  Diff comments   View file @5111a7e
... ... @@ -16,6 +16,7 @@ uses
16 16  
17 17 type
18 18  
  19 +
19 20 { TGameControl }
20 21  
21 22 TGameControl = class(TComponent)
... ... @@ -32,6 +33,7 @@ type
32 33 function GetSelectedColorF(AStringGrid : TStringGrid) : UTF8string;
33 34 function GetSelectedRowF(AStringGrid : TStringGrid) : UTF8string;
34 35 function MessageHas(const A_CONST : string; AMessage : TStringList; I:ShortInt=0): Boolean;
  36 + procedure CreatePlayerBox(P:TPlayer; Me:Boolean);
35 37 procedure SetMatrixType(AStringGrid : TStringGrid; AMatrixType:TGameMatrixType;
36 38 var ARowBase:integer; var ADrawDots, ADrawClear : Boolean);
37 39 procedure ReceiveMessage(AMessage : TStringList);
... ... @@ -42,15 +44,18 @@ type
42 44 procedure SetRowBase(AValue: integer);
43 45 private
44 46 function CanStartExperiment : Boolean;
  47 + procedure KickPlayer(AID:string);
45 48 procedure StartCycle;
46 49 procedure StartCondition;
47 50 procedure StartExperiment;
  51 + procedure StartTurn;
48 52 public
49 53 constructor Create(AOwner : TComponent);override;
50 54 destructor Destroy; override;
51 55 procedure SetMatrix;
52 56 procedure SendRequest(ARequest : UTF8string);
53 57 procedure SendMessage(AMessage : UTF8string);
  58 + property Experiment : TExperiment read FExperiment write FExperiment;
54 59 property ID : string read FID;
55 60 property RowBase : integer read FRowBase write SetRowBase;
56 61 property MustDrawDots: Boolean read FMustDrawDots write SetMustDrawDots;
... ... @@ -61,25 +66,25 @@ type
61 66  
62 67 const
63 68 K_FULLROOM = '.Full';
64   - K_PLAYING = '.Playing';
65   - K_ARRIVED = '.Arrived';
66   - K_REFUSED = '.Refused';
67   - K_CHAT_M = '.ChatM';
68   - K_CHOICE = '.Choice';
69   - K_LEFT = '.Left';
70   - K_RESUME = '.Resume';
71   - K_DATA_A = '.Data';
72   - K_LOGIN = '.login';
73   -
  69 + K_PLAYING = '.Playing';
  70 + K_ARRIVED = '.Arrived';
  71 + K_REFUSED = '.Refused';
  72 + K_CHAT_M = '.ChatM';
  73 + K_CHOICE = '.Choice';
  74 + K_LEFT = '.Left';
  75 + K_RESUME = '.Resume';
  76 + K_DATA_A = '.Data';
  77 + K_LOGIN = '.Login';
  78 + K_KICK = '.Kick'
74 79 //
75   - K_STATUS = '.Status';
76   - K_CYCLES = '.OnCycleStart';
  80 + K_STATUS = '.Status';
  81 + K_CYCLES = '.OnCycleStart';
77 82  
78 83 //K_RESPONSE =
79 84  
80 85 implementation
81 86  
82   -uses form_matrixgame, game_resources, string_methods, zhelpers;
  87 +uses LazUTF8, form_matrixgame, form_chooseactor, game_resources, string_methods, zhelpers;
83 88  
84 89 const
85 90 GA_ADMIN = 'Admin';
... ... @@ -106,7 +111,12 @@ end;
106 111  
107 112 function TGameControl.CanStartExperiment: Boolean;
108 113 begin
109   - Result := FExperiment.PlayersPlaying.Count = FExperiment.Condition[FExperiment.CurrentCondition].Turn.Value;
  114 + Result := FExperiment.PlayersCount = FExperiment.Condition[FExperiment.CurrentCondition].Turn.Value;
  115 +end;
  116 +
  117 +procedure TGameControl.KickPlayer(AID: string);
  118 +begin
  119 + FZMQActor.SendMessage([K_KICK, AID]);
110 120 end;
111 121  
112 122 function TGameControl.GetPlayerBox(AID: string): TPlayerBox;
... ... @@ -141,6 +151,26 @@ begin
141 151 Result := Pos(A_CONST,AMessage[I])>0;
142 152 end;
143 153  
  154 +procedure TGameControl.CreatePlayerBox(P: TPlayer; Me: Boolean);
  155 +var i1 : integer;
  156 +begin
  157 + with TPlayerBox.Create(FormMatrixGame.GBLastChoice,P.ID) do
  158 + begin
  159 + if Me then
  160 + Caption := P.Nicname+SysToUtf8(' (Você)' )
  161 + else
  162 + Caption := P.Nicname;
  163 + i1 := Integer(P.Choice.Last.Row);
  164 + if i1 > 0 then
  165 + LabelLastRowCount.Caption := Format('%-*.*d', [1,2,i1])
  166 + else
  167 + LabelLastRowCount.Caption := 'NA';
  168 + PanelLastColor.Color := GetColorFromCode(P.Choice.Last.Color);
  169 + Enabled := True;
  170 + Parent := FormMatrixGame.GBLastChoice;
  171 + end;
  172 +end;
  173 +
144 174 procedure TGameControl.SetMatrixType(AStringGrid: TStringGrid;
145 175 AMatrixType: TGameMatrixType; var ARowBase: integer; var ADrawDots,
146 176 ADrawClear: Boolean);
... ... @@ -166,7 +196,7 @@ begin
166 196 AStringGrid.FixedRows := 0;
167 197 AStringGrid.RowCount := 10;
168 198 AStringGrid.Height:=305;
169   - AStringGrid.Options := [goFixedHorzLine, goHorzLine, goDrawFocusSelected, goRowSelect];
  199 + AStringGrid.Options := [goFixedHorzLine, goHorzLine];
170 200 WriteGridFixedNames(AStringGrid, False);
171 201 end;
172 202  
... ... @@ -177,7 +207,7 @@ begin
177 207 AStringGrid.FixedRows := 1;
178 208 AStringGrid.RowCount := 11;
179 209 AStringGrid.Height:=335;
180   - AStringGrid.Options := [goFixedHorzLine, goHorzLine, goDrawFocusSelected, goRowSelect, goVertLine];
  210 + AStringGrid.Options := [goFixedHorzLine, goHorzLine, goVertLine];
181 211 WriteGridFixedNames(AStringGrid, True);
182 212 end;
183 213  
... ... @@ -237,6 +267,13 @@ begin
237 267  
238 268 end;
239 269  
  270 +procedure TGameControl.StartTurn;
  271 +begin
  272 + FormMatrixGame.StringGridMatrix.Options := FormMatrixGame.StringGridMatrix.Options-[goRowSelect];
  273 + FormMatrixGame.btnConfirmRow.Enabled:=True;
  274 + FormMatrixGame.btnConfirmRow.Visible := False;
  275 +end;
  276 +
240 277 constructor TGameControl.Create(AOwner: TComponent);
241 278 begin
242 279 FZMQActor := TZMQActor(AOwner);
... ... @@ -284,28 +321,26 @@ var
284 321 M[i] := A[i];
285 322 end;
286 323 begin
287   - case ARequest of
288   - K_LOGIN : SetM([
289   - FZMQActor.ID
290   - , ' '
291   - , ARequest
292   - ]);
293   - end;
  324 + SetM([
  325 + FZMQActor.ID
  326 + , ' '
  327 + , ARequest
  328 + ]);
294 329  
295 330 case FActor of
296 331 gaAdmin: begin
297   - M[2] := GA_ADMIN+M[2];
  332 + //M[2] := GA_ADMIN+M[2];// for now cannot Requests
298 333 end;
299 334 gaPlayer:begin
300 335 M[2] := GA_PLAYER+M[2];
301 336 end;
302   - //gaWatcher:begin // for now cannot SendMessages
  337 + //gaWatcher:begin
303 338 // M[0] := GA_WATCHER+M[0];
304 339 end;
305 340 FZMQActor.Request(M);
306 341 end;
307 342  
308   -
  343 +// called from outside
309 344 procedure TGameControl.SendMessage(AMessage: UTF8string);
310 345 var
311 346 M : array of UTF8String;
... ... @@ -319,10 +354,6 @@ var
319 354 end;
320 355 begin
321 356 case AMessage of
322   - //K_ARRIVED : SetM([
323   - // AMessage
324   - // , FZMQActor.ID
325   - //]);
326 357  
327 358 K_CHOICE : SetM([
328 359 AMessage
... ... @@ -340,15 +371,6 @@ begin
340 371 ]);
341 372 end;
342 373  
343   - K_LEFT : SetM([
344   - AMessage
345   - , FZMQActor.ID
346   - ]);
347   -
348   - K_RESUME : SetM([
349   - AMessage
350   - , FZMQActor.ID
351   - ]);
352 374 end;
353 375  
354 376 case FActor of
... ... @@ -358,7 +380,7 @@ begin
358 380 gaPlayer:begin
359 381 M[0] := GA_PLAYER+M[0];
360 382 end;
361   - //gaWatcher:begin // for now cannot SendMessages
  383 + //gaWatcher:begin
362 384 // M[0] := GA_WATCHER+M[0];
363 385 end;
364 386 FZMQActor.SendMessage(M);
... ... @@ -383,38 +405,18 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
383 405 gaPlayer:
384 406 begin
385 407 P := FExperiment.PlayerFromString[AMessage[1]];
386   - if Self.ID = P.ID then Exit;
387   - with TPlayerBox.Create(FormMatrixGame.GBLastChoice,P.ID) do
  408 + if Self.ID = P.ID then
388 409 begin
389   - Caption := P.Nicname;
390   - LabelLastRowCount.Caption := IntToStr(ShortInt(P.Choice.Last.Row));
391   - PanelLastColor.Color := GetColorFromCode(P.Choice.Last.Color);
392   - Enabled := True;
393   - Parent := FormMatrixGame.GBLastChoice;
394   - end;
  410 + FExperiment.AppendPlayer(P);
  411 + CreatePlayerBox(P, True);
  412 + end
  413 + else
  414 + CreatePlayerBox(P,False);
395 415 end;
396 416 end;
397 417  
398 418 end;
399 419  
400   -
401   - procedure ReceiveStatus;
402   - //var P : PPlayer;
403   - // i : integer;
404   - begin
405   - //P := New(PPlayer);
406   - //case FActor of
407   - // gaPlayer:begin
408   -
409   - //
410   - // end;
411   - //
412   - // gaAdmin:begin
413   -
414   - //end;
415   - //Dispose(P);
416   - end;
417   -
418 420 procedure ReceiveChoice;
419 421 begin
420 422 case FActor of
... ... @@ -436,10 +438,17 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
436 438 begin
437 439 case FActor of
438 440 gaPlayer:begin
439   -
440   - end;
441   - gaAdmin:begin
442   -
  441 + if Self.ID <> AMessage[1] then Exit;
  442 + FormMatrixGame.Visible := False;
  443 + FormChooseActor := TFormChooseActor.Create(nil);
  444 + FormChooseActor.Style := K_LEFT;
  445 + if FormChooseActor.ShowModal = 1 then
  446 + begin
  447 + FZMQActor.Request([K_RESUME,Self.ID]);
  448 + FormMatrixGame.Visible := True;
  449 + end
  450 + else;
  451 + FormChooseActor.Free;
443 452 end;
444 453 end;
445 454 end;
... ... @@ -484,8 +493,7 @@ begin
484 493 if MHas(K_ARRIVED) then ReceiveActor;
485 494 if MHas(K_CHAT_M) then ReceiveChat;
486 495 if MHas(K_CHOICE) then ReceiveChoice;
487   - if MHas(K_LEFT) then SayGoodBye;
488   - if MHas(K_RESUME) then ResumeActor;
  496 + if MHas(K_KICK) then SayGoodBye;
489 497 if MHas(K_STATUS) then ReceiveStatus;
490 498 end;
491 499  
... ... @@ -499,11 +507,15 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList);
499 507 procedure ReplyLoginRequest;
500 508 var i : integer;
501 509 P : TPlayer;
502   - PS : string;
  510 + TS,
  511 + PS : UTF8string;
503 512 begin
504 513 if not FExperiment.PlayerIsPlaying[ARequest[0]] then
505 514 begin
506   - if FExperiment.PlayersPlaying.Count < FExperiment.Condition[FExperiment.CurrentCondition].Turn.Value then
  515 + {$IFDEF DEBUG}
  516 + WriteLn(FExperiment.PlayersCount,'<',FExperiment.Condition[FExperiment.CurrentCondition].Turn.Value);
  517 + {$ENDIF}
  518 + if FExperiment.PlayersCount < FExperiment.Condition[FExperiment.CurrentCondition].Turn.Value then
507 519 begin
508 520 // ok, let player login
509 521 P.ID := ARequest[0];
... ... @@ -517,7 +529,7 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList);
517 529 end
518 530 else
519 531 begin
520   - // if not save p data
  532 + // if not generate and save p data
521 533 i := FExperiment.AppendPlayer;
522 534 P.Nicname := GenResourceName(i);
523 535 P.Turn := FExperiment.NextTurn;
... ... @@ -529,50 +541,40 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList);
529 541 P.Choice.Last.Color:=gcNone;
530 542 P.Choice.Last.Row:=grNone;
531 543 // turns by entrance order
532   - P.Turn := FExperiment.PlayersPlaying.Count;
  544 + P.Turn := FExperiment.PlayersCount;
533 545 FExperiment.Player[i] := P;
534 546 end;
535 547  
536   - // add player to playing list
537   - FExperiment.PlayersPlaying.Add(FExperiment.PlayerPointer[i]);
538   -
539 548 // create/config playerbox
540   - with TPlayerBox.Create(FormMatrixGame.GBLastChoice,P.ID) do
541   - begin
542   - Caption := P.Nicname;
543   - i := Integer(P.Choice.Last.Row);
544   - if i > 0 then
545   - LabelLastRowCount.Caption := Format('%-*.*d', [1,2,i]);
546   -
547   - PanelLastColor.Color := GetColorFromCode(P.Choice.Last.Color);
548   - Enabled := True;
549   - Parent := FormMatrixGame.GBLastChoice;
550   - end;
  549 + CreatePlayerBox(P,False);
551 550  
552 551 // Request is now a reply with the following standard:
553 552 // [Requester.ID 0, ' ' 1, ReplyTag 2, PlayerData 3, PlayersPlaying 4 .. n, ChatData Last]
554 553 ARequest[2] := GA_ADMIN+ARequest[2]+K_ARRIVED;
555 554  
556   - // append player
  555 + // player
557 556 PS := FExperiment.PlayerAsString[P];
558   - ARequest.Append(PS); // 3
  557 + //ARequest.Append(PS);
559 558  
560 559 // append current players playing
561   - if FExperiment.PlayersPlaying.Count > 0 then
562   - for i:=0 to FExperiment.PlayersPlaying.Count -1 do
563   - if PPlayer(FExperiment.PlayersPlaying[i])^.ID <> P.ID then
564   - ARequest.Append(FExperiment.PlayerAsString[PPlayer(FExperiment.PlayersPlaying[i])^]); // FROM 4 to COUNT-2
565   -
566   - // send chat data if allowed at the last position
  560 + if FExperiment.PlayersCount > 0 then
  561 + for i:=0 to FExperiment.PlayersCount -1 do
  562 + if FExperiment.Player[i].ID <> P.ID then
  563 + begin
  564 + TS := FExperiment.PlayerAsString[FEXperiment.Player[i]];
  565 + ARequest.Append(TS); // FROM 3 to COUNT-2
  566 + end;
  567 +
  568 + // append chat data if allowed at the last position
567 569 if FExperiment.SendChatHistoryForNewPlayers then
568 570 ARequest.Append(FormMatrixGame.ChatMemoRecv.Lines.Text) // LAST
569 571 else
570 572 ARequest.Append('[CHAT]'); // must append something to keep the message envelop standard
571 573  
572   - // inform other players about the new player
  574 + // inform all players about the new player, including itself
573 575 FZMQActor.SendMessage([K_ARRIVED,PS]);
574 576  
575   - // start cycle if allowed
  577 + // start Experiment if allowed
576 578 if CanStartExperiment then
577 579 StartExperiment;
578 580  
... ... @@ -592,31 +594,12 @@ begin
592 594 if MHas(K_LOGIN) then ReplyLoginRequest;
593 595 end;
594 596  
595   -// Here FActor is garanted to be a TZMQPlayer
  597 +// Here FActor is garanted to be a TZMQPlayer, should be used to send all wanted history for new income players
596 598 procedure TGameControl.ReceiveReply(AReply: TStringList);
597 599 function MHas(const C : string) : Boolean;
598 600 begin
599 601 Result := MessageHas(C,AReply,2);
600 602 end;
601   - procedure CreatePlayerBox(P:TPlayer; Me:Boolean);
602   - var i1 : integer;
603   - begin
604   - with TPlayerBox.Create(FormMatrixGame.GBLastChoice,P.ID) do
605   - begin
606   - if Me then
607   - Caption := P.Nicname+'Você'
608   - else
609   - Caption := P.Nicname;
610   - i1 := Integer(P.Choice.Last.Row);
611   - if i1 > 0 then
612   - LabelLastRowCount.Caption := Format('%-*.*d', [1,2,i1])
613   - else
614   - LabelLastRowCount.Caption := 'NA';
615   - PanelLastColor.Color := GetColorFromCode(P.Choice.Last.Color);
616   - Enabled := True;
617   - Parent := FormMatrixGame.GBLastChoice;
618   - end;
619   - end;
620 603  
621 604 procedure LoginAccepted;
622 605 var
... ... @@ -624,15 +607,12 @@ procedure TGameControl.ReceiveReply(AReply: TStringList);
624 607 P : TPlayer;
625 608 begin
626 609 {$IFDEF DEBUG}
627   - WriteLn(Self.ID +' self' + AReply[0] +' reply');
  610 + WriteLn(Self.ID +' self');
  611 + WriteLn(AReply[0] +' reply');
628 612 {$ENDIF}
629 613 if Self.ID = AReply[0] then
630 614 begin
631   - P := FExperiment.PlayerFromString[AReply[3]];
632   - FExperiment.AppendPlayer(P);
633   - CreatePlayerBox(P, True);
634   -
635   - for i:= 4 to AReply.Count -2 do
  615 + for i:= 3 to AReply.Count -2 do
636 616 begin
637 617 P := FExperiment.PlayerFromString[AReply[i]];
638 618 CreatePlayerBox(P, False);
... ... @@ -651,6 +631,7 @@ procedure TGameControl.ReceiveReply(AReply: TStringList);
651 631 end;
652 632  
653 633 begin
  634 + if MHas(K_RESUME+K_ARRIVED) then ResumePlayer;
654 635 if MHas(K_LOGIN+K_ARRIVED) then LoginAccepted;
655 636 end;
656 637  
... ...
units/game_experiment.pas
  Diff comments   View file @5111a7e
... ... @@ -14,6 +14,7 @@ type
14 14  
15 15 { TExperiment }
16 16  
  17 + TExperimentState = (xsWaiting,xsRunning,xsPaused,xsCanceled);
17 18 TPlayers = array of TPlayer;
18 19 TConditions = array of TCondition;
19 20  
... ... @@ -22,11 +23,10 @@ type
22 23 FExperimentAim,
23 24 FExperimentName,
24 25 FFilename,
25   - FResearcher : string;
  26 + FResearcher : UTF8string;
26 27 FMatrixType: TGameMatrixType;
27 28 FRegData : TRegData;
28 29 FGenPlayersAsNeeded : Boolean;
29   - FPlayersPlaying : TList;
30 30 FPlayers : TPlayers;
31 31 FCurrentCondition : integer;
32 32 FConditions : TConditions;
... ... @@ -34,29 +34,28 @@ type
34 34 FResearcherCanPlay: Boolean;
35 35 FSendChatHistoryForNewPlayers: Boolean;
36 36 FShowChat: Boolean;
  37 + FState: TExperimentState;
37 38 function GetCondition(I : Integer): TCondition;
38 39 function GetConditionsCount: integer;
39 40 function GetContingency(ACondition, I : integer): TContingency;
40 41 function GetNextTurn: integer;
41 42 function GetNextTurnPlayerID: UTF8string;
42 43 function GetPlayer(I : integer): TPlayer; overload;
43   - function GetPlayer(AID : string): TPlayer; overload;
  44 + function GetPlayer(AID : UTF8string): TPlayer; overload;
44 45 function GetPlayerAsString(P: TPlayer): UTF8string;
45   - function GetPlayerFromString(s : string): TPlayer;
46   - function GetPlayerIndexFromID(AID : string): integer;
47   - function GetPlayerIsPlaying(AID : string): Boolean;
48   - function GetPlayerPointer(i: integer): PPlayer;
  46 + function GetPlayerFromString(s : UTF8string): TPlayer;
  47 + function GetPlayerIndexFromID(AID : UTF8string): integer;
  48 + function GetPlayerIsPlaying(AID : UTF8string): Boolean;
49 49 function GetPlayersCount: integer;
50   - //function GetPlayersPlaying: TList;
51 50 procedure SetCondition(I : Integer; AValue: TCondition);
52 51 procedure SetContingency(ACondition, I : integer; AValue: TContingency);
53 52 procedure SetMatrixType(AValue: TGameMatrixType);
54 53 procedure SetPlayer(I : integer; AValue: TPlayer); overload;
55   - procedure SetPlayer(S : string ; AValue: TPlayer); overload;
56   - procedure SetPlayersPlaying(AValue: TList);
  54 + procedure SetPlayer(S : UTF8string ; AValue: TPlayer); overload;
57 55 procedure SetResearcherCanChat(AValue: Boolean);
58 56 procedure SetResearcherCanPlay(AValue: Boolean);
59 57 procedure SetSendChatHistoryForNewPlayers(AValue: Boolean);
  58 + procedure SetState(AValue: TExperimentState);
60 59 public
61 60 constructor Create(AOwner:TComponent);override;
62 61 constructor Create(AFilename: string; AOwner:TComponent); overload;
... ... @@ -71,30 +70,30 @@ type
71 70 function AppendPlayer(APlayer : TPlayer) : integer; overload;
72 71 procedure SaveToFile(AFilename: string); overload;
73 72 procedure SaveToFile; overload;
  73 + procedure Clean;
74 74 property ResearcherCanPlay : Boolean read FResearcherCanPlay write SetResearcherCanPlay;
75 75 property ResearcherCanChat : Boolean read FResearcherCanChat write SetResearcherCanChat;
76   - property Researcher : string read FResearcher write FResearcher;
  76 + property Researcher : UTF8string read FResearcher write FResearcher;
77 77 property Condition[I : Integer]: TCondition read GetCondition write SetCondition;
78 78 property ConditionsCount : integer read GetConditionsCount;
79 79 property CurrentCondition : integer read FCurrentCondition write FCurrentCondition;
80 80 property Contingency[C, I : integer] : TContingency read GetContingency write SetContingency;
81   - property ExperimentAim : string read FExperimentAim write FExperimentAim;
82   - property ExperimentName : string read FExperimentName write FExperimentName;
  81 + property ExperimentAim : UTF8string read FExperimentAim write FExperimentAim;
  82 + property ExperimentName : UTF8string read FExperimentName write FExperimentName;
83 83 property GenPlayersAsNeeded : Boolean read FGenPlayersAsNeeded write FGenPlayersAsNeeded;
84 84 property Player[I : integer] : TPlayer read GetPlayer write SetPlayer;
85   - property PlayerFromID[S : string ] : TPlayer read GetPlayer write SetPlayer;
86   - property PlayersCount : integer read GetPlayersCount; // how many players per turn?
87   - property PlayersPlaying : TList read FPlayersPlaying write SetPlayersPlaying; // how many players are playing?
88   - property PlayerIsPlaying[s : string] : Boolean read GetPlayerIsPlaying;
89   - property PlayerIndexFromID[s : string]: integer read GetPlayerIndexFromID;
  85 + property PlayerFromID[S : UTF8string ] : TPlayer read GetPlayer write SetPlayer;
  86 + property PlayersCount : integer read GetPlayersCount;
  87 + property PlayerIsPlaying[s : UTF8string] : Boolean read GetPlayerIsPlaying;
  88 + property PlayerIndexFromID[s : UTF8string]: integer read GetPlayerIndexFromID;
90 89 property PlayerAsString[P:TPlayer]: UTF8string read GetPlayerAsString;
91   - property PlayerFromString[s : string]: TPlayer read GetPlayerFromString;
92   - property PlayerPointer[i:integer]: PPlayer read GetPlayerPointer;
  90 + property PlayerFromString[s : UTF8string]: TPlayer read GetPlayerFromString;
93 91 property ShowChat : Boolean read FShowChat write FShowChat;
94 92 property SendChatHistoryForNewPlayers : Boolean read FSendChatHistoryForNewPlayers write SetSendChatHistoryForNewPlayers;
95 93 property MatrixType : TGameMatrixType read FMatrixType write SetMatrixType;
96 94 property NextTurnPlayerID : UTF8string read GetNextTurnPlayerID;
97 95 property NextTurn : integer read GetNextTurn;
  96 + property State : TExperimentState read FState write SetState;
98 97 end;
99 98  
100 99 resourcestring
... ... @@ -113,7 +112,7 @@ end;
113 112  
114 113 function TExperiment.GetConditionsCount: integer;
115 114 begin
116   - Result := High(FConditions);
  115 + Result := Length(FConditions);
117 116 end;
118 117  
119 118 function TExperiment.GetContingency(ACondition, I : integer): TContingency;
... ... @@ -130,15 +129,9 @@ begin
130 129 end;
131 130  
132 131 function TExperiment.GetNextTurnPlayerID: UTF8string; // used during cycles
133   -var
134   - P : PPlayer;
135 132 begin
136   - Result := '';
137   - P := New(PPlayer);
138   - P := PlayersPlaying[FConditions[CurrentCondition].Turn.Count];
139   - Result := P^.ID;
  133 + Result := Player[FConditions[CurrentCondition].Turn.Count].ID;
140 134 GetNextTurn;
141   - Dispose(P);
142 135 end;
143 136  
144 137 function TExperiment.GetPlayer(I : integer): TPlayer;
... ... @@ -146,7 +139,7 @@ begin
146 139 Result := FPlayers[i];
147 140 end;
148 141  
149   -function TExperiment.GetPlayer(AID: string): TPlayer;
  142 +function TExperiment.GetPlayer(AID: UTF8string): TPlayer;
150 143 var
151 144 i : integer;
152 145 begin
... ... @@ -236,7 +229,7 @@ begin
236 229 Result += M[i] + '|';
237 230 end;
238 231  
239   -function TExperiment.GetPlayerFromString(s : string): TPlayer;
  232 +function TExperiment.GetPlayerFromString(s: UTF8string): TPlayer;
240 233  
241 234 function GetRowFromString(S: string): TGameRow;
242 235 begin
... ... @@ -304,7 +297,7 @@ begin
304 297 Result.Choice.Last := GetChoiceFromString(ExtractDelimited(6,s,['|']));
305 298 end;
306 299  
307   -function TExperiment.GetPlayerIndexFromID(AID: string): integer;
  300 +function TExperiment.GetPlayerIndexFromID(AID: UTF8string): integer;
308 301 var i : integer;
309 302 begin
310 303 Result := -1;
... ... @@ -316,46 +309,23 @@ begin
316 309 end;
317 310 end;
318 311  
319   -function TExperiment.GetPlayerIsPlaying(AID: string): Boolean;
  312 +function TExperiment.GetPlayerIsPlaying(AID: UTF8string): Boolean;
320 313 var i : integer;
321 314 begin
322   - Result := PlayersPlaying.Count > 0;
  315 + Result := PlayersCount > 0;
323 316 if Result then
324   - for i := 0 to PlayersPlaying.Count -1 do
325   - if PPlayer(PlayersPlaying[i])^.ID = AID then
  317 + for i := 0 to PlayersCount -1 do
  318 + if Player[i].ID = AID then
326 319 Exit;
327 320 Result:= False;
328 321 end;
329 322  
330   -function TExperiment.GetPlayerPointer(i: integer): PPlayer;
331   -begin
332   - Result := @FPlayers[i];
333   -end;
334 323  
335 324 function TExperiment.GetPlayersCount: integer;
336 325 begin
337 326 Result := Length(FPlayers);
338 327 end;
339 328  
340   -//function TExperiment.GetPlayersPlaying: TList;
341   -//var
342   -// //i:integer;
343   -// //P:PPlayer;
344   -//begin
345   -// //P := New(PPlayer);
346   -// //if FPlayersPlaying.Count > 0 then
347   -// // FPlayersPlaying.Clear;
348   -// //
349   -// //for i := Low(FPlayers) to High(FPlayers) do
350   -// // if FPlayers[i].Status = gpsPlaying then
351   -// // begin
352   -// // P := @FPlayers[i];
353   -// // FPlayersPlaying.Add(P);
354   -// // end;
355   -// //Dispose(P);
356   -// Result := FPlayersPlaying;
357   -//end;
358   -
359 329 procedure TExperiment.SetCondition(I : Integer; AValue: TCondition);
360 330 begin
361 331 FConditions[I] := AValue;
... ... @@ -378,7 +348,7 @@ begin
378 348 FPlayers[I] := AValue;
379 349 end;
380 350  
381   -procedure TExperiment.SetPlayer(S : string ; AValue: TPlayer);
  351 +procedure TExperiment.SetPlayer(S: UTF8string; AValue: TPlayer);
382 352 var i : integer;
383 353 begin
384 354 if PlayersCount > 0 then
... ... @@ -391,12 +361,6 @@ begin
391 361 raise Exception.Create('TExperiment.SetPlayer: Could not set player.');
392 362 end;
393 363  
394   -procedure TExperiment.SetPlayersPlaying(AValue: TList);
395   -begin
396   - if FPlayersPlaying = AValue then Exit;
397   - FPlayersPlaying := AValue;
398   -end;
399   -
400 364 procedure TExperiment.SetResearcherCanChat(AValue: Boolean);
401 365 begin
402 366 if FResearcherCanChat=AValue then Exit;
... ... @@ -415,10 +379,15 @@ begin
415 379 FSendChatHistoryForNewPlayers:=AValue;
416 380 end;
417 381  
  382 +procedure TExperiment.SetState(AValue: TExperimentState);
  383 +begin
  384 + if FState=AValue then Exit;
  385 + FState:=AValue;
  386 +end;
  387 +
418 388 constructor TExperiment.Create(AOwner: TComponent);
419 389 begin
420 390 inherited Create(AOwner);
421   - FPlayersPlaying := TList.Create;
422 391 LoadExperimentFromResource(Self);
423 392 end;
424 393  
... ... @@ -430,7 +399,6 @@ end;
430 399  
431 400 destructor TExperiment.Destroy;
432 401 begin
433   - FPlayersPlaying.Free;
434 402 inherited Destroy;
435 403 end;
436 404  
... ... @@ -503,5 +471,10 @@ begin
503 471 {$ENDIF};
504 472 end;
505 473  
  474 +procedure TExperiment.Clean;
  475 +begin
  476 +
  477 +end;
  478 +
506 479 end.
507 480  
... ...
units/game_file_methods.pas
  Diff comments   View file @5111a7e
... ... @@ -34,6 +34,7 @@ uses LCLIntf, game_actors_point, game_resources, string_methods, regdata, zhelpe
34 34  
35 35 function LoadExperimentFromResource(var AExperiment: TExperiment): Boolean;
36 36 var i,j : integer;
  37 + C : TCondition;
37 38 begin
38 39 Result := False;
39 40 with AExperiment do
... ... @@ -47,18 +48,17 @@ begin
47 48 GenPlayersAsNeeded:=True;
48 49 CurrentCondition := 0;
49 50 MatrixType:=[gmRows];
50   - PlayersPlaying := TList.Create;
51 51 //AppendPlayer(C_PLAYER_TEMPLATE);
52 52 //AppendPlayer(C_PLAYER_TEMPLATE);
53   - i := AppendCondition(C_CONDITION_TEMPLATE);
54   - with Condition[i] do
  53 + C := C_CONDITION_TEMPLATE;
  54 + with C do
55 55 begin
56   - ConditionName := SEC_CONDITION+IntToStr(i+1);
  56 + ConditionName := SEC_CONDITION+IntToStr(1);
57 57 Turn.Count:=0;
58 58 Turn.Value:=2;
59 59 Turn.Random:=False;
60 60 end;
61   - //j := AppendContingency(i,C_METACONTINGENCY_A1);
  61 + i := AppendCondition(C);
62 62 end;
63 63 end;
64 64  
... ...
units/game_resources.pas
  Diff comments   View file @5111a7e
... ... @@ -84,7 +84,7 @@ const
84 84 const
85 85  
86 86 CPlayerNamesMale : array [0..49] of UTF8String =
87   - ('Junho','Rodrigo','Francisco','Martim','Santiago',
  87 + ('João','Rodrigo','Francisco','Martim','Santiago',
88 88 'Tomás','Afonso','Duarte','Miguel','Guilherme','Tiago',
89 89 'Gonçalo','Diogo','Gabriel','Pedro','Rafael','Salvador',
90 90 'Dinis','Lucas','Simael','Gustavo','David',
... ...