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 55 <PackageName Value="LCL"/>
56 56 </Item2>
57 57 </RequiredPackages>
58   - <Units Count="14">
  58 + <Units Count="15">
59 59 <Unit0>
60 60 <Filename Value="cultural_matrix.lpr"/>
61 61 <IsPartOfProject Value="True"/>
... ... @@ -117,6 +117,10 @@
117 117 <ComponentName Value="FormChooseActor"/>
118 118 <ResourceBaseClass Value="Form"/>
119 119 </Unit13>
  120 + <Unit14>
  121 + <Filename Value="units/csv_writer.pas"/>
  122 + <IsPartOfProject Value="True"/>
  123 + </Unit14>
120 124 </Units>
121 125 </ProjectOptions>
122 126 <CompilerOptions>
... ...
cultural_matrix.lpr
  Diff comments   View file @64b24cf
... ... @@ -35,7 +35,9 @@ var
35 35 I : integer;
36 36 {$ENDIF}
37 37 ID : TStringList;
  38 + ApplicationPath,
38 39 F : string;
  40 +
39 41 const
40 42 PAdmin : array [0..3] of string = ('--admin','--adm','-admin','-adm');
41 43 PPlayer : array [0..3] of string = ('--player','--play','-player','-play');
... ... @@ -43,50 +45,68 @@ const
43 45  
44 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 101 begin
  102 + ApplicationPath := ExtractFilePath(Application.ExeName);
47 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 105 {$ENDIF}
64 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 111 FormMatrixGame.SetID(F);
92 112 if Paramcount > 0 then
... ...
form_matrixgame.pas
  Diff comments   View file @64b24cf
... ... @@ -72,14 +72,14 @@ type
72 72 procedure ButtonExpStartClick(Sender: TObject);
73 73 procedure ChatMemoSendKeyPress(Sender: TObject; var Key: char);
74 74 procedure FormActivate(Sender: TObject);
75   - procedure PopupNotifierClose(Sender: TObject; var CloseAction: TCloseAction
76   - );
  75 + procedure PopupNotifierClose(Sender: TObject; var CloseAction: TCloseAction);
77 76 procedure StringGridMatrixClick(Sender: TObject);
78 77 procedure StringGridMatrixDrawCell(Sender: TObject; aCol, aRow: integer;
79 78 aRect: TRect; aState: TGridDrawState);
80 79 procedure TimerTimer(Sender: TObject);
81 80 private
82 81 FGameControl : TGameControl;
  82 + FAppPath,
83 83 FID: string;
84 84 public
85 85 procedure SetID(S : string);
... ... @@ -106,7 +106,6 @@ procedure TFormMatrixGame.StringGridMatrixDrawCell(Sender: TObject; aCol, aRow:
106 106 aRect: TRect; aState: TGridDrawState);
107 107 var
108 108 OldCanvas: TCanvas;
109   - RowBase : integer;
110 109  
111 110 procedure SaveOldCanvas;
112 111 begin
... ... @@ -157,8 +156,8 @@ var
157 156 TStringGrid(Sender).Canvas.Rectangle(aRect);
158 157 if Assigned(FGameControl) then
159 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 161 DrawDots;
163 162 end;
164 163 //function GetTextX(S : String): Longint;
... ... @@ -167,15 +166,14 @@ var
167 166 //end;
168 167  
169 168 begin
170   - if Assigned(FGameControl) then
171   - RowBase:=FGameControl.RowBase;
  169 + if not Assigned(FGameControl) then Exit;
172 170 SaveOldCanvas;
173 171 try
174 172 //if (aRow >= RowBase) and (aCol = 10) then
175 173 // DrawLines(clWhite);
176   - if (aCol <> 0) and (aRow > (RowBase-1)) then
  174 + if (aCol <> 0) and (aRow > (FGameControl.RowBase-1)) then
177 175 begin
178   - DrawLines(GetRowColor(aRow,RowBase));
  176 + DrawLines(GetRowColor(aRow,FGameControl.RowBase));
179 177  
180 178 if (gdSelected in aState) and (goRowSelect in TStringGrid(Sender).Options)then
181 179 begin
... ... @@ -226,13 +224,13 @@ procedure TFormMatrixGame.SetGameActor(AValue: TGameActor);
226 224  
227 225 procedure SetZMQAdmin;
228 226 begin
229   - FGameControl := TGameControl.Create(TZMQAdmin.Create(Self,FID));
  227 + FGameControl := TGameControl.Create(TZMQAdmin.Create(Self,FID),ExtractFilePath(Application.ExeName));
