Commit 8e90821249c2ce84083ef1a139eafa664a52998a

Authored by Carlos Picanco
1 parent 17c59756
Exists in master

loading experiments - incremental work

units/game_experiment.pas
... ... @@ -46,6 +46,7 @@ type
46 46 FShowChat: Boolean;
47 47 FMatrixType: TGameMatrixType;
48 48 private
  49 + FAppPath,
49 50 FLastReportColNames : string;
50 51 FRegData : TRegData;
51 52 FRegChat : TRegData;
... ... @@ -757,23 +758,24 @@ constructor TExperiment.Create(AOwner: TComponent;AppPath:string);
757 758 var LDataPath : string;
758 759 begin
759 760 inherited Create(AOwner);
  761 + FAppPath := AppPath;
760 762 FTurnsRandom := TStringList.Create;
761   - LoadExperimentFromResource(Self);
762   - LDataPath := AppPath+VAL_RESEARCHER+'es'+PathDelim+Researcher+PathDelim+ExperimentName+PathDelim;
763   -
  763 + //LoadExperimentFromResource(Self);
  764 + //LDataPath := AppPath+VAL_RESEARCHER+'es'+PathDelim+Researcher+PathDelim+ExperimentName+PathDelim;
  765 + //
764 766 // TODO: Allow custom target interlocking. Now just taking the first meta, as usual in the lab.
765   - SetTargetInterlockingEvent;
766   - SetContingenciesEvents;
767   -
768   - CheckNeedForRandomTurns;
769   -
770   - FReportReader := TReportReader.Create;
771   - FReportReader.UseRange:=True;
772   - FReportReader.SetXLastRows(Condition[CurrentCondition].EndCriterium.LastCycles);
773   -
774   - FRegData := TRegData.Create(Self, LDataPath+'000.dat');
775   - FRegChat := TRegData.Create(Self, LDataPath+'000.chat');
776   - WriteReportHeader;
  767 + //SetTargetInterlockingEvent;
  768 + //SetContingenciesEvents;
  769 + //
  770 + //CheckNeedForRandomTurns;
  771 + //
  772 + //FReportReader := TReportReader.Create;
  773 + //FReportReader.UseRange:=True;
  774 + //FReportReader.SetXLastRows(Condition[CurrentCondition].EndCriterium.LastCycles);
  775 + //
  776 + //FRegData := TRegData.Create(Self, LDataPath+'000.dat');
  777 + //FRegChat := TRegData.Create(Self, LDataPath+'000.chat');
  778 + //WriteReportHeader;
777 779 end;
778 780  
779 781 constructor TExperiment.Create(AOwner:TComponent;AFilename,AppPath:string);
... ... @@ -795,11 +797,28 @@ begin
795 797 end;
796 798  
797 799 function TExperiment.LoadFromFile(AFilename: string): Boolean;
  800 +var
  801 + LDataPath : string;
798 802 begin
799 803 Result := LoadExperimentFromFile(Self, AFilename);
800 804 if Result then
801   - FFilename := AFilename;
  805 + FFilename := AFilename
  806 + else Exit;
  807 +
  808 + LDataPath := FAppPath+VAL_RESEARCHER+'es'+PathDelim+Researcher+PathDelim+ExperimentName+PathDelim;
  809 +
  810 + SetTargetInterlockingEvent;
  811 + SetContingenciesEvents;
  812 +
802 813 CheckNeedForRandomTurns;
  814 +
  815 + FReportReader := TReportReader.Create;
  816 + FReportReader.UseRange:=True;
  817 + FReportReader.SetXLastRows(Condition[CurrentCondition].EndCriterium.LastCycles);
  818 +
  819 + FRegData := TRegData.Create(Self, LDataPath+'000.dat');
  820 + FRegChat := TRegData.Create(Self, LDataPath+'000.chat');
  821 + WriteReportHeader;
803 822 end;
804 823  
805 824 function TExperiment.LoadFromGenerator: Boolean;
... ...
units/game_file_methods.pas
... ... @@ -26,6 +26,8 @@ uses
26 26 resourcestring
27 27 ERROR_SECTION_NOT_FOUND = 'O arquivo não pode ser aberto, pois a secção não foi encontrada: ';
28 28 ERROR_FILE_NOT_FOUND = 'O arquivo não pode ser aberto, pois ele não existe.';
  29 + ERROR_NO_CONTINGENCIES = 'O experimento não pode ser aberto, pois uma condição sem contingências foi encontrada: ';
  30 + ERROR_NO_CONDITIONS = 'O experimento não pode ser aberto, pois nenhuma condição foi encontrada.';
