Download as
Browse Code »

Commit 81caf87805425d65a2dbef91380432961597df22

Authored by Carlos Picanco
1 parent 21d23065
Exists in master

cleaning, admin feedback and dumps

Showing 10 changed files with 294 additions and 94 deletions   Show diff stats
cultural_matrix.lpi
  Diff comments   View file @81caf87
... ... @@ -25,7 +25,7 @@
25 25 </Target>
26 26 <SearchPaths>
27 27 <IncludeFiles Value="$(ProjOutDir)"/>
28   - <Libraries Value="/usr/lib/gcc/x86_64-linux-gnu/4.9"/>
  28 + <Libraries Value="/usr/lib/gcc/x86_64-linux-gnu/4.9/"/>
29 29 <OtherUnitFiles Value="units;../../dependency/delphizmq;../../units"/>
30 30 <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
31 31 </SearchPaths>
... ... @@ -46,7 +46,7 @@
46 46 </Target>
47 47 <SearchPaths>
48 48 <IncludeFiles Value="$(ProjOutDir)"/>
49   - <Libraries Value="/usr/lib/gcc/x86_64-linux-gnu/4.9"/>
  49 + <Libraries Value="/usr/lib/gcc/x86_64-linux-gnu/4.9/"/>
50 50 <OtherUnitFiles Value="units;../../dependency/delphizmq;../../units"/>
51 51 <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
52 52 </SearchPaths>
... ... @@ -147,6 +147,7 @@
147 147 <Filename Value="form_chooseactor.pas"/>
148 148 <IsPartOfProject Value="True"/>
149 149 <ComponentName Value="FormChooseActor"/>
  150 + <HasResources Value="True"/>
150 151 <ResourceBaseClass Value="Form"/>
151 152 </Unit13>
152 153 <Unit14>
... ... @@ -162,7 +163,7 @@
162 163 </Target>
163 164 <SearchPaths>
164 165 <IncludeFiles Value="$(ProjOutDir)"/>
165   - <Libraries Value="/usr/lib/gcc/x86_64-linux-gnu/4.9"/>
  166 + <Libraries Value="/usr/lib/gcc/x86_64-linux-gnu/4.9/"/>
166 167 <OtherUnitFiles Value="units;../../dependency/delphizmq;../../units"/>
167 168 <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
168 169 </SearchPaths>
... ...
form_matrixgame.lfm
  Diff comments   View file @81caf87
1 1 object FormMatrixGame: TFormMatrixGame
2   - Left = 0
3   - Height = 565
4   - Top = 124
5   - Width = 1278
6   - HorzScrollBar.Page = 1278
  2 + Left = 54
  3 + Height = 612
  4 + Top = 80
  5 + Width = 1164
  6 + HorzScrollBar.Page = 1164
7 7 VertScrollBar.Page = 542
8 8 AutoScroll = True
9 9 Caption = 'FormMatrixGame'
10   - ClientHeight = 555
11   - ClientWidth = 1278
  10 + ClientHeight = 602
  11 + ClientWidth = 1164
12 12 Font.Name = 'Monospace'
13 13 OnActivate = FormActivate
14 14 LCLVersion = '1.6.2.0'
... ... @@ -184,7 +184,7 @@ object FormMatrixGame: TFormMatrixGame
184 184 AnchorSideBottom.Side = asrBottom
185 185 Left = 0
186 186 Height = 17
187   - Top = 538
  187 + Top = 585
188 188 Width = 1632
189 189 Anchors = [akLeft, akRight, akBottom]
190 190 AutoSize = True
... ... @@ -211,10 +211,10 @@ object FormMatrixGame: TFormMatrixGame
211 211 TabOrder = 4
212 212 Visible = False
213 213 object GBExperiment: TGroupBox
214   - Left = 8
215   - Height = 277
  214 + Left = 16
  215 + Height = 197
216 216 Top = 60
217   - Width = 188
  217 + Width = 228
218 218 AutoSize = True
219 219 Caption = 'Experimento'
220 220 ChildSizing.LeftRightSpacing = 10
... ... @@ -224,19 +224,19 @@ object FormMatrixGame: TFormMatrixGame
224 224 ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
225 225 ChildSizing.Layout = cclLeftToRightThenTopToBottom
226 226 ChildSizing.ControlsPerLine = 2
227   - ClientHeight = 260
228   - ClientWidth = 184
  227 + ClientHeight = 180
  228 + ClientWidth = 224
