Download as
Browse Code »

Commit 0dc88914a06240dfca63a5e031922ec11f8796b6

Authored by Carlos Picanco
1 parent 6a6bbd9f
Exists in master

refactoring, separating the issues, bug fix on appending stuff

Showing 11 changed files with 560 additions and 364 deletions   Show diff stats
cultural_matrix.lpr
  Diff comments   View file @0dc8891
... ... @@ -16,10 +16,15 @@ uses
16 16 cthreads,
17 17 {$ENDIF}{$ENDIF}
18 18 Interfaces // this includes the LCL widgetset
19   - , StrUtils, Forms, form_matrixgame, form_chooseactor, game_actors,
20   - game_experiment, game_file_methods, game_resources, game_control,
21   - string_methods, game_actors_point;
  19 + , StrUtils, Forms, Classes, sysutils, Dialogs
  20 + , form_matrixgame, form_chooseactor, game_actors
  21 + , zhelpers
  22 + ;
22 23  
  24 +
  25 +var
  26 + ID : TStringList;
  27 + F : string;
23 28 const
24 29 PAdmin : array [0..3] of string = ('--admin','--adm','-admin','-adm');
25 30 PPlayer : array [0..3] of string = ('--player','--play','-player','-play');
... ... @@ -30,15 +35,38 @@ const
30 35 begin
31 36 //RequireDerivedFormResource := True;
32 37 Application.Initialize;
  38 + F := ExtractFilePath(Application.ExeName)+PathDelim+'id';
  39 + ID := TStringList.Create;
  40 + if FileExists(F) then
  41 + try
  42 + ID.LoadFromFile(F);
  43 + F := ID.Text;
  44 + finally
  45 + ID.Free;
  46 + end
  47 + else
  48 + try
  49 + ID.Text := s_random(32);
  50 + ID.SaveToFile(F);
  51 + F := ID.Text;
  52 + except
  53 + on E: Exception do
  54 + begin
  55 + ID.Free;
  56 + ShowMessage(E.Message);
  57 + Exit;
  58 + end;
  59 + end;
33 60 Application.CreateForm(TFormMatrixGame, FormMatrixGame);
  61 + FormMatrixGame.SetID(F);
34 62 if Paramcount > 0 then
35 63 begin
36 64 if AnsiMatchStr(lowercase(ParamStr(0)), PAdmin) then
37   - FormMatrixGame.GameActor := gaAdmin;
  65 + FormMatrixGame.SetGameActor(gaAdmin);
38 66 if AnsiMatchStr(lowercase(ParamStr(0)), PPlayer) then
39   - FormMatrixGame.GameActor := gaPlayer;
  67 + FormMatrixGame.SetGameActor(gaPlayer);
40 68 if AnsiMatchStr(lowercase(ParamStr(0)), PWatcher) then
41   - FormMatrixGame.GameActor := gaWatcher;
  69 + FormMatrixGame.SetGameActor(gaWatcher);
42 70 end
43 71 else
44 72 begin
... ... @@ -46,14 +74,15 @@ begin
46 74 if Form1.ShowModal = 1 then
47 75 begin
48 76 case Form1.GameActor of
49   - gaAdmin:FormMatrixGame.GameActor := gaAdmin;
50   - gaPlayer: FormMatrixGame.GameActor := gaPlayer;
51   - gaWatcher: {FormMatrixGame.GameActor := gaWatcher};
  77 + gaAdmin:FormMatrixGame.SetGameActor(gaAdmin);
  78 + gaPlayer: FormMatrixGame.SetGameActor(gaPlayer);
  79 + gaWatcher: FormMatrixGame.SetGameActor(gaWatcher);
52 80 end;
53 81 end
54 82 else Exit;
55 83 Form1.Free;
56 84 end;
  85 +
57 86 Application.Run;
58 87 end.
59 88  
... ...
form_matrixgame.lfm
  Diff comments   View file @0dc8891
1 1 object FormMatrixGame: TFormMatrixGame
2   - Left = 301
3   - Height = 632
4   - Top = 130
5   - Width = 1278
6   - HorzScrollBar.Page = 1278
  2 + Left = 190
  3 + Height = 657
  4 + Top = 94
  5 + Width = 1518
  6 + HorzScrollBar.Page = 1492
7 7 VertScrollBar.Page = 542
8 8 AutoScroll = True
9 9 Caption = 'FormMatrixGame'
10   - ClientHeight = 622
11   - ClientWidth = 1278
  10 + ClientHeight = 657
  11 + ClientWidth = 1518
12 12 Font.Name = 'Monospace'
13 13 OnActivate = FormActivate
14   - OnCreate = FormCreate
15 14 LCLVersion = '1.6.0.4'
16 15 object StringGridMatrix: TStringGrid
17 16 AnchorSideLeft.Control = Owner
... ... @@ -38,7 +37,7 @@ object FormMatrixGame: TFormMatrixGame
38 37 OnBeforeSelection = StringGridMatrixBeforeSelection
39 38 OnDrawCell = StringGridMatrixDrawCell
40 39 end
41   - object GBIndividualPoints: TGroupBox
  40 + object GBIndividualAB: TGroupBox
42 41 Left = 796
43 42 Height = 122
44 43 Top = 0
... ... @@ -113,9 +112,9 @@ object FormMatrixGame: TFormMatrixGame
113 112 end
114 113 end
115 114 object GBGrupo: TGroupBox
116   - AnchorSideLeft.Control = GBIndividualPoints
  115 + AnchorSideLeft.Control = GBIndividualAB
117 116 AnchorSideLeft.Side = asrBottom
118   - AnchorSideTop.Control = GBIndividualPoints
  117 + AnchorSideTop.Control = GBIndividualAB
119 118 Left = 976
120 119 Height = 122
121 120 Top = 0
... ... @@ -153,8 +152,8 @@ object FormMatrixGame: TFormMatrixGame
153 152 AnchorSideBottom.Side = asrBottom
154 153 Left = 0
155 154 Height = 124
156   - Top = 498
157   - Width = 1492
  155 + Top = 533
  156 + Width = 1518
158 157 Anchors = [akLeft, akRight, akBottom]
159 158 AutoSize = True
160 159 Caption = 'Escolhas na última jogada'
... ... @@ -163,7 +162,7 @@ object FormMatrixGame: TFormMatrixGame
163 162 ChildSizing.HorizontalSpacing = 10
164 163 ChildSizing.ControlsPerLine = 6
165 164 ClientHeight = 107
166   - ClientWidth = 1488
  165 + ClientWidth = 1514
167 166 TabOrder = 3
168 167 object GBLastChoiceP0: TGroupBox
169 168 Left = 10
... ... @@ -339,65 +338,13 @@ object FormMatrixGame: TFormMatrixGame
339 338 ClientWidth = 332
340 339 TabOrder = 4
341 340 Visible = False
342   - object rgMatrixType: TRadioGroup
343   - Left = 10
344   - Height = 59
345   - Top = 8
346   - Width = 119
347   - AutoFill = True
348   - AutoSize = True
349   - Caption = 'MatrixType'
350   - ChildSizing.LeftRightSpacing = 6
351   - ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
352   - ChildSizing.EnlargeVertical = crsHomogenousChildResize
353   - ChildSizing.ShrinkHorizontal = crsScaleChilds
354   - ChildSizing.ShrinkVertical = crsScaleChilds
355   - ChildSizing.Layout = cclLeftToRightThenTopToBottom
356   - ChildSizing.ControlsPerLine = 1
357   - ClientHeight = 42
358   - ClientWidth = 115
359   - ItemIndex = 0
360   - Items.Strings = (
361   - 'Rows'
362   - 'Rows & Cols'
363   - )
364   - OnClick = rgMatrixTypeClick
365   - TabOrder = 0
366   - end
367   - object CheckBoxDrawDots: TCheckBox
368   - Left = 10
369   - Height = 21
370   - Top = 80
371   - Width = 119
372   - AutoSize = False
373   - Caption = 'DrawDots'
374   - OnChange = CheckBoxDrawDotsChange
375   - TabOrder = 1
376   - end
377   - object Button1: TButton
378   - Left = 10
379   - Height = 25
380   - Top = 112
381   - Width = 119
382   - Caption = 'Button1'
383   - OnClick = Button1Click
384   - TabOrder = 2
385   - end
386   - object Button2: TButton
387   - Left = 10
388   - Height = 25
389   - Top = 144
390   - Width = 119
391   - Caption = 'Button2'
392   - TabOrder = 3
393   - end
394 341 object GBExperiment: TGroupBox
395   - Left = 159
  342 + Left = 8