230 228 GBAdmin.Visible:= True;
231 229 end;
232 230  
233 231 procedure SetZMQPlayer;
234 232 begin
235   - FGameControl := TGameControl.Create(TZMQPlayer.Create(Self,FID));
  233 + FGameControl := TGameControl.Create(TZMQPlayer.Create(Self,FID),ExtractFilePath(Application.ExeName));
236 234 //StringGridMatrix.Enabled := True;
237 235 end;
238 236  
... ... @@ -257,24 +255,27 @@ end;
257 255  
258 256 procedure TFormMatrixGame.FormActivate(Sender: TObject);
259 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 279 end;
279 280  
280 281 procedure TFormMatrixGame.PopupNotifierClose(Sender: TObject;
... ...
units/csv_writer.pas 0 → 100644
  Diff comments   View file @64b24cf
... ... @@ -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 106 destructor Destroy;override;
107 107 function AsString(AID :string): string;
108 108 function GenerateMessage(ForGroup: Boolean):string;
  109 + procedure Clean; virtual;
109 110 procedure PresentMessage;
110 111 procedure PresentPoints;
111 112 property ShouldPublishMessage : Boolean read GetShouldPublishMessage;
... ... @@ -123,6 +124,7 @@ type
123 124 FMeta : Boolean; //True: Consequence occurs OnEndTurn, False: Consequence occurs OnEndCycle
124 125 FConsequence : TConsequence;
125 126 FCriteria : TCriteria;
  127 + FName: string;
126 128 FOnCriteria: TNotifyEvent;
127 129 function RowMod(R:TGameRow):TGameRow;
128 130 procedure CriteriaEvent;
... ... @@ -131,11 +133,14 @@ type
131 133 function CriteriaString : string;
132 134 function ResponseMeetsCriteriaI(R : TGameRow; C : TGameColor):Boolean; // Does response meets operant criteria?
133 135 function ResponseMeetsCriteriaG(Players : TPlayers):Boolean;
  136 + function ConsequenceFromPlayerID(AID:string):string;
  137 + procedure Clean;
134 138 property OnCriteria : TNotifyEvent read FOnCriteria write FOncriteria;
135 139 property Fired : Boolean read FFired;
136 140 property Consequence : TConsequence read FConsequence;
137 141 property Criteria : TCriteria read FCriteria;
138 142 property Meta : Boolean read FMeta;
  143 + property ContingencyName : string read FName write FName;
139 144 end;
140 145  
141 146 { TContingencies }
... ... @@ -155,8 +160,9 @@ type
155 160 public
156 161 constructor Create(AOwner:TComponent; APStyle:TPromptStyle; APTarget : TContingencies; AMessage:string);reintroduce;
157 162 function ResponsesCount : integer;
158   - procedure AppendResponse(AID,R:string);
159 163 function AsString: TStringList; overload;
  164 + procedure AppendResponse(AID,R:string);
  165 + procedure Clean;override;
160 166 property Question: string read FPromptMessage;
161 167 property PromptResult:string read FResult;
162 168  
... ... @@ -398,6 +404,17 @@ begin // All -&gt; (Diff,Equal,Even, Odd) or not all
398 404 CriteriaEvent;
399 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 419 { TPrompt }
403 420  
... ... @@ -426,6 +443,12 @@ begin
426 443 FResponses[High(FResponses)] := AID+'|'+R+'|';
427 444 end;
428 445  
  446 +procedure TPrompt.Clean;
  447 +begin
  448 + //inherited Clean;
  449 + FResponses := nil;
  450 +end;
  451 +
429 452 function TPrompt.AsString: TStringList;
430 453 var
431 454 j,i : integer;
... ... @@ -454,8 +477,8 @@ var
454 477  
455 478 if (gscB in LCsqStyle) and (gsBasA in FPromptStyle) then
456 479 begin
457   - LCsqStyle += [gscB];
458   - LCsqStyle -= [gscA];
  480 + LCsqStyle += [gscA];
  481 + LCsqStyle -= [gscB];
459 482 end;
460 483  
461 484 if IsMeta then
... ... @@ -471,17 +494,22 @@ var
471 494 ExtractDelimited(5,LConsequence, ['|']);
472 495 end;
473 496 begin
  497 + Result := TStringList.Create;
474 498 // to do, sanitize FPromptStyle first
475 499 Pts:= 0;
476 500 if (gsAll in FPromptStyle) and (gsYes in FPromptStyle) then
477 501 if AllPlayersClickedYes then
478 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 504 begin
481 505 LID := FPromptTargets[i].Consequence.ConsequenseByPlayerID.Names[j];
482 506 LConsequence := FPromptTargets[i].Consequence.ConsequenseByPlayerID.Values[LID];
483 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 513 if gsContingency in FPromptStyle then
486 514 if (FPromptTargets[i].Fired) and (not FPromptTargets[i].Meta) then
487 515 if (gscA in LCsqStyle) or (gscB in LCsqStyle) then
... ... @@ -493,7 +521,7 @@ begin
493 521 if gscG in LCsqStyle then
494 522 ApplyPointsConditions(True);
495 523  
496   - Result := TStringList.Create;
  524 +
497 525 Result.Add(LConsequence);
498 526 end;
499 527  
... ... @@ -541,7 +569,7 @@ begin
541 569 FMessage := TPopupNotifier.Create(Self);
542 570 FTimer := TTimer.Create(Self);
543 571 FTimer.Enabled:=False;
544   - FTimer.Interval:=6000;
  572 + FTimer.Interval:=10000;
545 573 FTimer.OnTimer:=@SelfDestroy;
546 574 FConsequenceByPlayerID := TStringList.Create;
547 575 end;
... ... @@ -568,27 +596,25 @@ begin
568 596 FMessage.Text := Result;
569 597 end;
570 598  
  599 +procedure TConsequence.Clean;
  600 +begin
  601 + FConsequenceByPlayerID.Clear;
  602 +end;
  603 +
571 604 procedure TConsequence.PresentMessage;
572 605 var
573 606 PopUpPos : TPoint;
574 607 begin
  608 + PopUpPos.X := FormMatrixGame.GBIndividualAB.Left;
575 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 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 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 618 PopUpPos := FormMatrixGame.ClientToScreen(PopUpPos);
593 619 FMessage.Color:=clTeal;
594 620 FMessage.Title:='';
... ...
units/game_actors_point.pas
  Diff comments   View file @64b24cf
... ... @@ -73,7 +73,7 @@ end;
73 73  
74 74 function TGamePoint.GetResultAsString: string;
75 75 begin
76   - Result := IntToStr(FResult);
  76 + Result := IntToStr(abs(FResult));
77 77 end;
78 78  
79 79 constructor TGamePoint.Create(AOwner: TComponent; AValue: integer);
... ... @@ -111,7 +111,7 @@ begin
111 111 case FResult of
112 112 -MaxInt..-2: Result += ' produziram a perda de '+Self.AsString+ ' pontos para o grupo';
113 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 115 1 : Result += ' produziram 1 ponto para o grupo';
116 116 2..MaxInt: Result += ' produziram '+Self.AsString+' pontos para o grupo'
117 117 end;
... ... @@ -119,11 +119,11 @@ begin
119 119 else
120 120 begin
121 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 125 1 : Result += ' produziram 1 ' + AAppendiceSingular;
126   - 2..MaxInt: Result += ' produziram '+Self.AsString+ ' ' + AAppendicePlural;
  126 + 2..MaxInt: Result += ' produziram ' + Self.AsString + ' ' + AAppendicePlural;
127 127 end;
128 128 end;
129 129 end
... ... @@ -148,7 +148,7 @@ begin
148 148 begin
149 149 case FResult of
150 150 -MaxInt..-2: Result += ' perdeu '+Self.AsString+ ' ' + AAppendicePlural;
151   - -1 : Result += ' ponto 1 ' + AAppendiceSingular;
  151 + -1 : Result += ' perdeu 1 ' + AAppendiceSingular;
152 152 0 : Result += ' não perdeu nem ganhou ' + AAppendicePlural;
153 153 1 : Result += ' ganhou 1 ' + AAppendiceSingular;
154 154 2..MaxInt: Result += ' ganhou '+Self.AsString+ ' ' + AAppendicePlural;
... ...
units/game_control.pas
  Diff comments   View file @64b24cf
... ... @@ -54,10 +54,12 @@ type
54 54 private
55 55 function AskQuestion(AQuestion:string):UTF8string;
56 56 procedure ShowPopUp(AText:string);
  57 + procedure ShowConsequenceMessage(AID,S:string;ForGroup:Boolean);
57 58 procedure DisableConfirmationButton;
58 59 procedure CleanMatrix(AEnabled : Boolean);
59 60 procedure EnablePlayerMatrix(AID:UTF8string; ATurn:integer; AEnabled:Boolean);
60 61 private
  62 +
61 63 function ShouldStartExperiment: Boolean;
62 64 function ShouldEndCycle : Boolean;
63 65 function ShouldAskQuestion : Boolean;
... ... @@ -71,7 +73,7 @@ type
71 73 procedure EndExperiment(Sender: TObject);
72 74 procedure StartExperiment;
73 75 public
74   - constructor Create(AOwner : TComponent);override;
  76 + constructor Create(AOwner : TComponent;AppPath:string);overload;
75 77 destructor Destroy; override;
76 78 procedure SetMatrix;
77 79 procedure SendRequest(ARequest : UTF8string);
... ... @@ -145,15 +147,14 @@ begin
145 147 Result := FExperiment.PlayersCount = FExperiment.Condition[FExperiment.CurrentCondition].Turn.Value;
146 148 end;
147 149  
148   -function TGameControl.ShouldEndCycle: Boolean;
  150 +function TGameControl.ShouldEndCycle: Boolean; //CAUTION: MUST BE CALLED BEFORE EXPERIMENT.NEXTCYCLE
149 151 begin
150 152 Result := FExperiment.Condition[FExperiment.CurrentCondition].Turn.Count = FExperiment.Condition[FExperiment.CurrentCondition].Turn.Value-1;
151 153 end;
152 154  
153   -function TGameControl.ShouldAskQuestion: Boolean; // end cycle, restart alias
  155 +function TGameControl.ShouldAskQuestion: Boolean;
154 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 158 end;
158 159  
159 160 procedure TGameControl.KickPlayer(AID: string);
... ... @@ -169,24 +170,11 @@ begin
169 170 end;
170 171  
171 172 procedure TGameControl.NextCycle(Sender: TObject);
172   -var
173   - i,
174   - LCount : integer;
175   - LConsequences : string;
176 173 begin
177   - // prompt question to all players
178 174 FormMatrixGame.LabelExpCountCycle.Caption:=IntToStr(FExperiment.Condition[FExperiment.CurrentCondition].Cycles.Count+1);
179 175 {$IFDEF DEBUG}
180 176 WriteLn('cycle:>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>');
181 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 178 end;
191 179  
192 180 procedure TGameControl.NextLineage(Sender: TObject);
... ... @@ -229,7 +217,7 @@ end;
229 217 procedure TGameControl.StartExperiment;
230 218 begin
231 219 // all players arrived, lets begin
232   - FExperiment.State:=xsRunning;
  220 + FExperiment.Play;
233 221  
234 222 // wait some time, we just sent a message earlier
235 223 Sleep(5);
... ... @@ -445,6 +433,21 @@ begin
445 433 FormMatrixGame.Timer.Enabled:=True;
446 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 451 procedure TGameControl.DisableConfirmationButton;
449 452 begin
450 453 FormMatrixGame.StringGridMatrix.Enabled:= False;
... ... @@ -467,7 +470,7 @@ begin
467 470 CleanMatrix(AEnabled);
468 471 end;
469 472  
470   -constructor TGameControl.Create(AOwner: TComponent);
  473 +constructor TGameControl.Create(AOwner: TComponent;AppPath:string);
471 474 begin
472 475 FZMQActor := TZMQActor(AOwner);
473 476 inherited Create(FZMQActor.Owner);
... ... @@ -487,8 +490,11 @@ begin
487 490 RowBase:= 0;
488 491 MustDrawDots:=False;
489 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 498 FExperiment.State:=xsWaiting;
493 499 FExperiment.OnEndTurn := @NextTurn;
494 500 FExperiment.OnEndCycle := @NextCycle;
... ... @@ -633,8 +639,21 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
633 639 end;
634 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 654 procedure ReceiveChoice;
637   - var P : TPlayer;
  655 + var
  656 + P : TPlayer;
638 657 begin
639 658 P := FExperiment.PlayerFromID[AMessage[1]];
640 659  
... ... @@ -648,6 +667,8 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
648 667  
649 668 case FActor of
650 669 gaPlayer:begin
  670 +
  671 + // last turn// end cycle
651 672 if P.Turn = FExperiment.PlayersCount-1 then
652 673 begin
653 674 // update next turn
... ... @@ -657,16 +678,20 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
657 678 FExperiment.Player[Self.ID] := P;
658 679 end;
659 680  
660   - //CleanMatrix;
661 681 CleanMatrix(False);
662 682  
  683 +
663 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 690 // wait for server
667 691 Exit;
668 692 end;
669 693  
  694 + // else
670 695 if Self.ID = P.ID then
671 696 begin
672 697 // update confirmation button
... ... @@ -697,20 +722,21 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
697 722 end;
698 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 741 procedure ReceiveChat;
716 742 begin
... ... @@ -736,80 +762,55 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
736 762 end;
737 763 end;
738 764  
739   - procedure ShowQuestion;
  765 + procedure QuestionMessages;
  766 + var
  767 + i : integer;
  768 + MID : string;
740 769 begin
741 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 787 end;
749 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 800 // end;
799 801 // end;
800   - //end;
801   -
802 802  
803 803 begin
804 804 if MHas(K_ARRIVED) then ReceiveActor;
805 805 if MHas(K_CHAT_M) then ReceiveChat;
806 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 808 if MHas(K_KICK) then SayGoodBye;
809 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 814 end;
814 815  
815 816 // Here FActor is garanted to be a TZMQAdmin
... ... @@ -900,11 +901,14 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList);
900 901 end;
901 902  
902 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 909 begin
906 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 912 {$ENDIF}
909 913 P := FExperiment.PlayerFromID[ARequest[0]];
910 914 P.Choice.Row:= GetRowFromString(ARequest[3]); // row
... ... @@ -919,65 +923,70 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList);
919 923  
920 924 if Pos('$NICNAME',S) > 0 then
921 925 S := ReplaceStr(S,'$NICNAME',P.Nicname);
922   - ARequest.Append(S);
923 926  
924 927 // update turn
  928 + LEndCycle:=ShouldEndCycle;
