Download as
Browse Code »

Commit 64b24cf17cd7d3f1e52b2ba0b05b477597b8846b

Authored by Carlos Picanco
1 parent 675bd299
Exists in master

fully implement prompts, real time report, and dumps

Showing 11 changed files with 699 additions and 404 deletions   Show diff stats
cultural_matrix.lpi
  Diff comments   View file @64b24cf
@@ -55,7 +55,7 @@ @@ -55,7 +55,7 @@
55 <PackageName Value="LCL"/> 55 <PackageName Value="LCL"/>
56 </Item2> 56 </Item2>
57 </RequiredPackages> 57 </RequiredPackages>
58 - <Units Count="14"> 58 + <Units Count="15">
59 <Unit0> 59 <Unit0>
60 <Filename Value="cultural_matrix.lpr"/> 60 <Filename Value="cultural_matrix.lpr"/>
61 <IsPartOfProject Value="True"/> 61 <IsPartOfProject Value="True"/>
@@ -117,6 +117,10 @@ @@ -117,6 +117,10 @@
117 <ComponentName Value="FormChooseActor"/> 117 <ComponentName Value="FormChooseActor"/>
118 <ResourceBaseClass Value="Form"/> 118 <ResourceBaseClass Value="Form"/>
119 </Unit13> 119 </Unit13>
  120 + <Unit14>
  121 + <Filename Value="units/csv_writer.pas"/>
  122 + <IsPartOfProject Value="True"/>
  123 + </Unit14>
120 </Units> 124 </Units>
121 </ProjectOptions> 125 </ProjectOptions>
122 <CompilerOptions> 126 <CompilerOptions>
cultural_matrix.lpr
  Diff comments   View file @64b24cf
@@ -35,7 +35,9 @@ var @@ -35,7 +35,9 @@ var
35 I : integer; 35 I : integer;
36 {$ENDIF} 36 {$ENDIF}
37 ID : TStringList; 37 ID : TStringList;
  38 + ApplicationPath,
38 F : string; 39 F : string;
  40 +
39 const 41 const
40 PAdmin : array [0..3] of string = ('--admin','--adm','-admin','-adm'); 42 PAdmin : array [0..3] of string = ('--admin','--adm','-admin','-adm');
41 PPlayer : array [0..3] of string = ('--player','--play','-player','-play'); 43 PPlayer : array [0..3] of string = ('--player','--play','-player','-play');
@@ -43,50 +45,68 @@ const @@ -43,50 +45,68 @@ const
43 45
44 {$R *.res} 46 {$R *.res}
45 47
  48 +
  49 +{$IFDEF DEBUG}
  50 + function CreateDebugFoldersForPlayers:Boolean;
  51 + var
  52 + i : integer;
  53 + begin
  54 + Result := True;
  55 + for i := 0 to 2 do
  56 + begin
  57 + if Pos((PathDelim+'P'+IntToStr(i+1)+PathDelim), Application.ExeName) > 0 then
  58 + Break;
  59 + F := ApplicationPath+'P'+IntToStr(i+1);
  60 + WriteLn(F);
  61 + if ForceDirectoriesUTF8(F) then // ensure we have always the newer version for tests
  62 + begin
  63 + CopyFile(Application.ExeName,F+PathDelim+ApplicationName,[cffOverwriteFile]);
  64 + {$IFDEF LINUX}
  65 + FpChmod(F+PathDelim+ApplicationName,S_IRWXU);
  66 + {$ENDIF}
  67 + end
  68 + else Result := False;
  69 + end;
  70 + end;
  71 +{$ENDIF}
  72 +
  73 + function GetZMQNetworkID(var F:string):Boolean;
  74 + begin
  75 + Result := True;
  76 + ID := TStringList.Create;
  77 + if FileExists(F) then
  78 + try
  79 + ID.LoadFromFile(F);
  80 + F := Copy(ID.Text,0,Length(ID.Text)-2);
  81 + finally
  82 + ID.Free;
  83 + end
  84 + else
  85 + try
  86 + ID.Text := s_random(32);
  87 + ID.SaveToFile(F);
  88 + F := Copy(ID.Text,0,Length(ID.Text)-2);
  89 + except
  90 + on E: Exception do
  91 + begin
  92 + ID.Free;
  93 + {$IFDEF DEBUG}
  94 + ShowMessage(E.Message);
  95 + {$ENDIF}
  96 + Result := False;
  97 + end;
  98 + end;
  99 + end;
  100 +
46 begin 101 begin
  102 + ApplicationPath := ExtractFilePath(Application.ExeName);
47 {$IFDEF DEBUG} 103 {$IFDEF DEBUG}
48 - for i:= 0 to 2 do  
49 - begin  
50 - if Pos((PathDelim+'P'+IntToStr(i+1)+PathDelim), Application.ExeName) > 0 then  
51 - Break;  
52 - F := ExtractFilePath(Application.ExeName)+'P'+IntToStr(i+1);  
53 - WriteLn(F);  
54 - if ForceDirectoriesUTF8(F) then // ensure we have always the newer version for tests  
55 - begin  
56 - CopyFile(Application.ExeName,F+PathDelim+ApplicationName,[cffOverwriteFile]);  
57 - {$IFDEF LINUX}  
58 - FpChmod(F+PathDelim+ApplicationName,S_IRWXU);  
59 - {$ENDIF}  
60 - end  
61 - else Exit;  
62 - end; 104 + if not CreateDebugFoldersForPlayers then Exit;
63 {$ENDIF} 105 {$ENDIF}
64 Application.Initialize; 106 Application.Initialize;
65 - F := ExtractFilePath(Application.ExeName)+PathDelim+'id';  
66 - ID := TStringList.Create;  
67 - if FileExists(F) then  
68 - try  
69 - ID.LoadFromFile(F);  
70 - F := Copy(ID.Text,0,Length(ID.Text)-2);  
71 - finally  
72 - ID.Free;  
73 - end  
74 - else  
75 - try  
76 - ID.Text := s_random(32);  
77 - ID.SaveToFile(F);  
78 - F := Copy(ID.Text,0,Length(ID.Text)-2);  
79 - except  
80 - on E: Exception do  
81 - begin  
82 - ID.Free;  
83 - {$IFDEF DEBUG}  
84 - ShowMessage(E.Message);  
85 - {$ENDIF}  
86 - Exit;  
87 - end;  
88 - end;  
89 - Application.CreateForm(TFormMatrixGame, FormMatrixGame); 107 + F := ApplicationPath+PathDelim+'id';
  108 + if not GetZMQNetworkID(F) then Exit;
  109 + Application.CreateForm(TFormMatrixGame, FormMatrixGame);
90 110
91 FormMatrixGame.SetID(F); 111 FormMatrixGame.SetID(F);
92 if Paramcount > 0 then 112 if Paramcount > 0 then
form_matrixgame.pas
  Diff comments   View file @64b24cf
@@ -72,14 +72,14 @@ type @@ -72,14 +72,14 @@ type
72 procedure ButtonExpStartClick(Sender: TObject); 72 procedure ButtonExpStartClick(Sender: TObject);
73 procedure ChatMemoSendKeyPress(Sender: TObject; var Key: char); 73 procedure ChatMemoSendKeyPress(Sender: TObject; var Key: char);
74 procedure FormActivate(Sender: TObject); 74 procedure FormActivate(Sender: TObject);
75 - procedure PopupNotifierClose(Sender: TObject; var CloseAction: TCloseAction  
76 - ); 75 + procedure PopupNotifierClose(Sender: TObject; var CloseAction: TCloseAction);
77 procedure StringGridMatrixClick(Sender: TObject); 76 procedure StringGridMatrixClick(Sender: TObject);
78 procedure StringGridMatrixDrawCell(Sender: TObject; aCol, aRow: integer; 77 procedure StringGridMatrixDrawCell(Sender: TObject; aCol, aRow: integer;
79 aRect: TRect; aState: TGridDrawState); 78 aRect: TRect; aState: TGridDrawState);
80 procedure TimerTimer(Sender: TObject); 79 procedure TimerTimer(Sender: TObject);
81 private 80 private
82 FGameControl : TGameControl; 81 FGameControl : TGameControl;
  82 + FAppPath,
83 FID: string; 83 FID: string;
84 public 84 public
85 procedure SetID(S : string); 85 procedure SetID(S : string);
@@ -106,7 +106,6 @@ procedure TFormMatrixGame.StringGridMatrixDrawCell(Sender: TObject; aCol, aRow: @@ -106,7 +106,6 @@ procedure TFormMatrixGame.StringGridMatrixDrawCell(Sender: TObject; aCol, aRow:
106 aRect: TRect; aState: TGridDrawState); 106 aRect: TRect; aState: TGridDrawState);
107 var 107 var
108 OldCanvas: TCanvas; 108 OldCanvas: TCanvas;
109 - RowBase : integer;  
110 109
111 procedure SaveOldCanvas; 110 procedure SaveOldCanvas;
112 begin 111 begin
@@ -157,8 +156,8 @@ var @@ -157,8 +156,8 @@ var
157 TStringGrid(Sender).Canvas.Rectangle(aRect); 156 TStringGrid(Sender).Canvas.Rectangle(aRect);
158 if Assigned(FGameControl) then 157 if Assigned(FGameControl) then
159 if FGameControl.MustDrawDots then 158 if FGameControl.MustDrawDots then
160 - if (Odd(aRow + RowBase) and not Odd(aCol)) or  
161 - (not Odd(aRow + RowBase) and Odd(aCol)) then 159 + if (Odd(aRow + FGameControl.RowBase) and not Odd(aCol)) or
  160 + (not Odd(aRow + FGameControl.RowBase) and Odd(aCol)) then
162 DrawDots; 161 DrawDots;
163 end; 162 end;
164 //function GetTextX(S : String): Longint; 163 //function GetTextX(S : String): Longint;
@@ -167,15 +166,14 @@ var @@ -167,15 +166,14 @@ var
167 //end; 166 //end;
168 167
169 begin 168 begin
170 - if Assigned(FGameControl) then  
171 - RowBase:=FGameControl.RowBase; 169 + if not Assigned(FGameControl) then Exit;
172 SaveOldCanvas; 170 SaveOldCanvas;
173 try 171 try
174 //if (aRow >= RowBase) and (aCol = 10) then 172 //if (aRow >= RowBase) and (aCol = 10) then
175 // DrawLines(clWhite); 173 // DrawLines(clWhite);
176 - if (aCol <> 0) and (aRow > (RowBase-1)) then 174 + if (aCol <> 0) and (aRow > (FGameControl.RowBase-1)) then
177 begin 175 begin
178 - DrawLines(GetRowColor(aRow,RowBase)); 176 + DrawLines(GetRowColor(aRow,FGameControl.RowBase));
179 177
180 if (gdSelected in aState) and (goRowSelect in TStringGrid(Sender).Options)then 178 if (gdSelected in aState) and (goRowSelect in TStringGrid(Sender).Options)then
181 begin 179 begin
@@ -226,13 +224,13 @@ procedure TFormMatrixGame.SetGameActor(AValue: TGameActor); @@ -226,13 +224,13 @@ procedure TFormMatrixGame.SetGameActor(AValue: TGameActor);
226 224
227 procedure SetZMQAdmin; 225 procedure SetZMQAdmin;
228 begin 226 begin
229 - FGameControl := TGameControl.Create(TZMQAdmin.Create(Self,FID)); 227 + FGameControl := TGameControl.Create(TZMQAdmin.Create(Self,FID),ExtractFilePath(Application.ExeName));
230 GBAdmin.Visible:= True; 228 GBAdmin.Visible:= True;
231 end; 229 end;
232 230
233 procedure SetZMQPlayer; 231 procedure SetZMQPlayer;
234 begin 232 begin
235 - FGameControl := TGameControl.Create(TZMQPlayer.Create(Self,FID)); 233 + FGameControl := TGameControl.Create(TZMQPlayer.Create(Self,FID),ExtractFilePath(Application.ExeName));
236 //StringGridMatrix.Enabled := True; 234 //StringGridMatrix.Enabled := True;
237 end; 235 end;
238 236
@@ -257,24 +255,27 @@ end; @@ -257,24 +255,27 @@ end;
257 255
258 procedure TFormMatrixGame.FormActivate(Sender: TObject); 256 procedure TFormMatrixGame.FormActivate(Sender: TObject);
259 begin 257 begin
260 - FormChooseActor := TFormChooseActor.Create(Self);  
261 - FormChooseActor.Style := '.Arrived';  
262 - try  
263 - if FormChooseActor.ShowModal = 1 then  
264 - begin  
265 - case FormChooseActor.GameActor of  
266 - gaAdmin:FormMatrixGame.SetGameActor(gaAdmin);  
267 - gaPlayer: FormMatrixGame.SetGameActor(gaPlayer);  
268 - gaWatcher: FormMatrixGame.SetGameActor(gaWatcher);  
269 - end;  
270 - StringGridMatrix.ClearSelections;  
271 - StringGridMatrix.FocusRectVisible := False;  
272 - FGameControl.SetMatrix;  
273 - end  
274 - else Close;  
275 - finally  
276 - FormChooseActor.Free;  
277 - end; 258 + if not Assigned(FGameControl) then
  259 + begin
  260 + FormChooseActor := TFormChooseActor.Create(Self);
  261 + FormChooseActor.Style := '.Arrived';
  262 + try
  263 + if FormChooseActor.ShowModal = 1 then
  264 + begin
  265 + case FormChooseActor.GameActor of
  266 + gaAdmin:FormMatrixGame.SetGameActor(gaAdmin);
  267 + gaPlayer: FormMatrixGame.SetGameActor(gaPlayer);
  268 + gaWatcher: FormMatrixGame.SetGameActor(gaWatcher);
  269 + end;
  270 + StringGridMatrix.ClearSelections;
  271 + StringGridMatrix.FocusRectVisible := False;
  272 + FGameControl.SetMatrix;
  273 + end
  274 + else Close;
  275 + finally
  276 + FormChooseActor.Free;
  277 + end;
  278 + end;