396 343 Height = 172
397 344 Top = 8
398   - Width = 178
  345 + Width = 218
399 346 AutoSize = True
400   - Caption = 'Experiment'
  347 + Caption = 'Experimento'
401 348 ChildSizing.LeftRightSpacing = 20
402 349 ChildSizing.TopBottomSpacing = 20
403 350 ChildSizing.HorizontalSpacing = 30
... ... @@ -406,19 +353,19 @@ object FormMatrixGame: TFormMatrixGame
406 353 ChildSizing.Layout = cclLeftToRightThenTopToBottom
407 354 ChildSizing.ControlsPerLine = 2
408 355 ClientHeight = 155
409   - ClientWidth = 174
410   - TabOrder = 4
  356 + ClientWidth = 214
  357 + TabOrder = 0
411 358 object LabelExpCond: TLabel
412 359 Left = 20
413 360 Height = 15
414 361 Top = 20
415   - Width = 88
  362 + Width = 128
416 363 AutoSize = False
417 364 Caption = 'Condição:'
418 365 ParentColor = False
419 366 end
420 367 object LabelExpCondCount: TLabel
421   - Left = 138
  368 + Left = 178
422 369 Height = 15
423 370 Top = 20
424 371 Width = 16
... ... @@ -430,12 +377,12 @@ object FormMatrixGame: TFormMatrixGame
430 377 Left = 20
431 378 Height = 15
432 379 Top = 45
433   - Width = 88
  380 + Width = 128
434 381 Caption = 'Generation:'
435 382 ParentColor = False
436 383 end
437 384 object LabelExpGenCount: TLabel
438   - Left = 138
  385 + Left = 178
439 386 Height = 15
440 387 Top = 45
441 388 Width = 16
... ... @@ -446,12 +393,12 @@ object FormMatrixGame: TFormMatrixGame
446 393 Left = 20
447 394 Height = 15
448 395 Top = 70
449   - Width = 88
  396 + Width = 128
450 397 Caption = 'Cycle:'
451 398 ParentColor = False
452 399 end
453 400 object LabelExpCycleCount: TLabel
454   - Left = 138
  401 + Left = 178
455 402 Height = 15
456 403 Top = 70
457 404 Width = 16
... ... @@ -462,28 +409,28 @@ object FormMatrixGame: TFormMatrixGame
462 409 Left = 20
463 410 Height = 15
464 411 Top = 95
465   - Width = 88
  412 + Width = 128
466 413 Caption = 'Prox. Jog.:'
467 414 ParentColor = False
468 415 end
469 416 object LabelExpNxtPlayerCount: TLabel
470   - Left = 138
  417 + Left = 178
471 418 Height = 15
472 419 Top = 95
473 420 Width = 16
474 421 Caption = 'NA'
475 422 ParentColor = False
476 423 end
477   - object Label21: TLabel
  424 + object LabelExpInterlocks: TLabel
478 425 Left = 20
479 426 Height = 15
480 427 Top = 120
481   - Width = 88
482   - Caption = 'NA'
  428 + Width = 128
  429 + Caption = 'Entrelaçamentos:'
483 430 ParentColor = False
484 431 end
485   - object Label22: TLabel
486   - Left = 138
  432 + object LabelExpInterlocksCount: TLabel
  433 + Left = 178
487 434 Height = 15
488 435 Top = 120
489 436 Width = 16
... ... @@ -502,18 +449,9 @@ object FormMatrixGame: TFormMatrixGame
502 449 TabOrder = 5
503 450 Visible = False
504 451 end
505   - object Button3: TButton
506   - Left = 1176
507   - Height = 25
508   - Top = 216
509   - Width = 75
510   - Caption = 'Button3'
511   - OnClick = Button3Click
512   - TabOrder = 6
513   - end
514 452 object ChatPanel: TPanel
515   - AnchorSideLeft.Control = GBIndividualPoints
516   - AnchorSideTop.Control = GBIndividualPoints
  453 + AnchorSideLeft.Control = GBIndividualAB
  454 + AnchorSideTop.Control = GBIndividualAB
517 455 AnchorSideTop.Side = asrBottom
518 456 AnchorSideRight.Control = GBGrupo
519 457 AnchorSideRight.Side = asrBottom
... ... @@ -525,7 +463,7 @@ object FormMatrixGame: TFormMatrixGame
525 463 BorderSpacing.Top = 10
526 464 ClientHeight = 354
527 465 ClientWidth = 350
528   - TabOrder = 7
  466 + TabOrder = 6
529 467 object ChatMemoRecv: TMemo
530 468 AnchorSideBottom.Control = ChatSplitter
531 469 Left = 6
... ... @@ -573,4 +511,36 @@ object FormMatrixGame: TFormMatrixGame
573 511 WantTabs = True
574 512 end
575 513 end
  514 + object GBIndividual: TGroupBox
  515 + AnchorSideLeft.Control = GBIndividualAB
  516 + AnchorSideTop.Control = GBIndividualAB
  517 + Left = 796
  518 + Height = 122
  519 + Top = 0
  520 + Width = 170
  521 + AutoSize = True
  522 + Caption = 'Pontuação Individual'
  523 + ChildSizing.LeftRightSpacing = 35
  524 + ChildSizing.TopBottomSpacing = 45
  525 + ChildSizing.Layout = cclLeftToRightThenTopToBottom
  526 + ChildSizing.ControlsPerLine = 1
  527 + ClientHeight = 105
  528 + ClientWidth = 166
  529 + TabOrder = 7
  530 + Visible = False
  531 + object LabelIndCount: TLabel
  532 + Left = 35
  533 + Height = 15
  534 + Top = 45
  535 + Width = 96
  536 + Align = alClient
  537 + Alignment = taCenter
  538 + AutoSize = False
  539 + Caption = '0'
  540 + Color = clDefault
  541 + Layout = tlCenter
  542 + ParentColor = False
  543 + Transparent = False
  544 + end
  545 + end
576 546 end
... ...
form_matrixgame.pas
  Diff comments   View file @0dc8891
... ... @@ -20,6 +20,7 @@ uses
20 20 //, zmq_pub_sub
21 21 , game_zmq_actors
22 22 , game_actors
  23 + , game_control
23 24 ;
24 25  
25 26 type
... ... @@ -28,12 +29,9 @@ type
28 29  
29 30 TFormMatrixGame = class(TForm)
30 31 btnConfirmRow: TButton;
31   - Button1: TButton;
32   - Button2: TButton;
33   - Button3: TButton;
34   - CheckBoxDrawDots: TCheckBox;
  32 + GBIndividual: TGroupBox;
35 33 GBLastChoice: TGroupBox;
36   - GBIndividualPoints: TGroupBox;
  34 + GBIndividualAB: TGroupBox;
37 35 GBGrupo: TGroupBox;
38 36 GBAdmin: TGroupBox;
39 37 GBLastChoiceP0: TGroupBox;
... ... @@ -51,8 +49,9 @@ type
51 49 LabelExpCycleCount: TLabel;
52 50 LabelExpNxtPlayer: TLabel;
53 51 LabelExpNxtPlayerCount: TLabel;
54   - Label21: TLabel;
55   - Label22: TLabel;
  52 + LabelExpInterlocks: TLabel;
  53 + LabelExpInterlocksCount: TLabel;
  54 + LabelIndCount: TLabel;
