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,10 +16,15 @@ uses
16 cthreads, 16 cthreads,
17 {$ENDIF}{$ENDIF} 17 {$ENDIF}{$ENDIF}
18 Interfaces // this includes the LCL widgetset 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 const 28 const
24 PAdmin : array [0..3] of string = ('--admin','--adm','-admin','-adm'); 29 PAdmin : array [0..3] of string = ('--admin','--adm','-admin','-adm');
25 PPlayer : array [0..3] of string = ('--player','--play','-player','-play'); 30 PPlayer : array [0..3] of string = ('--player','--play','-player','-play');
@@ -30,15 +35,38 @@ const @@ -30,15 +35,38 @@ const
30 begin 35 begin
31 //RequireDerivedFormResource := True; 36 //RequireDerivedFormResource := True;
32 Application.Initialize; 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 Application.CreateForm(TFormMatrixGame, FormMatrixGame); 60 Application.CreateForm(TFormMatrixGame, FormMatrixGame);
  61 + FormMatrixGame.SetID(F);
34 if Paramcount > 0 then 62 if Paramcount > 0 then
35 begin 63 begin
36 if AnsiMatchStr(lowercase(ParamStr(0)), PAdmin) then 64 if AnsiMatchStr(lowercase(ParamStr(0)), PAdmin) then
37 - FormMatrixGame.GameActor := gaAdmin; 65 + FormMatrixGame.SetGameActor(gaAdmin);
38 if AnsiMatchStr(lowercase(ParamStr(0)), PPlayer) then 66 if AnsiMatchStr(lowercase(ParamStr(0)), PPlayer) then
39 - FormMatrixGame.GameActor := gaPlayer; 67 + FormMatrixGame.SetGameActor(gaPlayer);
40 if AnsiMatchStr(lowercase(ParamStr(0)), PWatcher) then 68 if AnsiMatchStr(lowercase(ParamStr(0)), PWatcher) then
41 - FormMatrixGame.GameActor := gaWatcher; 69 + FormMatrixGame.SetGameActor(gaWatcher);
42 end 70 end
43 else 71 else
44 begin 72 begin
@@ -46,14 +74,15 @@ begin @@ -46,14 +74,15 @@ begin
46 if Form1.ShowModal = 1 then 74 if Form1.ShowModal = 1 then
47 begin 75 begin
48 case Form1.GameActor of 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 end; 80 end;
53 end 81 end
54 else Exit; 82 else Exit;
55 Form1.Free; 83 Form1.Free;
56 end; 84 end;
  85 +
57 Application.Run; 86 Application.Run;
58 end. 87 end.
59 88
form_matrixgame.lfm
  Diff comments   View file @0dc8891
1 object FormMatrixGame: TFormMatrixGame 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 VertScrollBar.Page = 542 7 VertScrollBar.Page = 542
8 AutoScroll = True 8 AutoScroll = True
9 Caption = 'FormMatrixGame' 9 Caption = 'FormMatrixGame'
10 - ClientHeight = 622  
11 - ClientWidth = 1278 10 + ClientHeight = 657
  11 + ClientWidth = 1518
12 Font.Name = 'Monospace' 12 Font.Name = 'Monospace'
13 OnActivate = FormActivate 13 OnActivate = FormActivate
14 - OnCreate = FormCreate  
15 LCLVersion = '1.6.0.4' 14 LCLVersion = '1.6.0.4'
16 object StringGridMatrix: TStringGrid 15 object StringGridMatrix: TStringGrid
17 AnchorSideLeft.Control = Owner 16 AnchorSideLeft.Control = Owner
@@ -38,7 +37,7 @@ object FormMatrixGame: TFormMatrixGame @@ -38,7 +37,7 @@ object FormMatrixGame: TFormMatrixGame
38 OnBeforeSelection = StringGridMatrixBeforeSelection 37 OnBeforeSelection = StringGridMatrixBeforeSelection
39 OnDrawCell = StringGridMatrixDrawCell 38 OnDrawCell = StringGridMatrixDrawCell
40 end 39 end
41 - object GBIndividualPoints: TGroupBox 40 + object GBIndividualAB: TGroupBox
42 Left = 796 41 Left = 796
43 Height = 122 42 Height = 122
44 Top = 0 43 Top = 0
@@ -113,9 +112,9 @@ object FormMatrixGame: TFormMatrixGame @@ -113,9 +112,9 @@ object FormMatrixGame: TFormMatrixGame
113 end 112 end
114 end 113 end
115 object GBGrupo: TGroupBox 114 object GBGrupo: TGroupBox
116 - AnchorSideLeft.Control = GBIndividualPoints 115 + AnchorSideLeft.Control = GBIndividualAB
117 AnchorSideLeft.Side = asrBottom 116 AnchorSideLeft.Side = asrBottom
118 - AnchorSideTop.Control = GBIndividualPoints 117 + AnchorSideTop.Control = GBIndividualAB
119 Left = 976 118 Left = 976
120 Height = 122 119 Height = 122
121 Top = 0 120 Top = 0
@@ -153,8 +152,8 @@ object FormMatrixGame: TFormMatrixGame @@ -153,8 +152,8 @@ object FormMatrixGame: TFormMatrixGame
153 AnchorSideBottom.Side = asrBottom 152 AnchorSideBottom.Side = asrBottom
154 Left = 0 153 Left = 0
155 Height = 124 154 Height = 124
156 - Top = 498  
157 - Width = 1492 155 + Top = 533
  156 + Width = 1518
