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,7 +25,7 @@
25 </Target> 25 </Target>
26 <SearchPaths> 26 <SearchPaths>
27 <IncludeFiles Value="$(ProjOutDir)"/> 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 <OtherUnitFiles Value="units;../../dependency/delphizmq;../../units"/> 29 <OtherUnitFiles Value="units;../../dependency/delphizmq;../../units"/>
30 <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> 30 <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
31 </SearchPaths> 31 </SearchPaths>
@@ -46,7 +46,7 @@ @@ -46,7 +46,7 @@
46 </Target> 46 </Target>
47 <SearchPaths> 47 <SearchPaths>
48 <IncludeFiles Value="$(ProjOutDir)"/> 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 <OtherUnitFiles Value="units;../../dependency/delphizmq;../../units"/> 50 <OtherUnitFiles Value="units;../../dependency/delphizmq;../../units"/>
51 <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> 51 <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
52 </SearchPaths> 52 </SearchPaths>
@@ -147,6 +147,7 @@ @@ -147,6 +147,7 @@
147 <Filename Value="form_chooseactor.pas"/> 147 <Filename Value="form_chooseactor.pas"/>
148 <IsPartOfProject Value="True"/> 148 <IsPartOfProject Value="True"/>
149 <ComponentName Value="FormChooseActor"/> 149 <ComponentName Value="FormChooseActor"/>
  150 + <HasResources Value="True"/>
150 <ResourceBaseClass Value="Form"/> 151 <ResourceBaseClass Value="Form"/>
151 </Unit13> 152 </Unit13>
152 <Unit14> 153 <Unit14>
@@ -162,7 +163,7 @@ @@ -162,7 +163,7 @@
162 </Target> 163 </Target>
163 <SearchPaths> 164 <SearchPaths>
164 <IncludeFiles Value="$(ProjOutDir)"/> 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 <OtherUnitFiles Value="units;../../dependency/delphizmq;../../units"/> 167 <OtherUnitFiles Value="units;../../dependency/delphizmq;../../units"/>
167 <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> 168 <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
168 </SearchPaths> 169 </SearchPaths>
form_matrixgame.lfm
  Diff comments   View file @81caf87
1 object FormMatrixGame: TFormMatrixGame 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 VertScrollBar.Page = 542 7 VertScrollBar.Page = 542
8 AutoScroll = True 8 AutoScroll = True
9 Caption = 'FormMatrixGame' 9 Caption = 'FormMatrixGame'
10 - ClientHeight = 555  
11 - ClientWidth = 1278 10 + ClientHeight = 602
  11 + ClientWidth = 1164
12 Font.Name = 'Monospace' 12 Font.Name = 'Monospace'
13 OnActivate = FormActivate 13 OnActivate = FormActivate
14 LCLVersion = '1.6.2.0' 14 LCLVersion = '1.6.2.0'
@@ -184,7 +184,7 @@ object FormMatrixGame: TFormMatrixGame @@ -184,7 +184,7 @@ object FormMatrixGame: TFormMatrixGame
184 AnchorSideBottom.Side = asrBottom 184 AnchorSideBottom.Side = asrBottom
185 Left = 0 185 Left = 0
186 Height = 17 186 Height = 17
187 - Top = 538 187 + Top = 585
188 Width = 1632 188 Width = 1632
189 Anchors = [akLeft, akRight, akBottom] 189 Anchors = [akLeft, akRight, akBottom]
190 AutoSize = True 190 AutoSize = True
@@ -211,10 +211,10 @@ object FormMatrixGame: TFormMatrixGame @@ -211,10 +211,10 @@ object FormMatrixGame: TFormMatrixGame
211 TabOrder = 4 211 TabOrder = 4
212 Visible = False 212 Visible = False
213 object GBExperiment: TGroupBox 213 object GBExperiment: TGroupBox
214 - Left = 8  
215 - Height = 277 214 + Left = 16
  215 + Height = 197