229 229 TabOrder = 0
230 230 object LabelExpCond: TLabel
231 231 Left = 10
232 232 Height = 15
233 233 Top = 20
234   - Width = 128
  234 + Width = 168
235 235 Caption = 'Condição:'
236 236 ParentColor = False
237 237 end
238 238 object LabelExpCountCondition: TLabel
239   - Left = 158
  239 + Left = 198
240 240 Height = 15
241 241 Top = 20
242 242 Width = 16
... ... @@ -247,12 +247,12 @@ object FormMatrixGame: TFormMatrixGame
247 247 Left = 10
248 248 Height = 15
249 249 Top = 45
250   - Width = 128
  250 + Width = 168
251 251 Caption = 'Geração:'
252 252 ParentColor = False
253 253 end
254 254 object LabelExpCountGeneration: TLabel
255   - Left = 158
  255 + Left = 198
256 256 Height = 15
257 257 Top = 45
258 258 Width = 16
... ... @@ -263,12 +263,12 @@ object FormMatrixGame: TFormMatrixGame
263 263 Left = 10
264 264 Height = 15
265 265 Top = 70
266   - Width = 128
  266 + Width = 168
267 267 Caption = 'Ciclo:'
268 268 ParentColor = False
269 269 end
270 270 object LabelExpCountCycle: TLabel
271   - Left = 158
  271 + Left = 198
272 272 Height = 15
273 273 Top = 70
274 274 Width = 16
... ... @@ -279,12 +279,12 @@ object FormMatrixGame: TFormMatrixGame
279 279 Left = 10
280 280 Height = 15
281 281 Top = 95
282   - Width = 128
  282 + Width = 168
283 283 Caption = 'Turno:'
284 284 ParentColor = False
285 285 end
286 286 object LabelExpCountTurn: TLabel
287   - Left = 158
  287 + Left = 198
288 288 Height = 15
289 289 Top = 95
290 290 Width = 16
... ... @@ -295,74 +295,69 @@ object FormMatrixGame: TFormMatrixGame
295 295 Left = 10
296 296 Height = 15
297 297 Top = 120
298   - Width = 128
  298 + Width = 168
299 299 Caption = 'Entrelaçamentos:'
300 300 ParentColor = False
301 301 end
302 302 object LabelExpCountInterlocks: TLabel
303   - Left = 158
  303 + Left = 198
304 304 Height = 15
305 305 Top = 120
306 306 Width = 16
307 307 Caption = 'NA'
308 308 ParentColor = False
309 309 end
310   - object ButtonExpStart: TButton
  310 + object LabelExpTInterlocks: TLabel
311 311 Left = 10
312   - Height = 25
313   - Top = 145
314   - Width = 128
315   - Caption = 'Começar'
316   - OnClick = ButtonExpStartClick
317   - TabOrder = 0
318   - end
319   - object LabelUnseen1: TLabel
320   - Left = 158
321   - Height = 25
  312 + Height = 15
322 313 Top = 145
323   - Width = 16
324   - ParentColor = False
325   - end
326   - object ButtonExpPause: TButton
327   - Left = 10
328   - Height = 25
329   - Top = 180
330   - Width = 128
331   - Caption = 'Pausar'
332   - Enabled = False
333   - OnClick = ButtonExpPauseClick
334   - TabOrder = 1
335   - end
336   - object LabelUnseen2: TLabel
337   - Left = 158
338   - Height = 25
339   - Top = 180
340   - Width = 16
  314 + Width = 168
  315 + Caption = 'Entrelaçamentos Alvo:'
341 316 ParentColor = False
342 317 end
343   - object ButtonExpCancel: TButton
344   - Left = 10
345   - Height = 25
346   - Top = 215
347   - Width = 128
348   - Caption = 'Cancelar'
349   - Enabled = False
350   - OnClick = ButtonExpCancelClick
351   - TabOrder = 2
352   - end
353   - object LabelUnseen3: TLabel
354   - Left = 158
355   - Height = 25
356   - Top = 215
  318 + object LabelExpCountTInterlocks: TLabel
  319 + Left = 198
  320 + Height = 15
  321 + Top = 145