29 31 WARN_CONDITION_WITH_NO_END = 'Condição sem critério de encerramento: ';
30 32 WARN_END = ' será usado.';
31 33  
... ... @@ -93,18 +95,43 @@ begin
93 95 EndCriterium.Style := gecWhichComeFirst;
94 96  
95 97 SetLength(Contingencies, 4);
96   - LConcequence := TConsequence.Create(AExperiment,1,[gscPoints, gscB, gscMessage,gscBroadcastMessage],['$NICNAME','queijo','queijos']);
  98 + // test contingency
  99 + LConcequence := TConsequence.Create(
  100 + AExperiment,
  101 + 1,
  102 + [gscPoints, gscB, gscMessage,gscBroadcastMessage],
  103 + ['$NICNAME','perdeu','queijo','queijos', 'ganhou', 'queijo','queijos','não perdeu nem ganhou queijos']);
97 104 Contingencies[0] := TContingency.Create(AExperiment,LConcequence,LCriteria1,False);
98 105 Contingencies[0].ContingencyName := 'CRF 1B';
99   - LConcequence := TConsequence.Create(AExperiment,3,[gscPoints, gscA, gscMessage,gscBroadcastMessage],['$NICNAME','pão','pães']);
  106 +
  107 + // test contingency 2
  108 + LConcequence := TConsequence.Create(
  109 + AExperiment,
  110 + 3,
  111 + [gscPoints, gscA, gscMessage,gscBroadcastMessage],
  112 + ['$NICNAME','queimou','pão','pães','assou','pão','pães','não cozinhou nada.']);
100 113 Contingencies[1] := TContingency.Create(AExperiment,LConcequence,LCriteria2,False);
101 114 Contingencies[1].ContingencyName := 'CRF 3A';
102   - LConcequence := TConsequence.Create(AExperiment,1,[gscPoints, gscG, gscMessage],['','item escolar','itens escolares']);
  115 +
  116 + // test contingency 3
  117 + LConcequence := TConsequence.Create(
  118 + AExperiment,
  119 + 1,
  120 + [gscPoints, gscG, gscMessage],
  121 + ['','perderam','item escolar','itens escolares','produziram','item escolar','itens escolares','não produziram nem perderam itens escolares']);
103 122 Contingencies[2] := TContingency.Create(AExperiment,LConcequence,LCriteria3,True);
104 123 Contingencies[2].ContingencyName := 'MCRF 1G';
105   - LConcequence := TConsequence.Create(AExperiment,-1,[gscPoints, gscG, gscMessage],['','item escolar','itens escolares']);
  124 +
  125 + // test contingency 4
  126 + LConcequence := TConsequence.Create(
  127 + AExperiment,
  128 + -1,
  129 + [gscPoints, gscG, gscMessage],
  130 + ['','perderam','item escolar','itens escolares','produziram','item escolar','itens escolares','não produziram nem perderam itens escolares']);
106 131 Contingencies[3] := TContingency.Create(AExperiment,LConcequence,LCriteria4,True);
107 132 Contingencies[3].ContingencyName := 'MPUN -1G';
  133 +
  134 + // test prompt