56 55 LabelIndACount: TLabel;
57 56 LabelIndBCount: TLabel;
58 57 LabelCurrentColor1: TLabel;
... ... @@ -70,32 +69,25 @@ type
70 69 Panel4: TPanel;
71 70 Panel5: TPanel;
72 71 PanelCurrentColor1: TPanel;
73   - rgMatrixType: TRadioGroup;
74 72 ChatSplitter: TSplitter;
75 73 StringGridMatrix: TStringGrid;
76 74 procedure btnConfirmRowClick(Sender: TObject);
77   - procedure Button1Click(Sender: TObject);
78   - procedure Button3Click(Sender: TObject);
79 75 procedure ChatMemoSendKeyPress(Sender: TObject; var Key: char);
80 76 procedure CheckBoxDrawDotsChange(Sender: TObject);
81 77 procedure FormActivate(Sender: TObject);
82   - procedure FormCreate(Sender: TObject);
83   - procedure rgMatrixTypeClick(Sender: TObject);
84 78 procedure StringGridMatrixBeforeSelection(Sender: TObject; aCol, aRow: integer);
85 79 procedure StringGridMatrixDrawCell(Sender: TObject; aCol, aRow: integer;
86 80 aRect: TRect; aState: TGridDrawState);
87 81 private
88   - //FZMQAdmin : TZMQAdmin;
89   - FZMQActor : TZMQActor;
90   - FGameActor : TGameActor;
91   - //FGameActors : TGameActors;
92   - function GetSelectedColorF(AStringGrid : TStringGrid) : UTF8string;
93   - function GetSelectedRowF(AStringGrid : TStringGrid) : UTF8string;
94   - function GetRowColor(ARow : integer) : TColor;
95   - procedure SetGameActor(AValue: TGameActor);
96   - procedure MessageReceived(AMessage : TStringList);
  82 + FGameControl : TGameControl;
  83 + FID: string;
  84 + FMustDrawDots: Boolean;
  85 + FMustDrawDotsClear: Boolean;
  86 + FRowBase: integer;
97 87 public
98   - property GameActor : TGameActor read FGameActor write SetGameActor;
  88 + procedure SetID(S : string);
  89 + procedure SetGameActor(AValue: TGameActor);
  90 + property ID : string read FID;
99 91 end;
100 92  
101 93 var
... ... @@ -107,7 +99,6 @@ uses LCLType, game_resources;
107 99  
108 100 // uses datamodule;
109 101 var
110   - RowBase: integer = 0;
111 102 MustDrawSelection : Boolean; // work around until a bug fix for ClearSelection is released
112 103  
113 104 {$R *.lfm}
... ... @@ -118,6 +109,7 @@ procedure TFormMatrixGame.StringGridMatrixDrawCell(Sender: TObject; aCol, aRow:
118 109 aRect: TRect; aState: TGridDrawState);
119 110 var
120 111 OldCanvas: TCanvas;
  112 + RowBase : integer;
121 113  
122 114 procedure SaveOldCanvas;
123 115 begin
... ... @@ -166,10 +158,11 @@ var
166 158 TStringGrid(Sender).Canvas.Brush.Color := Color;
167 159 TStringGrid(Sender).Canvas.Pen.Color := Color;
168 160 TStringGrid(Sender).Canvas.Rectangle(aRect);
169   - if CheckBoxDrawDots.Checked then
170   - if (Odd(aRow + RowBase) and not Odd(aCol)) or
171   - (not Odd(aRow + RowBase) and Odd(aCol)) then
172   - DrawDots;
  161 + if Assigned(FGameControl) then
  162 + if FGameControl.MustDrawDots then
  163 + if (Odd(aRow + RowBase) and not Odd(aCol)) or
  164 + (not Odd(aRow + RowBase) and Odd(aCol)) then
  165 + DrawDots;
173 166 end;
174 167 //function GetTextX(S : String): Longint;
175 168 //begin
... ... @@ -177,6 +170,8 @@ var
177 170 //end;
178 171  
179 172 begin
  173 + if Assigned(FGameControl) then
  174 + RowBase:=FGameControl.RowBase;
180 175 SaveOldCanvas;
181 176 try
182 177 //if (aRow >= RowBase) and (aCol = 10) then
... ... @@ -184,7 +179,7 @@ begin
184 179  
185 180 if (aCol <> 0) and (aRow > (RowBase-1)) then
186 181 begin
187   - DrawLines(GetRowColor(aRow));
  182 + DrawLines(GetRowColor(aRow,RowBase));
188 183  
189 184 if (gdSelected in aState) and MustDrawSelection then
190 185 begin
... ... @@ -226,111 +221,42 @@ begin
226 221 end;
227 222 end;
228 223  
229   -function TFormMatrixGame.GetSelectedColorF(AStringGrid : TStringGrid): UTF8string;
230   -var LColor : TColor;
231   -begin
232   - LColor := GetRowColor(AStringGrid.Selection.Top);
233   - case LColor of
234   - ccYellow: Result := 'Y';
235   - ccBlue : Result := 'B';
236   - ccGreen: Result := 'G';
237   - ccRed: Result := 'R';
238   - ccMagenta: Result := 'M';
239   - end;
240   -end;
241   -
242   -function TFormMatrixGame.GetSelectedRowF(AStringGrid: TStringGrid): UTF8string;
243   -begin
244   - Result := IntToStr(AStringGrid.Selection.Top);
245   -end;
246   -
247   -function TFormMatrixGame.GetRowColor(ARow: integer): TColor;
248   -var LRow : integer;
249   -begin
250   - if RowBase = 1 then
251   - LRow := aRow -1
252   - else LRow := aRow;
253   -
254   - case LRow of
255   - 0,5 :Result := ccYellow;
256   - 1,6 :Result := ccGreen;
257   - 2,7 :Result := ccRed;
258   - 3,8 :Result := ccBlue;
259   - 4,9 :Result := ccMagenta;
260   - end;
261   -end;
262   -
263 224 procedure TFormMatrixGame.SetGameActor(AValue: TGameActor);
264 225  
265 226 procedure SetZMQAdmin;
266 227 begin
267   - FZMQActor := TZMQAdmin.Create(Self);
  228 + FGameControl := TGameControl.Create(TZMQAdmin.Create(Self));
268 229 GBAdmin.Visible:= True;
269 230 end;
270 231  
271 232 procedure SetZMQPlayer;
272 233 begin
273   - FZMQActor := TZMQPlayer.Create(Self);
  234 + FGameControl := TGameControl.Create(TZMQPlayer.Create(Self));
274 235 btnConfirmRow.Visible := True;
275 236 StringGridMatrix.Enabled := True;
  237 +
  238 + FGameControl.SendMessage(K_ARRIVED);
276 239 end;
277 240  
278 241 procedure SetZMQWatcher;
279 242 begin
280   - FZMQActor := TZMQWatcher.Create(Self);
  243 + FGameControl := TGameControl.Create(TZMQWatcher.Create(Self));
281 244 end;
282 245  
283 246 begin
284   - if FGameActor=AValue then Exit;
285   - FGameActor:=AValue;
286   -
287   - case FGameActor of
  247 + case AValue of
288 248 gaAdmin: SetZMQAdmin;
289 249 gaPlayer: SetZMQPlayer;
290 250 gaWatcher: SetZMQWatcher;
291 251 end;
292   -
293   - FZMQActor.OnMessageReceived:=@MessageReceived;
294   - FZMQActor.Start;
  252 + FGameControl.SetID(FID);
295 253 end;
296 254  
297   -procedure TFormMatrixGame.MessageReceived(AMessage: TStringList);
298   -
299   - procedure SendChat;
300   - begin
301   - ChatMemoRecv.Lines.Append(('['+AMessage[1]+']: ')+AMessage[2]);
302   - end;
303   -
304   - procedure PlayerChoice;
305   - begin
306   -
307   - end;
308   -
309   - procedure PlayerArrived;
310   - begin
311   - WriteLn('arrived');
312   - end;
313   -
314   - procedure PlayerLogin;
315   - begin
316   - WriteLn('login');
317   - end;
318   -
319   - procedure PlayerLogout;
320   - begin
321   - WriteLn('logout');
322   - end;
  255 +procedure TFormMatrixGame.SetID(S: string);