357 322 Width = 16
  323 + Caption = 'NA'
358 324 ParentColor = False
359 325 end
360 326 end
  327 + object ButtonExpStart: TButton
  328 + Left = 16
  329 + Height = 25
  330 + Top = 16
  331 + Width = 128
  332 + Caption = 'Começar'
  333 + OnClick = ButtonExpStartClick
  334 + TabOrder = 1
  335 + end
  336 + object ButtonExpPause: TButton
  337 + Left = 168
  338 + Height = 25
  339 + Top = 16
  340 + Width = 128
  341 + Caption = 'Pausar'
  342 + Enabled = False
  343 + OnClick = ButtonExpPauseClick
  344 + TabOrder = 2
  345 + end
  346 + object ButtonExpCancel: TButton
  347 + Left = 320
  348 + Height = 25
  349 + Top = 16
  350 + Width = 128
  351 + Caption = 'Cancelar'
  352 + Enabled = False
  353 + OnClick = ButtonExpCancelClick
  354 + TabOrder = 3
  355 + end
361 356 end
362 357 object btnConfirmRow: TButton
363 358 Left = 712
364 359 Height = 26
365   - Top = 319
  360 + Top = 152
366 361 Width = 86
367 362 Caption = 'Confirmar'
368 363 OnClick = btnConfirmRowClick
... ...
form_matrixgame.pas
  Diff comments   View file @81caf87
... ... @@ -28,23 +28,22 @@ type
28 28  
29 29 TFormMatrixGame = class(TForm)
30 30 btnConfirmRow: TButton;
31   - ButtonExpStart: TButton;
32   - ButtonExpPause: TButton;
33 31 ButtonExpCancel: TButton;
  32 + ButtonExpPause: TButton;
  33 + ButtonExpStart: TButton;
34 34 GBIndividual: TGroupBox;
35 35 GBLastChoice: TGroupBox;
36 36 GBIndividualAB: TGroupBox;
37 37 GBGrupo: TGroupBox;
38 38 GBAdmin: TGroupBox;
39 39 GBExperiment: TGroupBox;
40   - LabelUnseen1: TLabel;
41   - LabelUnseen2: TLabel;
42   - LabelUnseen3: TLabel;
43 40 LabelExpCountCondition: TLabel;
  41 + LabelExpCountTInterlocks: TLabel;
44 42 LabelExpGen: TLabel;
45 43 LabelExpCountGeneration: TLabel;
46 44 LabelExpCycle: TLabel;
47 45 LabelExpCountCycle: TLabel;
  46 + LabelExpTInterlocks: TLabel;
48 47 LabelExpTurn: TLabel;
49 48 LabelExpCountTurn: TLabel;
50 49 LabelExpInterlocks: TLabel;
... ... @@ -222,6 +221,8 @@ procedure TFormMatrixGame.SetGameActor(AValue: TGameActor);
222 221 procedure SetZMQAdmin;
223 222 begin
224 223 FGameControl := TGameControl.Create(TZMQAdmin.Create(Self,FID),ExtractFilePath(Application.ExeName));
  224 + GBIndividual.Visible:=False;
  225 + GBIndividualAB.Visible:=False;
225 226 GBAdmin.Visible:= True;
226 227 end;
227 228  
... ...
units/backup/presentation_classes.pas 0 → 100644
  Diff comments   View file @81caf87