158 Anchors = [akLeft, akRight, akBottom] 157 Anchors = [akLeft, akRight, akBottom]
159 AutoSize = True 158 AutoSize = True
160 Caption = 'Escolhas na última jogada' 159 Caption = 'Escolhas na última jogada'
@@ -163,7 +162,7 @@ object FormMatrixGame: TFormMatrixGame @@ -163,7 +162,7 @@ object FormMatrixGame: TFormMatrixGame
163 ChildSizing.HorizontalSpacing = 10 162 ChildSizing.HorizontalSpacing = 10
164 ChildSizing.ControlsPerLine = 6 163 ChildSizing.ControlsPerLine = 6
165 ClientHeight = 107 164 ClientHeight = 107
166 - ClientWidth = 1488 165 + ClientWidth = 1514
167 TabOrder = 3 166 TabOrder = 3
168 object GBLastChoiceP0: TGroupBox 167 object GBLastChoiceP0: TGroupBox
169 Left = 10 168 Left = 10
@@ -339,65 +338,13 @@ object FormMatrixGame: TFormMatrixGame @@ -339,65 +338,13 @@ object FormMatrixGame: TFormMatrixGame
339 ClientWidth = 332 338 ClientWidth = 332
340 TabOrder = 4 339 TabOrder = 4
341 Visible = False 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 object GBExperiment: TGroupBox 341 object GBExperiment: TGroupBox
395 - Left = 159 342 + Left = 8
396 Height = 172 343 Height = 172
397 Top = 8 344 Top = 8
398 - Width = 178 345 + Width = 218
399 AutoSize = True 346 AutoSize = True
400 - Caption = 'Experiment' 347 + Caption = 'Experimento'
401 ChildSizing.LeftRightSpacing = 20 348 ChildSizing.LeftRightSpacing = 20
402 ChildSizing.TopBottomSpacing = 20 349 ChildSizing.TopBottomSpacing = 20
403 ChildSizing.HorizontalSpacing = 30 350 ChildSizing.HorizontalSpacing = 30
@@ -406,19 +353,19 @@ object FormMatrixGame: TFormMatrixGame @@ -406,19 +353,19 @@ object FormMatrixGame: TFormMatrixGame
406 ChildSizing.Layout = cclLeftToRightThenTopToBottom 353 ChildSizing.Layout = cclLeftToRightThenTopToBottom
407 ChildSizing.ControlsPerLine = 2 354 ChildSizing.ControlsPerLine = 2
408 ClientHeight = 155 355 ClientHeight = 155
409 - ClientWidth = 174  
410 - TabOrder = 4 356 + ClientWidth = 214
  357 + TabOrder = 0
411 object LabelExpCond: TLabel 358 object LabelExpCond: TLabel
412 Left = 20 359 Left = 20
413 Height = 15 360 Height = 15
414 Top = 20 361 Top = 20
415 - Width = 88 362 + Width = 128
416 AutoSize = False 363 AutoSize = False
417 Caption = 'Condição:' 364 Caption = 'Condição:'
418 ParentColor = False 365 ParentColor = False
419 end 366 end
420 object LabelExpCondCount: TLabel 367 object LabelExpCondCount: TLabel
421 - Left = 138 368 + Left = 178
422 Height = 15 369 Height = 15
423 Top = 20 370 Top = 20
424 Width = 16 371 Width = 16
@@ -430,12 +377,12 @@ object FormMatrixGame: TFormMatrixGame @@ -430,12 +377,12 @@ object FormMatrixGame: TFormMatrixGame
430 Left = 20 377 Left = 20
431 Height = 15 378 Height = 15
432 Top = 45 379 Top = 45
433 - Width = 88 380 + Width = 128
434 Caption = 'Generation:' 381 Caption = 'Generation:'
435 ParentColor = False 382 ParentColor = False
436 end 383 end
437 object LabelExpGenCount: TLabel 384 object LabelExpGenCount: TLabel
438 - Left = 138 385 + Left = 178
439 Height = 15 386 Height = 15
440 Top = 45 387 Top = 45
441 Width = 16 388 Width = 16
@@ -446,12 +393,12 @@ object FormMatrixGame: TFormMatrixGame @@ -446,12 +393,12 @@ object FormMatrixGame: TFormMatrixGame
446 Left = 20 393 Left = 20
447 Height = 15 394 Height = 15
448 Top = 70 395 Top = 70
449 - Width = 88 396 + Width = 128
450 Caption = 'Cycle:' 397 Caption = 'Cycle:'
451 ParentColor = False 398 ParentColor = False
452 end 399 end
453 object LabelExpCycleCount: TLabel 400 object LabelExpCycleCount: TLabel
454 - Left = 138 401 + Left = 178
455 Height = 15 402 Height = 15
456 Top = 70 403 Top = 70
457 Width = 16 404 Width = 16
@@ -462,28 +409,28 @@ object FormMatrixGame: TFormMatrixGame @@ -462,28 +409,28 @@ object FormMatrixGame: TFormMatrixGame
462 Left = 20 409 Left = 20
463 Height = 15 410 Height = 15
464 Top = 95 411 Top = 95
465 - Width = 88 412 + Width = 128
466 Caption = 'Prox. Jog.:' 413 Caption = 'Prox. Jog.:'
467 ParentColor = False 414 ParentColor = False
468 end 415 end
469 object LabelExpNxtPlayerCount: TLabel 416 object LabelExpNxtPlayerCount: TLabel
470 - Left = 138 417 + Left = 178
471 Height = 15 418 Height = 15
472 Top = 95 419 Top = 95
473 Width = 16 420 Width = 16
474 Caption = 'NA' 421 Caption = 'NA'
475 ParentColor = False 422 ParentColor = False
476 end 423 end
477 - object Label21: TLabel 424 + object LabelExpInterlocks: TLabel
478 Left = 20 425 Left = 20
479 Height = 15 426 Height = 15
480 Top = 120 427 Top = 120
481 - Width = 88  
482 - Caption = 'NA' 428 + Width = 128
  429 + Caption = 'Entrelaçamentos:'
483 ParentColor = False 430 ParentColor = False
484 end 431 end
485 - object Label22: TLabel  
486 - Left = 138 432 + object LabelExpInterlocksCount: TLabel
  433 + Left = 178
487 Height = 15 434 Height = 15
488 Top = 120 435 Top = 120
489 Width = 16 436 Width = 16
@@ -502,18 +449,9 @@ object FormMatrixGame: TFormMatrixGame @@ -502,18 +449,9 @@ object FormMatrixGame: TFormMatrixGame
502 TabOrder = 5 449 TabOrder = 5
503 Visible = False 450 Visible = False
504 end 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 object ChatPanel: TPanel 452 object ChatPanel: TPanel
515 - AnchorSideLeft.Control = GBIndividualPoints  
516 - AnchorSideTop.Control = GBIndividualPoints 453 + AnchorSideLeft.Control = GBIndividualAB
  454 + AnchorSideTop.Control = GBIndividualAB