216 Top = 60 216 Top = 60
217 - Width = 188 217 + Width = 228
218 AutoSize = True 218 AutoSize = True
219 Caption = 'Experimento' 219 Caption = 'Experimento'
220 ChildSizing.LeftRightSpacing = 10 220 ChildSizing.LeftRightSpacing = 10
@@ -224,19 +224,19 @@ object FormMatrixGame: TFormMatrixGame @@ -224,19 +224,19 @@ object FormMatrixGame: TFormMatrixGame
224 ChildSizing.EnlargeHorizontal = crsHomogenousChildResize 224 ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
225 ChildSizing.Layout = cclLeftToRightThenTopToBottom 225 ChildSizing.Layout = cclLeftToRightThenTopToBottom
226 ChildSizing.ControlsPerLine = 2 226 ChildSizing.ControlsPerLine = 2
227 - ClientHeight = 260  
228 - ClientWidth = 184 227 + ClientHeight = 180
  228 + ClientWidth = 224
229 TabOrder = 0 229 TabOrder = 0
230 object LabelExpCond: TLabel 230 object LabelExpCond: TLabel
231 Left = 10 231 Left = 10
232 Height = 15 232 Height = 15
233 Top = 20 233 Top = 20
234 - Width = 128 234 + Width = 168
235 Caption = 'Condição:' 235 Caption = 'Condição:'
236 ParentColor = False 236 ParentColor = False
237 end 237 end
238 object LabelExpCountCondition: TLabel 238 object LabelExpCountCondition: TLabel
239 - Left = 158 239 + Left = 198
240 Height = 15 240 Height = 15
241 Top = 20 241 Top = 20
242 Width = 16 242 Width = 16
@@ -247,12 +247,12 @@ object FormMatrixGame: TFormMatrixGame @@ -247,12 +247,12 @@ object FormMatrixGame: TFormMatrixGame
247 Left = 10 247 Left = 10
248 Height = 15 248 Height = 15
249 Top = 45 249 Top = 45
250 - Width = 128 250 + Width = 168
251 Caption = 'Geração:' 251 Caption = 'Geração:'
252 ParentColor = False 252 ParentColor = False
253 end 253 end
254 object LabelExpCountGeneration: TLabel 254 object LabelExpCountGeneration: TLabel
255 - Left = 158 255 + Left = 198
256 Height = 15 256 Height = 15
257 Top = 45 257 Top = 45
258 Width = 16 258 Width = 16
@@ -263,12 +263,12 @@ object FormMatrixGame: TFormMatrixGame @@ -263,12 +263,12 @@ object FormMatrixGame: TFormMatrixGame
263 Left = 10 263 Left = 10
264 Height = 15 264 Height = 15
265 Top = 70 265 Top = 70
266 - Width = 128 266 + Width = 168
267 Caption = 'Ciclo:' 267 Caption = 'Ciclo:'
268 ParentColor = False 268 ParentColor = False
269 end 269 end
270 object LabelExpCountCycle: TLabel 270 object LabelExpCountCycle: TLabel
271 - Left = 158 271 + Left = 198
272 Height = 15 272 Height = 15
273 Top = 70 273 Top = 70
274 Width = 16 274 Width = 16
@@ -279,12 +279,12 @@ object FormMatrixGame: TFormMatrixGame @@ -279,12 +279,12 @@ object FormMatrixGame: TFormMatrixGame
279 Left = 10 279 Left = 10
280 Height = 15 280 Height = 15
281 Top = 95 281 Top = 95
282 - Width = 128 282 + Width = 168
283 Caption = 'Turno:' 283 Caption = 'Turno:'
284 ParentColor = False 284 ParentColor = False
285 end 285 end
286 object LabelExpCountTurn: TLabel 286 object LabelExpCountTurn: TLabel
287 - Left = 158 287 + Left = 198
288 Height = 15 288 Height = 15
289 Top = 95 289 Top = 95
290 Width = 16 290 Width = 16
@@ -295,74 +295,69 @@ object FormMatrixGame: TFormMatrixGame @@ -295,74 +295,69 @@ object FormMatrixGame: TFormMatrixGame
295 Left = 10 295 Left = 10
296 Height = 15 296 Height = 15
297 Top = 120 297 Top = 120
298 - Width = 128 298 + Width = 168
299 Caption = 'Entrelaçamentos:' 299 Caption = 'Entrelaçamentos:'
300 ParentColor = False 300 ParentColor = False
301 end 301 end
302 object LabelExpCountInterlocks: TLabel 302 object LabelExpCountInterlocks: TLabel
303 - Left = 158 303 + Left = 198
304 Height = 15 304 Height = 15
305 Top = 120 305 Top = 120
306 Width = 16 306 Width = 16
307 Caption = 'NA' 307 Caption = 'NA'
308 ParentColor = False 308 ParentColor = False
309 end 309 end
310 - object ButtonExpStart: TButton 310 + object LabelExpTInterlocks: TLabel
311 Left = 10 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 Top = 145 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 ParentColor = False 316 ParentColor = False
342 end 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 Width = 16 322 Width = 16
  323 + Caption = 'NA'