925 929 P.Turn := FExperiment.NextTurn;
926 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 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 944 end;
942 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 986 begin
978 987 if MHas(K_LOGIN) then ReplyLoginRequest;
979 988 if MHas(K_CHOICE) then ValidateChoice;
980   - //if MHas(K_QUESTION) then ValidateQuestionResponse;
  989 + if MHas(K_QUESTION) then ValidateQuestionResponse;
981 990 end;
982 991  
983 992 // Here FActor is garanted to be a TZMQPlayer, reply by:
... ... @@ -1020,31 +1029,56 @@ procedure TGameControl.ReceiveReply(AReply: TStringList);
1020 1029 LConsequence : TConsequence;
1021 1030 LCount,
1022 1031 i : integer;
1023   - M : string;
1024 1032 //P : TPlayer;
1025 1033 begin
1026 1034 if Self.ID = AReply[0] then
1027 1035 begin
1028 1036 //P := FExperiment.PlayerFromID[Self.ID];
1029   - LCount := WordCount(AReply[5],['+']);
1030 1037 {$IFDEF DEBUG}
1031 1038 WriteLn('LCount:',LCount);
1032 1039 {$ENDIF}
  1040 + FZMQActor.SendMessage([K_CHOICE,AReply[0],AReply[3],AReply[4],AReply[5]]);
  1041 +
  1042 + LCount := WordCount(AReply[6],['+']);