517 AnchorSideTop.Side = asrBottom 455 AnchorSideTop.Side = asrBottom
518 AnchorSideRight.Control = GBGrupo 456 AnchorSideRight.Control = GBGrupo
519 AnchorSideRight.Side = asrBottom 457 AnchorSideRight.Side = asrBottom
@@ -525,7 +463,7 @@ object FormMatrixGame: TFormMatrixGame @@ -525,7 +463,7 @@ object FormMatrixGame: TFormMatrixGame
525 BorderSpacing.Top = 10 463 BorderSpacing.Top = 10
526 ClientHeight = 354 464 ClientHeight = 354
527 ClientWidth = 350 465 ClientWidth = 350
528 - TabOrder = 7 466 + TabOrder = 6
529 object ChatMemoRecv: TMemo 467 object ChatMemoRecv: TMemo
530 AnchorSideBottom.Control = ChatSplitter 468 AnchorSideBottom.Control = ChatSplitter
531 Left = 6 469 Left = 6
@@ -573,4 +511,36 @@ object FormMatrixGame: TFormMatrixGame @@ -573,4 +511,36 @@ object FormMatrixGame: TFormMatrixGame
573 WantTabs = True 511 WantTabs = True
574 end 512 end
575 end 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 end 546 end
form_matrixgame.pas
  Diff comments   View file @0dc8891
@@ -20,6 +20,7 @@ uses @@ -20,6 +20,7 @@ uses
20 //, zmq_pub_sub 20 //, zmq_pub_sub
21 , game_zmq_actors 21 , game_zmq_actors
22 , game_actors 22 , game_actors
  23 + , game_control
23 ; 24 ;
24 25
25 type 26 type
@@ -28,12 +29,9 @@ type @@ -28,12 +29,9 @@ type
28 29
29 TFormMatrixGame = class(TForm) 30 TFormMatrixGame = class(TForm)
30 btnConfirmRow: TButton; 31 btnConfirmRow: TButton;
31 - Button1: TButton;  
32 - Button2: TButton;  
33 - Button3: TButton;  
34 - CheckBoxDrawDots: TCheckBox; 32 + GBIndividual: TGroupBox;
35 GBLastChoice: TGroupBox; 33 GBLastChoice: TGroupBox;
36 - GBIndividualPoints: TGroupBox; 34 + GBIndividualAB: TGroupBox;
37 GBGrupo: TGroupBox; 35 GBGrupo: TGroupBox;
38 GBAdmin: TGroupBox; 36 GBAdmin: TGroupBox;
39 GBLastChoiceP0: TGroupBox; 37 GBLastChoiceP0: TGroupBox;
@@ -51,8 +49,9 @@ type @@ -51,8 +49,9 @@ type
51 LabelExpCycleCount: TLabel; 49 LabelExpCycleCount: TLabel;
52 LabelExpNxtPlayer: TLabel; 50 LabelExpNxtPlayer: TLabel;
53 LabelExpNxtPlayerCount: TLabel; 51 LabelExpNxtPlayerCount: TLabel;
54 - Label21: TLabel;  
55 - Label22: TLabel; 52 + LabelExpInterlocks: TLabel;
  53 + LabelExpInterlocksCount: TLabel;
  54 + LabelIndCount: TLabel;
56 LabelIndACount: TLabel; 55 LabelIndACount: TLabel;
57 LabelIndBCount: TLabel; 56 LabelIndBCount: TLabel;
58 LabelCurrentColor1: TLabel; 57 LabelCurrentColor1: TLabel;
@@ -70,32 +69,25 @@ type @@ -70,32 +69,25 @@ type
70 Panel4: TPanel; 69 Panel4: TPanel;
71 Panel5: TPanel; 70 Panel5: TPanel;
72 PanelCurrentColor1: TPanel; 71 PanelCurrentColor1: TPanel;
73 - rgMatrixType: TRadioGroup;  
74 ChatSplitter: TSplitter; 72 ChatSplitter: TSplitter;
75 StringGridMatrix: TStringGrid; 73 StringGridMatrix: TStringGrid;
76 procedure btnConfirmRowClick(Sender: TObject); 74 procedure btnConfirmRowClick(Sender: TObject);
77 - procedure Button1Click(Sender: TObject);  
78 - procedure Button3Click(Sender: TObject);  
79 procedure ChatMemoSendKeyPress(Sender: TObject; var Key: char); 75 procedure ChatMemoSendKeyPress(Sender: TObject; var Key: char);
80 procedure CheckBoxDrawDotsChange(Sender: TObject); 76 procedure CheckBoxDrawDotsChange(Sender: TObject);
81 procedure FormActivate(Sender: TObject); 77 procedure FormActivate(Sender: TObject);
82 - procedure FormCreate(Sender: TObject);  
83 - procedure rgMatrixTypeClick(Sender: TObject);  
84 procedure StringGridMatrixBeforeSelection(Sender: TObject; aCol, aRow: integer); 78 procedure StringGridMatrixBeforeSelection(Sender: TObject; aCol, aRow: integer);
85 procedure StringGridMatrixDrawCell(Sender: TObject; aCol, aRow: integer; 79 procedure StringGridMatrixDrawCell(Sender: TObject; aCol, aRow: integer;
86 aRect: TRect; aState: TGridDrawState); 80 aRect: TRect; aState: TGridDrawState);
87 private 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 public 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 end; 91 end;
100 92
101 var 93 var
@@ -107,7 +99,6 @@ uses LCLType, game_resources; @@ -107,7 +99,6 @@ uses LCLType, game_resources;
107 99
108 // uses datamodule; 100 // uses datamodule;
109 var 101 var
110 - RowBase: integer = 0;  
111 MustDrawSelection : Boolean; // work around until a bug fix for ClearSelection is released 102 MustDrawSelection : Boolean; // work around until a bug fix for ClearSelection is released
112 103
113 {$R *.lfm} 104 {$R *.lfm}
@@ -118,6 +109,7 @@ procedure TFormMatrixGame.StringGridMatrixDrawCell(Sender: TObject; aCol, aRow: @@ -118,6 +109,7 @@ procedure TFormMatrixGame.StringGridMatrixDrawCell(Sender: TObject; aCol, aRow:
118 aRect: TRect; aState: TGridDrawState); 109 aRect: TRect; aState: TGridDrawState);
119 var 110 var
120 OldCanvas: TCanvas; 111 OldCanvas: TCanvas;
  112 + RowBase : integer;