323 256 begin
324   - case AMessage[0] of
325   - 'Player.Choice' : PlayerChoice;
326   - 'Player.Arrived' : PlayerArrived;
327   - 'Player.Login' : PlayerLogin;
328   - 'Player.Logout': PlayerLogout;
329   - 'Player.SendChat','Admin.SendChat': SendChat;
330   - end;
  257 + FID := S;
331 258 end;
332 259  
333   -
334 260 procedure TFormMatrixGame.CheckBoxDrawDotsChange(Sender: TObject);
335 261 begin
336 262 StringGridMatrix.Invalidate;
... ... @@ -342,85 +268,17 @@ begin
342 268 StringGridMatrix.FocusRectVisible := False;
343 269 end;
344 270  
345   -
346   -procedure TFormMatrixGame.FormCreate(Sender: TObject);
347   -begin
348   - GameActor := gaNone;
349   -end;
350   -
351   -procedure TFormMatrixGame.rgMatrixTypeClick(Sender: TObject);
352   -
353   - procedure WriteGridFixedNames(AStringGrid: TStringGrid; WriteCols: boolean);
354   - var
355   - i: integer;
356   - begin
357   - with AStringGrid do
358   - for i := 0 to 9 do
359   - begin
360   - Cells[0, i + RowBase] := IntToStr(i + 1);
361   - if WriteCols then
362   - Cells[i + 1, 0] := chr(65 + i);
363   - end;
364   - end;
365   -
366   -begin
367   - case rgMatrixType.ItemIndex of
368   - // rows only
369   - 0:
370   - begin
371   - StringGridMatrix.Clean;
372   - StringGridMatrix.FixedRows := 0;
373   - StringGridMatrix.RowCount := 10;
374   - StringGridMatrix.Height:=305;
375   - StringGridMatrix.Options := [goFixedHorzLine, goHorzLine, goDrawFocusSelected, goRowSelect];
376   - RowBase := 0;
377   - WriteGridFixedNames(StringGridMatrix, False);
378   - end;
379   - // rows and cols
380   - 1:
381   - begin
382   - StringGridMatrix.Clean;
383   - StringGridMatrix.FixedRows := 1;
384   - StringGridMatrix.RowCount := 11;
385   - StringGridMatrix.Height:=335;
386   - StringGridMatrix.Options := [goFixedHorzLine, goHorzLine, goDrawFocusSelected, goRowSelect, goVertLine];
387   - RowBase := 1;
388   - WriteGridFixedNames(StringGridMatrix, True);
389   - end;
390   - end;
391   -
392   -end;
393   -
394 271 procedure TFormMatrixGame.StringGridMatrixBeforeSelection(Sender: TObject; aCol, aRow: integer);
395 272 begin
396 273 if MustDrawSelection then Exit;
397 274 MustDrawSelection := True;
398 275 end;
399 276  
400   -procedure TFormMatrixGame.Button1Click(Sender: TObject);
401   -begin
402   -
403   -end;
404   -
405   -procedure TFormMatrixGame.Button3Click(Sender: TObject);
406   -begin
407   - //S := TStringList.Create;
408   - //S.Add('Player.Arrived');
409   - //S.Add(TZMQAdmin(FZMQActor).ID);
410   - TZMQAdmin(FZMQActor).SendMessage(['Player.Arrived', TZMQAdmin(FZMQActor).ID]);
411   - //S.Free;
412   -end;
413   -
414 277 procedure TFormMatrixGame.ChatMemoSendKeyPress(Sender: TObject; var Key: char);
415 278 begin
416 279 if Key = Char(VK_RETURN) then
417 280 begin
418   - if FZMQActor.ClassType = TZMQAdmin then
419   - TZMQAdmin(FZMQActor).SendMessage(['Admin.SendChat', CPlayerNamesMale[0], ChatMemoSend.Lines.Text]);
420   -
421   - if FZMQActor.ClassType = TZMQPlayer then
422   - TZMQPlayer(FZMQActor).SendMessage(['Player.SendChat', CPlayerNamesFemale[0], ChatMemoSend.Lines.Text]);
423   -
  281 + FGameControl.SendMessage(K_CHAT_M);
424 282 with ChatMemoSend do
425 283 begin
426 284 Clear;
... ... @@ -434,17 +292,11 @@ end;
434 292  
435 293 procedure TFormMatrixGame.btnConfirmRowClick(Sender: TObject);
436 294 begin
437   - if FZMQActor.ClassType = TZMQPlayer then
438   - begin
439   - //StringGridMatrix.ClearSelections;
440   - //MustDrawSelection := False;
441   - StringGridMatrix.Enabled:= False;
442   - btnConfirmRow.Visible:=False;
443   - TZMQPlayer(FZMQActor).SendMessage(['Player.Choice',
444   - TZMQPlayer(FZMQActor).ID,
445   - GetSelectedRowF(StringGridMatrix),
446   - GetSelectedColorF(StringGridMatrix)]);
447   - end;
  295 + //StringGridMatrix.ClearSelections;
  296 + //MustDrawSelection := False;
  297 + StringGridMatrix.Enabled:= False;
  298 + btnConfirmRow.Visible:=False;
  299 + FGameControl.SendMessage(K_CHOICE);
448 300 end;
449 301  
450 302 end.
... ...
units/game_actors.pas
  Diff comments   View file @0dc8891
... ... @@ -10,9 +10,13 @@ uses
10 10 ;
11 11 type
12 12  
  13 +
13 14 TGameActor = ( gaNone, gaAdmin, gaPlayer, gaWatcher );
14 15 TGamePlayerStatus = (gpsWaiting, gpsPlaying, gpsPlayed);
15 16  
  17 + TGameMatrix = (gmRows,gmColumns, gmDots,gmClearDots);
  18 + TGameMatrixType = set of TGameMatrix;
  19 +