358 ParentColor = False 324 ParentColor = False
359 end 325 end
360 end 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 end 356 end
362 object btnConfirmRow: TButton 357 object btnConfirmRow: TButton
363 Left = 712 358 Left = 712
364 Height = 26 359 Height = 26
365 - Top = 319 360 + Top = 152
366 Width = 86 361 Width = 86
367 Caption = 'Confirmar' 362 Caption = 'Confirmar'
368 OnClick = btnConfirmRowClick 363 OnClick = btnConfirmRowClick
form_matrixgame.pas
  Diff comments   View file @81caf87
@@ -28,23 +28,22 @@ type @@ -28,23 +28,22 @@ type
28 28
29 TFormMatrixGame = class(TForm) 29 TFormMatrixGame = class(TForm)
30 btnConfirmRow: TButton; 30 btnConfirmRow: TButton;
31 - ButtonExpStart: TButton;  
32 - ButtonExpPause: TButton;  
33 ButtonExpCancel: TButton; 31 ButtonExpCancel: TButton;
  32 + ButtonExpPause: TButton;
  33 + ButtonExpStart: TButton;
34 GBIndividual: TGroupBox; 34 GBIndividual: TGroupBox;
35 GBLastChoice: TGroupBox; 35 GBLastChoice: TGroupBox;
36 GBIndividualAB: TGroupBox; 36 GBIndividualAB: TGroupBox;
37 GBGrupo: TGroupBox; 37 GBGrupo: TGroupBox;
38 GBAdmin: TGroupBox; 38 GBAdmin: TGroupBox;
39 GBExperiment: TGroupBox; 39 GBExperiment: TGroupBox;
40 - LabelUnseen1: TLabel;  
41 - LabelUnseen2: TLabel;  
42 - LabelUnseen3: TLabel;  
43 LabelExpCountCondition: TLabel; 40 LabelExpCountCondition: TLabel;
  41 + LabelExpCountTInterlocks: TLabel;
44 LabelExpGen: TLabel; 42 LabelExpGen: TLabel;
45 LabelExpCountGeneration: TLabel; 43 LabelExpCountGeneration: TLabel;
46 LabelExpCycle: TLabel; 44 LabelExpCycle: TLabel;
47 LabelExpCountCycle: TLabel; 45 LabelExpCountCycle: TLabel;
  46 + LabelExpTInterlocks: TLabel;
48 LabelExpTurn: TLabel; 47 LabelExpTurn: TLabel;
49 LabelExpCountTurn: TLabel; 48 LabelExpCountTurn: TLabel;
50 LabelExpInterlocks: TLabel; 49 LabelExpInterlocks: TLabel;
@@ -222,6 +221,8 @@ procedure TFormMatrixGame.SetGameActor(AValue: TGameActor); @@ -222,6 +221,8 @@ procedure TFormMatrixGame.SetGameActor(AValue: TGameActor);
222 procedure SetZMQAdmin; 221 procedure SetZMQAdmin;
223 begin 222 begin
224 FGameControl := TGameControl.Create(TZMQAdmin.Create(Self,FID),ExtractFilePath(Application.ExeName)); 223 FGameControl := TGameControl.Create(TZMQAdmin.Create(Self,FID),ExtractFilePath(Application.ExeName));
  224 + GBIndividual.Visible:=False;
  225 + GBIndividualAB.Visible:=False;