121 113
122 procedure SaveOldCanvas; 114 procedure SaveOldCanvas;
123 begin 115 begin
@@ -166,10 +158,11 @@ var @@ -166,10 +158,11 @@ var
166 TStringGrid(Sender).Canvas.Brush.Color := Color; 158 TStringGrid(Sender).Canvas.Brush.Color := Color;
167 TStringGrid(Sender).Canvas.Pen.Color := Color; 159 TStringGrid(Sender).Canvas.Pen.Color := Color;
168 TStringGrid(Sender).Canvas.Rectangle(aRect); 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 end; 166 end;
174 //function GetTextX(S : String): Longint; 167 //function GetTextX(S : String): Longint;
175 //begin 168 //begin
@@ -177,6 +170,8 @@ var @@ -177,6 +170,8 @@ var
177 //end; 170 //end;
178 171
179 begin 172 begin
  173 + if Assigned(FGameControl) then
  174 + RowBase:=FGameControl.RowBase;
180 SaveOldCanvas; 175 SaveOldCanvas;
181 try 176 try
182 //if (aRow >= RowBase) and (aCol = 10) then 177 //if (aRow >= RowBase) and (aCol = 10) then
@@ -184,7 +179,7 @@ begin @@ -184,7 +179,7 @@ begin
184 179
185 if (aCol <> 0) and (aRow > (RowBase-1)) then 180 if (aCol <> 0) and (aRow > (RowBase-1)) then
186 begin 181 begin
187 - DrawLines(GetRowColor(aRow)); 182 + DrawLines(GetRowColor(aRow,RowBase));
188 183
189 if (gdSelected in aState) and MustDrawSelection then 184 if (gdSelected in aState) and MustDrawSelection then
190 begin 185 begin
@@ -226,111 +221,42 @@ begin @@ -226,111 +221,42 @@ begin
226 end; 221 end;
227 end; 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 procedure TFormMatrixGame.SetGameActor(AValue: TGameActor); 224 procedure TFormMatrixGame.SetGameActor(AValue: TGameActor);
264 225
265 procedure SetZMQAdmin; 226 procedure SetZMQAdmin;
266 begin 227 begin
267 - FZMQActor := TZMQAdmin.Create(Self); 228 + FGameControl := TGameControl.Create(TZMQAdmin.Create(Self));
268 GBAdmin.Visible:= True; 229 GBAdmin.Visible:= True;
269 end; 230 end;
270 231
271 procedure SetZMQPlayer; 232 procedure SetZMQPlayer;
272 begin 233 begin
273 - FZMQActor := TZMQPlayer.Create(Self); 234 + FGameControl := TGameControl.Create(TZMQPlayer.Create(Self));
274 btnConfirmRow.Visible := True; 235 btnConfirmRow.Visible := True;
275 StringGridMatrix.Enabled := True; 236 StringGridMatrix.Enabled := True;
  237 +
  238 + FGameControl.SendMessage(K_ARRIVED);
276 end; 239 end;
277 240
278 procedure SetZMQWatcher; 241 procedure SetZMQWatcher;
279 begin 242 begin
280 - FZMQActor := TZMQWatcher.Create(Self); 243 + FGameControl := TGameControl.Create(TZMQWatcher.Create(Self));
281 end; 244 end;
282 245
283 begin 246 begin
284 - if FGameActor=AValue then Exit;  
285 - FGameActor:=AValue;  
286 -  
287 - case FGameActor of 247 + case AValue of
288 gaAdmin: SetZMQAdmin; 248 gaAdmin: SetZMQAdmin;
289 gaPlayer: SetZMQPlayer; 249 gaPlayer: SetZMQPlayer;
290 gaWatcher: SetZMQWatcher; 250 gaWatcher: SetZMQWatcher;
291 end; 251 end;
292 -  
293 - FZMQActor.OnMessageReceived:=@MessageReceived;  
294 - FZMQActor.Start; 252 + FGameControl.SetID(FID);
295 end; 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 begin 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 end; 258 end;
332 259
333 -  
334 procedure TFormMatrixGame.CheckBoxDrawDotsChange(Sender: TObject); 260 procedure TFormMatrixGame.CheckBoxDrawDotsChange(Sender: TObject);
335 begin 261 begin
336 StringGridMatrix.Invalidate; 262 StringGridMatrix.Invalidate;
@@ -342,85 +268,17 @@ begin @@ -342,85 +268,17 @@ begin
342 StringGridMatrix.FocusRectVisible := False; 268 StringGridMatrix.FocusRectVisible := False;
343 end; 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 procedure TFormMatrixGame.StringGridMatrixBeforeSelection(Sender: TObject; aCol, aRow: integer); 271 procedure TFormMatrixGame.StringGridMatrixBeforeSelection(Sender: TObject; aCol, aRow: integer);
395 begin 272 begin
396 if MustDrawSelection then Exit; 273 if MustDrawSelection then Exit;
397 MustDrawSelection := True; 274 MustDrawSelection := True;
398 end; 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 procedure TFormMatrixGame.ChatMemoSendKeyPress(Sender: TObject; var Key: char); 277 procedure TFormMatrixGame.ChatMemoSendKeyPress(Sender: TObject; var Key: char);
415 begin 278 begin
416 if Key = Char(VK_RETURN) then 279 if Key = Char(VK_RETURN) then
417 begin 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 with ChatMemoSend do 282 with ChatMemoSend do
425 begin 283 begin
426 Clear; 284 Clear;
@@ -434,17 +292,11 @@ end; @@ -434,17 +292,11 @@ end;
434 292
435 procedure TFormMatrixGame.btnConfirmRowClick(Sender: TObject); 293 procedure TFormMatrixGame.btnConfirmRowClick(Sender: TObject);
436 begin 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 end; 300 end;
449 301
450 end. 302 end.
units/game_actors.pas
  Diff comments   View file @0dc8891
@@ -10,9 +10,13 @@ uses @@ -10,9 +10,13 @@ uses
10 ; 10 ;
11 type 11 type
12 12
  13 +
13 TGameActor = ( gaNone, gaAdmin, gaPlayer, gaWatcher ); 14 TGameActor = ( gaNone, gaAdmin, gaPlayer, gaWatcher );
14 TGamePlayerStatus = (gpsWaiting, gpsPlaying, gpsPlayed); 15 TGamePlayerStatus = (gpsWaiting, gpsPlaying, gpsPlayed);
15 16
  17 + TGameMatrix = (gmRows,gmColumns, gmDots,gmClearDots);
  18 + TGameMatrixType = set of TGameMatrix;
  19 +