16 20 TGameRow = (grNone,
17 21 grOne,grTwo,grThree,grFour,grFive,grSix,grSeven,grEight,grNine,grTen, // 10 rows
18 22 grEven,grOdd,
... ... @@ -107,6 +111,7 @@ type
107 111 end;
108 112  
109 113 TCondition = record
  114 + ConditionName : string;
110 115 Contingencies : TContingencies; // for producing points during the condition
111 116  
112 117 Points : record
... ... @@ -138,6 +143,8 @@ type
138 143 Color : TGameColor;
139 144 end;
140 145  
  146 + PPlayer = ^TPlayer;
  147 +
141 148 TPlayer = record
142 149 ID,
143 150 Nicname,
... ...
units/game_control.pas
  Diff comments   View file @0dc8891
... ... @@ -2,12 +2,15 @@ unit game_control;
2 2  
3 3 {$mode objfpc}{$H+}
4 4  
  5 +{$DEFINE DEBUG}
  6 +
5 7 interface
6 8  
7 9 uses
8   - Classes, SysUtils
  10 + Classes, SysUtils, Graphics, Grids
9 11 , game_zmq_actors
10 12 , game_experiment
  13 + , game_actors
11 14 ;
12 15  
13 16 type
... ... @@ -16,32 +19,314 @@ type
16 19  
17 20 TGameControl = class(TComponent)
18 21 private
  22 + FID: string;
  23 + FMustDrawDots: Boolean;
  24 + FMustDrawDotsClear: Boolean;
  25 + FRowBase : integer;
  26 + FActor : TGameActor;
19 27 FZMQActor : TZMQActor;
20 28 FExperiment : TExperiment;
21   - public
22   - constructor Create(AZMQActor : TZMQActor; AOwner : TComponent); overload;
23   - procedure SendMessage(AMessage : array of UTF8string);
  29 + function GetActorNicname(AID:string; Brackets : Boolean = False) : string;
  30 + function MessageHas(const A_CONST : string; AMessage : TStringList): Boolean;
  31 + procedure SetMatrixType(AStringGrid : TStringGrid; AMatrixType:TGameMatrixType;
  32 + var ARowBase:integer; var ADrawDots, ADrawClear : Boolean);
24 33 procedure ReceiveMessage(AMessage : TStringList);
  34 + function GetSelectedColorF(AStringGrid : TStringGrid) : UTF8string;
  35 + function GetSelectedRowF(AStringGrid : TStringGrid) : UTF8string;
  36 + procedure SetMustDrawDots(AValue: Boolean);
  37 + procedure SetMustDrawDotsClear(AValue: Boolean);
  38 + procedure SetRowBase(AValue: integer);
  39 + public
  40 + constructor Create(AZMQActor : TZMQActor); reintroduce;
  41 + destructor Destroy; override;
  42 + procedure SetID(S:string);
  43 + procedure SendMessage(AMessage : UTF8string);
  44 + property ID : string read FID;
  45 + property RowBase : integer read FRowBase write SetRowBase;
  46 + property MustDrawDots: Boolean read FMustDrawDots write SetMustDrawDots;
  47 + property MustDrawDotsClear:Boolean read FMustDrawDotsClear write SetMustDrawDotsClear;
25 48 end;
26 49  
  50 + function GetRowColor(ARow : integer;ARowBase:integer) : TColor;
  51 +
  52 +const
  53 + K_ARRIVED = '.Arrived';
  54 + K_CHAT_M = '.ChatM';
  55 + K_CHOICE = '.Choice';
  56 + //K_RESPONSE =
  57 +
27 58 implementation
28 59  
  60 +uses form_matrixgame, game_resources, string_methods, zhelpers;
  61 +
  62 +const
  63 + GA_ADMIN = 'Admin';
  64 + GA_PLAYER = 'Player';
  65 + //GA_WATCHER = 'Watcher';
  66 +
  67 +function GetRowColor(ARow: integer; ARowBase:integer): TColor;
  68 +var LRow : integer;
  69 +begin
  70 + if ARowBase = 1 then
  71 + LRow := aRow -1
  72 + else LRow := aRow;
  73 +
  74 + case LRow of
  75 + 0,5 :Result := ccYellow;
  76 + 1,6 :Result := ccGreen;
  77 + 2,7 :Result := ccRed;
  78 + 3,8 :Result := ccBlue;
  79 + 4,9 :Result := ccMagenta;
  80 + end;
  81 +end;
  82 +
29 83 { TGameControl }
30 84  
31   -constructor TGameControl.Create(AZMQActor: TZMQActor; AOwner: TComponent);
  85 +function TGameControl.GetActorNicname(AID: string; Brackets: Boolean): string;
  86 +var i : integer;
  87 +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]';
  104 + end;
  105 +end;
  106 +
  107 +function TGameControl.MessageHas(const A_CONST: string; AMessage: TStringList): Boolean;
  108 +begin
  109 + Result := Pos(A_CONST,AMessage[0])>0;
  110 +end;
  111 +
  112 +procedure TGameControl.SetMatrixType(AStringGrid: TStringGrid;
  113 + AMatrixType: TGameMatrixType; var ARowBase: integer; var ADrawDots,
  114 + ADrawClear: Boolean);
  115 +
  116 + procedure WriteGridFixedNames(ASGrid: TStringGrid; WriteCols: boolean);
  117 + var
  118 + i: integer;
  119 + begin
  120 + with ASGrid do
  121 + for i := 0 to 9 do
  122 + begin
  123 + Cells[0, i + ARowBase] := IntToStr(i + 1);
  124 + if WriteCols then
  125 + Cells[i + 1, 0] := chr(65 + i);
  126 + end;
  127 + end;
  128 +
  129 +begin
  130 + AStringGrid.Clean;
  131 + if gmRows in AMatrixType then
  132 + begin
  133 + ARowBase := 0;
  134 + AStringGrid.FixedRows := 0;
  135 + AStringGrid.RowCount := 10;
  136 + AStringGrid.Height:=305;
  137 + AStringGrid.Options := [goFixedHorzLine, goHorzLine, goDrawFocusSelected, goRowSelect];
  138 + WriteGridFixedNames(AStringGrid, False);
  139 + end;
  140 +
  141 + if gmColumns in AMatrixType then
  142 + begin
  143 + ARowBase := 1;
  144 + AStringGrid.Clean;
  145 + AStringGrid.FixedRows := 1;
  146 + AStringGrid.RowCount := 11;
  147 + AStringGrid.Height:=335;
  148 + AStringGrid.Options := [goFixedHorzLine, goHorzLine, goDrawFocusSelected, goRowSelect, goVertLine];
  149 + WriteGridFixedNames(AStringGrid, True);
  150 + end;
  151 +
  152 + ADrawDots := gmDots in AMatrixType;
  153 + ADrawClear:= gmClearDots in AMatrixType;
  154 +end;
  155 +
  156 +function TGameControl.GetSelectedColorF(AStringGrid: TStringGrid): UTF8string;
  157 +begin
  158 + Result := GetRowColorString(GetRowColor(AStringGrid.Selection.Top,RowBase));
  159 +end;
  160 +
  161 +function TGameControl.GetSelectedRowF(AStringGrid: TStringGrid): UTF8string;
  162 +begin
  163 + Result := IntToStr(AStringGrid.Selection.Top);
  164 +end;
  165 +
  166 +procedure TGameControl.SetMustDrawDots(AValue: Boolean);
  167 +begin
  168 + if FMustDrawDots=AValue then Exit;
  169 + FMustDrawDots:=AValue;
  170 +end;
  171 +
  172 +procedure TGameControl.SetMustDrawDotsClear(AValue: Boolean);
  173 +begin
  174 + if FMustDrawDotsClear=AValue then Exit;
  175 + FMustDrawDotsClear:=AValue;
  176 +end;
  177 +
  178 +procedure TGameControl.SetRowBase(AValue: integer);
  179 +begin
  180 + if FRowBase=AValue then Exit;
  181 + case AValue of
  182 + 0 : FExperiment.MatrixType := [gmRows];
  183 + 1 : FExperiment.MatrixType := [gmRows,gmColumns];
  184 + end;
  185 + FRowBase:=AValue;
  186 +end;
  187 +
  188 +constructor TGameControl.Create(AZMQActor: TZMQActor);
32 189 begin
33   - inherited Create(AOwner);
  190 + inherited Create(AZMQActor.Owner);
34 191 FZMQActor := AZMQActor;
  192 + FZMQActor.SetID(ID);
  193 + FZMQActor.OnMessageReceived:=@ReceiveMessage;
  194 + FZMQActor.Start;
  195 +
  196 + if FZMQActor.ClassType = TZMQAdmin then
  197 + FActor := gaAdmin;
  198 + if FZMQActor.ClassType = TZMQPlayer then
  199 + FActor := gaPlayer;
  200 + if FZMQActor.ClassType = TZMQWatcher then
  201 + FActor := gaWatcher;
  202 +
  203 + RowBase:= 0;
  204 + MustDrawDots:=False;
  205 + MustDrawDotsClear:=False;
  206 +
  207 + {$IFDEF DEBUG}
  208 + case FActor of
  209 + gaAdmin:begin
  210 + FExperiment := TExperiment.Create(AZMQActor.Owner);
  211 + end;
  212 + gaPlayer:begin
  213 +
  214 + end;
  215 + end;
  216 + {$ENDIF}
35 217 end;
36 218  
37   -procedure TGameControl.SendMessage(AMessage: array of UTF8string);
  219 +destructor TGameControl.Destroy;
38 220 begin
  221 + inherited Destroy;
  222 +end;
39 223  
  224 +procedure TGameControl.SetID(S: string);
  225 +begin
  226 + FID := S;