1033 1043 if LCount > 0 then
1034 1044 for i := 1 to LCount do
1035 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 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 1050 else
1041   - LConsequence.PresentMessage;
1042   - LConsequence.PresentPoints;
  1051 + begin
  1052 + LConsequence.PresentMessage;
  1053 + LConsequence.PresentPoints;
  1054 + end;
1043 1055 {$IFDEF DEBUG}
1044 1056 WriteLn('A consequence should have shown.');
1045 1057 {$ENDIF}
  1058 + //Sleep(1000);
1046 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 1082 end;
1049 1083 end;
1050 1084  
... ... @@ -1053,13 +1087,13 @@ procedure TGameControl.ReceiveReply(AReply: TStringList);
1053 1087 // // wait
1054 1088 //end;
1055 1089  
1056   - procedure ResumePlayer;
1057   - begin
1058   -
1059   - end;
  1090 + //procedure ResumePlayer;
  1091 + //begin
  1092 + //
  1093 + //end;
1060 1094  
1061 1095 begin
1062   - if MHas(K_RESUME+K_ARRIVED) then ResumePlayer;
  1096 + //if MHas(K_RESUME+K_ARRIVED) then ResumePlayer;
1063 1097 if MHas(K_LOGIN+K_ARRIVED) then LoginAccepted;
1064 1098 if MHas(K_CHOICE+K_ARRIVED) then ChoiceValidated;
1065 1099 //if MHas(K_QUESTION+K_ARRIVED) then QuestionValidated;
... ...
units/game_experiment.pas
  Diff comments   View file @64b24cf