278 end; 279 end;
279 280
280 procedure TFormMatrixGame.PopupNotifierClose(Sender: TObject; 281 procedure TFormMatrixGame.PopupNotifierClose(Sender: TObject;
units/csv_writer.pas 0 → 100644
  Diff comments   View file @64b24cf
@@ -0,0 +1,98 @@ @@ -0,0 +1,98 @@
  1 +unit csv_writer;
  2 +
  3 +{$mode objfpc}{$H+}
  4 +
  5 +interface
  6 +
  7 +uses SysUtils, Classes, LazFileUtils;
  8 +
  9 +type
  10 +
  11 + { TCSVWriter }
  12 +
  13 + TCSVWriter = class(TComponent)
  14 + private
  15 + FFileName: string;
  16 + FFile: TextFile;
  17 + FSessionNumber: integer;
  18 + procedure Close;
  19 + procedure UpdateFileName(ANewFileName : string);
  20 + function OpenNoOverride(AFilename : string):string;
  21 + public
  22 + constructor Create(AOwner: TComponent; AFileName: String); reintroduce;
  23 + destructor Destroy; override;
  24 + procedure Write(AData: array of const);
  25 + end;
  26 +
  27 +
  28 +
  29 +
  30 +implementation
  31 +
  32 +{ TCSVWriter }
  33 +
  34 +procedure TCSVWriter.Close;
  35 +begin
  36 + if FFilename <> '' then
  37 + if TextRec(FFile).Mode = 55218 then // file is opened read/write
  38 + begin
  39 + CloseFile(FFile);
  40 + end
  41 +end;
  42 +
  43 +procedure TCSVWriter.UpdateFileName(ANewFileName: string);
  44 +begin
  45 + if (ANewFileName = '') or (ANewFileName = FFilename) then Exit;
  46 + Close;
  47 + FFileName := OpenNoOverride(ANewFileName);
  48 +end;
  49 +
  50 +function TCSVWriter.OpenNoOverride(AFilename: string): string;
  51 +var
  52 + i : Integer;
  53 + FilePath, LExtension: string;
  54 +begin
  55 + if AFileName <> '' then
  56 + begin
  57 + ForceDirectoriesUTF8(ExtractFilePath(AFilename));
  58 + FilePath := ExtractFilePath(AFilename);
  59 + LExtension := ExtractFileExt(AFilename);
  60 + i := 0;
  61 +
  62 + // ensure to never override an existing file
  63 + while FileExistsUTF8(AFilename) do begin
  64 + Inc(i);
  65 + AFilename := FilePath + StringOfChar(#48, 3 - Length(IntToStr(i))) + IntToStr(i) + LExtension;
  66 + end;
  67 +
  68 + FSessionNumber := i;
  69 +
  70 + // as override is impossible, don't mind about an Assign/Rewrite conditional
  71 + AssignFile(FFile, AFilename);
  72 + Rewrite(FFile);
  73 + {$ifdef DEBUG}
  74 + WriteLn(FFile, mt_Debug + 'Saving data to:' + AFilename );
  75 + {$endif}
  76 + Result := AFilename;
  77 + end;
  78 +end;
  79 +
  80 +constructor TCSVWriter.Create(AOwner: TComponent; AFileName: String);
  81 +begin
  82 + inherited Create(AOwner);
  83 + FFilename := OpenNoOverride(AFilename);
  84 +end;
  85 +
  86 +destructor TCSVWriter.Destroy;
  87 +begin
  88 + Close;
  89 + inherited Destroy;
  90 +end;
  91 +
  92 +procedure TCSVWriter.Write(AData: array of const);
  93 +begin
  94 +
  95 +end;
  96 +
  97 +end.
  98 +
units/game_actors.pas
  Diff comments   View file @64b24cf
@@ -106,6 +106,7 @@ type @@ -106,6 +106,7 @@ type
106 destructor Destroy;override; 106 destructor Destroy;override;
107 function AsString(AID :string): string; 107 function AsString(AID :string): string;
108 function GenerateMessage(ForGroup: Boolean):string; 108 function GenerateMessage(ForGroup: Boolean):string;
  109 + procedure Clean; virtual;
109 procedure PresentMessage; 110 procedure PresentMessage;
110 procedure PresentPoints; 111 procedure PresentPoints;
111 property ShouldPublishMessage : Boolean read GetShouldPublishMessage; 112 property ShouldPublishMessage : Boolean read GetShouldPublishMessage;
@@ -123,6 +124,7 @@ type @@ -123,6 +124,7 @@ type
123 FMeta : Boolean; //True: Consequence occurs OnEndTurn, False: Consequence occurs OnEndCycle 124 FMeta : Boolean; //True: Consequence occurs OnEndTurn, False: Consequence occurs OnEndCycle
124 FConsequence : TConsequence; 125 FConsequence : TConsequence;
125 FCriteria : TCriteria; 126 FCriteria : TCriteria;
  127 + FName: string;
126 FOnCriteria: TNotifyEvent; 128 FOnCriteria: TNotifyEvent;
127 function RowMod(R:TGameRow):TGameRow; 129 function RowMod(R:TGameRow):TGameRow;
128 procedure CriteriaEvent; 130 procedure CriteriaEvent;
@@ -131,11 +133,14 @@ type @@ -131,11 +133,14 @@ type
131 function CriteriaString : string; 133 function CriteriaString : string;
132 function ResponseMeetsCriteriaI(R : TGameRow; C : TGameColor):Boolean; // Does response meets operant criteria? 134 function ResponseMeetsCriteriaI(R : TGameRow; C : TGameColor):Boolean; // Does response meets operant criteria?
133 function ResponseMeetsCriteriaG(Players : TPlayers):Boolean; 135 function ResponseMeetsCriteriaG(Players : TPlayers):Boolean;
  136 + function ConsequenceFromPlayerID(AID:string):string;
  137 + procedure Clean;
134 property OnCriteria : TNotifyEvent read FOnCriteria write FOncriteria; 138 property OnCriteria : TNotifyEvent read FOnCriteria write FOncriteria;
135 property Fired : Boolean read FFired; 139 property Fired : Boolean read FFired;
136 property Consequence : TConsequence read FConsequence; 140 property Consequence : TConsequence read FConsequence;
137 property Criteria : TCriteria read FCriteria; 141 property Criteria : TCriteria read FCriteria;
138 property Meta : Boolean read FMeta; 142 property Meta : Boolean read FMeta;
  143 + property ContingencyName : string read FName write FName;
139 end; 144 end;
140 145
141 { TContingencies } 146 { TContingencies }
@@ -155,8 +160,9 @@ type @@ -155,8 +160,9 @@ type
155 public 160 public
156 constructor Create(AOwner:TComponent; APStyle:TPromptStyle; APTarget : TContingencies; AMessage:string);reintroduce; 161 constructor Create(AOwner:TComponent; APStyle:TPromptStyle; APTarget : TContingencies; AMessage:string);reintroduce;
157 function ResponsesCount : integer; 162 function ResponsesCount : integer;
158 - procedure AppendResponse(AID,R:string);  
159 function AsString: TStringList; overload; 163 function AsString: TStringList; overload;
  164 + procedure AppendResponse(AID,R:string);
  165 + procedure Clean;override;
160 property Question: string read FPromptMessage; 166 property Question: string read FPromptMessage;
161 property PromptResult:string read FResult; 167 property PromptResult:string read FResult;
162 168
@@ -398,6 +404,17 @@ begin // All -&gt; (Diff,Equal,Even, Odd) or not all @@ -398,6 +404,17 @@ begin // All -&gt; (Diff,Equal,Even, Odd) or not all
398 CriteriaEvent; 404 CriteriaEvent;
399 end; 405 end;
400 406
  407 +function TContingency.ConsequenceFromPlayerID(AID: string): string;
  408 +begin
  409 + Result := Consequence.ConsequenseByPlayerID.Values[AID];
  410 +end;
  411 +
  412 +procedure TContingency.Clean;
  413 +begin
  414 + FFired := False;
  415 + Consequence.Clean;
  416 +end;
  417 +
401 418
402 { TPrompt } 419 { TPrompt }
403 420
@@ -426,6 +443,12 @@ begin @@ -426,6 +443,12 @@ begin
426 FResponses[High(FResponses)] := AID+'|'+R+'|'; 443 FResponses[High(FResponses)] := AID+'|'+R+'|';
427 end; 444 end;
428 445
  446 +procedure TPrompt.Clean;
  447 +begin
  448 + //inherited Clean;
  449 + FResponses := nil;
  450 +end;
  451 +
429 function TPrompt.AsString: TStringList; 452 function TPrompt.AsString: TStringList;
430 var 453 var
431 j,i : integer; 454 j,i : integer;
@@ -454,8 +477,8 @@ var @@ -454,8 +477,8 @@ var
454 477
455 if (gscB in LCsqStyle) and (gsBasA in FPromptStyle) then 478 if (gscB in LCsqStyle) and (gsBasA in FPromptStyle) then
456 begin 479 begin
457 - LCsqStyle += [gscB];  
458 - LCsqStyle -= [gscA]; 480 + LCsqStyle += [gscA];
  481 + LCsqStyle -= [gscB];
459 end; 482 end;
460 483
461 if IsMeta then 484 if IsMeta then
@@ -471,17 +494,22 @@ var @@ -471,17 +494,22 @@ var
471 ExtractDelimited(5,LConsequence, ['|']); 494 ExtractDelimited(5,LConsequence, ['|']);
472 end; 495 end;
473 begin 496 begin
  497 + Result := TStringList.Create;
474 // to do, sanitize FPromptStyle first 498 // to do, sanitize FPromptStyle first
475 Pts:= 0; 499 Pts:= 0;
476 if (gsAll in FPromptStyle) and (gsYes in FPromptStyle) then 500 if (gsAll in FPromptStyle) and (gsYes in FPromptStyle) then
477 if AllPlayersClickedYes then 501 if AllPlayersClickedYes then
478 for i := 0 to Length(FPromptTargets)-1 do 502 for i := 0 to Length(FPromptTargets)-1 do
479 - for j := 0 to FPromptTargets[i].Consequence.ConsequenseByPlayerID.Count do 503 + for j := 0 to FPromptTargets[i].Consequence.ConsequenseByPlayerID.Count-1 do
480 begin 504 begin
481 LID := FPromptTargets[i].Consequence.ConsequenseByPlayerID.Names[j]; 505 LID := FPromptTargets[i].Consequence.ConsequenseByPlayerID.Names[j];
482 LConsequence := FPromptTargets[i].Consequence.ConsequenseByPlayerID.Values[LID]; 506 LConsequence := FPromptTargets[i].Consequence.ConsequenseByPlayerID.Values[LID];
483 LCsqStyle := GetConsequenceStylesFromString(ExtractDelimited(2,LConsequence, ['|'])); 507 LCsqStyle := GetConsequenceStylesFromString(ExtractDelimited(2,LConsequence, ['|']));
484 508
  509 + // TODO: should BasA revert appendices? right now reverting points only
  510 + //LAppendiceSingular:=
  511 + //LAppendicePlural:=
  512 +
485 if gsContingency in FPromptStyle then 513 if gsContingency in FPromptStyle then
486 if (FPromptTargets[i].Fired) and (not FPromptTargets[i].Meta) then 514 if (FPromptTargets[i].Fired) and (not FPromptTargets[i].Meta) then
487 if (gscA in LCsqStyle) or (gscB in LCsqStyle) then 515 if (gscA in LCsqStyle) or (gscB in LCsqStyle) then
@@ -493,7 +521,7 @@ begin @@ -493,7 +521,7 @@ begin
493 if gscG in LCsqStyle then 521 if gscG in LCsqStyle then
494 ApplyPointsConditions(True); 522 ApplyPointsConditions(True);
495 523
496 - Result := TStringList.Create; 524 +
497 Result.Add(LConsequence); 525 Result.Add(LConsequence);
498 end; 526 end;
499 527
@@ -541,7 +569,7 @@ begin @@ -541,7 +569,7 @@ begin
541 FMessage := TPopupNotifier.Create(Self); 569 FMessage := TPopupNotifier.Create(Self);
542 FTimer := TTimer.Create(Self); 570 FTimer := TTimer.Create(Self);
543 FTimer.Enabled:=False; 571 FTimer.Enabled:=False;
544 - FTimer.Interval:=6000; 572 + FTimer.Interval:=10000;
545 FTimer.OnTimer:=@SelfDestroy; 573 FTimer.OnTimer:=@SelfDestroy;
546 FConsequenceByPlayerID := TStringList.Create; 574 FConsequenceByPlayerID := TStringList.Create;
547 end; 575 end;
@@ -568,27 +596,25 @@ begin @@ -568,27 +596,25 @@ begin
568 FMessage.Text := Result; 596 FMessage.Text := Result;
569 end; 597 end;
570 598
  599 +procedure TConsequence.Clean;
  600 +begin
  601 + FConsequenceByPlayerID.Clear;
  602 +end;
  603 +
571 procedure TConsequence.PresentMessage; 604 procedure TConsequence.PresentMessage;
572 var 605 var
573 PopUpPos : TPoint; 606 PopUpPos : TPoint;
574 begin 607 begin
  608 + PopUpPos.X := FormMatrixGame.GBIndividualAB.Left;
575 if gscA in FStyle then 609 if gscA in FStyle then
576 - begin  
577 - PopUpPos.X := FormMatrixGame.GBIndividualAB.Left-110;  
578 - PopUpPos.Y := FormMatrixGame.GBIndividualAB.Top+FormMatrixGame.GBIndividual.Height-10;  
579 - end; 610 + PopUpPos.Y := FormMatrixGame.GBIndividualAB.Top+FormMatrixGame.GBIndividualAB.Height-20;
580 611
581 if gscB in FStyle then 612 if gscB in FStyle then
582 - begin  
583 - PopUpPos.X := FormMatrixGame.GBIndividualAB.Left+110;  
584 - PopUpPos.Y := FormMatrixGame.GBIndividualAB.Top+FormMatrixGame.GBIndividual.Height-10;  
585 - end; 613 + PopUpPos.Y := FormMatrixGame.GBIndividualAB.Top+FormMatrixGame.GBIndividualAB.Height+150;
586 614
587 if gscG in FStyle then 615 if gscG in FStyle then
588 - begin  
589 - PopUpPos.X := FormMatrixGame.GBIndividualAB.Left-110;  
590 - PopUpPos.Y := FormMatrixGame.GBIndividualAB.Top+FormMatrixGame.GBIndividual.Height+100;  
591 - end; 616 + PopUpPos.Y := FormMatrixGame.GBIndividualAB.Top+FormMatrixGame.GBIndividualAB.Height+300;
  617 +
592 PopUpPos := FormMatrixGame.ClientToScreen(PopUpPos); 618 PopUpPos := FormMatrixGame.ClientToScreen(PopUpPos);
593 FMessage.Color:=clTeal; 619 FMessage.Color:=clTeal;
594 FMessage.Title:=''; 620 FMessage.Title:='';
units/game_actors_point.pas
  Diff comments   View file @64b24cf
@@ -73,7 +73,7 @@ end; @@ -73,7 +73,7 @@ end;
73 73
74 function TGamePoint.GetResultAsString: string; 74 function TGamePoint.GetResultAsString: string;
75 begin 75 begin
76 - Result := IntToStr(FResult); 76 + Result := IntToStr(abs(FResult));
77 end; 77 end;
78 78
79 constructor TGamePoint.Create(AOwner: TComponent; AValue: integer); 79 constructor TGamePoint.Create(AOwner: TComponent; AValue: integer);
@@ -111,7 +111,7 @@ begin @@ -111,7 +111,7 @@ begin
111 case FResult of 111 case FResult of
112 -MaxInt..-2: Result += ' produziram a perda de '+Self.AsString+ ' pontos para o grupo'; 112 -MaxInt..-2: Result += ' produziram a perda de '+Self.AsString+ ' pontos para o grupo';
113 -1 : Result += ' produziram a perda de 1 ponto para o grupo'; 113 -1 : Result += ' produziram a perda de 1 ponto para o grupo';
114 - 0 : Result += ' pontos do grupo não foram produzidos nem perdidos'; 114 + 0 : Result += ' não produziram nem perderam pontos para o grupo';
115 1 : Result += ' produziram 1 ponto para o grupo'; 115 1 : Result += ' produziram 1 ponto para o grupo';
116 2..MaxInt: Result += ' produziram '+Self.AsString+' pontos para o grupo' 116 2..MaxInt: Result += ' produziram '+Self.AsString+' pontos para o grupo'
117 end; 117 end;
@@ -119,11 +119,11 @@ begin @@ -119,11 +119,11 @@ begin
119 else 119 else
120 begin 120 begin
121 case FResult of 121 case FResult of
122 - -MaxInt..-2: Result += ' produziram a perda de '+Self.AsString+ ' ' + AAppendicePlural;  
123 - -1 : Result += ' produziram a perda de 1'+ ' ' + AAppendiceSingular;  
124 - 0 : Result += ' não produziram ' + AAppendicePlural; 122 + -MaxInt..-2: Result += ' produziram a perda de ' + Self.AsString + ' ' + AAppendicePlural;
  123 + -1 : Result += ' produziram a perda de 1 ' + AAppendiceSingular;
  124 + 0 : Result += ' não produziram nem perderam ' + AAppendicePlural;
125 1 : Result += ' produziram 1 ' + AAppendiceSingular; 125 1 : Result += ' produziram 1 ' + AAppendiceSingular;
126 - 2..MaxInt: Result += ' produziram '+Self.AsString+ ' ' + AAppendicePlural; 126 + 2..MaxInt: Result += ' produziram ' + Self.AsString + ' ' + AAppendicePlural;
127 end; 127 end;
128 end; 128 end;
129 end 129 end
@@ -148,7 +148,7 @@ begin @@ -148,7 +148,7 @@ begin
148 begin 148 begin
149 case FResult of 149 case FResult of
150 -MaxInt..-2: Result += ' perdeu '+Self.AsString+ ' ' + AAppendicePlural; 150 -MaxInt..-2: Result += ' perdeu '+Self.AsString+ ' ' + AAppendicePlural;
151 - -1 : Result += ' ponto 1 ' + AAppendiceSingular; 151 + -1 : Result += ' perdeu 1 ' + AAppendiceSingular;
152 0 : Result += ' não perdeu nem ganhou ' + AAppendicePlural; 152 0 : Result += ' não perdeu nem ganhou ' + AAppendicePlural;
153 1 : Result += ' ganhou 1 ' + AAppendiceSingular; 153 1 : Result += ' ganhou 1 ' + AAppendiceSingular;
154 2..MaxInt: Result += ' ganhou '+Self.AsString+ ' ' + AAppendicePlural; 154 2..MaxInt: Result += ' ganhou '+Self.AsString+ ' ' + AAppendicePlural;
units/game_control.pas
  Diff comments   View file @64b24cf
@@ -54,10 +54,12 @@ type @@ -54,10 +54,12 @@ type
54 private 54 private
55 function AskQuestion(AQuestion:string):UTF8string; 55 function AskQuestion(AQuestion:string):UTF8string;
56 procedure ShowPopUp(AText:string); 56 procedure ShowPopUp(AText:string);
  57 + procedure ShowConsequenceMessage(AID,S:string;ForGroup:Boolean);
57 procedure DisableConfirmationButton; 58 procedure DisableConfirmationButton;
58 procedure CleanMatrix(AEnabled : Boolean); 59 procedure CleanMatrix(AEnabled : Boolean);
59 procedure EnablePlayerMatrix(AID:UTF8string; ATurn:integer; AEnabled:Boolean); 60 procedure EnablePlayerMatrix(AID:UTF8string; ATurn:integer; AEnabled:Boolean);
60 private 61 private
  62 +
61 function ShouldStartExperiment: Boolean; 63 function ShouldStartExperiment: Boolean;
62 function ShouldEndCycle : Boolean; 64 function ShouldEndCycle : Boolean;
63 function ShouldAskQuestion : Boolean; 65 function ShouldAskQuestion : Boolean;
@@ -71,7 +73,7 @@ type @@ -71,7 +73,7 @@ type
71 procedure EndExperiment(Sender: TObject); 73 procedure EndExperiment(Sender: TObject);
72 procedure StartExperiment; 74 procedure StartExperiment;
73 public 75 public
74 - constructor Create(AOwner : TComponent);override; 76 + constructor Create(AOwner : TComponent;AppPath:string);overload;
75 destructor Destroy; override; 77 destructor Destroy; override;
76 procedure SetMatrix; 78 procedure SetMatrix;
77 procedure SendRequest(ARequest : UTF8string); 79 procedure SendRequest(ARequest : UTF8string);
@@ -145,15 +147,14 @@ begin @@ -145,15 +147,14 @@ begin
145 Result := FExperiment.PlayersCount = FExperiment.Condition[FExperiment.CurrentCondition].Turn.Value; 147 Result := FExperiment.PlayersCount = FExperiment.Condition[FExperiment.CurrentCondition].Turn.Value;
146 end; 148 end;
147 149
148 -function TGameControl.ShouldEndCycle: Boolean; 150 +function TGameControl.ShouldEndCycle: Boolean; //CAUTION: MUST BE CALLED BEFORE EXPERIMENT.NEXTCYCLE
149 begin 151 begin
150 Result := FExperiment.Condition[FExperiment.CurrentCondition].Turn.Count = FExperiment.Condition[FExperiment.CurrentCondition].Turn.Value-1; 152 Result := FExperiment.Condition[FExperiment.CurrentCondition].Turn.Count = FExperiment.Condition[FExperiment.CurrentCondition].Turn.Value-1;
151 end; 153 end;
152 154
153 -function TGameControl.ShouldAskQuestion: Boolean; // end cycle, restart alias 155 +function TGameControl.ShouldAskQuestion: Boolean;
154 begin 156 begin
155 - // TODO: prompt only when an odd row was selected  
156 - Result := ShouldEndCycle and FExperiment.Condition[FExperiment.CurrentCondition].Contingencies[3].Fired; 157 + Result := Assigned(FExperiment.Condition[FExperiment.CurrentCondition].Prompt) and FExperiment.Condition[FExperiment.CurrentCondition].Contingencies[3].Fired;
157 end; 158 end;
158 159
159 procedure TGameControl.KickPlayer(AID: string); 160 procedure TGameControl.KickPlayer(AID: string);
@@ -169,24 +170,11 @@ begin @@ -169,24 +170,11 @@ begin
169 end; 170 end;
170 171
171 procedure TGameControl.NextCycle(Sender: TObject); 172 procedure TGameControl.NextCycle(Sender: TObject);
172 -var  
173 - i,  
174 - LCount : integer;  
175 - LConsequences : string;  
176 begin 173 begin
177 - // prompt question to all players  
178 FormMatrixGame.LabelExpCountCycle.Caption:=IntToStr(FExperiment.Condition[FExperiment.CurrentCondition].Cycles.Count+1); 174 FormMatrixGame.LabelExpCountCycle.Caption:=IntToStr(FExperiment.Condition[FExperiment.CurrentCondition].Cycles.Count+1);
179 {$IFDEF DEBUG} 175 {$IFDEF DEBUG}
180 WriteLn('cycle:>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>'); 176 WriteLn('cycle:>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>');
181 {$ENDIF} 177 {$ENDIF}
182 -  
183 -  
184 - //P := FExperiment.PlayerFromID[Self.ID];  
185 - LConsequences := FExperiment.ConsequenceStringFromChoices;  
186 - LCount := WordCount(LConsequences,['+']);  
187 - if LCount > 0 then  
188 - for i := 1 to LCount do  
189 - FZMQActor.SendMessage([K_CYCLES,ExtractDelimited(i,LConsequences,['+'])]); // as string generates the pts result  
190 end; 178 end;
191 179
192 procedure TGameControl.NextLineage(Sender: TObject); 180 procedure TGameControl.NextLineage(Sender: TObject);
@@ -229,7 +217,7 @@ end; @@ -229,7 +217,7 @@ end;
229 procedure TGameControl.StartExperiment; 217 procedure TGameControl.StartExperiment;
230 begin 218 begin
231 // all players arrived, lets begin 219 // all players arrived, lets begin
232 - FExperiment.State:=xsRunning; 220 + FExperiment.Play;
233 221
234 // wait some time, we just sent a message earlier 222 // wait some time, we just sent a message earlier
235 Sleep(5); 223 Sleep(5);
@@ -445,6 +433,21 @@ begin @@ -445,6 +433,21 @@ begin
445 FormMatrixGame.Timer.Enabled:=True; 433 FormMatrixGame.Timer.Enabled:=True;
446 end; 434 end;
447 435
  436 +procedure TGameControl.ShowConsequenceMessage(AID, S: string; ForGroup: Boolean);
  437 +var
  438 + LConsequence : TConsequence;
  439 +begin
  440 + LConsequence := TConsequence.Create(nil,S);
  441 + LConsequence.GenerateMessage(ForGroup);
  442 + LConsequence.PresentMessage;
  443 + if ForGroup then
  444 + LConsequence.PresentPoints
  445 + else
  446 + if Self.ID = AID then
  447 + LConsequence.PresentPoints;
  448 +
  449 +end;
  450 +
448 procedure TGameControl.DisableConfirmationButton; 451 procedure TGameControl.DisableConfirmationButton;
449 begin 452 begin
450 FormMatrixGame.StringGridMatrix.Enabled:= False; 453 FormMatrixGame.StringGridMatrix.Enabled:= False;
@@ -467,7 +470,7 @@ begin @@ -467,7 +470,7 @@ begin
467 CleanMatrix(AEnabled); 470 CleanMatrix(AEnabled);
468 end; 471 end;
469 472
470 -constructor TGameControl.Create(AOwner: TComponent); 473 +constructor TGameControl.Create(AOwner: TComponent;AppPath:string);
471 begin 474 begin
472 FZMQActor := TZMQActor(AOwner); 475 FZMQActor := TZMQActor(AOwner);
473 inherited Create(FZMQActor.Owner); 476 inherited Create(FZMQActor.Owner);
@@ -487,8 +490,11 @@ begin @@ -487,8 +490,11 @@ begin
487 RowBase:= 0; 490 RowBase:= 0;
488 MustDrawDots:=False; 491 MustDrawDots:=False;
489 MustDrawDotsClear:=False; 492 MustDrawDotsClear:=False;
490 -  
491 - FExperiment := TExperiment.Create(FZMQActor.Owner); 493 + case FActor of
  494 + gaAdmin:FExperiment := TExperiment.Create(FZMQActor.Owner,AppPath);
  495 + gaPlayer:FExperiment := TExperiment.Create(FZMQActor.Owner);
  496 + gaWatcher:FExperiment := TExperiment.Create(FZMQActor.Owner);
  497 + end;
492 FExperiment.State:=xsWaiting; 498 FExperiment.State:=xsWaiting;
493 FExperiment.OnEndTurn := @NextTurn; 499 FExperiment.OnEndTurn := @NextTurn;
494 FExperiment.OnEndCycle := @NextCycle; 500 FExperiment.OnEndCycle := @NextCycle;
@@ -633,8 +639,21 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList); @@ -633,8 +639,21 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
633 end; 639 end;
634 end; 640 end;
635 641
  642 + procedure ShowQuestion;
  643 + begin
  644 + case FActor of
  645 + gaPlayer:FZMQActor.Request([
  646 + FZMQActor.ID
  647 + , ' '
  648 + , GA_PLAYER+K_QUESTION
  649 + , AskQuestion(AMessage[1])
  650 + ]);
  651 + end;
  652 + end;
  653 +
636 procedure ReceiveChoice; 654 procedure ReceiveChoice;
637 - var P : TPlayer; 655 + var
  656 + P : TPlayer;
638 begin 657 begin
639 P := FExperiment.PlayerFromID[AMessage[1]]; 658 P := FExperiment.PlayerFromID[AMessage[1]];
640 659
@@ -648,6 +667,8 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList); @@ -648,6 +667,8 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
648 667
649 case FActor of 668 case FActor of
650 gaPlayer:begin 669 gaPlayer:begin
  670 +
  671 + // last turn// end cycle
651 if P.Turn = FExperiment.PlayersCount-1 then 672 if P.Turn = FExperiment.PlayersCount-1 then
652 begin 673 begin
653 // update next turn 674 // update next turn
@@ -657,16 +678,20 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList); @@ -657,16 +678,20 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
657 FExperiment.Player[Self.ID] := P; 678 FExperiment.Player[Self.ID] := P;
658 end; 679 end;
659 680
660 - //CleanMatrix;  
661 CleanMatrix(False); 681 CleanMatrix(False);
662 682
  683 +