... ... @@ -0,0 +1,135 @@
  1 +unit presentation_classes;
  2 +
  3 +{$mode objfpc}{$H+}
  4 +
  5 +interface
  6 +
  7 +uses
  8 + Classes, SysUtils, ExtCtrls;
  9 +
  10 +type
  11 +
  12 + { TAnnouncerStartEvent }
  13 +
  14 + TAnnouncerStartEvent = procedure (AMessage : array of UTF8String) of object;
  15 +
  16 + { TAnnoucerMessages }
  17 +
  18 + TAnnoucerMessages = array of array of UTF8String;
  19 +
  20 + { TIntervalarAnnouncer }
  21 +
  22 + TIntervalarAnnouncer = class(TComponent)
  23 + private
  24 + FMessages: TAnnoucerMessages;
  25 + FTimer : TTimer;
  26 + FOnStart: TAnnouncerStartEvent;
  27 + function GetEnabled: Boolean;
  28 + function GetInterval: integer;
  29 + procedure NextMessage;
  30 + procedure SetEnabled(AValue: Boolean);
  31 + procedure SelfDestroy(Sender: TObject);
  32 + procedure SetInterval(AValue: integer);
  33 + procedure StartTimer(Sender:TObject);
  34 + public
  35 + constructor Create(AOwner : TComponent); override;
  36 + procedure Append(M : array of UTF8String);
  37 + procedure Reversed;
  38 + property Messages : TAnnoucerMessages read FMessages write FMessages;
  39 + property OnStart : TAnnouncerStartEvent read FOnStart write FOnStart;
  40 + property Interval : integer read GetInterval write SetInterval;
  41 + property Enabled : Boolean read GetEnabled write SetEnabled;
  42 + end;
  43 +
  44 +implementation
  45 +
  46 +{ TIntervalarAnnouncer }
  47 +
  48 +procedure TIntervalarAnnouncer.SetEnabled(AValue: Boolean);
  49 +begin
  50 + if FTimer.Enabled=AValue then Exit;
  51 + FTimer.Enabled:= AValue;
  52 +end;
  53 +
  54 +function TIntervalarAnnouncer.GetEnabled: Boolean;
  55 +begin
  56 + Result := FTimer.Enabled;
  57 +end;
  58 +
  59 +function TIntervalarAnnouncer.GetInterval: integer;
  60 +begin
  61 + Result := FTimer.Interval;
  62 +end;
  63 +
  64 +procedure TIntervalarAnnouncer.NextMessage;
  65 +begin
  66 + SetLength(FMessages,Length(FMessages)-1);
  67 +end;
  68 +
  69 +procedure TIntervalarAnnouncer.SelfDestroy(Sender : TObject);
  70 +var LAnnouncer : TIntervalarAnnouncer;
  71 +begin
  72 + if Length(FMessages) > 0 then
  73 + begin
  74 + LAnnouncer := TIntervalarAnnouncer.Create(nil);
  75 + LAnnouncer.Messages := FMessages;
  76 + LAnnouncer.OnStart:= FOnStart;
  77 + LAnnouncer.Enabled:=True;
  78 + end;
  79 + Free;
  80 +end;
  81 +
  82 +procedure TIntervalarAnnouncer.SetInterval(AValue: integer);
  83 +begin
  84 + if FTimer.Interval=AValue then Exit;
  85 + FTimer.Interval:= AValue;
  86 +end;
  87 +
  88 +procedure TIntervalarAnnouncer.StartTimer(Sender: TObject);
  89 +var M : array of UTF8String;
  90 +begin
  91 + M := FMessages[High(FMessages)];
  92 + NextMessage;
  93 + if Assigned(FOnStart) then FOnStart(M);
  94 +end;
  95 +
  96 +constructor TIntervalarAnnouncer.Create(AOwner: TComponent);
  97 +begin
  98 + inherited Create(AOwner);
  99 + FTimer := TTimer.Create(Self);
  100 + FTimer.Enabled := False;
  101 + FTimer.Interval := 5000;
  102 + FTimer.OnTimer:=@SelfDestroy;
  103 + //FTimer.OnStopTimer:=@SelfDestroy;
  104 + FTimer.OnStartTimer:=@StartTimer;
  105 +end;
  106 +
  107 +procedure TIntervalarAnnouncer.Append(M: array of UTF8String);
  108 +var
  109 + H : TAnnoucerMessages;
  110 + i: Integer;
  111 +begin
  112 + SetLength(H,1,Length(M));
  113 +
  114 + for i := Low(M) to High(M) do
  115 + H[0,i] := M[i];
  116 +
  117 + SetLength(FMessages,Length(FMessages)+1);
  118 + FMessages[High(FMessages)] := H[0];
  119 +end;
  120 +
  121 +procedure TIntervalarAnnouncer.Reversed;
  122 +var
  123 + i : integer;
  124 + M : TAnnoucerMessages;
  125 +begin
  126 + for i := High(FMessages) downto Low(FMessages) do
  127 + begin
  128 + SetLength(M,Length(M)+1);
  129 + M[High(M)] := FMessages[i]
  130 + end;
  131 + FMessages := M;
  132 +end;
  133 +
  134 +end.
  135 +