108 135 Prompt := TPrompt.Create(
109 136 AExperiment
110 137 , [gsAll,gsYes,gsMetacontingency,gsContingency,gsRevertPoints,gsBasA]
... ... @@ -121,6 +148,7 @@ end;
121 148 function LoadExperimentFromFile(var AExperiment: TExperiment; AFilename: string):Boolean;
122 149 var
123 150 LIniFile : TIniFile;
  151 + i: Integer;
124 152  
125 153 //procedure HandleRootPath(var APath : string);
126 154 //begin
... ... @@ -131,48 +159,28 @@ var
131 159  
132 160 procedure ReadExperiment;
133 161 begin
134   - // Experiment;
135 162 with LIniFile do
136 163 begin
  164 + // must have something
137 165 AExperiment.Researcher := ReadString(SEC_EXPERIMENT, KEY_RESEARCHER,VAL_RESEARCHER);
138   - AExperiment.ExperimentName:=ReadString(SEC_EXPERIMENT, KEY_NAME,'');
  166 + AExperiment.ExperimentName:=ReadString(SEC_EXPERIMENT, KEY_NAME,VAL_EXPERIMENT);
  167 +
  168 + // optional
139 169 AExperiment.ExperimentAim:=ReadString(SEC_EXPERIMENT, KEY_AIM,'');
140   - AExperiment.GenPlayersAsNeeded:=ReadBool(SEC_EXPERIMENT, KEY_GEN_PLAYER_AS_NEEDED,True);
  170 +
  171 + // general configs
  172 + AExperiment.ResearcherCanPlay := ReadBool(SEC_EXPERIMENT, KEY_RESEARCHER_CANPLAY,False);
  173 + AExperiment.ResearcherCanChat := ReadBool(SEC_EXPERIMENT, KEY_RESEARCHER_CANCHAT,False);
  174 + AExperiment.GenPlayersAsNeeded := ReadBool(SEC_EXPERIMENT, KEY_GEN_PLAYER_AS_NEEDED,False);
  175 + AExperiment.SendChatHistoryForNewPlayers := ReadBool(SEC_EXPERIMENT, KEY_CHAT_HISTORY_FOR_NEW_PLAYERS,False);
  176 + AExperiment.ABPoints:= ReadBool(SEC_EXPERIMENT, KEY_POINTS_TYPE,False);
  177 + AExperiment.MatrixType := GetMatrixTypeFromString(ReadString(SEC_EXPERIMENT,KEY_MATRIX_TYPE,DEF_MATRIX_TYPE));
  178 +
  179 + // used when loading from paused experiments
141 180 AExperiment.CurrentCondition := ReadInteger(SEC_EXPERIMENT, KEY_CURRENT_CONDITION,0)-1; //zero based
142 181 end;
143 182 end;
144 183  
145   - procedure ReadPlayers;
146   - var
147   - LS : string;
148   - i : integer;
149   - P : TPlayer;
150   - begin
151   - i := 0;
152   - LS := SEC_PLAYER+IntToStr(i+1);
153   - with LIniFile do
154   - while SectionExists(LS) do
155   - begin
156   - if i = 0 then
157   - i := AExperiment.AppendPlayer;
158   - with P do
159   - begin
160   - Turn := ReadInteger(LS,KEY_PLAYER_TURN,i);
161   - Choice := GetChoiceFromString(ReadString(LS,KEY_PLAYER_CHOICE_LAST,'0,NONE,'));
162   - ID := ReadString(LS,KEY_PLAYER_ID,'ID');
163   - Nicname := ReadString(LS,KEY_PLAYER_NICNAME,GenResourceName(i));
164   - Login := ReadString(LS,KEY_PLAYER_LOGIN,'jogador'+IntToStr(i+1));
165   - Password := ReadString(LS,KEY_PLAYER_PASSWORD,'1234');
166   - Points := GetPPointsFromString(ReadString(LS,KEY_PLAYER_POINTS,'0,0,'));
167   - Status := GetStatusFromString(ReadString(LS,KEY_PLAYER_STATUS,'esperando'));
168   - Data.Values[KEY_PLAYER_TEMP] := ReadString(LS,KEY_PLAYER_TEMP,'');
169   - end;
170   - AExperiment.Player[i] := P;
171   - i := AExperiment.AppendPlayer;
172   - LS := SEC_PLAYER+IntToStr(i+1);
173   - end;
174   - end;
175   -
176 184 procedure ReadContingencies(ACondition:integer;IsMeta : Boolean);
177 185 var
178 186 i : integer;
... ... @@ -208,45 +216,39 @@ var
208 216 i : integer;
209 217 C :TCondition;
210 218 begin
211   - i := 0;
  219 + //i := 0;
  220 + i := AExperiment.AppendCondition;
212 221 LS := SEC_CONDITION+IntToStr(i+1);
213 222 with LIniFile do
214 223 while SectionExists(LS) do
215 224 begin
216   - if i = 0 then
217   - i := AExperiment.AppendCondition;
218   -
  225 + //if i = 0 then
  226 + // i := AExperiment.AppendCondition;
219 227 with C do
220 228 begin
221   - s1 := ReadString(LS, KEY_ENDCRITERIA,'');
222   - if s1 = '' then
223   - begin
224   - {$IFDEF DEBUG}
225   - WriteLn(WARN_CONDITION_WITH_NO_END+LS+'. '+KEY_ENDCRITERIA+KV_SEP+DEF_END+WARN_END);
226   - {$ENDIF}
227   - s1 := DEF_END;
228   - end;
229   - EndCriterium := GetEndCriteriaFromString(s1);
230 229 ConditionName := ReadString(LS,KEY_COND_NAME,LS);
231 230 Points.Count := GetPointsFromString(ReadString(LS, KEY_POINTS_COUNT,DEF_POINTS));
232 231 Points.OnStart := GetPointsFromString(ReadString(LS, KEY_POINTS_ONSTART,DEF_POINTS));
233   - Turn.Count:= ReadInteger(LS, KEY_TURN_COUNT,1);
  232 + Turn.Count:= ReadInteger(LS, KEY_TURN_COUNT,0);
234 233 Turn.Value:= ReadInteger(LS, KEY_TURN_VALUE,2);
235 234 Turn.Random:= ReadBool(LS, KEY_TURN_RANDOM,False);
236   - Cycles.Count:= ReadInteger(LS, KEY_CYCLES_COUNT,1);
  235 + Cycles.Count:= ReadInteger(LS, KEY_CYCLES_COUNT,0);
237 236 Cycles.Value:= ReadInteger(LS, KEY_CYCLES_VALUE,10);
238   - Cycles.Generation:= ReadInteger(LS, KEY_CYCLES_GEN,1);
  237 + Cycles.Generation:= ReadInteger(LS, KEY_CYCLES_GEN,5);
  238 + EndCriterium.Style := GetEndCriteriaStyleFromString(ReadString(LS,KEY_ENDCRITERIA,DEF_END_CRITERIA_STYLE));
  239 + EndCriterium.AbsoluteCycles:=ReadInteger(LS,KEY_ENDCRITERIA_CYCLES,20);
  240 + s1 := ReadString(LS,KEY_ENDCRITERIA_PORCENTAGE,DEF_END_CRITERIA_PORCENTAGE);
  241 + EndCriterium.InterlockingPorcentage:= GetEndCriteriaPorcentageFromString(s1);
  242 + EndCriterium.LastCycles:= GetEndCriteriaLastCyclesFromString(s1);
239 243  
240 244 ReadContingencies(i,True);
241 245 ReadContingencies(i,False);
242 246  
243   - // if no contingencies, return false...
244   -
245 247 Prompt := TPrompt.Create(
246 248 AExperiment
247   - , GetPromptStyleFromString(ReadString(LS,KEY_PROMPT_STYLE,'todos,sim,metacontingência,recuperar pontos,'))
  249 + , GetPromptStyleFromString(ReadString(LS,KEY_PROMPT_STYLE,''))
248 250 , Contingencies
249   - , ReadString(LS,KEY_PROMPT_MESSAGE,DEF_PROMPTMESSAGE)
  251 + , ReadString(LS,KEY_PROMPT_MESSAGE,'')
250 252 );
251 253  
252 254 end;
... ... @@ -256,6 +258,37 @@ var
256 258 end;
257 259 end;
258 260  
  261 + procedure ReadPlayers;
  262 + var
  263 + LS : string;
  264 + i : integer;
  265 + P : TPlayer;
  266 + begin
  267 + i := 0;
  268 + LS := SEC_PLAYER+IntToStr(i+1);
  269 + with LIniFile do
  270 + while SectionExists(LS) do
  271 + begin
  272 + if i = 0 then
  273 + i := AExperiment.AppendPlayer;
  274 + with P do
  275 + begin
  276 + Turn := ReadInteger(LS,KEY_PLAYER_TURN,i);
  277 + Choice := GetChoiceFromString(ReadString(LS,KEY_PLAYER_CHOICE_LAST,'0,NONE,'));
  278 + ID := ReadString(LS,KEY_PLAYER_ID,'ID');
  279 + Nicname := ReadString(LS,KEY_PLAYER_NICNAME,GenResourceName(i));
  280 + Login := ReadString(LS,KEY_PLAYER_LOGIN,'jogador'+IntToStr(i+1));
  281 + Password := ReadString(LS,KEY_PLAYER_PASSWORD,'1234');
  282 + Points := GetPPointsFromString(ReadString(LS,KEY_PLAYER_POINTS,'0,0,'));
  283 + Status := GetStatusFromString(ReadString(LS,KEY_PLAYER_STATUS,'esperando'));
  284 + Data.Values[KEY_PLAYER_TEMP] := ReadString(LS,KEY_PLAYER_TEMP,'');
  285 + end;
  286 + AExperiment.Player[i] := P;
  287 + i := AExperiment.AppendPlayer;
  288 + LS := SEC_PLAYER+IntToStr(i+1);
  289 + end;
  290 + end;
  291 +
259 292 begin
260 293 Result := False;
261 294 if FileExists(AFileName) then
... ... @@ -266,15 +299,33 @@ begin
266 299 begin
267 300 AExperiment := TExperiment.Create(AExperiment.Owner);
268 301 ReadExperiment;
269   - ReadPlayers;
270 302 ReadConditions;
  303 + ReadPlayers;
  304 +
  305 + with AExperiment do
  306 + if ConditionsCount > 0 then
  307 + for i := 0 to ConditionsCount-1 do
  308 + if ContingenciesCount[i] > 0 then
  309 + Continue
  310 + else
  311 + begin
  312 + ShowMessage(ERROR_NO_CONTINGENCIES+SEC_CONDITION+IntToStr(i+1));
  313 + Exit;
  314 + end
  315 + else
  316 + begin
  317 + ShowMessage(ERROR_NO_CONDITIONS);
  318 + Exit;
  319 + end;
  320 +
  321 + Result := True;
271 322 end
272 323 else
273 324 begin
274 325 ShowMessage(ERROR_SECTION_NOT_FOUND+SEC_EXPERIMENT);
275   - LIniFile.Free;
276 326 Exit;
277 327 end;
  328 + LIniFile.Free;
278 329 end
279 330 else
280 331 ShowMessage(ERROR_FILE_NOT_FOUND);
... ... @@ -311,7 +362,7 @@ begin
311 362 WriteInteger(LC, KEY_CYCLES_VALUE,Cycles.Value);
312 363 WriteInteger(LC, KEY_CYCLES_GEN,Cycles.Generation);
313 364 //WriteBool(LC, KEY_PROMPT_VALUE,Prompt.Value);
314   - //WriteString(LC, KEY_PROMPT_MESSAGE, Prompt.PromptMessage); TODO: write prompt as string
  365 + //WriteString(LC, KEY_PROMPT_MESSAGE, Prompt.PromptMessage);
315 366 //WriteString(LC, KEY_PROMPT_STYLE, GetPromptStyleString(Prompt.PromptStyle));
316 367  
317 368 for j := 0 to High(Contingencies) do
... ... @@ -323,7 +374,7 @@ begin
323 374  
324 375 with Contingencies[j] do
325 376 begin
326   - WriteString(LC,LCK+KEY_CONSEQUE,Consequence.AsString('')); // TODO review this
  377 + WriteString(LC,LCK+KEY_CONSEQUE,Consequence.AsString(''));
327 378 WriteString(LC,LCK+KEY_CRITERIA,CriteriaString);
328 379 end;
329 380 end;
... ...
units/game_resources.pas
... ... @@ -81,16 +81,19 @@ resourcestring
81 81 VAL_RESEARCHER = 'Pesquisador';
82 82 VAL_EXPERIMENT = 'Experimento';
83 83 VAL_INTERLOCKING = 'Entrelaçamento';
84   -
85 84 VAL_BEGIN_TIME = 'Começo';
  85 + VAL_RESEARCHERS = 'Pesquisadores';
  86 +
  87 + DEF_END_CRITERIA_STYLE = 'CICLOS';
  88 + //DEF_END_CRITERIA_CYCLES = '20';
  89 + DEF_END_CRITERIA_PORCENTAGE = '80,10';
86 90  
87   - DEF_END = '2,20,10,10,'; // which come first, 20 cycles | 10% entrelaçamentos in the last 10 cycles
88 91 DEF_POINTS = '0,0,0,';
89   - DEF_CONSEQUENCE = '1,0|M,C,P,A,|$NICNAME|ponto|pontos|';
  92 + DEF_CONSEQUENCE = '1,0|M,C,P,A,|$NICNAME produziu|ponto.|pontos.|';
90 93 DEF_METARESPONSE = 'IMPAR,E,DIFERENTES,';
91 94 DEF_CRITERIA = 'PAR,E,INDIFERENTE,';
92   - DEF_PROMPTMESSAGE = 'Vocês perderam <$G> item escolar. Desejam recuperá-lo gastando pontos do Tipo A?';
93   -
  95 + //DEF_PROMPTMESSAGE = 'Vocês perderam 1 item escolar. Desejam recuperá-lo gastando pontos do Tipo A?';
  96 + DEF_MATRIX_TYPE = 'CORES,LINHAS,';
94 97 const
95 98 // grid colors
96 99 ccYellow = $00FFFF;
... ...
units/string_methods.pas
... ... @@ -56,9 +56,12 @@ function GetChoiceFromString(S:string) : TPlayerChoice;
56 56 function GetEndCriteriaLastCyclesFromString(S:string):integer;
57 57 function GetEndCriteriaPorcentageFromString(S:string):integer;
58 58 function GetEndCriteriaStyleString(AEndCriteriaStyle : TGameEndCondition):string;
  59 +function GetEndCriteriaStyleFromString(S:string):TGameEndCondition;
59 60 function GetEndCriteriaString(AEndCriterium:TEndConditionCriterium) : string;
60 61 function GetEndCriteriaFromString(S:string) : TEndConditionCriterium;
61 62  
  63 +function GetMatrixTypeFromString(S:string) : TGameMatrixType;
  64 +function GetMatrixTypeString(AMatrixType: TGameMatrixType): string;
62 65  
63 66 function GetPlayerFromString(s: string): TPlayer;
64 67 function GetPlayerAsString(P: TPlayer): string;
... ... @@ -411,6 +414,15 @@ begin
411 414 end;
412 415 end;
413 416  
  417 +function GetEndCriteriaStyleFromString(S: string): TGameEndCondition;
  418 +begin
  419 + case S of
  420 + 'CICLOS': Result := gecAbsoluteCycles;
  421 + 'PORCENTAGEM': Result := gecInterlockingPorcentage;
  422 + 'O QUE OCORRER PRIMEIRO': Result := gecWhichComeFirst;
  423 + end;
  424 +end;
  425 +
414 426 function GetEndCriteriaString(AEndCriterium: TEndConditionCriterium
415 427 ): string;
416 428 begin
... ... @@ -524,6 +536,39 @@ begin
524 536 Result += M[i] + '|';
525 537 end;
526 538  
  539 +function GetMatrixTypeFromString(S: string): TGameMatrixType;
  540 +var
  541 + LCount, i: Integer;
  542 +begin
  543 + Result := [];
  544 + LCount := WordCount(S,[#0,',']);
  545 + for i:= 1 to LCount do
  546 + case ExtractDelimited(i,S,[',']) of
  547 + 'CORES' : Result +=[gmColors];
  548 + 'LINHAS':Result+=[gmRows];
  549 + 'COLUNAS':Result+=[gmColumns];
  550 + 'CÍRCULOS PREENCHIDOS':Result+=[gmDots];
  551 + 'CÍRCULOS VAZADOS':Result+=[gmClearDots];
  552 + 'CÍRCULOS AMBOS':Result+=[gmDotsClearDots];
  553 + end;
  554 +end;
  555 +
  556 +function GetMatrixTypeString(AMatrixType: TGameMatrixType): string;
  557 +var
  558 + LCount: Integer;
  559 + LType : TGameMatrix;
  560 +begin
  561 + Result := '';
  562 + for LType in AMatrixType do
  563 + case LType of
  564 + gmColors : Result += 'CORES,';
  565 + gmRows : Result += 'LINHAS,';
  566 + gmColumns : Result += 'COLUNAS,';
  567 + gmDots : Result += 'CÍRCULOS PREENCHIDOS,';
  568 + gmClearDots : Result += 'CÍRCULOS VAZADOS,';
  569 + gmDotsClearDots : Result += 'CÍRCULOS AMBOS,';
  570 + end;
  571 +end;
527 572  
528 573 function GetPlayerFromString(s: string): TPlayer;
529 574  
... ...