663 // no wait turns 684 // no wait turns
664 - EnablePlayerMatrix(Self.ID,0, True); 685 + // if should continue then
  686 + //if StrToBool(AMessage[6]) then
  687 + //EnablePlayerMatrix(Self.ID,0, True)
  688 +
665 689
666 // wait for server 690 // wait for server
667 Exit; 691 Exit;
668 end; 692 end;
669 693
  694 + // else
670 if Self.ID = P.ID then 695 if Self.ID = P.ID then
671 begin 696 begin
672 // update confirmation button 697 // update confirmation button
@@ -697,20 +722,21 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList); @@ -697,20 +722,21 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
697 end; 722 end;
698 end; 723 end;
699 724
700 - procedure OnEndCycle;  
701 - var  
702 - LConsequence : TConsequence;  
703 - begin  
704 - case FActor of  
705 - gaPlayer:  
706 - begin  
707 - LConsequence := TConsequence.Create(nil,AMessage[1]);  
708 - LConsequence.GenerateMessage(True);  
709 - LConsequence.PresentPoints;  
710 - LConsequence.PresentMessage;  
711 - end;  
712 - end;  
713 - end; 725 + //procedure OnEndCycle;
  726 + //var
  727 + // LConsequence : TConsequence;
  728 + //begin
  729 + // case FActor of
  730 + // gaPlayer:
  731 + // begin
  732 + // LConsequence := TConsequence.Create(nil,AMessage[1]);
  733 + // LConsequence.GenerateMessage(True);
  734 + //
  735 + // LConsequence.PresentPoints;
  736 + // LConsequence.PresentMessage;
  737 + // end;
  738 + // end;
  739 + //end;