... ...
units/game_actors.pas
  Diff comments   View file @81caf87
... ... @@ -15,7 +15,7 @@ interface
15 15  
16 16 uses
17 17 Classes, SysUtils, Forms,PopupNotifier, ExtCtrls
18   - , game_actors_point
  18 + , game_actors_point, game_visual_elements
19 19 ;
20 20 type
21 21  
... ... @@ -42,7 +42,7 @@ type
42 42 //TGameOperator = (goNONE, goAND, goOR);
43 43 TGameStyle = (gtNone, gtRowsOnly, gtColorsOnly, gtRowsAndColors, gtRowsOrColors);
44 44  
45   - TGameConsequenceStyle = (gscNone, gscMessage, gscBroadcastMessage, gscPoints, gscVariablePoints, gscA, gscB,gscG);
  45 + TGameConsequenceStyle = (gscNone, gscMessage, gscBroadcastMessage, gscPoints, gscVariablePoints, gscA, gscB,gscG,gscI);
46 46 TConsequenceStyle = set of TGameConsequenceStyle;
47 47  
48 48 TGamePromptStyle = (gsYes, gsNo, gsAll, gsMetacontingency, gsContingency, gsBasA, gsRevertPoints);
... ... @@ -109,6 +109,7 @@ type
109 109 procedure Clean; virtual;
110 110 procedure PresentMessage;
111 111 procedure PresentPoints;
  112 + procedure PresentPoints(APlayerBox : TPlayerBox); overload;
112 113 property ShouldPublishMessage : Boolean read GetShouldPublishMessage;
113 114 property PlayerNicname : string read FNicname write FNicname;
114 115 property AppendiceSingular : string read FAppendiceSingular;
... ... @@ -127,6 +128,7 @@ type
127 128 FCriteria : TCriteria;
128 129 FName: string;
129 130 FOnCriteria: TNotifyEvent;
  131 + FOnTargetCriteria : TNotifyEvent;
130 132 function RowMod(R:TGameRow):TGameRow;
131 133 procedure CriteriaEvent;
132 134 public
... ... @@ -137,6 +139,7 @@ type
137 139 function ConsequenceFromPlayerID(AID:string):string;
138 140 procedure Clean;
139 141 property OnCriteria : TNotifyEvent read FOnCriteria write FOncriteria;
  142 + property OnTargetCriteria : TNotifyEvent read FOnTargetCriteria write FOnTargetCriteria;
140 143 property Fired : Boolean read FFired;
141 144 property Consequence : TConsequence read FConsequence;
142 145 property Criteria : TCriteria read FCriteria;
... ... @@ -184,10 +187,10 @@ type
184 187 TCondition = record
185 188 ConditionName : string;
186 189 Contingencies : TContingencies; // for producing points during the condition
187   - Interlocks : record
188   - Count : integer; // culturant,
189   - History: array of Boolean; // to calculate interlock porcentage in the last cycles. sync with OnCycles
190   - end;
  190 + //Interlocks : record
  191 + // Count : integer; // culturant,
  192 + // History: array of Boolean; // to calculate interlock porcentage in the last cycles. sync with OnCycles
  193 + //end;
191 194  
192 195 Points : record
193 196 Count : TPoints; // sum of points produced during the condition
... ... @@ -235,6 +238,7 @@ procedure TContingency.CriteriaEvent;
235 238 begin
236 239 FFired:=True;
237 240 if Assigned(FOnCriteria) then FOnCriteria(Self);
  241 + if Assigned(FOnTargetCriteria) then FOnTargetCriteria(Self);
238 242 end;
239 243  
240 244 constructor TContingency.Create(AOwner:TComponent;AConsequence:TConsequence;ACriteria:TCriteria;IsMeta:Boolean);
... ... @@ -646,6 +650,9 @@ end;
646 650 procedure TConsequence.PresentPoints;
647 651 begin
648 652 //is gscPoints in FStyle then just in case...
  653 + if gscI in FStyle then
  654 + FormMatrixGame.LabelIndACount.Caption := IntToStr(StrToInt(FormMatrixGame.LabelIndACount.Caption) + FP.ResultAsInteger);
  655 +