225 GBAdmin.Visible:= True; 226 GBAdmin.Visible:= True;
226 end; 227 end;
227 228
units/backup/presentation_classes.pas 0 → 100644
  Diff comments   View file @81caf87
@@ -0,0 +1,135 @@ @@ -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,7 +15,7 @@ interface
15 15
16 uses 16 uses
17 Classes, SysUtils, Forms,PopupNotifier, ExtCtrls 17 Classes, SysUtils, Forms,PopupNotifier, ExtCtrls
18 - , game_actors_point 18 + , game_actors_point, game_visual_elements
19 ; 19 ;
20 type 20 type
21 21
@@ -42,7 +42,7 @@ type @@ -42,7 +42,7 @@ type
42 //TGameOperator = (goNONE, goAND, goOR); 42 //TGameOperator = (goNONE, goAND, goOR);
43 TGameStyle = (gtNone, gtRowsOnly, gtColorsOnly, gtRowsAndColors, gtRowsOrColors); 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 TConsequenceStyle = set of TGameConsequenceStyle; 46 TConsequenceStyle = set of TGameConsequenceStyle;
47 47
48 TGamePromptStyle = (gsYes, gsNo, gsAll, gsMetacontingency, gsContingency, gsBasA, gsRevertPoints); 48 TGamePromptStyle = (gsYes, gsNo, gsAll, gsMetacontingency, gsContingency, gsBasA, gsRevertPoints);
@@ -109,6 +109,7 @@ type @@ -109,6 +109,7 @@ type
109 procedure Clean; virtual; 109 procedure Clean; virtual;
110 procedure PresentMessage; 110 procedure PresentMessage;
111 procedure PresentPoints; 111 procedure PresentPoints;
  112 + procedure PresentPoints(APlayerBox : TPlayerBox); overload;
112 property ShouldPublishMessage : Boolean read GetShouldPublishMessage; 113 property ShouldPublishMessage : Boolean read GetShouldPublishMessage;
113 property PlayerNicname : string read FNicname write FNicname; 114 property PlayerNicname : string read FNicname write FNicname;
114 property AppendiceSingular : string read FAppendiceSingular; 115 property AppendiceSingular : string read FAppendiceSingular;
@@ -127,6 +128,7 @@ type @@ -127,6 +128,7 @@ type
127 FCriteria : TCriteria; 128 FCriteria : TCriteria;
128 FName: string; 129 FName: string;
129 FOnCriteria: TNotifyEvent; 130 FOnCriteria: TNotifyEvent;
  131 + FOnTargetCriteria : TNotifyEvent;
130 function RowMod(R:TGameRow):TGameRow; 132 function RowMod(R:TGameRow):TGameRow;
131 procedure CriteriaEvent; 133 procedure CriteriaEvent;
132 public 134 public
@@ -137,6 +139,7 @@ type @@ -137,6 +139,7 @@ type
137 function ConsequenceFromPlayerID(AID:string):string; 139 function ConsequenceFromPlayerID(AID:string):string;
138 procedure Clean; 140 procedure Clean;
139 property OnCriteria : TNotifyEvent read FOnCriteria write FOncriteria; 141 property OnCriteria : TNotifyEvent read FOnCriteria write FOncriteria;
  142 + property OnTargetCriteria : TNotifyEvent read FOnTargetCriteria write FOnTargetCriteria;
140 property Fired : Boolean read FFired; 143 property Fired : Boolean read FFired;
141 property Consequence : TConsequence read FConsequence; 144 property Consequence : TConsequence read FConsequence;
142 property Criteria : TCriteria read FCriteria; 145 property Criteria : TCriteria read FCriteria;
@@ -184,10 +187,10 @@ type @@ -184,10 +187,10 @@ type
184 TCondition = record 187 TCondition = record
185 ConditionName : string; 188 ConditionName : string;
186 Contingencies : TContingencies; // for producing points during the condition 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 Points : record 195 Points : record
193 Count : TPoints; // sum of points produced during the condition 196 Count : TPoints; // sum of points produced during the condition
@@ -235,6 +238,7 @@ procedure TContingency.CriteriaEvent; @@ -235,6 +238,7 @@ procedure TContingency.CriteriaEvent;
235 begin 238 begin
236 FFired:=True; 239 FFired:=True;
237 if Assigned(FOnCriteria) then FOnCriteria(Self); 240 if Assigned(FOnCriteria) then FOnCriteria(Self);
  241 + if Assigned(FOnTargetCriteria) then FOnTargetCriteria(Self);