714 740
715 procedure ReceiveChat; 741 procedure ReceiveChat;
716 begin 742 begin
@@ -736,80 +762,55 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList); @@ -736,80 +762,55 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
736 end; 762 end;
737 end; 763 end;
738 764
739 - procedure ShowQuestion; 765 + procedure QuestionMessages;
  766 + var
  767 + i : integer;
  768 + MID : string;
740 begin 769 begin
741 case FActor of 770 case FActor of
742 - gaPlayer:FZMQActor.Request([  
743 - FZMQActor.ID  
744 - , ' '  
745 - , GA_PLAYER+K_QUESTION  
746 - , AskQuestion(AMessage[1])  
747 - ]); 771 + gaPlayer:begin
  772 + if AMessage.Count > 1 then
  773 + begin
  774 + for i := 1 to AMessage.Count -1 do
  775 + begin
  776 + MID := ExtractDelimited(1,AMessage[i],['+']);
  777 + ShowConsequenceMessage(MID, ExtractDelimited(2,AMessage[i],['+']),MID = 'M');
  778 +
  779 + {$IFDEF DEBUG}
  780 + WriteLn('A Prompt consequence should have shown.');
  781 + {$ENDIF}
  782 + end;
  783 + end;
  784 + EnablePlayerMatrix(Self.ID,0, True);
  785 + WriteLn('>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>');
  786 + end;
748 end; 787 end;
749 end; 788 end;
750 -//  
751 -// procedure ResumeActor;  
752 -// begin  
753 -// case FActor of  
754 -// gaPlayer:begin  
755 -//  
756 -// end;  
757 -// gaAdmin:begin  
758 -//  
759 -// end;  
760 -// end;  
761 -// end;  
762 -  
763 -  
764 - //procedure QuestionMessages;  
765 - //var  
766 - // LConsequence : TConsequence;  
767 - // i : integer;  
768 - // MID : string;  
769 - //begin  
770 - // case FActor of  
771 - // // AMessage[i] :=  
772 - // // S + '+' +  
773 - // // IntToStr(Pts) +'|'+  
774 - // // GetConsequenceStylesString(LCsqStyle) +'|'+  
775 - // // ExtractDelimited(3,LConsequence, ['|']) +'|'+  
776 - // // ExtractDelimited(4,LConsequence, ['|']) +'|'+  
777 - // // ExtractDelimited(5,LConsequence, ['|']);  
778 - // gaPlayer:begin  
779 - // if AMessage.Count > 1 then  
780 - // begin  
781 - // for i := 1 to AMessage.Count -1 do  
782 - // begin  
783 - // MID := ExtractDelimited(1,AMessage[i],['+']);  
784 - // if (MID = 'M') or (MID = Self.ID) then  
785 - // begin  
786 - // LConsequence := TConsequence.Create(FormMatrixGame,ExtractDelimited(2,AMessage[i],['+']));  
787 - // //LConsequence.PlayerNicname := P.Nicname;  
788 - // ShowPopUp(LConsequence.PointMessage(MID = 'M'));  
789 - // while FormMatrixGame.PopupNotifier.Visible do  
790 - // Application.ProcessMessages; 789 +
  790 +
  791 + // procedure ResumeActor;
  792 + // begin
  793 + // case FActor of
  794 + // gaPlayer:begin
791 // 795 //
792 - // {$IFDEF DEBUG}  
793 - // WriteLn('A consequence should have shown.');  
794 - // {$ENDIF}  
795 - // end;  
796 - // end;  
797 - // end; 796 + // end;
  797 + // gaAdmin:begin
  798 + //
  799 + // end;
798 // end; 800 // end;
799 // end; 801 // end;
800 - //end;  
801 -  
802 802
803 begin 803 begin
804 if MHas(K_ARRIVED) then ReceiveActor; 804 if MHas(K_ARRIVED) then ReceiveActor;
805 if MHas(K_CHAT_M) then ReceiveChat; 805 if MHas(K_CHAT_M) then ReceiveChat;
806 if MHas(K_CHOICE) then ReceiveChoice; 806 if MHas(K_CHOICE) then ReceiveChoice;
807 - if MHas(K_MESSAGE) then ShowPopUp(AMessage[1]); 807 + if MHas(K_MESSAGE) then ShowConsequenceMessage(AMessage[1],AMessage[2],StrToBool(AMessage[3]));
808 if MHas(K_KICK) then SayGoodBye; 808 if MHas(K_KICK) then SayGoodBye;
809 if MHas(K_START) then NotifyPlayers; 809 if MHas(K_START) then NotifyPlayers;
810 - if MHas(K_CYCLES) then OnEndCycle;  
811 - //if MHas(K_QUESTION) then ShowQuestion;  
812 - //if MHas(K_QMESSAGE) then QuestionMessages; 810 + if MHas(K_QUESTION) then ShowQuestion;
  811 + if MHAS(K_RESUME) then EnablePlayerMatrix(Self.ID,0, True);
  812 + //if MHas(K_CYCLES) then OnEndCycle;
  813 + if MHas(K_QMESSAGE) then QuestionMessages;
813 end; 814 end;
814 815
815 // Here FActor is garanted to be a TZMQAdmin 816 // Here FActor is garanted to be a TZMQAdmin
@@ -900,11 +901,14 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList); @@ -900,11 +901,14 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList);
900 end; 901 end;
901 902
902 procedure ValidateChoice; 903 procedure ValidateChoice;
903 - var P : TPlayer;  
904 - S : string; 904 + var
  905 + LConsequences : string;
  906 + P : TPlayer;
  907 + S : string;
  908 + LEndCycle : Boolean;
905 begin 909 begin
906 {$IFDEF DEBUG} 910 {$IFDEF DEBUG}
907 - WriteLn('Count:>>>>>>>>>>>>>>>>>>>>>>>>>>>',FExperiment.Condition[FExperiment.CurrentCondition].Turn.Count, '<', FExperiment.Condition[FExperiment.CurrentCondition].Turn.Value); 911 + WriteLn('Count:',FExperiment.Condition[FExperiment.CurrentCondition].Turn.Count, '<', FExperiment.Condition[FExperiment.CurrentCondition].Turn.Value);
908 {$ENDIF} 912 {$ENDIF}
909 P := FExperiment.PlayerFromID[ARequest[0]]; 913 P := FExperiment.PlayerFromID[ARequest[0]];
910 P.Choice.Row:= GetRowFromString(ARequest[3]); // row 914 P.Choice.Row:= GetRowFromString(ARequest[3]); // row
@@ -919,65 +923,70 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList); @@ -919,65 +923,70 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList);
919 923
920 if Pos('$NICNAME',S) > 0 then 924 if Pos('$NICNAME',S) > 0 then
921 S := ReplaceStr(S,'$NICNAME',P.Nicname); 925 S := ReplaceStr(S,'$NICNAME',P.Nicname);
922 - ARequest.Append(S);  
923 926
924 // update turn 927 // update turn
  928 + LEndCycle:=ShouldEndCycle;