16 TGameRow = (grNone, 20 TGameRow = (grNone,
17 grOne,grTwo,grThree,grFour,grFive,grSix,grSeven,grEight,grNine,grTen, // 10 rows 21 grOne,grTwo,grThree,grFour,grFive,grSix,grSeven,grEight,grNine,grTen, // 10 rows
18 grEven,grOdd, 22 grEven,grOdd,
@@ -107,6 +111,7 @@ type @@ -107,6 +111,7 @@ type
107 end; 111 end;
108 112
109 TCondition = record 113 TCondition = record
  114 + ConditionName : string;
110 Contingencies : TContingencies; // for producing points during the condition 115 Contingencies : TContingencies; // for producing points during the condition
111 116
112 Points : record 117 Points : record
@@ -138,6 +143,8 @@ type @@ -138,6 +143,8 @@ type
138 Color : TGameColor; 143 Color : TGameColor;
139 end; 144 end;
140 145
  146 + PPlayer = ^TPlayer;
  147 +
141 TPlayer = record 148 TPlayer = record
142 ID, 149 ID,
143 Nicname, 150 Nicname,
units/game_control.pas
  Diff comments   View file @0dc8891
@@ -2,12 +2,15 @@ unit game_control; @@ -2,12 +2,15 @@ unit game_control;
2 2
3 {$mode objfpc}{$H+} 3 {$mode objfpc}{$H+}
4 4
  5 +{$DEFINE DEBUG}
  6 +
5 interface 7 interface
6 8
7 uses 9 uses
8 - Classes, SysUtils 10 + Classes, SysUtils, Graphics, Grids
9 , game_zmq_actors 11 , game_zmq_actors
10 , game_experiment 12 , game_experiment
  13 + , game_actors
11 ; 14 ;
12 15
13 type 16 type
@@ -16,32 +19,314 @@ type @@ -16,32 +19,314 @@ type
16 19
17 TGameControl = class(TComponent) 20 TGameControl = class(TComponent)
18 private 21 private
  22 + FID: string;
  23 + FMustDrawDots: Boolean;
  24 + FMustDrawDotsClear: Boolean;
  25 + FRowBase : integer;
  26 + FActor : TGameActor;
19 FZMQActor : TZMQActor; 27 FZMQActor : TZMQActor;
20 FExperiment : TExperiment; 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 procedure ReceiveMessage(AMessage : TStringList); 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 end; 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 implementation 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 { TGameControl } 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 begin 189 begin
33 - inherited Create(AOwner); 190 + inherited Create(AZMQActor.Owner);
34 FZMQActor := AZMQActor; 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 end; 217 end;
36 218
37 -procedure TGameControl.SendMessage(AMessage: array of UTF8string); 219 +destructor TGameControl.Destroy;
38 begin 220 begin
  221 + inherited Destroy;
  222 +end;
39 223
  224 +procedure TGameControl.SetID(S: string);
  225 +begin
  226 + FID := S;
40 end; 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 begin 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 end; 330 end;
46 331
47 end. 332 end.
units/game_experiment.pas
  Diff comments   View file @0dc8891
@@ -14,7 +14,8 @@ type @@ -14,7 +14,8 @@ type
14 14
15 { TExperiment } 15 { TExperiment }
16 16
17 - TPlayersPlaying = array of integer; 17 + TPlayers = array of TPlayer;
  18 + TConditions = array of TCondition;
18 19
19 TExperiment = class(TComponent) 20 TExperiment = class(TComponent)
20 private 21 private
@@ -22,23 +23,27 @@ type @@ -22,23 +23,27 @@ type
22 FExperimentName, 23 FExperimentName,
23 FFilename, 24 FFilename,
24 FResearcher : string; 25 FResearcher : string;
  26 + FMatrixType: TGameMatrixType;
25 FRegData : TRegData; 27 FRegData : TRegData;
26 FGenPlayersAsNeeded : Boolean; 28 FGenPlayersAsNeeded : Boolean;
27 - FPlayersPlaying : TPlayersPlaying;  
28 - FPlayers : array of TPlayer; 29 + FPlayersPlaying : TList;
  30 + FPlayers : TPlayers;
29 FCurrentCondition : integer; 31 FCurrentCondition : integer;
30 - FConditions : array of TCondition; 32 + FConditions : TConditions;
  33 + FResearcherCanChat: Boolean;
31 FShowChat: Boolean; 34 FShowChat: Boolean;
32 function GetCondition(I : Integer): TCondition; 35 function GetCondition(I : Integer): TCondition;
33 function GetConditionsCount: integer; 36 function GetConditionsCount: integer;
34 function GetContingency(ACondition, I : integer): TContingency; 37 function GetContingency(ACondition, I : integer): TContingency;
35 function GetPlayer(I : integer): TPlayer; 38 function GetPlayer(I : integer): TPlayer;
36 function GetPlayersCount: integer; 39 function GetPlayersCount: integer;
37 - function GetPlayersPlaying: TPlayersPlaying; 40 + function GetPlayersPlaying: TList;
38 procedure SetCondition(I : Integer; AValue: TCondition); 41 procedure SetCondition(I : Integer; AValue: TCondition);
39 procedure SetContingency(ACondition, I : integer; AValue: TContingency); 42 procedure SetContingency(ACondition, I : integer; AValue: TContingency);
  43 + procedure SetMatrixType(AValue: TGameMatrixType);
40 procedure SetPlayer(I : integer; AValue: TPlayer); 44 procedure SetPlayer(I : integer; AValue: TPlayer);
41 - procedure SetPlayersPlaying(AValue: TPlayersPlaying); 45 + procedure SetPlayersPlaying(AValue: TList);
  46 + procedure SetResearcherCanChat(AValue: Boolean);
42 public 47 public
43 constructor Create(AOwner:TComponent);override; 48 constructor Create(AOwner:TComponent);override;
44 constructor Create(AFilename: string; AOwner:TComponent); overload; 49 constructor Create(AFilename: string; AOwner:TComponent); overload;
@@ -50,9 +55,10 @@ type @@ -50,9 +55,10 @@ type
50 function AppendContingency(ACondition : integer) : integer;overload; 55 function AppendContingency(ACondition : integer) : integer;overload;
51 function AppendContingency(ACondition : integer;AContingency : TContingency) : integer;overload; 56 function AppendContingency(ACondition : integer;AContingency : TContingency) : integer;overload;
52 function AppendPlayer : integer;overload; 57 function AppendPlayer : integer;overload;
53 - function AppendPlayer(APlayer : TPlayer) : integer;overload; 58 + function AppendPlayer(APlayer : TPlayer) : integer; overload;
54 procedure SaveToFile(AFilename: string); overload; 59 procedure SaveToFile(AFilename: string); overload;
55 procedure SaveToFile; overload; 60 procedure SaveToFile; overload;
  61 + property ResearcherCanChat : Boolean read FResearcherCanChat write SetResearcherCanChat ;
56 property Researcher : string read FResearcher write FResearcher; 62 property Researcher : string read FResearcher write FResearcher;
57 property Condition[I : Integer]: TCondition read GetCondition write SetCondition; 63 property Condition[I : Integer]: TCondition read GetCondition write SetCondition;
58 property ConditionsCount : integer read GetConditionsCount; 64 property ConditionsCount : integer read GetConditionsCount;
@@ -62,9 +68,10 @@ type @@ -62,9 +68,10 @@ type
62 property ExperimentName : string read FExperimentName write FExperimentName; 68 property ExperimentName : string read FExperimentName write FExperimentName;
63 property GenPlayersAsNeeded : Boolean read FGenPlayersAsNeeded write FGenPlayersAsNeeded; 69 property GenPlayersAsNeeded : Boolean read FGenPlayersAsNeeded write FGenPlayersAsNeeded;
64 property Player[I : integer] : TPlayer read GetPlayer write SetPlayer; 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 property ShowChat : Boolean read FShowChat write FShowChat; 73 property ShowChat : Boolean read FShowChat write FShowChat;
  74 + property MatrixType : TGameMatrixType read FMatrixType write SetMatrixType;
68 end; 75 end;
69 76
70 resourcestring 77 resourcestring
@@ -72,7 +79,7 @@ resourcestring @@ -72,7 +79,7 @@ resourcestring
72 79
73 implementation 80 implementation
74 81
75 -uses game_file_methods, game_actors_point; 82 +uses game_file_methods, game_actors_point,Dialogs;
76 83
77 { TExperiment } 84 { TExperiment }
78 85
@@ -98,19 +105,28 @@ end; @@ -98,19 +105,28 @@ end;
98 105
99 function TExperiment.GetPlayersCount: integer; 106 function TExperiment.GetPlayersCount: integer;
100 begin 107 begin
101 - Result := High(FPlayers); 108 + if Length(FPlayers) = 0 then
  109 + Result := High(FPlayers)
  110 + else
  111 + Result := -1;
102 end; 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 begin 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 Result := FPlayersPlaying; 130 Result := FPlayersPlaying;
115 end; 131 end;
116 132
@@ -127,32 +143,35 @@ begin @@ -127,32 +143,35 @@ begin
127 FConditions[ACondition].Contingencies[I] := AValue; 143 FConditions[ACondition].Contingencies[I] := AValue;
128 end; 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 procedure TExperiment.SetPlayer(I : integer; AValue: TPlayer); 153 procedure TExperiment.SetPlayer(I : integer; AValue: TPlayer);
131 begin 154 begin
132 if (I >= Low(FPlayers)) and (I <= High(FPlayers)) then 155 if (I >= Low(FPlayers)) and (I <= High(FPlayers)) then
133 FPlayers[I] := AValue; 156 FPlayers[I] := AValue;
134 end; 157 end;
135 158
136 -procedure TExperiment.SetPlayersPlaying(AValue: TPlayersPlaying);  
137 -var i : integer; LAllEqualDontSet : Boolean; 159 +procedure TExperiment.SetPlayersPlaying(AValue: TList);
138 begin 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 end; 169 end;
152 170
153 constructor TExperiment.Create(AOwner: TComponent); 171 constructor TExperiment.Create(AOwner: TComponent);
154 begin 172 begin
155 inherited Create(AOwner); 173 inherited Create(AOwner);
  174 + FPlayersPlaying := TList.Create;
156 LoadExperimentFromResource(Self); 175 LoadExperimentFromResource(Self);
157 end; 176 end;
158 177
@@ -164,6 +183,7 @@ end; @@ -164,6 +183,7 @@ end;
164 183
165 destructor TExperiment.Destroy; 184 destructor TExperiment.Destroy;
166 begin 185 begin
  186 + FPlayersPlaying.Free;
167 inherited Destroy; 187 inherited Destroy;
168 end; 188 end;
169 189
@@ -189,35 +209,36 @@ end; @@ -189,35 +209,36 @@ end;
189 209
190 function TExperiment.AppendCondition(ACondition: TCondition): integer; 210 function TExperiment.AppendCondition(ACondition: TCondition): integer;
191 begin 211 begin
192 - FConditions[AppendCondition] := ACondition; 212 + SetLength(FConditions, Length(FConditions)+1);
193 Result := High(FConditions); 213 Result := High(FConditions);
  214 + FConditions[Result] := ACondition;
194 end; 215 end;
195 216
196 function TExperiment.AppendContingency(ACondition: integer): integer; 217 function TExperiment.AppendContingency(ACondition: integer): integer;
197 begin 218 begin
198 SetLength(FConditions[ACondition].Contingencies, Length(FConditions[ACondition].Contingencies)+1); 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 Result := High(FConditions[ACondition].Contingencies); 220 Result := High(FConditions[ACondition].Contingencies);
202 end; 221 end;
203 222
204 function TExperiment.AppendContingency(ACondition: integer; 223 function TExperiment.AppendContingency(ACondition: integer;
205 AContingency: TContingency): integer; 224 AContingency: TContingency): integer;
206 begin 225 begin
207 - FConditions[ACondition].Contingencies[AppendContingency(ACondition)] := AContingency; 226 + SetLength(FConditions[ACondition].Contingencies, Length(FConditions[ACondition].Contingencies)+1);
208 Result := High(FConditions[ACondition].Contingencies); 227 Result := High(FConditions[ACondition].Contingencies);
  228 + FConditions[ACondition].Contingencies[Result] := AContingency;
209 end; 229 end;
210 230
211 function TExperiment.AppendPlayer: integer; 231 function TExperiment.AppendPlayer: integer;
212 begin 232 begin
213 SetLength(FPlayers, Length(FPlayers)+1); 233 SetLength(FPlayers, Length(FPlayers)+1);
214 - Result := High(FPlayers); 234 + Result := Length(FPlayers)-1;
215 end; 235 end;
216 236
217 function TExperiment.AppendPlayer(APlayer: TPlayer): integer; 237 function TExperiment.AppendPlayer(APlayer: TPlayer): integer;
218 begin 238 begin
219 - FPlayers[AppendPlayer] := APlayer; 239 + SetLength(FPlayers, Length(FPlayers)+1);
220 Result := High(FPlayers); 240 Result := High(FPlayers);
  241 + FPlayers[Result] := APlayer;
221 end; 242 end;
222 243
223 procedure TExperiment.SaveToFile(AFilename: string); 244 procedure TExperiment.SaveToFile(AFilename: string);
units/game_file_methods.pas
  Diff comments   View file @0dc8891
@@ -39,11 +39,21 @@ begin @@ -39,11 +39,21 @@ begin
39 with AExperiment do 39 with AExperiment do
40 begin 40 begin
41 Researcher := VAL_RESEARCHER; 41 Researcher := VAL_RESEARCHER;
  42 + ResearcherCanChat:=True;
42 ExperimentName:='Test Experiment'; 43 ExperimentName:='Test Experiment';
43 ExperimentAim:='This is a test experiment.'; 44 ExperimentAim:='This is a test experiment.';
44 GenPlayersAsNeeded:=True; 45 GenPlayersAsNeeded:=True;
45 CurrentCondition := 0; 46 CurrentCondition := 0;
  47 + AppendPlayer(C_PLAYER_TEMPLATE);
  48 + AppendPlayer(C_PLAYER_TEMPLATE);
46 i := AppendCondition(C_CONDITION_TEMPLATE); 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 //j := AppendContingency(i,C_METACONTINGENCY_A1); 57 //j := AppendContingency(i,C_METACONTINGENCY_A1);
48 end; 58 end;
49 end; 59 end;
@@ -240,6 +250,7 @@ var @@ -240,6 +250,7 @@ var
240 s1 := DEF_END; 250 s1 := DEF_END;
241 end; 251 end;
242 EndCriterium := GetEndCriteria(s1); 252 EndCriterium := GetEndCriteria(s1);
  253 + ConditionName := ReadString(LS,KEY_COND_NAME,LS);
243 Points.Count := GetPoints(ReadString(LS, KEY_POINTS_COUNT,DEF_POINTS)); 254 Points.Count := GetPoints(ReadString(LS, KEY_POINTS_COUNT,DEF_POINTS));
244 Points.OnStart := GetPoints(ReadString(LS, KEY_POINTS_ONSTART,DEF_POINTS)); 255 Points.OnStart := GetPoints(ReadString(LS, KEY_POINTS_ONSTART,DEF_POINTS));
245 Turn.Count:= ReadInteger(LS, KEY_TURN_COUNT,1); 256 Turn.Count:= ReadInteger(LS, KEY_TURN_COUNT,1);
units/game_resources.pas
  Diff comments   View file @0dc8891
@@ -20,6 +20,7 @@ resourcestring @@ -20,6 +20,7 @@ resourcestring
20 KEY_RESEARCHER = 'Pesquisador.Responsável'; 20 KEY_RESEARCHER = 'Pesquisador.Responsável';
21 KEY_GEN_PLAYER_AS_NEEDED = 'GerarJogadoresAutomaticamente'; 21 KEY_GEN_PLAYER_AS_NEEDED = 'GerarJogadoresAutomaticamente';
22 KEY_CURRENT_CONDITION = 'ComeçarNaCondição'; 22 KEY_CURRENT_CONDITION = 'ComeçarNaCondição';
  23 + KEY_MATRIX_TYPE= 'TipoDaMatrix';
23 24
24 SEC_PLAYER = 'Jogador.'; 25 SEC_PLAYER = 'Jogador.';
25 KEY_PLAYER_TEMP = 'Data.X'; 26 KEY_PLAYER_TEMP = 'Data.X';
@@ -34,12 +35,7 @@ resourcestring @@ -34,12 +35,7 @@ resourcestring
34 KEY_PLAYER_STATUS = 'Status'; 35 KEY_PLAYER_STATUS = 'Status';
35 36
36 SEC_CONDITION = 'Condição.'; 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 KEY_TURN_VALUE = 'Rodada.NúmeroDeJogadores'; // 3 40 KEY_TURN_VALUE = 'Rodada.NúmeroDeJogadores'; // 3
45 KEY_TURN_COUNT = 'Rodada.IniciarNaJogada'; // 1 41 KEY_TURN_COUNT = 'Rodada.IniciarNaJogada'; // 1
@@ -56,7 +52,14 @@ resourcestring @@ -56,7 +52,14 @@ resourcestring
56 KEY_PROMPT_STYLE = 'Questão.Estilo'; // string 52 KEY_PROMPT_STYLE = 'Questão.Estilo'; // string
57 KEY_PROMPT_MESSAGE = 'Questão.Mensagem'; // string 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 VAL_RESEARCHER = 'Pesquisador'; 64 VAL_RESEARCHER = 'Pesquisador';
62 65
@@ -93,6 +96,21 @@ const @@ -93,6 +96,21 @@ const
93 'Nicole','Luísa','Daniela','Núria','Bruna', 96 'Nicole','Luísa','Daniela','Núria','Bruna',
94 'Victória','Alícia','Rafaela','Helena','Miriam'); 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 //C_OPERANT_1 : TContingency = 114 //C_OPERANT_1 : TContingency =
97 // ( 115 // (
98 // Consequence : ( 116 // Consequence : (
@@ -238,6 +256,7 @@ const @@ -238,6 +256,7 @@ const
238 256
239 C_CONDITION_TEMPLATE : TCondition = 257 C_CONDITION_TEMPLATE : TCondition =
240 ( 258 (
  259 + ConditionName : '';
241 Contingencies : nil; 260 Contingencies : nil;
242 261
243 Points : ( 262 Points : (
units/game_zmq_actors.pas
  Diff comments   View file @0dc8891
@@ -12,21 +12,24 @@ uses @@ -12,21 +12,24 @@ uses
12 12
13 type 13 type
14 14
  15 + // Everything sent is received by everybody connected.
  16 +
15 { TZMQActor } 17 { TZMQActor }
16 18
17 TZMQActor = class(TComponent) 19 TZMQActor = class(TComponent)
18 private 20 private
  21 + FID: UTF8string;
19 FSubscriber: TZMQPollThread; 22 FSubscriber: TZMQPollThread;
20 FOnMessageReceived : TMessRecvProc; 23 FOnMessageReceived : TMessRecvProc;
21 - function GetActorID: UTF8string; virtual;  
22 protected 24 protected
23 procedure MessageReceived(AMultipartMessage : TStringList); 25 procedure MessageReceived(AMultipartMessage : TStringList);
24 public 26 public
25 constructor Create(AOwner : TComponent); override; 27 constructor Create(AOwner : TComponent); override;
26 destructor Destroy; override; 28 destructor Destroy; override;
27 procedure Start; virtual; 29 procedure Start; virtual;
  30 + procedure SetID(S:string);
28 property OnMessageReceived : TMessRecvProc read FOnMessageReceived write FOnMessageReceived; 31 property OnMessageReceived : TMessRecvProc read FOnMessageReceived write FOnMessageReceived;
29 - property ID : UTF8string read GetActorID; 32 + property ID : UTF8string read FID;
30 end; 33 end;
31 34
32 { TZMQPlayer } 35 { TZMQPlayer }
@@ -34,13 +37,11 @@ type @@ -34,13 +37,11 @@ type
34 TZMQPlayer = class(TZMQActor) 37 TZMQPlayer = class(TZMQActor)
35 private 38 private
36 FPusher : TZMQPusher; 39 FPusher : TZMQPusher;
37 - function GetActorID: UTF8string; override;  
38 public 40 public
39 constructor Create(AOwner : TComponent); override; 41 constructor Create(AOwner : TComponent); override;
40 destructor Destroy; override; 42 destructor Destroy; override;
41 procedure Start; override; 43 procedure Start; override;
42 procedure SendMessage(AMessage : array of UTF8string); 44 procedure SendMessage(AMessage : array of UTF8string);
43 - property ID : UTF8string read GetActorID;  
44 end; 45 end;
45 46
46 { TZMQAdmin } 47 { TZMQAdmin }
@@ -100,11 +101,6 @@ begin @@ -100,11 +101,6 @@ begin
100 FPusher.SendMessage(AMessage); 101 FPusher.SendMessage(AMessage);
101 end; 102 end;
102 103
103 -function TZMQPlayer.GetActorID: UTF8string;  
104 -begin  
105 - Result := FPusher.ID;  
106 -end;  
107 -  
108 constructor TZMQPlayer.Create(AOwner: TComponent); 104 constructor TZMQPlayer.Create(AOwner: TComponent);
109 begin 105 begin
110 inherited Create(AOwner); 106 inherited Create(AOwner);
@@ -125,10 +121,9 @@ end; @@ -125,10 +121,9 @@ end;
125 121
126 { TZMQActor } 122 { TZMQActor }
127 123
128 -function TZMQActor.GetActorID: UTF8string; 124 +procedure TZMQActor.SetID(S: string);
129 begin 125 begin
130 - AbstractError;  
131 - Result := ''; 126 + FID := S;
132 end; 127 end;
133 128
134 procedure TZMQActor.MessageReceived(AMultipartMessage: TStringList); 129 procedure TZMQActor.MessageReceived(AMultipartMessage: TStringList);
units/string_methods.pas
  Diff comments   View file @0dc8891
@@ -5,7 +5,7 @@ unit string_methods; @@ -5,7 +5,7 @@ unit string_methods;
5 interface 5 interface
6 6
7 uses 7 uses
8 - Classes, SysUtils, LazFileUtils 8 + Classes, SysUtils, Graphics, LazFileUtils
9 , game_actors 9 , game_actors
10 , game_resources 10 , game_resources
11 ; 11 ;
@@ -21,6 +21,7 @@ function GetConsequenceStyleFromString(s:string):TGameConsequenceStyle; @@ -21,6 +21,7 @@ function GetConsequenceStyleFromString(s:string):TGameConsequenceStyle;
21 function GetConsequenceStyleString(AStyle: TGameConsequenceStyle): string; 21 function GetConsequenceStyleString(AStyle: TGameConsequenceStyle): string;
22 function GetResponseString(ACriteria : TCriteria) : string; 22 function GetResponseString(ACriteria : TCriteria) : string;
23 function GetResponseFromString(S: string) : TCriteria; 23 function GetResponseFromString(S: string) : TCriteria;
  24 +function GetRowColorString(C: TColor):string;
24 25
25 implementation 26 implementation
26 27
@@ -207,6 +208,17 @@ begin @@ -207,6 +208,17 @@ begin
207 else Break; 208 else Break;
208 end; 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 //function ValidateString(S: String): string; 222 //function ValidateString(S: String): string;
211 ////var 223 ////var
212 //// i:integer; 224 //// i:integer;
units/zmq_network.pas
  Diff comments   View file @0dc8891
@@ -14,7 +14,6 @@ unit zmq_network; @@ -14,7 +14,6 @@ unit zmq_network;
14 interface 14 interface
15 15
16 uses Classes, SysUtils, Process 16 uses Classes, SysUtils, Process
17 -  
18 , zmqapi 17 , zmqapi
19 //, zmq_client 18 //, zmq_client
20 ; 19 ;
@@ -32,7 +31,6 @@ type @@ -32,7 +31,6 @@ type
32 constructor Create; 31 constructor Create;
33 destructor Destroy; override; 32 destructor Destroy; override;
34 procedure SendMessage(AMultipartMessage : array of UTF8string); 33 procedure SendMessage(AMultipartMessage : array of UTF8string);
35 - property ID : UTF8string read FID;  
36 end; 34 end;
37 35
38 { TZMQPubThread } 36 { TZMQPubThread }
@@ -74,8 +72,6 @@ type @@ -74,8 +72,6 @@ type
74 72
75 implementation 73 implementation
76 74
77 -uses zhelpers;  
78 -  
79 { TZMQSubscriber } 75 { TZMQSubscriber }
80 76
81 procedure TZMQPollThread.MessageReceived; 77 procedure TZMQPollThread.MessageReceived;
@@ -140,7 +136,6 @@ end; @@ -140,7 +136,6 @@ end;
140 136
141 constructor TZMQPusher.Create; 137 constructor TZMQPusher.Create;
142 begin 138 begin
143 - FID := s_random(20);  
144 FContext := TZMQContext.create; 139 FContext := TZMQContext.create;
145 FPusher := FContext.Socket( stPush ); 140 FPusher := FContext.Socket( stPush );
146 FPusher.connect('tcp://localhost:5057'); 141 FPusher.connect('tcp://localhost:5057');