649 656 if gscA in FStyle then
650 657 FormMatrixGame.LabelIndACount.Caption := IntToStr(StrToInt(FormMatrixGame.LabelIndACount.Caption) + FP.ResultAsInteger);
651 658  
... ... @@ -656,6 +663,14 @@ begin
656 663 FormMatrixGame.LabelGroupCount.Caption:= IntToStr(StrToInt(FormMatrixGame.LabelGroupCount.Caption) + FP.ResultAsInteger);
657 664 end;
658 665  
  666 +procedure TConsequence.PresentPoints(APlayerBox: TPlayerBox);
  667 +begin
  668 + if gscG in FStyle then
  669 + FormMatrixGame.LabelGroupCount.Caption:= IntToStr(StrToInt(FormMatrixGame.LabelGroupCount.Caption) + FP.ResultAsInteger)
  670 + else
  671 + APlayerBox.LabelPointsCount.Caption := IntToStr(StrToInt(APlayerBox.LabelPointsCount.Caption) + FP.ResultAsInteger);
  672 +end;
  673 +
659 674 function TConsequence.GetShouldPublishMessage: Boolean; // for players only
660 675 begin
661 676 Result := gscBroadcastMessage in FStyle;
... ...
units/game_experiment.pas
  Diff comments   View file @81caf87
... ... @@ -85,6 +85,7 @@ type
85 85 procedure SetResearcherCanPlay(AValue: Boolean);
86 86 procedure SetSendChatHistoryForNewPlayers(AValue: Boolean);
87 87 procedure SetState(AValue: TExperimentState);
  88 + procedure SetTargetInterlocking;
88 89 private
89 90 FABPoints: Boolean;
90 91 FChangeGeneration: string;
... ... @@ -95,9 +96,11 @@ type
95 96 FOnEndCycle: TNotifyEvent;
96 97 FOnEndExperiment: TNotifyEvent;
97 98 FOnEndGeneration: TNotifyEvent;
  99 + FOnTargetInterlocking: TNotifyEvent;
98 100 procedure Consequence(Sender : TObject);
99 101 function GetPlayerToKick: string;
100 102 procedure Interlocking(Sender : TObject);
  103 + procedure TargetInterlocking(Sender : TObject);
101 104 procedure SetPlayersQueue(AValue: string);
102 105 procedure WriteReportHeader;
103 106 procedure WriteReportRowNames;
... ... @@ -136,6 +139,7 @@ type
136 139 property CurrentCondition : integer read FCurrentCondition write FCurrentCondition;
137 140 property Contingency[C, I : integer] : TContingency read GetContingency write SetContingency;
138 141 property ContingenciesCount[C:integer]:integer read GetContingenciesCount;
  142 + property Cycles : integer read GetCurrentAbsoluteCycle;
139 143 property Player[I : integer] : TPlayer read GetPlayer write SetPlayer;
140 144 property PlayerFromID[S : UTF8string ] : TPlayer read GetPlayer write SetPlayer;
141 145 property PlayersCount : integer read GetPlayersCount;
... ... @@ -161,6 +165,7 @@ type
161 165 property OnEndExperiment : TNotifyEvent read FOnEndExperiment write SetOnEndExperiment;
162 166 property OnConsequence : TNotifyEvent read FOnConsequence write SetOnConsequence;
163 167 property OnInterlocking : TNotifyEvent read FOnInterlocking write SetOnInterlocking;
  168 + property OnTargetInterlocking : TNotifyEvent read FOnTargetInterlocking write FOnTargetInterlocking;
164 169 end;
165 170  
166 171 resourcestring
... ... @@ -246,7 +251,7 @@ var
246 251 begin
247 252 if Assigned(FOnEndCondition) then FOnEndCondition(Self);
248 253 Inc(FCurrentCondition);
249   - if FCurrentCondition = ConditionsCount-1 then
  254 + if FCurrentCondition = ConditionsCount then
250 255 begin
251 256 EndExperiment;
252 257 Exit;
... ... @@ -264,13 +269,13 @@ begin
264 269 case FConditions[CurrentCondition].EndCriterium.Style of
265 270 gecWhichComeFirst:
266 271 begin
267   - if (GetCurrentAbsoluteCycle = FConditions[CurrentCondition].EndCriterium.AbsoluteCycles) or
  272 + if (GetCurrentAbsoluteCycle = FConditions[CurrentCondition].EndCriterium.AbsoluteCycles-1) or