925 P.Turn := FExperiment.NextTurn; 929 P.Turn := FExperiment.NextTurn;
926 FExperiment.Player[P.ID] := P; 930 FExperiment.Player[P.ID] := P;
927 931
928 - // broadcast choice  
929 - FZMQActor.SendMessage([K_CHOICE,P.ID,ARequest[3],ARequest[4],IntToStr(P.Turn)]);  
930 -  
931 - if ShouldEndCycle then 932 + // append results
  933 + ARequest.Append(IntToStr(P.Turn));
  934 + ARequest.Append(S);
  935 + if LEndCycle then
932 begin 936 begin
933 - while FormMatrixGame.PopupNotifier.Visible do  
934 - Application.ProcessMessages;  
935 -  
936 - //if ShouldAskQuestion then // TODO: prompt only when an odd row was selected  
937 - // begin  
938 - // P.Turn := 0;  
939 - // FZMQActor.SendMessage([K_QUESTION,FExperiment.Condition[FExperiment.CurrentCondition].Prompt.Question]);  
940 - // end; 937 + LConsequences := FExperiment.ConsequenceStringFromChoices;// AsString generates the pts result
  938 + ARequest.Append(LConsequences);
  939 +
  940 + if ShouldAskQuestion then // TODO: prompt only when an odd row was selected
  941 + ARequest.Append(FExperiment.Condition[FExperiment.CurrentCondition].Prompt.Question)
  942 + else
  943 + FExperiment.Clean;
941 end; 944 end;
942 end; 945 end;
943 946
944 - //procedure ValidateQuestionResponse;  
945 - //var  
946 - // P : TPlayer;  
947 - // M : array of UTF8string;  
948 - // i : integer;  
949 - // LPromptConsequences : TStringList;  
950 - //begin  
951 - // P := FExperiment.PlayerFromID[ARequest[0]];  
952 - // ARequest[2] := K_QUESTION+K_ARRIVED;  
953 - //  
954 - // // append response of each player  
955 - // FExperiment.Condition[FExperiment.CurrentCondition].Prompt.AppendResponse(P.ID,ARequest[3]);  
956 - //  
957 - // // return to experiment and present the prompt consequence, if any  
958 - // if FExperiment.Condition[FExperiment.CurrentCondition].Prompt.ResponsesCount = Experiment.PlayersCount then  
959 - // begin  
960 - // // M setup  
961 - //  
962 - //  
963 - // // generate messages  
964 - // LPromptConsequences := FExperiment.Condition[FExperiment.CurrentCondition].Prompt.AsString;  
965 - // if LPromptConsequences.Count > 0 then  
966 - // begin  
967 - // SetLength(M, 1+LPromptConsequences.Count);  
968 - // M[0] := GA_ADMIN+K_QUESTION+K_QMESSAGE;  
969 - // for i := 0 to LPromptConsequences.Count -1 do  
970 - // M[i+1] := LPromptConsequences[i]  
971 - // end;  
972 - //  
973 - // // send identified messages; each player takes only its own message and ignore the rest  
974 - // FZMQActor.SendMessage(M);  
975 - // end;  
976 - //end; 947 + procedure ValidateQuestionResponse;
  948 + var
  949 + P : TPlayer;
  950 + M : array of UTF8string;
  951 + i : integer;
  952 + LPromptConsequences : TStringList;
  953 + begin
  954 + P := FExperiment.PlayerFromID[ARequest[0]];
  955 + ARequest[2] := K_QUESTION+K_ARRIVED;
  956 +
  957 + // append response of each player
  958 + FExperiment.Condition[FExperiment.CurrentCondition].Prompt.AppendResponse(P.ID,ARequest[3]);
  959 +
  960 + // return to experiment and present the prompt consequence, if any
  961 + if FExperiment.Condition[FExperiment.CurrentCondition].Prompt.ResponsesCount = FExperiment.PlayersCount then
  962 + begin
  963 +
  964 + // generate messages
  965 + LPromptConsequences := FExperiment.Condition[FExperiment.CurrentCondition].Prompt.AsString;
  966 + SetLength(M, 1+LPromptConsequences.Count);
  967 + M[0] := K_QMESSAGE;
  968 + if LPromptConsequences.Count > 0 then
  969 + begin
  970 + for i := 0 to LPromptConsequences.Count-1 do
  971 + if Pos('$NICNAME',LPromptConsequences[i]) > 0 then
  972 + begin
  973 + P := FExperiment.PlayerFromID[ExtractDelimited(1,LPromptConsequences[i],['+'])];
  974 + LPromptConsequences[i] := ReplaceStr(LPromptConsequences[i],'$NICNAME', P.Nicname);
  975 + end;
  976 + for i := 0 to LPromptConsequences.Count -1 do
  977 + M[i+1] := LPromptConsequences[i];
  978 + end
  979 + else;
  980 +
  981 + // send identified messages; each player takes only its own message and ignore the rest
  982 + FZMQActor.SendMessage(M);
  983 + FExperiment.Clean;
  984 + end;
  985 + end;
977 begin 986 begin
978 if MHas(K_LOGIN) then ReplyLoginRequest; 987 if MHas(K_LOGIN) then ReplyLoginRequest;
979 if MHas(K_CHOICE) then ValidateChoice; 988 if MHas(K_CHOICE) then ValidateChoice;
980 - //if MHas(K_QUESTION) then ValidateQuestionResponse; 989 + if MHas(K_QUESTION) then ValidateQuestionResponse;
981 end; 990 end;
982 991
983 // Here FActor is garanted to be a TZMQPlayer, reply by: 992 // Here FActor is garanted to be a TZMQPlayer, reply by:
@@ -1020,31 +1029,56 @@ procedure TGameControl.ReceiveReply(AReply: TStringList); @@ -1020,31 +1029,56 @@ procedure TGameControl.ReceiveReply(AReply: TStringList);
1020 LConsequence : TConsequence; 1029 LConsequence : TConsequence;
1021 LCount, 1030 LCount,
1022 i : integer; 1031 i : integer;
1023 - M : string;  
1024 //P : TPlayer; 1032 //P : TPlayer;
1025 begin 1033 begin
1026 if Self.ID = AReply[0] then 1034 if Self.ID = AReply[0] then
1027 begin 1035 begin
1028 //P := FExperiment.PlayerFromID[Self.ID]; 1036 //P := FExperiment.PlayerFromID[Self.ID];
1029 - LCount := WordCount(AReply[5],['+']);  
1030 {$IFDEF DEBUG} 1037 {$IFDEF DEBUG}
1031 WriteLn('LCount:',LCount); 1038 WriteLn('LCount:',LCount);
1032 {$ENDIF} 1039 {$ENDIF}
  1040 + FZMQActor.SendMessage([K_CHOICE,AReply[0],AReply[3],AReply[4],AReply[5]]);
  1041 +
  1042 + LCount := WordCount(AReply[6],['+']);
1033 if LCount > 0 then 1043 if LCount > 0 then
1034 for i := 1 to LCount do 1044 for i := 1 to LCount do
1035 begin 1045 begin
1036 - LConsequence := TConsequence.Create(nil,ExtractDelimited(i,AReply[5],['+']));  
1037 - M := LConsequence.GenerateMessage(False); 1046 + LConsequence := TConsequence.Create(nil,ExtractDelimited(i,AReply[6],['+']));
  1047 + LConsequence.GenerateMessage(False);
1038 if LConsequence.ShouldPublishMessage then 1048 if LConsequence.ShouldPublishMessage then
1039 - FZMQActor.SendMessage([K_MESSAGE,M]) 1049 + FZMQActor.SendMessage([K_MESSAGE,Self.ID,ExtractDelimited(i,AReply[6],['+']),BoolToStr(False)])
1040 else 1050 else
1041 - LConsequence.PresentMessage;  
1042 - LConsequence.PresentPoints; 1051 + begin
  1052 + LConsequence.PresentMessage;
  1053 + LConsequence.PresentPoints;
  1054 + end;
1043 {$IFDEF DEBUG} 1055 {$IFDEF DEBUG}
1044 WriteLn('A consequence should have shown.'); 1056 WriteLn('A consequence should have shown.');
1045 {$ENDIF} 1057 {$ENDIF}
  1058 + //Sleep(1000);
1046 end; 1059 end;
1047 1060
  1061 + if AReply.Count > 7 then
  1062 + begin
  1063 + LCount := WordCount(AReply[7],['+']);
  1064 + if LCount > 0 then
  1065 + for i := 1 to LCount do
  1066 + begin
  1067 + LConsequence := TConsequence.Create(nil,ExtractDelimited(i,AReply[7],['+']));
  1068 + LConsequence.GenerateMessage(True);
  1069 + FZMQActor.SendMessage([K_MESSAGE,'',ExtractDelimited(i,AReply[7],['+']),BoolToStr(True)]);
  1070 +
  1071 + {$IFDEF DEBUG}
  1072 + WriteLn('A metaconsequence should have shown.');
  1073 + {$ENDIF}
  1074 + //Sleep(1000);
  1075 + end;
  1076 +
  1077 + if AReply.Count > 8 then
  1078 + FZMQActor.SendMessage([K_QUESTION,AReply[8]])
  1079 + else
  1080 + FZMQActor.SendMessage([K_RESUME]);
  1081 + end;
1048 end; 1082 end;
1049 end; 1083 end;
1050 1084
@@ -1053,13 +1087,13 @@ procedure TGameControl.ReceiveReply(AReply: TStringList); @@ -1053,13 +1087,13 @@ procedure TGameControl.ReceiveReply(AReply: TStringList);
1053 // // wait 1087 // // wait
1054 //end; 1088 //end;
1055 1089
1056 - procedure ResumePlayer;  
1057 - begin  
1058 -  
1059 - end; 1090 + //procedure ResumePlayer;
  1091 + //begin
  1092 + //
  1093 + //end;
1060 1094
1061 begin 1095 begin
1062 - if MHas(K_RESUME+K_ARRIVED) then ResumePlayer; 1096 + //if MHas(K_RESUME+K_ARRIVED) then ResumePlayer;
1063 if MHas(K_LOGIN+K_ARRIVED) then LoginAccepted; 1097 if MHas(K_LOGIN+K_ARRIVED) then LoginAccepted;
1064 if MHas(K_CHOICE+K_ARRIVED) then ChoiceValidated; 1098 if MHas(K_CHOICE+K_ARRIVED) then ChoiceValidated;
1065 //if MHas(K_QUESTION+K_ARRIVED) then QuestionValidated; 1099 //if MHas(K_QUESTION+K_ARRIVED) then QuestionValidated;
units/game_experiment.pas
  Diff comments   View file @64b24cf
@@ -30,28 +30,23 @@ type @@ -30,28 +30,23 @@ type
30 30
31 TExperiment = class(TComponent) 31 TExperiment = class(TComponent)
32 private 32 private
33 - FExperimentStart : Boolean;  
34 FExperimentAim, 33 FExperimentAim,
35 FExperimentName, 34 FExperimentName,
36 FFilename, 35 FFilename,
37 - FResearcher : UTF8string;  
38 - FOnConsequence: TNotifyEvent;  
39 - FOnInterlocking: TNotifyEvent;  
40 - FOnEndTurn: TNotifyEvent;  
41 - FOnEndCondition: TNotifyEvent;  
42 - FOnEndCycle: TNotifyEvent;  
43 - FOnEndExperiment: TNotifyEvent;  
44 - FOnEndGeneration: TNotifyEvent;  
45 - FMatrixType: TGameMatrixType;  
46 - FRegData : TRegData; 36 + FResearcher : string;
  37 + FExperimentStart : Boolean;
47 FGenPlayersAsNeeded : Boolean; 38 FGenPlayersAsNeeded : Boolean;
48 - FPlayers : TPlayers;  
49 - FCurrentCondition : integer;  
50 - FConditions : TConditions;  
51 FResearcherCanChat: Boolean; 39 FResearcherCanChat: Boolean;
52 FResearcherCanPlay: Boolean; 40 FResearcherCanPlay: Boolean;
53 FSendChatHistoryForNewPlayers: Boolean; 41 FSendChatHistoryForNewPlayers: Boolean;
54 FShowChat: Boolean; 42 FShowChat: Boolean;
  43 + FMatrixType: TGameMatrixType;
  44 + private
  45 + FLastReportColNames : string;
  46 + FRegData : TRegData;
  47 + FPlayers : TPlayers;
  48 + FCurrentCondition : integer;
  49 + FConditions : TConditions;