238 end; 242 end;
239 243
240 constructor TContingency.Create(AOwner:TComponent;AConsequence:TConsequence;ACriteria:TCriteria;IsMeta:Boolean); 244 constructor TContingency.Create(AOwner:TComponent;AConsequence:TConsequence;ACriteria:TCriteria;IsMeta:Boolean);
@@ -646,6 +650,9 @@ end; @@ -646,6 +650,9 @@ end;
646 procedure TConsequence.PresentPoints; 650 procedure TConsequence.PresentPoints;
647 begin 651 begin
648 //is gscPoints in FStyle then just in case... 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 if gscA in FStyle then 656 if gscA in FStyle then
650 FormMatrixGame.LabelIndACount.Caption := IntToStr(StrToInt(FormMatrixGame.LabelIndACount.Caption) + FP.ResultAsInteger); 657 FormMatrixGame.LabelIndACount.Caption := IntToStr(StrToInt(FormMatrixGame.LabelIndACount.Caption) + FP.ResultAsInteger);
651 658
@@ -656,6 +663,14 @@ begin @@ -656,6 +663,14 @@ begin
656 FormMatrixGame.LabelGroupCount.Caption:= IntToStr(StrToInt(FormMatrixGame.LabelGroupCount.Caption) + FP.ResultAsInteger); 663 FormMatrixGame.LabelGroupCount.Caption:= IntToStr(StrToInt(FormMatrixGame.LabelGroupCount.Caption) + FP.ResultAsInteger);
657 end; 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 function TConsequence.GetShouldPublishMessage: Boolean; // for players only 674 function TConsequence.GetShouldPublishMessage: Boolean; // for players only
660 begin 675 begin
661 Result := gscBroadcastMessage in FStyle; 676 Result := gscBroadcastMessage in FStyle;
units/game_experiment.pas
  Diff comments   View file @81caf87
@@ -85,6 +85,7 @@ type @@ -85,6 +85,7 @@ type
85 procedure SetResearcherCanPlay(AValue: Boolean); 85 procedure SetResearcherCanPlay(AValue: Boolean);
86 procedure SetSendChatHistoryForNewPlayers(AValue: Boolean); 86 procedure SetSendChatHistoryForNewPlayers(AValue: Boolean);
87 procedure SetState(AValue: TExperimentState); 87 procedure SetState(AValue: TExperimentState);
  88 + procedure SetTargetInterlocking;
88 private 89 private
89 FABPoints: Boolean; 90 FABPoints: Boolean;
90 FChangeGeneration: string; 91 FChangeGeneration: string;
@@ -95,9 +96,11 @@ type @@ -95,9 +96,11 @@ type
95 FOnEndCycle: TNotifyEvent; 96 FOnEndCycle: TNotifyEvent;
96 FOnEndExperiment: TNotifyEvent; 97 FOnEndExperiment: TNotifyEvent;
97 FOnEndGeneration: TNotifyEvent; 98 FOnEndGeneration: TNotifyEvent;
  99 + FOnTargetInterlocking: TNotifyEvent;
98 procedure Consequence(Sender : TObject); 100 procedure Consequence(Sender : TObject);
99 function GetPlayerToKick: string; 101 function GetPlayerToKick: string;
100 procedure Interlocking(Sender : TObject); 102 procedure Interlocking(Sender : TObject);
  103 + procedure TargetInterlocking(Sender : TObject);