268 273 (LInterlocks >= FConditions[CurrentCondition].EndCriterium.InterlockingPorcentage) then
269 274 EndCondition;
270 275  
271 276 end;
272 277 gecAbsoluteCycles:
273   - if GetCurrentAbsoluteCycle = FConditions[CurrentCondition].EndCriterium.AbsoluteCycles then
  278 + if GetCurrentAbsoluteCycle = FConditions[CurrentCondition].EndCriterium.AbsoluteCycles-1 then
274 279 EndCondition;
275 280  
276 281 gecInterlockingPorcentage:
... ... @@ -288,6 +293,9 @@ var c:integer;
288 293 begin
289 294 c := CurrentCondition;
290 295 Result := (Condition[c].Cycles.Value*Condition[c].Cycles.Generation)+Condition[c].Cycles.Count;
  296 + {$IFDEF DEBUG}
  297 + WriteLn('TExperiment.GetCurrentAbsoluteCycle:',Result);
  298 + {$ENDIF}
291 299 end;
292 300  
293 301 function TExperiment.GetPlayer(I : integer): TPlayer;
... ... @@ -382,6 +390,9 @@ begin
382 390 // return result in porcentage
383 391 Result := (i*100)/LContingencyResults.Count;
384 392 end;
  393 + {$IFDEF DEBUG}
  394 + WriteLn('TExperiment.GetInterlockingPorcentageInLastCycles:',Result);
  395 + {$ENDIF}
385 396 end;
386 397  
387 398 function TExperiment.GetConsequenceStringFromChoice(P: TPlayer): Utf8string;
... ... @@ -542,14 +553,25 @@ begin
542 553 FState:=AValue;
543 554 end;
544 555  
  556 +procedure TExperiment.SetTargetInterlocking;
  557 +var i : integer;
  558 +begin
  559 + for i:= 0 to ContingenciesCount[CurrentCondition] do
  560 + if Condition[CurrentCondition].Contingencies[i].Meta then
  561 + begin
  562 + Condition[CurrentCondition].Contingencies[i].OnTargetCriteria:=@TargetInterlocking;
  563 + Break;
  564 + end;
  565 +end;
  566 +
545 567 procedure TExperiment.Consequence(Sender: TObject);
546 568 begin
547 569 if Assigned(FOnConsequence) then FOnConsequence(Sender);
548 570 end;
549 571  
550   -procedure TExperiment.Interlocking(Sender: TObject);
  572 +procedure TExperiment.TargetInterlocking(Sender: TObject);
551 573 begin
552   - if Assigned(FOnInterlocking) then FOnInterlocking(Sender);
  574 + if Assigned(FOnTargetInterlocking) then FOnTargetInterlocking(Sender);
553 575 end;
554 576  
555 577 procedure TExperiment.SetPlayersQueue(AValue: string);
... ... @@ -573,6 +595,11 @@ begin
573 595 Result := FPlayers[0].ID;
574 596 end;
575 597  
  598 +procedure TExperiment.Interlocking(Sender: TObject);
  599 +begin
  600 + if Assigned(FOnInterlocking) then FOnInterlocking(Sender);
  601 +end;
  602 +
576 603  
577 604 procedure TExperiment.WriteReportHeader;
578 605 var
... ... @@ -715,10 +742,15 @@ begin
715 742 end;
716 743  
717 744 constructor TExperiment.Create(AOwner: TComponent;AppPath:string);
  745 +var i : integer;
718 746 begin
719 747 inherited Create(AOwner);
720 748 FTurnsRandom := TStringList.Create;
721 749 LoadExperimentFromResource(Self);
  750 +
  751 + // TODO: Allow custom target interlocking. Now just taking the first meta, as usual in the lab.
  752 + SetTargetInterlocking;
  753 +
722 754 CheckNeedForRandomTurns;
723 755  
724 756 FReportReader := TReportReader.Create;
... ...
units/game_resources.pas
  Diff comments   View file @81caf87