55 FState: TExperimentState; 50 FState: TExperimentState;
56 FTurnsRandom : TStringList; 51 FTurnsRandom : TStringList;
57 function GetCondition(I : Integer): TCondition; 52 function GetCondition(I : Integer): TCondition;
@@ -90,36 +85,50 @@ type @@ -90,36 +85,50 @@ type
90 procedure SetSendChatHistoryForNewPlayers(AValue: Boolean); 85 procedure SetSendChatHistoryForNewPlayers(AValue: Boolean);
91 procedure SetState(AValue: TExperimentState); 86 procedure SetState(AValue: TExperimentState);
92 private 87 private
  88 + FOnConsequence: TNotifyEvent;
  89 + FOnInterlocking: TNotifyEvent;
  90 + FOnEndTurn: TNotifyEvent;
  91 + FOnEndCondition: TNotifyEvent;
  92 + FOnEndCycle: TNotifyEvent;
  93 + FOnEndExperiment: TNotifyEvent;
  94 + FOnEndGeneration: TNotifyEvent;
93 procedure Consequence(Sender : TObject); 95 procedure Consequence(Sender : TObject);
94 procedure Interlocking(Sender : TObject); 96 procedure Interlocking(Sender : TObject);
  97 + procedure WriteReportHeader;
  98 + procedure WriteReportRowNames;
  99 + procedure WriteReportRow;
95 public 100 public
96 constructor Create(AOwner:TComponent);override; 101 constructor Create(AOwner:TComponent);override;
97 - constructor Create(AFilename: string; AOwner:TComponent); overload; 102 + constructor Create(AOwner:TComponent; AppPath:string);overload;
  103 + constructor Create(AOwner:TComponent; AFilename, AppPath:string); overload;
98 destructor Destroy; override; 104 destructor Destroy; override;
99 function LoadFromFile(AFilename: string):Boolean; 105 function LoadFromFile(AFilename: string):Boolean;
100 function LoadFromGenerator:Boolean; 106 function LoadFromGenerator:Boolean;
101 - function AppendCondition : integer; overload;  
102 - function AppendCondition(ACondition : TCondition) : integer;overload;  
103 - function AppendContingency(ACondition : integer) : integer;overload;  
104 - function AppendContingency(ACondition : integer;AContingency : TContingency) : integer;overload;  
105 - function AppendPlayer : integer;overload;  
106 - function AppendPlayer(APlayer : TPlayer) : integer; overload;  
107 procedure SaveToFile(AFilename: string); overload; 107 procedure SaveToFile(AFilename: string); overload;
108 procedure SaveToFile; overload; 108 procedure SaveToFile; overload;
109 procedure Clean; 109 procedure Clean;
110 procedure Play; 110 procedure Play;
  111 + property ExperimentAim : string read FExperimentAim write FExperimentAim;
  112 + property ExperimentName : string read FExperimentName write FExperimentName;
  113 + property GenPlayersAsNeeded : Boolean read FGenPlayersAsNeeded write FGenPlayersAsNeeded;
111 property ResearcherCanPlay : Boolean read FResearcherCanPlay write SetResearcherCanPlay; 114 property ResearcherCanPlay : Boolean read FResearcherCanPlay write SetResearcherCanPlay;
112 property ResearcherCanChat : Boolean read FResearcherCanChat write SetResearcherCanChat; 115 property ResearcherCanChat : Boolean read FResearcherCanChat write SetResearcherCanChat;
113 - property Researcher : UTF8string read FResearcher write FResearcher; 116 + property Researcher : string read FResearcher write FResearcher;
  117 + property ShowChat : Boolean read FShowChat write FShowChat;
  118 + property SendChatHistoryForNewPlayers : Boolean read FSendChatHistoryForNewPlayers write SetSendChatHistoryForNewPlayers;
  119 + property MatrixType : TGameMatrixType read FMatrixType write SetMatrixType;
  120 + public
  121 + function AppendCondition : integer; overload;
  122 + function AppendCondition(ACondition : TCondition) : integer;overload;
  123 + function AppendContingency(ACondition : integer) : integer;overload;
  124 + function AppendContingency(ACondition : integer;AContingency : TContingency) : integer;overload;
  125 + function AppendPlayer : integer;overload;
  126 + function AppendPlayer(APlayer : TPlayer) : integer; overload;
114 property Condition[I : Integer]: TCondition read GetCondition write SetCondition; 127 property Condition[I : Integer]: TCondition read GetCondition write SetCondition;
115 property ConditionsCount : integer read GetConditionsCount; 128 property ConditionsCount : integer read GetConditionsCount;
116 property CurrentCondition : integer read FCurrentCondition write FCurrentCondition; 129 property CurrentCondition : integer read FCurrentCondition write FCurrentCondition;
117 property Contingency[C, I : integer] : TContingency read GetContingency write SetContingency; 130 property Contingency[C, I : integer] : TContingency read GetContingency write SetContingency;
118 property ContingenciesCount[C:integer]:integer read GetContingenciesCount; 131 property ContingenciesCount[C:integer]:integer read GetContingenciesCount;
119 - property ExperimentAim : UTF8string read FExperimentAim write FExperimentAim;  
120 - property ExperimentName : UTF8string read FExperimentName write FExperimentName;  
121 - property GenPlayersAsNeeded : Boolean read FGenPlayersAsNeeded write FGenPlayersAsNeeded;  
122 - property InterlockingsIn[i:integer]:integer read GetInterlockingsIn;  
123 property Player[I : integer] : TPlayer read GetPlayer write SetPlayer; 132 property Player[I : integer] : TPlayer read GetPlayer write SetPlayer;
124 property PlayerFromID[S : UTF8string ] : TPlayer read GetPlayer write SetPlayer; 133 property PlayerFromID[S : UTF8string ] : TPlayer read GetPlayer write SetPlayer;
125 property PlayersCount : integer read GetPlayersCount; 134 property PlayersCount : integer read GetPlayersCount;
@@ -127,11 +136,10 @@ type @@ -127,11 +136,10 @@ type
127 property PlayerIndexFromID[s : UTF8string]: integer read GetPlayerIndexFromID; 136 property PlayerIndexFromID[s : UTF8string]: integer read GetPlayerIndexFromID;
128 property PlayerAsString[P:TPlayer]: UTF8string read AliasPlayerAsString; 137 property PlayerAsString[P:TPlayer]: UTF8string read AliasPlayerAsString;
129 property PlayerFromString[s : UTF8string]: TPlayer read AliasPlayerFromString; 138 property PlayerFromString[s : UTF8string]: TPlayer read AliasPlayerFromString;
  139 + public
  140 + property InterlockingsIn[i:integer]:integer read GetInterlockingsIn;
130 property ConsequenceStringFromChoice[P:Tplayer]:UTF8String read GetConsequenceStringFromChoice; 141 property ConsequenceStringFromChoice[P:Tplayer]:UTF8String read GetConsequenceStringFromChoice;
131 property ConsequenceStringFromChoices: UTF8String read GetConsequenceStringFromChoices; 142 property ConsequenceStringFromChoices: UTF8String read GetConsequenceStringFromChoices;
132 - property ShowChat : Boolean read FShowChat write FShowChat;  
133 - property SendChatHistoryForNewPlayers : Boolean read FSendChatHistoryForNewPlayers write SetSendChatHistoryForNewPlayers;  
134 - property MatrixType : TGameMatrixType read FMatrixType write SetMatrixType;  
135 property NextTurnPlayerID : UTF8string read GetNextTurnPlayerID; 143 property NextTurnPlayerID : UTF8string read GetNextTurnPlayerID;
136 property NextTurn : integer read GetNextTurn; 144 property NextTurn : integer read GetNextTurn;
137 property NextCycle : integer read GetNextCycle; 145 property NextCycle : integer read GetNextCycle;
@@ -143,7 +151,6 @@ type @@ -143,7 +151,6 @@ type
143 property OnEndGeneration : TNotifyEvent read FOnEndGeneration write SetOnEndGeneration; 151 property OnEndGeneration : TNotifyEvent read FOnEndGeneration write SetOnEndGeneration;
144 property OnEndCondition : TNotifyEvent read FOnEndCondition write SetOnEndCondition; 152 property OnEndCondition : TNotifyEvent read FOnEndCondition write SetOnEndCondition;
145 property OnEndExperiment : TNotifyEvent read FOnEndExperiment write SetOnEndExperiment; 153 property OnEndExperiment : TNotifyEvent read FOnEndExperiment write SetOnEndExperiment;
146 - public  
147 property OnConsequence : TNotifyEvent read FOnConsequence write SetOnConsequence; 154 property OnConsequence : TNotifyEvent read FOnConsequence write SetOnConsequence;
148 property OnInterlocking : TNotifyEvent read FOnInterlocking write SetOnInterlocking; 155 property OnInterlocking : TNotifyEvent read FOnInterlocking write SetOnInterlocking;
149 end; 156 end;
@@ -489,6 +496,96 @@ begin @@ -489,6 +496,96 @@ begin
489 if Assigned(FOnInterlocking) then FOnInterlocking(Sender); 496 if Assigned(FOnInterlocking) then FOnInterlocking(Sender);
490 end; 497 end;
491 498
  499 +procedure TExperiment.WriteReportHeader;
  500 +var
  501 + LHeader : string;
  502 +begin
  503 + // header
  504 + LHeader := VAL_RESEARCHER+':'+#9+FResearcher + LineEnding +
  505 + VAL_EXPERIMENT+':' + #9 + FExperimentName + LineEnding +
  506 + VAL_BEGIN_TIME+':' + #9 + DateTimeToStr(Date) + #9 + TimeToStr(Time) + LineEnding + LineEnding;
  507 + FRegData.SaveData(LHeader);
  508 + WriteReportRowNames;
  509 +end;
  510 +
  511 +procedure TExperiment.WriteReportRowNames;
  512 +var
  513 + c,j,i: integer;
  514 + LHeader : string;
  515 +begin
  516 + c:= CurrentCondition;
  517 + // column names, line 1
  518 + LHeader := 'Experimento'+#9+#9;
  519 + for i:=0 to Condition[c].Turn.Value-1 do // player's response
  520 + LHeader += 'P'+IntToStr(i+1)+#9+#9;
  521 +
  522 + for i:=0 to ContingenciesCount[c]-1 do
  523 + if not Contingency[c,i].Meta then
  524 + begin
  525 + LHeader += Contingency[c,i].ContingencyName;
  526 + for j:=0 to Condition[c].Turn.Value-1 do
  527 + LHeader += #9;
  528 + end;
  529 +
  530 + LHeader += VAL_INTERLOCKING+'s';
  531 + for i:=0 to ContingenciesCount[c]-1 do
  532 + if Contingency[c,i].Meta then
  533 + LHeader += #9;
  534 +
  535 + LHeader += LineEnding;
  536 +
  537 +
  538 + // column names, line 2
  539 + LHeader += 'Condição'+#9+'Ciclo'+#9;
  540 + for i:=0 to Condition[c].Turn.Value-1 do
  541 + LHeader += 'Linha'+#9+'Cor'+#9;
  542 +
  543 + for i:=0 to ContingenciesCount[c]-1 do
  544 + if not Contingency[c,i].Meta then
  545 + for j:=0 to Condition[c].Turn.Value-1 do
  546 + LHeader += 'P'+IntToStr(j+1)+#9;
  547 +
  548 + for i:=0 to ContingenciesCount[c]-1 do
  549 + if Contingency[c,i].Meta then
  550 + LHeader += Contingency[c,i].ContingencyName+#9;
  551 + LHeader += LineEnding;
  552 +
  553 + FLastReportColNames := LHeader;
  554 + FRegData.SaveData(LHeader);
  555 +end;
  556 +
  557 +procedure TExperiment.WriteReportRow;
  558 +var
  559 + c,j,i: integer;
  560 + LHeader : string;
  561 +begin
  562 + c:= CurrentCondition;
  563 +
  564 + LHeader := IntToStr(c+1)+#9+IntToStr(Condition[c].Cycles.Count+1)+#9;
  565 + for i:=0 to Condition[c].Turn.Value-1 do
  566 + LHeader += GetRowString(FPlayers[i].Choice.Row)+#9+GetColorString(FPlayers[i].Choice.Color)+#9;
  567 +
  568 + for i:=0 to ContingenciesCount[c]-1 do
  569 + if not Contingency[c,i].Meta then
  570 + for j:=0 to Condition[c].Turn.Value-1 do
  571 + if Contingency[c,i].ConsequenceFromPlayerID(FPlayers[j].ID) <> '' then
  572 + LHeader += '1'+#9
  573 + else
  574 + LHeader += '0'+#9;
  575 +
  576 + for i:=0 to ContingenciesCount[c]-1 do
  577 + if Contingency[c,i].Meta then
  578 + if Contingency[c,i].Fired then
  579 + LHeader += '1'+#9
  580 + else
  581 + LHeader += '0'+#9;
  582 + LHeader += LineEnding;
  583 +
  584 + FLastReportColNames := LHeader;
  585 + FRegData.SaveData(LHeader);
  586 +
  587 +end;
  588 +