... ... @@ -30,28 +30,23 @@ type
30 30  
31 31 TExperiment = class(TComponent)
32 32 private
33   - FExperimentStart : Boolean;
34 33 FExperimentAim,
35 34 FExperimentName,
36 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 38 FGenPlayersAsNeeded : Boolean;
48   - FPlayers : TPlayers;
49   - FCurrentCondition : integer;
50   - FConditions : TConditions;
51 39 FResearcherCanChat: Boolean;
52 40 FResearcherCanPlay: Boolean;
53 41 FSendChatHistoryForNewPlayers: Boolean;
54 42 FShowChat: Boolean;
  43 + FMatrixType: TGameMatrixType;
  44 + private
  45 + FLastReportColNames : string;
  46 + FRegData : TRegData;
  47 + FPlayers : TPlayers;
  48 + FCurrentCondition : integer;
  49 + FConditions : TConditions;
55 50 FState: TExperimentState;
56 51 FTurnsRandom : TStringList;
57 52 function GetCondition(I : Integer): TCondition;
... ... @@ -90,36 +85,50 @@ type
90 85 procedure SetSendChatHistoryForNewPlayers(AValue: Boolean);
91 86 procedure SetState(AValue: TExperimentState);
92 87 private
  88 + FOnConsequence: TNotifyEvent;
  89 + FOnInterlocking: TNotifyEvent;
  90 + FOnEndTurn: TNotifyEvent;
  91 + FOnEndCondition: TNotifyEvent;
  92 + FOnEndCycle: TNotifyEvent;
  93 + FOnEndExperiment: TNotifyEvent;
  94 + FOnEndGeneration: TNotifyEvent;