40 227 end;
41 228  
42   -procedure TGameControl.ReceiveMessage(AMessage: TStringList);
  229 +procedure TGameControl.SendMessage(AMessage: UTF8string);
  230 +var
  231 +{$IFDEF DEBUG}
  232 + i : integer;
  233 +{$ENDIF}
  234 + M : array of UTF8string;
  235 +
  236 + procedure SetM(A: array of UTF8String);
  237 + var i : integer;
  238 + begin
  239 + SetLength(M,Length(A));
  240 + for i := 0 to Length(A) -1 do
  241 + M[i] := A[i];
  242 + end;
  243 +
43 244 begin
  245 + case AMessage of
  246 + K_ARRIVED : SetM([
  247 + AMessage
  248 + , FZMQActor.ID
  249 + ]);
  250 +
  251 + K_CHOICE : SetM([
  252 + AMessage
  253 + , FZMQActor.ID
  254 + , GetSelectedRowF(FormMatrixGame.StringGridMatrix)
  255 + , GetSelectedColorF(FormMatrixGame.StringGridMatrix)
  256 + ]);
  257 +
  258 + K_CHAT_M : SetM([
  259 + AMessage
  260 + , GetActorNicname(FZMQActor.ID, True)
  261 + , FormMatrixGame.ChatMemoSend.Lines.Text
  262 + ]);
  263 +
  264 + end;
  265 +
  266 + case FActor of
  267 + gaAdmin: begin
  268 + if not FExperiment.ResearcherCanChat then Exit;
  269 + M[0] := GA_ADMIN+M[0];
  270 + TZMQAdmin(FZMQActor).SendMessage(M);
  271 + end;
  272 + gaPlayer:begin
  273 + M[0] := GA_PLAYER+M[0];
  274 + TZMQPlayer(FZMQActor).SendMessage(M);
  275 + end;
  276 + //gaWatcher:begin // Cannot SendMessages
  277 + // M[0] := GA_WATCHER+M[0];
  278 + // TZMQWatcher(FZMQActor).SendMessage(M);
  279 + end;
44 280  
  281 +{$IFDEF DEBUG}
  282 + for i := 0 to Length(M)-1 do
  283 + WriteLn(M[i]);
  284 +{$ENDIF}
  285 +end;
  286 +
  287 +procedure TGameControl.ReceiveMessage(AMessage: TStringList);
  288 +
  289 + function MHas(const C : string) : Boolean;
  290 + begin
  291 + Result := MessageHas(C,AMessage);
  292 + end;
  293 +
  294 + procedure ReceiveActor;
  295 + var Data: TStringList;
  296 + begin
  297 + Data := TStringList.Create;
  298 + try
  299 + WriteLn('arrived');
  300 +
  301 + finally
  302 + Data.Free;
  303 + end;
  304 + end;
  305 +
  306 + procedure ReceiveChoice;
  307 + begin
  308 +
  309 + end;
  310 +
  311 + procedure ReceiveChat;
  312 + begin
  313 + FormMatrixGame.ChatMemoRecv.Lines.Append(('['+AMessage[1]+']: ')+AMessage[2]);
  314 + end;
  315 +
  316 + procedure ReceiveLogin;
  317 + begin
  318 + WriteLn('login');
  319 + end;
  320 +
  321 + procedure ReceiveLogout;
  322 + begin
  323 + WriteLn('logout');
  324 + end;
  325 +
  326 +begin
  327 + if MHas(K_ARRIVED) then ReceiveActor;
  328 + if MHas(K_CHAT_M) then ReceiveChat;
  329 + if MHas(K_CHOICE) then ReceiveChoice;
45 330 end;
46 331  
47 332 end.
... ...
units/game_experiment.pas
  Diff comments   View file @0dc8891
... ... @@ -14,7 +14,8 @@ type
14 14  
15 15 { TExperiment }
16 16  
17   - TPlayersPlaying = array of integer;
  17 + TPlayers = array of TPlayer;
  18 + TConditions = array of TCondition;
18 19  
19 20 TExperiment = class(TComponent)
20 21 private
... ... @@ -22,23 +23,27 @@ type
22 23 FExperimentName,
23 24 FFilename,
24 25 FResearcher : string;
  26 + FMatrixType: TGameMatrixType;
25 27 FRegData : TRegData;
26 28 FGenPlayersAsNeeded : Boolean;
27   - FPlayersPlaying : TPlayersPlaying;
28   - FPlayers : array of TPlayer;
  29 + FPlayersPlaying : TList;
  30 + FPlayers : TPlayers;
29 31 FCurrentCondition : integer;
30   - FConditions : array of TCondition;
  32 + FConditions : TConditions;
  33 + FResearcherCanChat: Boolean;
31 34 FShowChat: Boolean;
32 35 function GetCondition(I : Integer): TCondition;
33 36 function GetConditionsCount: integer;
34 37 function GetContingency(ACondition, I : integer): TContingency;
35 38 function GetPlayer(I : integer): TPlayer;
36 39 function GetPlayersCount: integer;
37   - function GetPlayersPlaying: TPlayersPlaying;
  40 + function GetPlayersPlaying: TList;
38 41 procedure SetCondition(I : Integer; AValue: TCondition);
39 42 procedure SetContingency(ACondition, I : integer; AValue: TContingency);
  43 + procedure SetMatrixType(AValue: TGameMatrixType);
40 44 procedure SetPlayer(I : integer; AValue: TPlayer);
41   - procedure SetPlayersPlaying(AValue: TPlayersPlaying);
  45 + procedure SetPlayersPlaying(AValue: TList);
  46 + procedure SetResearcherCanChat(AValue: Boolean);
42 47 public
43 48 constructor Create(AOwner:TComponent);override;
44 49 constructor Create(AFilename: string; AOwner:TComponent); overload;
... ... @@ -50,9 +55,10 @@ type
50 55 function AppendContingency(ACondition : integer) : integer;overload;
51 56 function AppendContingency(ACondition : integer;AContingency : TContingency) : integer;overload;
52 57 function AppendPlayer : integer;overload;
53   - function AppendPlayer(APlayer : TPlayer) : integer;overload;
  58 + function AppendPlayer(APlayer : TPlayer) : integer; overload;
54 59 procedure SaveToFile(AFilename: string); overload;
55 60 procedure SaveToFile; overload;
  61 + property ResearcherCanChat : Boolean read FResearcherCanChat write SetResearcherCanChat ;
56 62 property Researcher : string read FResearcher write FResearcher;
57 63 property Condition[I : Integer]: TCondition read GetCondition write SetCondition;
58 64 property ConditionsCount : integer read GetConditionsCount;
... ... @@ -62,9 +68,10 @@ type
62 68 property ExperimentName : string read FExperimentName write FExperimentName;
63 69 property GenPlayersAsNeeded : Boolean read FGenPlayersAsNeeded write FGenPlayersAsNeeded;
64 70 property Player[I : integer] : TPlayer read GetPlayer write SetPlayer;
65   - property PlayersCount : integer read GetPlayersCount;
66   - property PlayersPlaying : TPlayersPlaying read GetPlayersPlaying write SetPlayersPlaying;
  71 + property PlayersCount : integer read GetPlayersCount; // how many players per turn?
  72 + property PlayersPlaying : TList read GetPlayersPlaying write SetPlayersPlaying; // how many players are playing?
67 73 property ShowChat : Boolean read FShowChat write FShowChat;
  74 + property MatrixType : TGameMatrixType read FMatrixType write SetMatrixType;
68 75 end;
69 76  
70 77 resourcestring
... ... @@ -72,7 +79,7 @@ resourcestring
72 79  
73 80 implementation
74 81  
75   -uses game_file_methods, game_actors_point;
  82 +uses game_file_methods, game_actors_point,Dialogs;
76 83  
77 84 { TExperiment }
78 85  
... ... @@ -98,19 +105,28 @@ end;
98 105  
99 106 function TExperiment.GetPlayersCount: integer;
100 107 begin
101   - Result := High(FPlayers);
  108 + if Length(FPlayers) = 0 then
  109 + Result := High(FPlayers)
  110 + else
  111 + Result := -1;