101 procedure SetPlayersQueue(AValue: string); 104 procedure SetPlayersQueue(AValue: string);
102 procedure WriteReportHeader; 105 procedure WriteReportHeader;
103 procedure WriteReportRowNames; 106 procedure WriteReportRowNames;
@@ -136,6 +139,7 @@ type @@ -136,6 +139,7 @@ type
136 property CurrentCondition : integer read FCurrentCondition write FCurrentCondition; 139 property CurrentCondition : integer read FCurrentCondition write FCurrentCondition;
137 property Contingency[C, I : integer] : TContingency read GetContingency write SetContingency; 140 property Contingency[C, I : integer] : TContingency read GetContingency write SetContingency;
138 property ContingenciesCount[C:integer]:integer read GetContingenciesCount; 141 property ContingenciesCount[C:integer]:integer read GetContingenciesCount;
  142 + property Cycles : integer read GetCurrentAbsoluteCycle;
139 property Player[I : integer] : TPlayer read GetPlayer write SetPlayer; 143 property Player[I : integer] : TPlayer read GetPlayer write SetPlayer;
140 property PlayerFromID[S : UTF8string ] : TPlayer read GetPlayer write SetPlayer; 144 property PlayerFromID[S : UTF8string ] : TPlayer read GetPlayer write SetPlayer;
141 property PlayersCount : integer read GetPlayersCount; 145 property PlayersCount : integer read GetPlayersCount;
@@ -161,6 +165,7 @@ type @@ -161,6 +165,7 @@ type
161 property OnEndExperiment : TNotifyEvent read FOnEndExperiment write SetOnEndExperiment; 165 property OnEndExperiment : TNotifyEvent read FOnEndExperiment write SetOnEndExperiment;
162 property OnConsequence : TNotifyEvent read FOnConsequence write SetOnConsequence; 166 property OnConsequence : TNotifyEvent read FOnConsequence write SetOnConsequence;
163 property OnInterlocking : TNotifyEvent read FOnInterlocking write SetOnInterlocking; 167 property OnInterlocking : TNotifyEvent read FOnInterlocking write SetOnInterlocking;
  168 + property OnTargetInterlocking : TNotifyEvent read FOnTargetInterlocking write FOnTargetInterlocking;
164 end; 169 end;
165 170
166 resourcestring 171 resourcestring
@@ -246,7 +251,7 @@ var @@ -246,7 +251,7 @@ var
246 begin 251 begin
247 if Assigned(FOnEndCondition) then FOnEndCondition(Self); 252 if Assigned(FOnEndCondition) then FOnEndCondition(Self);
248 Inc(FCurrentCondition); 253 Inc(FCurrentCondition);
249 - if FCurrentCondition = ConditionsCount-1 then 254 + if FCurrentCondition = ConditionsCount then
250 begin 255 begin
251 EndExperiment; 256 EndExperiment;
252 Exit; 257 Exit;
@@ -264,13 +269,13 @@ begin @@ -264,13 +269,13 @@ begin
264 case FConditions[CurrentCondition].EndCriterium.Style of 269 case FConditions[CurrentCondition].EndCriterium.Style of
265 gecWhichComeFirst: 270 gecWhichComeFirst:
266 begin 271 begin
267 - if (GetCurrentAbsoluteCycle = FConditions[CurrentCondition].EndCriterium.AbsoluteCycles) or 272 + if (GetCurrentAbsoluteCycle = FConditions[CurrentCondition].EndCriterium.AbsoluteCycles-1) or
268 (LInterlocks >= FConditions[CurrentCondition].EndCriterium.InterlockingPorcentage) then 273 (LInterlocks >= FConditions[CurrentCondition].EndCriterium.InterlockingPorcentage) then
269 EndCondition; 274 EndCondition;
270 275
271 end; 276 end;
272 gecAbsoluteCycles: 277 gecAbsoluteCycles:
273 - if GetCurrentAbsoluteCycle = FConditions[CurrentCondition].EndCriterium.AbsoluteCycles then 278 + if GetCurrentAbsoluteCycle = FConditions[CurrentCondition].EndCriterium.AbsoluteCycles-1 then
274 EndCondition; 279 EndCondition;
275 280
276 gecInterlockingPorcentage: 281 gecInterlockingPorcentage:
@@ -288,6 +293,9 @@ var c:integer; @@ -288,6 +293,9 @@ var c:integer;
288 begin 293 begin
289 c := CurrentCondition; 294 c := CurrentCondition;
290 Result := (Condition[c].Cycles.Value*Condition[c].Cycles.Generation)+Condition[c].Cycles.Count; 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 end; 299 end;
292 300
293 function TExperiment.GetPlayer(I : integer): TPlayer; 301 function TExperiment.GetPlayer(I : integer): TPlayer;
@@ -382,6 +390,9 @@ begin @@ -382,6 +390,9 @@ begin
382 // return result in porcentage 390 // return result in porcentage
383 Result := (i*100)/LContingencyResults.Count; 391 Result := (i*100)/LContingencyResults.Count;
384 end; 392 end;
  393 + {$IFDEF DEBUG}
  394 + WriteLn('TExperiment.GetInterlockingPorcentageInLastCycles:',Result);
  395 + {$ENDIF}