492 constructor TExperiment.Create(AOwner: TComponent); 589 constructor TExperiment.Create(AOwner: TComponent);
493 begin 590 begin
494 inherited Create(AOwner); 591 inherited Create(AOwner);
@@ -497,7 +594,17 @@ begin @@ -497,7 +594,17 @@ begin
497 CheckNeedForRandomTurns; 594 CheckNeedForRandomTurns;
498 end; 595 end;
499 596
500 -constructor TExperiment.Create(AFilename: string;AOwner:TComponent); 597 +constructor TExperiment.Create(AOwner: TComponent;AppPath:string);
  598 +begin
  599 + inherited Create(AOwner);
  600 + FTurnsRandom := TStringList.Create;
  601 + LoadExperimentFromResource(Self);
  602 + CheckNeedForRandomTurns;
  603 + FRegData := TRegData.Create(Self, AppPath+VAL_RESEARCHER+'es'+PathDelim+Researcher+PathDelim+ExperimentName+PathDelim+'000.dat');
  604 + WriteReportHeader;
  605 +end;
  606 +
  607 +constructor TExperiment.Create(AOwner:TComponent;AFilename,AppPath:string);
501 begin 608 begin
502 inherited Create(AOwner); 609 inherited Create(AOwner);
503 FTurnsRandom := TStringList.Create; 610 FTurnsRandom := TStringList.Create;
@@ -583,13 +690,31 @@ begin @@ -583,13 +690,31 @@ begin
583 end; 690 end;
584 691
585 procedure TExperiment.Clean; 692 procedure TExperiment.Clean;
  693 +var c,i : integer;
586 begin 694 begin
  695 + WriteReportRow;
  696 + for i := 0 to PlayersCount -1 do
  697 + begin
  698 + FPlayers[i].Choice.Row:=grNone;
  699 + FPlayers[i].Choice.Color:=gcNone;
  700 + end;
  701 + c := CurrentCondition;
  702 + for i := 0 to ContingenciesCount[c]-1 do
  703 + Contingency[c,i].Clean;
  704 +
  705 + Condition[c].Prompt.Clean;
587 706
  707 + FRegData.CloseAndOpen;
588 end; 708 end;
589 709
590 procedure TExperiment.Play; 710 procedure TExperiment.Play;
  711 +var i : integer;
591 begin 712 begin
592 - 713 + for i := 0 to Condition[CurrentCondition].Turn.Value-1 do
  714 + begin
  715 + //TRegData.Save Header;
  716 + end;
  717 + FState:=xsRunning;
593 end; 718 end;
594 719
595 end. 720 end.
units/game_file_methods.pas
  Diff comments   View file @64b24cf
@@ -76,7 +76,7 @@ begin @@ -76,7 +76,7 @@ begin
76 ResearcherCanPlay:=False; 76 ResearcherCanPlay:=False;
77 ResearcherCanChat:=True; 77 ResearcherCanChat:=True;
78 SendChatHistoryForNewPlayers:=True; 78 SendChatHistoryForNewPlayers:=True;
79 - ExperimentName:='Test Experiment'; 79 + ExperimentName:='test_experiment';
80 ExperimentAim:='This is a test experiment.'; 80 ExperimentAim:='This is a test experiment.';
81 GenPlayersAsNeeded:=True; 81 GenPlayersAsNeeded:=True;
82 CurrentCondition := 0; 82 CurrentCondition := 0;
@@ -98,12 +98,16 @@ begin @@ -98,12 +98,16 @@ begin
98 SetLength(Contingencies, 4); 98 SetLength(Contingencies, 4);
99 LConcequence := TConsequence.Create(AExperiment,1,[gscPoints, gscB, gscMessage,gscBroadcastMessage],['$NICNAME','queijo','queijos']); 99 LConcequence := TConsequence.Create(AExperiment,1,[gscPoints, gscB, gscMessage,gscBroadcastMessage],['$NICNAME','queijo','queijos']);
100 Contingencies[0] := TContingency.Create(AExperiment,LConcequence,LCriteria1,False); 100 Contingencies[0] := TContingency.Create(AExperiment,LConcequence,LCriteria1,False);
  101 + Contingencies[0].ContingencyName := 'CRF 1B';
101 LConcequence := TConsequence.Create(AExperiment,3,[gscPoints, gscA, gscMessage,gscBroadcastMessage],['$NICNAME','pão','pães']); 102 LConcequence := TConsequence.Create(AExperiment,3,[gscPoints, gscA, gscMessage,gscBroadcastMessage],['$NICNAME','pão','pães']);
102 Contingencies[1] := TContingency.Create(AExperiment,LConcequence,LCriteria2,False); 103 Contingencies[1] := TContingency.Create(AExperiment,LConcequence,LCriteria2,False);
  104 + Contingencies[1].ContingencyName := 'CRF 1A';
103 LConcequence := TConsequence.Create(AExperiment,1,[gscPoints, gscG, gscMessage],['','item escolar','itens escolares']); 105 LConcequence := TConsequence.Create(AExperiment,1,[gscPoints, gscG, gscMessage],['','item escolar','itens escolares']);
104 Contingencies[2] := TContingency.Create(AExperiment,LConcequence,LCriteria3,True); 106 Contingencies[2] := TContingency.Create(AExperiment,LConcequence,LCriteria3,True);
  107 + Contingencies[2].ContingencyName := 'MCRF 1G';
105 LConcequence := TConsequence.Create(AExperiment,-1,[gscPoints, gscG, gscMessage],['','item escolar','itens escolares']); 108 LConcequence := TConsequence.Create(AExperiment,-1,[gscPoints, gscG, gscMessage],['','item escolar','itens escolares']);
106 Contingencies[3] := TContingency.Create(AExperiment,LConcequence,LCriteria4,True); 109 Contingencies[3] := TContingency.Create(AExperiment,LConcequence,LCriteria4,True);
  110 + Contingencies[3].ContingencyName := 'MPUN -1G';