102 112 end;
103 113  
104   -function TExperiment.GetPlayersPlaying: TPlayersPlaying;
105   -var i:integer;
  114 +function TExperiment.GetPlayersPlaying: TList;
  115 +var
  116 + i:integer;
  117 + P:PPlayer;
106 118 begin
107   - if Length(FPlayersPlaying) = 0 then
108   - for i := Low(FPlayers) to High(FPlayers) do
109   - if Player[i].Status = gpsPlaying then
110   - begin
111   - SetLength(FPlayersPlaying, Length(FPlayersPlaying)+1);
112   - FPlayersPlaying[High(FPlayersPlaying)] := i;
113   - end;
  119 + if FPlayersPlaying.Count > 0 then
  120 + FPlayersPlaying.Clear;
  121 +
  122 + for i := Low(FPlayers) to High(FPlayers) do
  123 + if Player[i].Status = gpsPlaying then
  124 + begin
  125 + P := nil;
  126 + P^ := Player[i];
  127 + FPlayersPlaying.Add(P);
  128 + end;
  129 +
114 130 Result := FPlayersPlaying;
115 131 end;
116 132  
... ... @@ -127,32 +143,35 @@ begin
127 143 FConditions[ACondition].Contingencies[I] := AValue;
128 144 end;
129 145  
  146 +procedure TExperiment.SetMatrixType(AValue: TGameMatrixType);
  147 +begin
  148 + if FMatrixType=AValue then Exit;
  149 + FMatrixType:=AValue;
  150 +end;
  151 +
  152 +
130 153 procedure TExperiment.SetPlayer(I : integer; AValue: TPlayer);
131 154 begin
132 155 if (I >= Low(FPlayers)) and (I <= High(FPlayers)) then
133 156 FPlayers[I] := AValue;
134 157 end;
135 158  
136   -procedure TExperiment.SetPlayersPlaying(AValue: TPlayersPlaying);
137   -var i : integer; LAllEqualDontSet : Boolean;
  159 +procedure TExperiment.SetPlayersPlaying(AValue: TList);
138 160 begin
139   - LAllEqualDontSet := True;
140   - if Length(FPlayersPlaying) = Length(AValue) then
141   - for i := Low(AValue) to High(AValue) do
142   - if not FPlayersPlaying[i] <> AValue[i] then
143   - begin
144   - LAllEqualDontSet := False;
145   - Break;
146   - end;
147   - if LAllEqualDontSet then Exit;
148   - SetLength(FPlayersPlaying,Length(AValue));
149   - for i := Low(AValue) to High(AValue) do
150   - FPlayersPlaying[i] := AValue[i];
  161 + if FPlayersPlaying = AValue then Exit;
  162 + FPlayersPlaying := AValue;
  163 +end;
  164 +
  165 +procedure TExperiment.SetResearcherCanChat(AValue: Boolean);
  166 +begin
  167 + if FResearcherCanChat=AValue then Exit;
  168 + FResearcherCanChat:=AValue;
151 169 end;
152 170  
153 171 constructor TExperiment.Create(AOwner: TComponent);
154 172 begin
155 173 inherited Create(AOwner);
  174 + FPlayersPlaying := TList.Create;
156 175 LoadExperimentFromResource(Self);
157 176 end;
158 177  
... ... @@ -164,6 +183,7 @@ end;
164 183  
165 184 destructor TExperiment.Destroy;
166 185 begin
  186 + FPlayersPlaying.Free;
167 187 inherited Destroy;
168 188 end;
169 189  
... ... @@ -189,35 +209,36 @@ end;
189 209  
190 210 function TExperiment.AppendCondition(ACondition: TCondition): integer;
191 211 begin
192   - FConditions[AppendCondition] := ACondition;
  212 + SetLength(FConditions, Length(FConditions)+1);
193 213 Result := High(FConditions);
  214 + FConditions[Result] := ACondition;
194 215 end;
195 216  
196 217 function TExperiment.AppendContingency(ACondition: integer): integer;
197 218 begin
198 219 SetLength(FConditions[ACondition].Contingencies, Length(FConditions[ACondition].Contingencies)+1);
199   - //FConditions[ACondition].Contingencies[High(FConditions[ACondition].Contingencies)].Consequence := TConsequence.Create(Self);
200   - //FConditions[ACondition].Contingencies[High(FConditions[ACondition].Contingencies)].Consequence.Points.A := TGamePoint.Create(Self);
201 220 Result := High(FConditions[ACondition].Contingencies);
202 221 end;
203 222  
204 223 function TExperiment.AppendContingency(ACondition: integer;
205 224 AContingency: TContingency): integer;
206 225 begin
207   - FConditions[ACondition].Contingencies[AppendContingency(ACondition)] := AContingency;
  226 + SetLength(FConditions[ACondition].Contingencies, Length(FConditions[ACondition].Contingencies)+1);
208 227 Result := High(FConditions[ACondition].Contingencies);
  228 + FConditions[ACondition].Contingencies[Result] := AContingency;
209 229 end;
210 230  
211 231 function TExperiment.AppendPlayer: integer;
212 232 begin
213 233 SetLength(FPlayers, Length(FPlayers)+1);
214   - Result := High(FPlayers);
  234 + Result := Length(FPlayers)-1;
215 235 end;
216 236  
217 237 function TExperiment.AppendPlayer(APlayer: TPlayer): integer;
218 238 begin
219   - FPlayers[AppendPlayer] := APlayer;
  239 + SetLength(FPlayers, Length(FPlayers)+1);
220 240 Result := High(FPlayers);
  241 + FPlayers[Result] := APlayer;
221 242 end;
222 243  
223 244 procedure TExperiment.SaveToFile(AFilename: string);
... ...
units/game_file_methods.pas
  Diff comments   View file @0dc8891
... ... @@ -39,11 +39,21 @@ begin
39 39 with AExperiment do
40 40 begin
41 41 Researcher := VAL_RESEARCHER;
  42 + ResearcherCanChat:=True;
42 43 ExperimentName:='Test Experiment';
43 44 ExperimentAim:='This is a test experiment.';
44 45 GenPlayersAsNeeded:=True;
45 46 CurrentCondition := 0;
  47 + AppendPlayer(C_PLAYER_TEMPLATE);
  48 + AppendPlayer(C_PLAYER_TEMPLATE);
46 49 i := AppendCondition(C_CONDITION_TEMPLATE);
  50 + with Condition[i] do
  51 + begin
  52 + ConditionName := SEC_CONDITION+IntToStr(i+1);
  53 + Turn.Count:=0;
  54 + Turn.Value:=0;
  55 + Turn.Random:=False;
  56 + end;
47 57 //j := AppendContingency(i,C_METACONTINGENCY_A1);
48 58 end;
49 59 end;
... ... @@ -240,6 +250,7 @@ var
240 250 s1 := DEF_END;
241 251 end;
242 252 EndCriterium := GetEndCriteria(s1);
  253 + ConditionName := ReadString(LS,KEY_COND_NAME,LS);
243 254 Points.Count := GetPoints(ReadString(LS, KEY_POINTS_COUNT,DEF_POINTS));
244 255 Points.OnStart := GetPoints(ReadString(LS, KEY_POINTS_ONSTART,DEF_POINTS));
245 256 Turn.Count:= ReadInteger(LS, KEY_TURN_COUNT,1);
... ...
units/game_resources.pas
  Diff comments   View file @0dc8891
... ... @@ -20,6 +20,7 @@ resourcestring
20 20 KEY_RESEARCHER = 'Pesquisador.Responsável';
21 21 KEY_GEN_PLAYER_AS_NEEDED = 'GerarJogadoresAutomaticamente';
22 22 KEY_CURRENT_CONDITION = 'ComeçarNaCondição';
  23 + KEY_MATRIX_TYPE= 'TipoDaMatrix';