... ... @@ -216,10 +216,10 @@ const
216 216 (
217 217 ConditionName : '';
218 218 Contingencies : nil;
219   - Interlocks : (
220   - Count : 0;
221   - History : nil;
222   - );
  219 + //Interlocks : (
  220 + // Count : 0;
  221 + // History : nil;
  222 + //);
223 223  
224 224 Points : (
225 225 Count : ( A:0; B:0; G:0; );
... ...
units/game_visual_elements.pas
  Diff comments   View file @81caf87
... ... @@ -25,16 +25,19 @@ type
25 25 PanelLastColor : TPanel;
26 26 LabelLastRow : TLabel;
27 27 LabelLastRowCount : TLabel;
  28 + LabelPoints : TLabel;
  29 + LabelPointsCount : TLabel;
28 30 private
29 31 FID: string;
30 32 public
31   - constructor Create(AOwner: TComponent;AID:string); reintroduce;
  33 + constructor Create(AOwner: TComponent;AID:string;Admin:Boolean=False); reintroduce;
32 34 property ID : string read FID write FID;
33 35 end;
34 36  
35 37 resourcestring
36 38 CAP_ROW = 'Linha:';
37 39 CAP_COLOR = 'Cor:';
  40 + CAP_POINTS = 'Pontos:';
38 41 CAP_NA = 'NA';
39 42 CAP_WAINTING_FOR_PLAYER = 'Esperando Jogador...';
40 43  
... ... @@ -42,7 +45,7 @@ implementation
42 45  
43 46 { TPlayerBox }
44 47  
45   -constructor TPlayerBox.Create(AOwner: TComponent; AID: string);
  48 +constructor TPlayerBox.Create(AOwner: TComponent; AID: string; Admin: Boolean);
46 49 begin
47 50 inherited Create(AOwner);
48 51 FID := AID;
... ... @@ -74,6 +77,17 @@ begin
74 77 LabelLastRowCount.Caption:=CAP_NA;
75 78 LabelLastRowCount.Parent := Self;
76 79 Enabled:= False;
  80 +
  81 + if Admin then
  82 + begin
  83 + LabelPoints:= TLabel.Create(Self);
  84 + LabelPoints.Caption:=CAP_POINTS;
  85 + LabelPoints.Parent := Self;
  86 +
  87 + LabelPointsCount:= TLabel.Create(Self);
  88 + LabelPointsCount.Caption:='0';
  89 + LabelPointsCount.Parent := Self;
  90 + end;
77 91 //LabelLastRow.AutoSize := False;
78 92 end;
79 93  
... ...
units/game_zmq_actors.pas
  Diff comments   View file @81caf87
... ... @@ -11,8 +11,6 @@ unit game_zmq_actors;
11 11  
12 12 {$mode objfpc}{$H+}
13 13  
14   -{$DEFINE DEBUG}
15   -
16 14 interface
17 15  
18 16 uses
... ...
units/string_methods.pas
  Diff comments   View file @81caf87
... ... @@ -234,6 +234,10 @@ begin
234 234 'MENSAGEM A TODOS' : Result:= gscBroadcastMessage;
235 235 'PONTOS' : Result:= gscPoints;
236 236 'PONTOS COM VARIAÇÃO' : Result:= gscVariablePoints;
  237 + 'PONTOS A' : Result:= gscA;
  238 + 'PONTOS B' : Result:= gscB;
  239 + 'PONTOS G' : Result:= gscG;
  240 + 'PONTOS I' : Result:= gscI;
237 241 end;
238 242 end;
239 243  
... ... @@ -245,6 +249,10 @@ begin
245 249 gscBroadcastMessage : Result:= 'MENSAGEM A TODOS';
246 250 gscPoints : Result:= 'PONTOS' ;
247 251 gscVariablePoints : Result:= 'PONTOS COM VARIAÇÃO';
  252 + gscA : Result:= 'PONTOS A';
  253 + gscB : Result:= 'PONTOS B';
  254 + gscG : Result:= 'PONTOS G';
  255 + gscI : Result:= 'PONTOS I';
248 256 end;
249 257 end;
250 258  
... ... @@ -358,6 +366,7 @@ begin
358 366 gscA:Result += 'A';
359 367 gscB:Result += 'B';
360 368 gscG:Result += 'G';
  369 + gscI:Result += 'I';
361 370 end;
362 371 Result += ',';
363 372 end;
... ...