93 95 procedure Consequence(Sender : TObject);
94 96 procedure Interlocking(Sender : TObject);
  97 + procedure WriteReportHeader;
  98 + procedure WriteReportRowNames;
  99 + procedure WriteReportRow;
95 100 public
96 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 104 destructor Destroy; override;
99 105 function LoadFromFile(AFilename: string):Boolean;
100 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 107 procedure SaveToFile(AFilename: string); overload;
108 108 procedure SaveToFile; overload;
109 109 procedure Clean;
110 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 114 property ResearcherCanPlay : Boolean read FResearcherCanPlay write SetResearcherCanPlay;
112 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 127 property Condition[I : Integer]: TCondition read GetCondition write SetCondition;
115 128 property ConditionsCount : integer read GetConditionsCount;
116 129 property CurrentCondition : integer read FCurrentCondition write FCurrentCondition;
117 130 property Contingency[C, I : integer] : TContingency read GetContingency write SetContingency;
118 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 132 property Player[I : integer] : TPlayer read GetPlayer write SetPlayer;
124 133 property PlayerFromID[S : UTF8string ] : TPlayer read GetPlayer write SetPlayer;
125 134 property PlayersCount : integer read GetPlayersCount;
... ... @@ -127,11 +136,10 @@ type
127 136 property PlayerIndexFromID[s : UTF8string]: integer read GetPlayerIndexFromID;
128 137 property PlayerAsString[P:TPlayer]: UTF8string read AliasPlayerAsString;
129 138 property PlayerFromString[s : UTF8string]: TPlayer read AliasPlayerFromString;
  139 + public
  140 + property InterlockingsIn[i:integer]:integer read GetInterlockingsIn;
130 141 property ConsequenceStringFromChoice[P:Tplayer]:UTF8String read GetConsequenceStringFromChoice;
131 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 143 property NextTurnPlayerID : UTF8string read GetNextTurnPlayerID;
136 144 property NextTurn : integer read GetNextTurn;
137 145 property NextCycle : integer read GetNextCycle;
... ... @@ -143,7 +151,6 @@ type
143 151 property OnEndGeneration : TNotifyEvent read FOnEndGeneration write SetOnEndGeneration;
144 152 property OnEndCondition : TNotifyEvent read FOnEndCondition write SetOnEndCondition;
145 153 property OnEndExperiment : TNotifyEvent read FOnEndExperiment write SetOnEndExperiment;
146   - public
147 154 property OnConsequence : TNotifyEvent read FOnConsequence write SetOnConsequence;
148 155 property OnInterlocking : TNotifyEvent read FOnInterlocking write SetOnInterlocking;
149 156 end;
... ... @@ -489,6 +496,96 @@ begin
489 496 if Assigned(FOnInterlocking) then FOnInterlocking(Sender);
490 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 589 constructor TExperiment.Create(AOwner: TComponent);
493 590 begin
494 591 inherited Create(AOwner);
... ... @@ -497,7 +594,17 @@ begin
497 594 CheckNeedForRandomTurns;
498 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 608 begin
502 609 inherited Create(AOwner);
503 610 FTurnsRandom := TStringList.Create;
... ... @@ -583,13 +690,31 @@ begin
583 690 end;
584 691  
585 692 procedure TExperiment.Clean;
  693 +var c,i : integer;