23 24  
24 25 SEC_PLAYER = 'Jogador.';
25 26 KEY_PLAYER_TEMP = 'Data.X';
... ... @@ -34,12 +35,7 @@ resourcestring
34 35 KEY_PLAYER_STATUS = 'Status';
35 36  
36 37 SEC_CONDITION = 'Condição.';
37   - KEY_CONTINGENCY = 'Contingência.';
38   - KEY_METACONTINGENCY = 'Metacontingência.';
39   -
40   - KEY_RESPONSE = '.RespostaEsperada'; // ROW,COLOR,OPCODE
41   - KEY_CONSEQUE = '.Consequência'; // A,B,G,CSQCODE
42   - KEY_CONSEQUE_MESSAGE = '.Consequência.Mensagem';
  38 + KEY_COND_NAME = 'Nome';
43 39  
44 40 KEY_TURN_VALUE = 'Rodada.NúmeroDeJogadores'; // 3
45 41 KEY_TURN_COUNT = 'Rodada.IniciarNaJogada'; // 1
... ... @@ -56,7 +52,14 @@ resourcestring
56 52 KEY_PROMPT_STYLE = 'Questão.Estilo'; // string
57 53 KEY_PROMPT_MESSAGE = 'Questão.Mensagem'; // string
58 54  
59   - KEY_ENDCRITERIA = '.Critério.DeFinalizaçãoDaCondição'; //2,50,10,30,
  55 + KEY_ENDCRITERIA = 'Critério.DeFinalizaçãoDaCondição'; //2,50,10,30,
  56 +
  57 + KEY_CONTINGENCY = 'Contingência.';
  58 + KEY_METACONTINGENCY = 'Metacontingência.';
  59 +
  60 + KEY_RESPONSE = '.RespostaEsperada'; // ROW,COLOR,OPCODE
  61 + KEY_CONSEQUE = '.Consequência'; // A,B,G,CSQCODE
  62 + KEY_CONSEQUE_MESSAGE = '.Consequência.Mensagem';
60 63  
61 64 VAL_RESEARCHER = 'Pesquisador';
62 65  
... ... @@ -93,6 +96,21 @@ const
93 96 'Nicole','Luísa','Daniela','Núria','Bruna',
94 97 'Victória','Alícia','Rafaela','Helena','Miriam');
95 98  
  99 + C_PLAYER_TEMPLATE : TPlayer = (
  100 + ID : '';
  101 + Nicname : '';
  102 + Login :'';
  103 + Password : '';
  104 + Status : gpsWaiting;
  105 + Data : nil;
  106 + Choice : (
  107 + Current : (Row:grNone; Color:gcNone;);
  108 + Last : (Row:grNone; Color:gcNone;);
  109 + );
  110 + Points : (A:0; B:0);
  111 + Turn : -1;
  112 + );
  113 +
96 114 //C_OPERANT_1 : TContingency =
97 115 // (
98 116 // Consequence : (
... ... @@ -238,6 +256,7 @@ const
238 256  
239 257 C_CONDITION_TEMPLATE : TCondition =
240 258 (
  259 + ConditionName : '';
241 260 Contingencies : nil;
242 261  
243 262 Points : (
... ...
units/game_zmq_actors.pas
  Diff comments   View file @0dc8891
... ... @@ -12,21 +12,24 @@ uses
12 12  
13 13 type
14 14  
  15 + // Everything sent is received by everybody connected.
  16 +
15 17 { TZMQActor }
16 18  
17 19 TZMQActor = class(TComponent)
18 20 private
  21 + FID: UTF8string;
19 22 FSubscriber: TZMQPollThread;
20 23 FOnMessageReceived : TMessRecvProc;
21   - function GetActorID: UTF8string; virtual;
22 24 protected
23 25 procedure MessageReceived(AMultipartMessage : TStringList);
24 26 public
25 27 constructor Create(AOwner : TComponent); override;
26 28 destructor Destroy; override;
27 29 procedure Start; virtual;
  30 + procedure SetID(S:string);
28 31 property OnMessageReceived : TMessRecvProc read FOnMessageReceived write FOnMessageReceived;
29   - property ID : UTF8string read GetActorID;
  32 + property ID : UTF8string read FID;
30 33 end;
31 34  
32 35 { TZMQPlayer }
... ... @@ -34,13 +37,11 @@ type
34 37 TZMQPlayer = class(TZMQActor)
35 38 private
36 39 FPusher : TZMQPusher;
37   - function GetActorID: UTF8string; override;
38 40 public
39 41 constructor Create(AOwner : TComponent); override;
40 42 destructor Destroy; override;
41 43 procedure Start; override;
42 44 procedure SendMessage(AMessage : array of UTF8string);
43   - property ID : UTF8string read GetActorID;
44 45 end;
45 46  
46 47 { TZMQAdmin }
... ... @@ -100,11 +101,6 @@ begin
100 101 FPusher.SendMessage(AMessage);
101 102 end;
102 103  
103   -function TZMQPlayer.GetActorID: UTF8string;
104   -begin
105   - Result := FPusher.ID;
106   -end;
107   -
108 104 constructor TZMQPlayer.Create(AOwner: TComponent);
109 105 begin
110 106 inherited Create(AOwner);
... ... @@ -125,10 +121,9 @@ end;
125 121  
126 122 { TZMQActor }
127 123  
128   -function TZMQActor.GetActorID: UTF8string;
  124 +procedure TZMQActor.SetID(S: string);
129 125 begin
130   - AbstractError;
131   - Result := '';
  126 + FID := S;
132 127 end;
133 128  
134 129 procedure TZMQActor.MessageReceived(AMultipartMessage: TStringList);
... ...
units/string_methods.pas
  Diff comments   View file @0dc8891
... ... @@ -5,7 +5,7 @@ unit string_methods;
5 5 interface
6 6  
7 7 uses
8   - Classes, SysUtils, LazFileUtils
  8 + Classes, SysUtils, Graphics, LazFileUtils
9 9 , game_actors
10 10 , game_resources
11 11 ;
... ... @@ -21,6 +21,7 @@ function GetConsequenceStyleFromString(s:string):TGameConsequenceStyle;
21 21 function GetConsequenceStyleString(AStyle: TGameConsequenceStyle): string;
22 22 function GetResponseString(ACriteria : TCriteria) : string;
23 23 function GetResponseFromString(S: string) : TCriteria;
  24 +function GetRowColorString(C: TColor):string;
24 25  
25 26 implementation
26 27  
... ... @@ -207,6 +208,17 @@ begin
207 208 else Break;
208 209 end;
209 210  
  211 +function GetRowColorString(C: TColor): string;
  212 +begin
  213 + case C of
  214 + ccYellow: Result := 'Y';
  215 + ccBlue : Result := 'B';
  216 + ccGreen: Result := 'G';
  217 + ccRed: Result := 'R';
  218 + ccMagenta: Result := 'M';
  219 + end;
  220 +end;
  221 +
210 222 //function ValidateString(S: String): string;
211 223 ////var
212 224 //// i:integer;
... ...
units/zmq_network.pas
  Diff comments   View file @0dc8891
... ... @@ -14,7 +14,6 @@ unit zmq_network;
14 14 interface
15 15  
16 16 uses Classes, SysUtils, Process
17   -
18 17 , zmqapi
19 18 //, zmq_client
20 19 ;
... ... @@ -32,7 +31,6 @@ type
32 31 constructor Create;
33 32 destructor Destroy; override;
34 33 procedure SendMessage(AMultipartMessage : array of UTF8string);
35   - property ID : UTF8string read FID;
36 34 end;
37 35  
38 36 { TZMQPubThread }
... ... @@ -74,8 +72,6 @@ type
74 72  
75 73 implementation
76 74  
77   -uses zhelpers;
78   -
79 75 { TZMQSubscriber }
80 76  
81 77 procedure TZMQPollThread.MessageReceived;
... ... @@ -140,7 +136,6 @@ end;
140 136  
141 137 constructor TZMQPusher.Create;
142 138 begin
143   - FID := s_random(20);
144 139 FContext := TZMQContext.create;
145 140 FPusher := FContext.Socket( stPush );
146 141 FPusher.connect('tcp://localhost:5057');
... ...