107 111
108 Prompt := TPrompt.Create( 112 Prompt := TPrompt.Create(
109 AExperiment 113 AExperiment
@@ -129,57 +133,6 @@ var @@ -129,57 +133,6 @@ var
129 // if not (APath[Length(APath)] = PathDelim) then APath:= APath + PathDelim; 133 // if not (APath[Length(APath)] = PathDelim) then APath:= APath + PathDelim;
130 //end; 134 //end;
131 135
132 - function GetEndCriteria(S:string) : TEndConditionCriterium;  
133 - begin  
134 - case StrToIntDef(ExtractDelimited(1,S,[',']),2) of  
135 - 0: Result.Value := gecAbsoluteCycles;  
136 - 1: Result.Value := gecInterlockingPorcentage;  
137 - 2: Result.Value := gecWhichComeFirst;  
138 - end;  
139 - Result.AbsoluteCycles := StrToIntDef(ExtractDelimited(2,S,[',']), 20);  
140 - Result.InterlockingPorcentage := StrToIntDef(ExtractDelimited(3,S,[',']),10);  
141 - Result.LastCycles := StrToIntDef(ExtractDelimited(4,S,[',']), 10);  
142 - end;  
143 -  
144 - function GetPoints(S: string) : TPoints;  
145 - begin  
146 - Result.A := StrToIntDef(ExtractDelimited(1,S,[',']),0);  
147 - Result.B := StrToIntDef(ExtractDelimited(2,S,[',']),0);  
148 - Result.G := StrToIntDef(ExtractDelimited(3,S,[',']),0);  
149 - end;  
150 -  
151 -  
152 - function GetChoiceFromString(S:string) : TPlayerChoice;  
153 - begin  
154 - Result.Row := GetRowFromString(ExtractDelimited(1,S,[',']));  
155 - Result.Color := GetGameColorFromString(ExtractDelimited(2,S,[',']));  
156 - end;  
157 -  
158 - function GetPPointsFromString(S:string) : TPlayerPoints;  
159 - begin  
160 - Result.A := StrToIntDef(ExtractDelimited(1,S,[',']),0);  
161 - Result.B := StrToIntDef(ExtractDelimited(2,S,[',']),0);  
162 - end;  
163 -  
164 - function GetStatusFromString(S : string): TGamePlayerStatus;  
165 - begin  
166 - case ExtractDelimited(1,S,[',']) of  
167 - 'esperando': Result := gpsWaiting;  
168 - 'jogou': Result := gpsPlayed;  
169 - 'jogando': Result := gpsPlaying;  
170 - end;  
171 - end;  
172 -  
173 - function GetPromptStyle(S:string):TPromptStyle;  
174 - var  
175 - i : integer;  
176 - begin  
177 - // Yes,All,Metacontingency,RecoverLostPoints,  
178 - Result := [];  
179 - for i := 1 to 4 do  
180 - Result := Result + GetPromptStyleFromString(ExtractDelimited(i,S,[',']));  
181 - end;  
182 -  
183 procedure ReadExperiment; 136 procedure ReadExperiment;
184 begin 137 begin
185 // Experiment; 138 // Experiment;
@@ -231,33 +184,6 @@ var @@ -231,33 +184,6 @@ var
231 LConsequence : TConsequence; 184 LConsequence : TConsequence;
232 LCriteria:TCriteria; 185 LCriteria:TCriteria;
233 186
234 - function GetCriteriaFromString(S:string):TCriteria;  
235 - var  
236 - LS : string;  
237 - i,  
238 - LCount: integer;  
239 - begin  
240 - LS := ExtractDelimited(1,S,['|']);  
241 - LCount := WordCount(LS,[#0,',']);  
242 - Result.Rows := [];  
243 - for i := 1 to LCount do  
244 - Result.Rows += [GetRowFromString(ExtractDelimited(i,LS,[',']))];  
245 -  
246 - case ExtractDelimited(2,S,['|'])of  
247 - 'NONE':Result.Style:=gtNone;  
248 - 'CORES':Result.Style:=gtColorsOnly;  
249 - 'E':Result.Style:=gtRowsAndColors;  
250 - 'LINHAS':Result.Style:=gtRowsOnly;  
251 - 'OU':Result.Style:=gtRowsOrColors;  
252 - end;  
253 -  
254 - LS := ExtractDelimited(3,S,['|']);  
255 - LCount := WordCount(LS,[#0,',']);  
256 - Result.Colors := [];  
257 - for i := 1 to LCount do  
258 - Result.Colors += [GetGameColorFromString(ExtractDelimited(i,LS,[',']))];  
259 - end;  
260 -  
261 procedure SetLCK(i:integer); 187 procedure SetLCK(i:integer);
262 begin 188 begin
263 if IsMeta then 189 if IsMeta then
@@ -304,10 +230,10 @@ var @@ -304,10 +230,10 @@ var
304 {$ENDIF} 230 {$ENDIF}
305 s1 := DEF_END; 231 s1 := DEF_END;
306 end; 232 end;
307 - EndCriterium := GetEndCriteria(s1); 233 + EndCriterium := GetEndCriteriaFromString(s1);
308 ConditionName := ReadString(LS,KEY_COND_NAME,LS); 234 ConditionName := ReadString(LS,KEY_COND_NAME,LS);
309 - Points.Count := GetPoints(ReadString(LS, KEY_POINTS_COUNT,DEF_POINTS));  
310 - Points.OnStart := GetPoints(ReadString(LS, KEY_POINTS_ONSTART,DEF_POINTS)); 235 + Points.Count := GetPointsFromString(ReadString(LS, KEY_POINTS_COUNT,DEF_POINTS));
  236 + Points.OnStart := GetPointsFromString(ReadString(LS, KEY_POINTS_ONSTART,DEF_POINTS));
311 Turn.Count:= ReadInteger(LS, KEY_TURN_COUNT,1); 237 Turn.Count:= ReadInteger(LS, KEY_TURN_COUNT,1);
312 Turn.Value:= ReadInteger(LS, KEY_TURN_VALUE,2); 238 Turn.Value:= ReadInteger(LS, KEY_TURN_VALUE,2);
313 Turn.Random:= ReadBool(LS, KEY_TURN_RANDOM,False); 239 Turn.Random:= ReadBool(LS, KEY_TURN_RANDOM,False);
@@ -322,7 +248,7 @@ var @@ -322,7 +248,7 @@ var
322 248
323 Prompt := TPrompt.Create( 249 Prompt := TPrompt.Create(
324 AExperiment 250 AExperiment
325 - , GetPromptStyle(ReadString(LS,KEY_PROMPT_STYLE,'todos,sim,metacontingência,recuperar pontos,')) 251 + , GetPromptStyleFromString(ReadString(LS,KEY_PROMPT_STYLE,'todos,sim,metacontingência,recuperar pontos,'))
326 , Contingencies 252 , Contingencies
327 , ReadString(LS,KEY_PROMPT_MESSAGE,DEF_PROMPTMESSAGE) 253 , ReadString(LS,KEY_PROMPT_MESSAGE,DEF_PROMPTMESSAGE)
328 ); 254 );
units/game_resources.pas
  Diff comments   View file @64b24cf
@@ -72,8 +72,12 @@ resourcestring @@ -72,8 +72,12 @@ resourcestring
72 KEY_CONSEQUE_MESSAGE_APPENDS = '.Consequência.Mensagem.Sufixo.Singular'; 72 KEY_CONSEQUE_MESSAGE_APPENDS = '.Consequência.Mensagem.Sufixo.Singular';
73 KEY_CONSEQUE_MESSAGE_APPENDP = '.Consequência.Mensagem.Sufixo.Plural'; 73 KEY_CONSEQUE_MESSAGE_APPENDP = '.Consequência.Mensagem.Sufixo.Plural';
74 74
75 - 75 + VAL_CONSEQUENCE = 'Cosequência';
76 VAL_RESEARCHER = 'Pesquisador'; 76 VAL_RESEARCHER = 'Pesquisador';
  77 + VAL_EXPERIMENT = 'Experimento';
  78 + VAL_INTERLOCKING = 'Entrelaçamento';
  79 +
  80 + VAL_BEGIN_TIME = 'Começo';
77 81
78 DEF_END = '2,20,10,10,'; // which come first, 20 cycles | 10% entrelaçamentos in the last 10 cycles 82 DEF_END = '2,20,10,10,'; // which come first, 20 cycles | 10% entrelaçamentos in the last 10 cycles
79 DEF_POINTS = '0,0,0,'; 83 DEF_POINTS = '0,0,0,';
units/string_methods.pas
  Diff comments   View file @64b24cf
@@ -19,8 +19,6 @@ uses @@ -19,8 +19,6 @@ uses
19 , game_resources 19 , game_resources
20 ; 20 ;
21 21
22 -function GetAndDelFirstValue(var S: string;Sep:Char=','):string; deprecated 'Use ExtracteDelimited from strutils instead';  
23 -  
24 function GetRowString(ARow : TGameRow) : string; 22 function GetRowString(ARow : TGameRow) : string;
25 function GetRowFromString(S : string):TGameRow; 23 function GetRowFromString(S : string):TGameRow;
26 24
@@ -31,6 +29,7 @@ function GetGameColorFromString(S : string) : TGameColor; @@ -31,6 +29,7 @@ function GetGameColorFromString(S : string) : TGameColor;
31 29
32 function GetPromptStyleFromString(S : string) : TPromptStyle; 30 function GetPromptStyleFromString(S : string) : TPromptStyle;
33 function GetPromptStyleString(AStyle : TPromptStyle) : string; 31 function GetPromptStyleString(AStyle : TPromptStyle) : string;
  32 +function GetGamePromptStyleFromString(S : string) : TGamePromptStyle;
34 33
35 function GetConsequenceStyleFromString(s : string):TGameConsequenceStyle; 34 function GetConsequenceStyleFromString(s : string):TGameConsequenceStyle;
36 function GetConsequenceStyleString(AStyle : TGameConsequenceStyle): string; 35 function GetConsequenceStyleString(AStyle : TGameConsequenceStyle): string;
@@ -42,10 +41,19 @@ function GetCriteriaFromString(S : string) : TCriteria; @@ -42,10 +41,19 @@ function GetCriteriaFromString(S : string) : TCriteria;
42 function GetCriteriaStyleString(AStyle: TGameStyle) : string; 41 function GetCriteriaStyleString(AStyle: TGameStyle) : string;
43 42
44 function GetStatusString(AStatus : TGamePlayerStatus): string; 43 function GetStatusString(AStatus : TGamePlayerStatus): string;
  44 +function GetStatusFromString(S : string): TGamePlayerStatus;
  45 +
  46 +function GetPPointsFromString(S:string) : TPlayerPoints;
45 function GetPPointsString(APPoints : TPlayerPoints) : string; 47 function GetPPointsString(APPoints : TPlayerPoints) : string;
46 -function GetChoiceString(AChoice : TPlayerChoice) : string; 48 +function GetPointsFromString(S: string) : TPoints;
47 function GetPointsString(APoints : TPoints) : string; 49 function GetPointsString(APoints : TPoints) : string;
  50 +
  51 +function GetChoiceString(AChoice : TPlayerChoice) : string;
  52 +function GetChoiceFromString(S:string) : TPlayerChoice;
  53 +
48 function GetEndCriteriaString(AEndCriterium:TEndConditionCriterium) : string; 54 function GetEndCriteriaString(AEndCriterium:TEndConditionCriterium) : string;
  55 +function GetEndCriteriaFromString(S:string) : TEndConditionCriterium;
  56 +
49 57
50 function GetPlayerFromString(s: string): TPlayer; 58 function GetPlayerFromString(s: string): TPlayer;
51 function GetPlayerAsString(P: TPlayer): string; 59 function GetPlayerAsString(P: TPlayer): string;
@@ -54,6 +62,57 @@ implementation @@ -54,6 +62,57 @@ implementation
54 62
55 uses strutils; 63 uses strutils;
56 64
  65 +function GetEndCriteriaFromString(S:string) : TEndConditionCriterium;
  66 +begin
  67 + case StrToIntDef(ExtractDelimited(1,S,[',']),2) of
  68 + 0: Result.Value := gecAbsoluteCycles;
  69 + 1: Result.Value := gecInterlockingPorcentage;
  70 + 2: Result.Value := gecWhichComeFirst;
  71 + end;
  72 + Result.AbsoluteCycles := StrToIntDef(ExtractDelimited(2,S,[',']), 20);
  73 + Result.InterlockingPorcentage := StrToIntDef(ExtractDelimited(3,S,[',']),10);
  74 + Result.LastCycles := StrToIntDef(ExtractDelimited(4,S,[',']), 10);
  75 +end;
  76 +
  77 +function GetPointsFromString(S: string) : TPoints;
  78 +begin
  79 + Result.A := StrToIntDef(ExtractDelimited(1,S,[',']),0);
  80 + Result.B := StrToIntDef(ExtractDelimited(2,S,[',']),0);
  81 + Result.G := StrToIntDef(ExtractDelimited(3,S,[',']),0);
  82 +end;
  83 +
  84 +
  85 +function GetChoiceFromString(S:string) : TPlayerChoice;
  86 +begin
  87 + Result.Row := GetRowFromString(ExtractDelimited(1,S,[',']));
  88 + Result.Color := GetGameColorFromString(ExtractDelimited(2,S,[',']));
  89 +end;
  90 +
  91 +function GetPPointsFromString(S:string) : TPlayerPoints;
  92 +begin
  93 + Result.A := StrToIntDef(ExtractDelimited(1,S,[',']),0);
  94 + Result.B := StrToIntDef(ExtractDelimited(2,S,[',']),0);
  95 +end;
  96 +
  97 +function GetStatusFromString(S : string): TGamePlayerStatus;
  98 +begin
  99 + case ExtractDelimited(1,S,[',']) of
  100 + 'esperando': Result := gpsWaiting;
  101 + 'jogou': Result := gpsPlayed;
  102 + 'jogando': Result := gpsPlaying;
  103 + end;
  104 +end;
  105 +
  106 +function GetPromptStyleFromString(S:string):TPromptStyle;
  107 +var
  108 + i : integer;
  109 +begin
  110 + // Yes,All,Metacontingency,RecoverLostPoints,
  111 + Result := [];
  112 + for i := 1 to 4 do
  113 + Result := Result + [GetGamePromptStyleFromString(ExtractDelimited(i,S,[',']))];
  114 +end;
  115 +
57 function GetAndDelFirstValue(var S: string;Sep:Char=','): string; 116 function GetAndDelFirstValue(var S: string;Sep:Char=','): string;
58 begin 117 begin
59 Result := Copy(S, 0, pos(Sep, S)-1); 118 Result := Copy(S, 0, pos(Sep, S)-1);
@@ -128,18 +187,18 @@ begin @@ -128,18 +187,18 @@ begin
128 end; 187 end;
129 188
130 189
131 -function GetPromptStyleFromString(S: string): TPromptStyle; 190 +function GetGamePromptStyleFromString(S: string): TGamePromptStyle;
132 begin 191 begin
133 // todos,sim,metacontingência,recuperar pontos, 192 // todos,sim,metacontingência,recuperar pontos,
134 case UpperCase(S) of 193 case UpperCase(S) of
135 //'NENHUM','NONE': Result:=[gsNone]; 194 //'NENHUM','NONE': Result:=[gsNone];
136 - 'TODOS', 'ALL' : Result:=[gsAll];  
137 - 'SIM', 'YES','S','Y': Result:=[gsYes];  
138 - 'NÃO','NAO','N' : Result:=[gsNo];  
139 - 'CONTINGÊNCIA','CONTINGENCIA','CONTINGENCY','OPERANTE', 'OPERANT': Result:=[gsContingency];  
140 - 'METACONTINGÊNCIA','METACONTINGENCIA','METACONTINGENCY','META': Result:=[gsMetacontingency];  
141 - 'RECUPERA','RECUPERAR','RECUPERAR PONTOS','RECOVER','RESETAR', 'RESET': Result:=[gsRevertPoints];  
142 - 'TIRAR DE A AO INVES DE B','TIRAR DE A AO INVÉS DE B', 'B as A' : Result:=[gsBasA]; 195 + 'TODOS', 'ALL' : Result := gsAll;
  196 + 'SIM', 'YES','S','Y': Result := gsYes;
  197 + 'NÃO','NAO','N' : Result := gsNo;
  198 + 'CONTINGÊNCIA','CONTINGENCIA','CONTINGENCY','OPERANTE', 'OPERANT': Result := gsContingency;
  199 + 'METACONTINGÊNCIA','METACONTINGENCIA','METACONTINGENCY','META': Result := gsMetacontingency;
  200 + 'RECUPERA','RECUPERAR','RECUPERAR PONTOS','RECOVER','RESETAR', 'RESET': Result := gsRevertPoints;
  201 + 'TIRAR DE A AO INVES DE B','TIRAR DE A AO INVÉS DE B', 'B as A' : Result := gsBasA;
143 end; 202 end;
144 end; 203 end;
145 204
@@ -197,33 +256,31 @@ begin @@ -197,33 +256,31 @@ begin
197 Result += '|'; 256 Result += '|';
198 end; 257 end;
199 258
200 -function GetCriteriaFromString(S: string): TCriteria; 259 +function GetCriteriaFromString(S:string):TCriteria;
201 var 260 var
202 - s1 : string;  
203 - i : integer; 261 + LS : string;
  262 + i,
  263 + LCount: integer;
204 begin 264 begin
205 - s1 := ExtractDelimited(1,S,['|']); 265 + LS := ExtractDelimited(1,S,['|']);
  266 + LCount := WordCount(LS,[#0,',']);
206 Result.Rows := []; 267 Result.Rows := [];
207 -  
208 - for i := 1 to WordCount(s1,[#0,',']) do  
209 - if ExtractDelimited(i,s1,[',']) <> '' then  
210 - Result.Rows += [GetRowFromString(ExtractDelimited(i,s1,[',']))]  
211 - else Break;  
212 -  
213 - s1 := ExtractDelimited(2,S,['|']);  
214 - case UpperCase(s1) of  
215 - '','INDIFERENTE', 'NONE' : Result.Style := gtNone;  
216 - 'E', 'AND' : Result.Style := gtRowsAndColors;  
217 - 'OU', 'OR' : Result.Style := gtRowsOrColors;  
218 - 268 + for i := 1 to LCount do
  269 + Result.Rows += [GetRowFromString(ExtractDelimited(i,LS,[',']))];
  270 +
  271 + case ExtractDelimited(2,S,['|'])of
  272 + 'NONE':Result.Style:=gtNone;
  273 + 'CORES':Result.Style:=gtColorsOnly;
  274 + 'E':Result.Style:=gtRowsAndColors;
  275 + 'LINHAS':Result.Style:=gtRowsOnly;
  276 + 'OU':Result.Style:=gtRowsOrColors;
219 end; 277 end;
220 278
221 - s1 := ExtractDelimited(3,S,['|']); 279 + LS := ExtractDelimited(3,S,['|']);
  280 + LCount := WordCount(LS,[#0,',']);
222 Result.Colors := []; 281 Result.Colors := [];
223 - for i := 1 to WordCount(s1,[#0,',']) do  
224 - if ExtractDelimited(i,s1,[',']) <> '' then  
225 - Result.Colors += [GetGameColorFromString(ExtractDelimited(i,s1,[',']))]  
226 - else Break; 282 + for i := 1 to LCount do
  283 + Result.Colors += [GetGameColorFromString(ExtractDelimited(i,LS,[',']))];
227 end; 284 end;
228 285
229 function GetCriteriaStyleString(AStyle: TGameStyle): string; 286 function GetCriteriaStyleString(AStyle: TGameStyle): string;