586 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 708 end;
589 709  
590 710 procedure TExperiment.Play;
  711 +var i : integer;
591 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 718 end;
594 719  
595 720 end.
... ...
units/game_file_methods.pas
  Diff comments   View file @64b24cf
... ... @@ -76,7 +76,7 @@ begin
76 76 ResearcherCanPlay:=False;
77 77 ResearcherCanChat:=True;
78 78 SendChatHistoryForNewPlayers:=True;
79   - ExperimentName:='Test Experiment';
  79 + ExperimentName:='test_experiment';
80 80 ExperimentAim:='This is a test experiment.';
81 81 GenPlayersAsNeeded:=True;
82 82 CurrentCondition := 0;
... ... @@ -98,12 +98,16 @@ begin
98 98 SetLength(Contingencies, 4);
99 99 LConcequence := TConsequence.Create(AExperiment,1,[gscPoints, gscB, gscMessage,gscBroadcastMessage],['$NICNAME','queijo','queijos']);
100 100 Contingencies[0] := TContingency.Create(AExperiment,LConcequence,LCriteria1,False);
  101 + Contingencies[0].ContingencyName := 'CRF 1B';
101 102 LConcequence := TConsequence.Create(AExperiment,3,[gscPoints, gscA, gscMessage,gscBroadcastMessage],['$NICNAME','pão','pães']);
102 103 Contingencies[1] := TContingency.Create(AExperiment,LConcequence,LCriteria2,False);
  104 + Contingencies[1].ContingencyName := 'CRF 1A';
103 105 LConcequence := TConsequence.Create(AExperiment,1,[gscPoints, gscG, gscMessage],['','item escolar','itens escolares']);
104 106 Contingencies[2] := TContingency.Create(AExperiment,LConcequence,LCriteria3,True);
  107 + Contingencies[2].ContingencyName := 'MCRF 1G';
105 108 LConcequence := TConsequence.Create(AExperiment,-1,[gscPoints, gscG, gscMessage],['','item escolar','itens escolares']);
106 109 Contingencies[3] := TContingency.Create(AExperiment,LConcequence,LCriteria4,True);
  110 + Contingencies[3].ContingencyName := 'MPUN -1G';