385 end; 396 end;
386 397
387 function TExperiment.GetConsequenceStringFromChoice(P: TPlayer): Utf8string; 398 function TExperiment.GetConsequenceStringFromChoice(P: TPlayer): Utf8string;
@@ -542,14 +553,25 @@ begin @@ -542,14 +553,25 @@ begin
542 FState:=AValue; 553 FState:=AValue;
543 end; 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 procedure TExperiment.Consequence(Sender: TObject); 567 procedure TExperiment.Consequence(Sender: TObject);
546 begin 568 begin
547 if Assigned(FOnConsequence) then FOnConsequence(Sender); 569 if Assigned(FOnConsequence) then FOnConsequence(Sender);
548 end; 570 end;
549 571
550 -procedure TExperiment.Interlocking(Sender: TObject); 572 +procedure TExperiment.TargetInterlocking(Sender: TObject);
551 begin 573 begin
552 - if Assigned(FOnInterlocking) then FOnInterlocking(Sender); 574 + if Assigned(FOnTargetInterlocking) then FOnTargetInterlocking(Sender);
553 end; 575 end;
554 576
555 procedure TExperiment.SetPlayersQueue(AValue: string); 577 procedure TExperiment.SetPlayersQueue(AValue: string);
@@ -573,6 +595,11 @@ begin @@ -573,6 +595,11 @@ begin
573 Result := FPlayers[0].ID; 595 Result := FPlayers[0].ID;
574 end; 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 procedure TExperiment.WriteReportHeader; 604 procedure TExperiment.WriteReportHeader;
578 var 605 var
@@ -715,10 +742,15 @@ begin @@ -715,10 +742,15 @@ begin
715 end; 742 end;
716 743
717 constructor TExperiment.Create(AOwner: TComponent;AppPath:string); 744 constructor TExperiment.Create(AOwner: TComponent;AppPath:string);
  745 +var i : integer;
718 begin 746 begin
719 inherited Create(AOwner); 747 inherited Create(AOwner);
720 FTurnsRandom := TStringList.Create; 748 FTurnsRandom := TStringList.Create;
721 LoadExperimentFromResource(Self); 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 CheckNeedForRandomTurns; 754 CheckNeedForRandomTurns;
723 755
724 FReportReader := TReportReader.Create; 756 FReportReader := TReportReader.Create;
units/game_resources.pas
  Diff comments   View file @81caf87