107 111  
108 112 Prompt := TPrompt.Create(
109 113 AExperiment
... ... @@ -129,57 +133,6 @@ var
129 133 // if not (APath[Length(APath)] = PathDelim) then APath:= APath + PathDelim;
130 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 136 procedure ReadExperiment;
184 137 begin
185 138 // Experiment;
... ... @@ -231,33 +184,6 @@ var
231 184 LConsequence : TConsequence;
232 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 187 procedure SetLCK(i:integer);
262 188 begin
263 189 if IsMeta then
... ... @@ -304,10 +230,10 @@ var
304 230 {$ENDIF}
305 231 s1 := DEF_END;
306 232 end;
307   - EndCriterium := GetEndCriteria(s1);
  233 + EndCriterium := GetEndCriteriaFromString(s1);
308 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 237 Turn.Count:= ReadInteger(LS, KEY_TURN_COUNT,1);
312 238 Turn.Value:= ReadInteger(LS, KEY_TURN_VALUE,2);
313 239 Turn.Random:= ReadBool(LS, KEY_TURN_RANDOM,False);
... ... @@ -322,7 +248,7 @@ var
322 248  
323 249 Prompt := TPrompt.Create(
324 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 252 , Contingencies
327 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 72 KEY_CONSEQUE_MESSAGE_APPENDS = '.Consequência.Mensagem.Sufixo.Singular';
73 73 KEY_CONSEQUE_MESSAGE_APPENDP = '.Consequência.Mensagem.Sufixo.Plural';
74 74  
75   -
  75 + VAL_CONSEQUENCE = 'Cosequência';
76 76 VAL_RESEARCHER = 'Pesquisador';
  77 + VAL_EXPERIMENT = 'Experimento';
  78 + VAL_INTERLOCKING = 'Entrelaçamento';
  79 +
  80 + VAL_BEGIN_TIME = 'Começo';
77 81  
78 82 DEF_END = '2,20,10,10,'; // which come first, 20 cycles | 10% entrelaçamentos in the last 10 cycles
79 83 DEF_POINTS = '0,0,0,';
... ...
units/string_methods.pas
  Diff comments   View file @64b24cf
... ... @@ -19,8 +19,6 @@ uses
19 19 , game_resources
20 20 ;
21 21  
22   -function GetAndDelFirstValue(var S: string;Sep:Char=','):string; deprecated 'Use ExtracteDelimited from strutils instead';
23   -
24 22 function GetRowString(ARow : TGameRow) : string;
25 23 function GetRowFromString(S : string):TGameRow;
26 24  
... ... @@ -31,6 +29,7 @@ function GetGameColorFromString(S : string) : TGameColor;
31 29  
32 30 function GetPromptStyleFromString(S : string) : TPromptStyle;
33 31 function GetPromptStyleString(AStyle : TPromptStyle) : string;
  32 +function GetGamePromptStyleFromString(S : string) : TGamePromptStyle;
34 33  
35 34 function GetConsequenceStyleFromString(s : string):TGameConsequenceStyle;
36 35 function GetConsequenceStyleString(AStyle : TGameConsequenceStyle): string;
... ... @@ -42,10 +41,19 @@ function GetCriteriaFromString(S : string) : TCriteria;
42 41 function GetCriteriaStyleString(AStyle: TGameStyle) : string;
43 42  
44 43 function GetStatusString(AStatus : TGamePlayerStatus): string;
  44 +function GetStatusFromString(S : string): TGamePlayerStatus;
  45 +
  46 +function GetPPointsFromString(S:string) : TPlayerPoints;
45 47 function GetPPointsString(APPoints : TPlayerPoints) : string;
46   -function GetChoiceString(AChoice : TPlayerChoice) : string;
  48 +function GetPointsFromString(S: string) : TPoints;
47 49 function GetPointsString(APoints : TPoints) : string;
  50 +
  51 +function GetChoiceString(AChoice : TPlayerChoice) : string;
  52 +function GetChoiceFromString(S:string) : TPlayerChoice;
  53 +
48 54 function GetEndCriteriaString(AEndCriterium:TEndConditionCriterium) : string;
  55 +function GetEndCriteriaFromString(S:string) : TEndConditionCriterium;
  56 +
49 57  
50 58 function GetPlayerFromString(s: string): TPlayer;
51 59 function GetPlayerAsString(P: TPlayer): string;
... ... @@ -54,6 +62,57 @@ implementation
54 62  
55 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 116 function GetAndDelFirstValue(var S: string;Sep:Char=','): string;
58 117 begin
59 118 Result := Copy(S, 0, pos(Sep, S)-1);
... ... @@ -128,18 +187,18 @@ begin
128 187 end;
129 188  
130 189  
131   -function GetPromptStyleFromString(S: string): TPromptStyle;
  190 +function GetGamePromptStyleFromString(S: string): TGamePromptStyle;
132 191 begin
133 192 // todos,sim,metacontingência,recuperar pontos,
134 193 case UpperCase(S) of
135 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 202 end;
144 203 end;
145 204  
... ... @@ -197,33 +256,31 @@ begin
197 256 Result += '|';
198 257 end;
199 258  
200   -function GetCriteriaFromString(S: string): TCriteria;
  259 +function GetCriteriaFromString(S:string):TCriteria;
201 260 var
202   - s1 : string;
203   - i : integer;
  261 + LS : string;
  262 + i,
  263 + LCount: integer;
204 264 begin
205   - s1 := ExtractDelimited(1,S,['|']);
  265 + LS := ExtractDelimited(1,S,['|']);
  266 + LCount := WordCount(LS,[#0,',']);
206 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 277 end;
220 278  
221   - s1 := ExtractDelimited(3,S,['|']);
  279 + LS := ExtractDelimited(3,S,['|']);
  280 + LCount := WordCount(LS,[#0,',']);
222 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 284 end;
228 285  
229 286 function GetCriteriaStyleString(AStyle: TGameStyle): string;
... ...