@@ -216,10 +216,10 @@ const @@ -216,10 +216,10 @@ const
216 ( 216 (
217 ConditionName : ''; 217 ConditionName : '';
218 Contingencies : nil; 218 Contingencies : nil;
219 - Interlocks : (  
220 - Count : 0;  
221 - History : nil;  
222 - ); 219 + //Interlocks : (
  220 + // Count : 0;
  221 + // History : nil;
  222 + //);
223 223
224 Points : ( 224 Points : (
225 Count : ( A:0; B:0; G:0; ); 225 Count : ( A:0; B:0; G:0; );
units/game_visual_elements.pas
  Diff comments   View file @81caf87
@@ -25,16 +25,19 @@ type @@ -25,16 +25,19 @@ type
25 PanelLastColor : TPanel; 25 PanelLastColor : TPanel;
26 LabelLastRow : TLabel; 26 LabelLastRow : TLabel;
27 LabelLastRowCount : TLabel; 27 LabelLastRowCount : TLabel;
  28 + LabelPoints : TLabel;
  29 + LabelPointsCount : TLabel;
28 private 30 private
29 FID: string; 31 FID: string;
30 public 32 public
31 - constructor Create(AOwner: TComponent;AID:string); reintroduce; 33 + constructor Create(AOwner: TComponent;AID:string;Admin:Boolean=False); reintroduce;
32 property ID : string read FID write FID; 34 property ID : string read FID write FID;
33 end; 35 end;
34 36
35 resourcestring 37 resourcestring
36 CAP_ROW = 'Linha:'; 38 CAP_ROW = 'Linha:';
37 CAP_COLOR = 'Cor:'; 39 CAP_COLOR = 'Cor:';
  40 + CAP_POINTS = 'Pontos:';
38 CAP_NA = 'NA'; 41 CAP_NA = 'NA';
39 CAP_WAINTING_FOR_PLAYER = 'Esperando Jogador...'; 42 CAP_WAINTING_FOR_PLAYER = 'Esperando Jogador...';
40 43
@@ -42,7 +45,7 @@ implementation @@ -42,7 +45,7 @@ implementation
42 45
43 { TPlayerBox } 46 { TPlayerBox }
44 47
45 -constructor TPlayerBox.Create(AOwner: TComponent; AID: string); 48 +constructor TPlayerBox.Create(AOwner: TComponent; AID: string; Admin: Boolean);
46 begin 49 begin
47 inherited Create(AOwner); 50 inherited Create(AOwner);
48 FID := AID; 51 FID := AID;
@@ -74,6 +77,17 @@ begin @@ -74,6 +77,17 @@ begin
74 LabelLastRowCount.Caption:=CAP_NA; 77 LabelLastRowCount.Caption:=CAP_NA;
75 LabelLastRowCount.Parent := Self; 78 LabelLastRowCount.Parent := Self;
76 Enabled:= False; 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 //LabelLastRow.AutoSize := False; 91 //LabelLastRow.AutoSize := False;
78 end; 92 end;
79 93
units/game_zmq_actors.pas
  Diff comments   View file @81caf87
@@ -11,8 +11,6 @@ unit game_zmq_actors; @@ -11,8 +11,6 @@ unit game_zmq_actors;
11 11
12 {$mode objfpc}{$H+} 12 {$mode objfpc}{$H+}
13 13
14 -{$DEFINE DEBUG}  
15 -  
16 interface 14 interface
17 15
18 uses 16 uses
units/string_methods.pas
  Diff comments   View file @81caf87
@@ -234,6 +234,10 @@ begin @@ -234,6 +234,10 @@ begin
234 'MENSAGEM A TODOS' : Result:= gscBroadcastMessage; 234 'MENSAGEM A TODOS' : Result:= gscBroadcastMessage;
235 'PONTOS' : Result:= gscPoints; 235 'PONTOS' : Result:= gscPoints;
236 'PONTOS COM VARIAÇÃO' : Result:= gscVariablePoints; 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 end; 241 end;
238 end; 242 end;
239 243
@@ -245,6 +249,10 @@ begin @@ -245,6 +249,10 @@ begin
245 gscBroadcastMessage : Result:= 'MENSAGEM A TODOS'; 249 gscBroadcastMessage : Result:= 'MENSAGEM A TODOS';
246 gscPoints : Result:= 'PONTOS' ; 250 gscPoints : Result:= 'PONTOS' ;
247 gscVariablePoints : Result:= 'PONTOS COM VARIAÇÃO'; 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 end; 256 end;
249 end; 257 end;
250 258
@@ -358,6 +366,7 @@ begin @@ -358,6 +366,7 @@ begin
358 gscA:Result += 'A'; 366 gscA:Result += 'A';
359 gscB:Result += 'B'; 367 gscB:Result += 'B';
360 gscG:Result += 'G'; 368 gscG:Result += 'G';
  369 + gscI:Result += 'I';
361 end; 370 end;
362 Result += ','; 371 Result += ',';
363 end; 372 end;