Download as
Browse Code »

Commit a1b6309a11f729e97e4031b5468f794029636ded

Authored by Carlos Picanco
1 parent fe645aa2
Exists in master

implement next condition and experiment end

Showing 5 changed files with 360 additions and 164 deletions   Show diff stats
form_chooseactor.pas
  Diff comments   View file @a1b6309
... ... @@ -126,9 +126,10 @@ begin
126 126 WordWrap := True;
127 127 Parent:=Self;
128 128 Font.Size := 30;
  129 + OnClick := @ShowResumeButton;
129 130 case FStyle of
130   - '.Left': OnClick := @ShowResumeButton;
131   - '.EndX': OnClick := @ExitApplication;
  131 + '.Left': btnPlayerResume.Caption := 'Entrar';
  132 + '.EndX': btnPlayerResume.Caption := 'Sair';
132 133 end;
133 134 end;
134 135 end;
... ...
units/game_control.pas
  Diff comments   View file @a1b6309
... ... @@ -56,11 +56,14 @@ type
56 56 procedure ShowConsequenceMessage(AID,S:string;ForGroup:Boolean);
57 57 procedure DisableConfirmationButton;
58 58 procedure CleanMatrix(AEnabled : Boolean);
  59 + procedure NextConditionSetup(S : string);
59 60 procedure EnablePlayerMatrix(AID:UTF8string; ATurn:integer; AEnabled:Boolean);
60 61 private
  62 + function IsLastCondition : Boolean;
61 63 function ShouldStartExperiment: Boolean;
62 64 function ShouldEndCycle : Boolean;
63   - function ShouldEndGeneration : Boolean;
  65 + function ShouldEndCondition : Boolean;
  66 + //function ShouldEndGeneration : Boolean;
64 67 function ShouldAskQuestion : Boolean;
65 68 procedure NextTurn(Sender: TObject);
66 69 procedure NextCycle(Sender: TObject);
... ... @@ -105,6 +108,7 @@ const
105 108 K_QMESSAGE = '.QMessage';
106 109 K_MOVQUEUE = '.Queue';
107 110 K_END = '.EndX';
  111 + K_NXTCND = '.NextCond';
108 112  
109 113 //
110 114 K_STATUS = '.Status';
... ... @@ -158,16 +162,31 @@ begin
158 162 Result := FExperiment.Condition[FExperiment.CurrentCondition].Turn.Count = FExperiment.Condition[FExperiment.CurrentCondition].Turn.Value-1;
159 163 end;
160 164  
161   -function TGameControl.ShouldEndGeneration: Boolean;
  165 +function TGameControl.IsLastCondition: Boolean;
162 166 begin
163   - Result := FExperiment.Condition[FExperiment.CurrentCondition].Cycles.Count = FExperiment.Condition[FExperiment.CurrentCondition].Cycles.Value-1;
  167 + Result := FExperiment.CurrentCondition = FExperiment.ConditionsCount-1;
164 168 end;
165 169  
  170 +function TGameControl.ShouldEndCondition: Boolean;
  171 +begin
  172 + Result := FExperiment.ShouldEndCondition;
  173 +end;
  174 +
  175 +//function TGameControl.ShouldEndGeneration: Boolean;
  176 +//begin
  177 +// Result := FExperiment.Condition[FExperiment.CurrentCondition].Cycles.Count = FExperiment.Condition[FExperiment.CurrentCondition].Cycles.Value-1;
  178 +//end;
  179 +
166 180 function TGameControl.ShouldAskQuestion: Boolean;
167 181 begin
168 182 Result := Assigned(FExperiment.Condition[FExperiment.CurrentCondition].Prompt) and FExperiment.Condition[FExperiment.CurrentCondition].Contingencies[3].Fired;
169 183 end;
170 184  
  185 +procedure TGameControl.EndExperiment(Sender: TObject);
  186 +begin
  187 + ShowPopUp('O Experimento terminou.');
  188 +end;
  189 +
171 190 procedure TGameControl.NextTurn(Sender: TObject);
172 191 begin
173 192 // update admin view
... ... @@ -194,11 +213,7 @@ begin
194 213 FormMatrixGame.LabelExpCountCondition.Caption:= FExperiment.Condition[FExperiment.CurrentCondition].ConditionName;
195 214  
196 215 // append OnStart data
197   - //FExperiment.Condition[FExperiment.CurrentCondition].Points.OnStart.A;
198   - //FExperiment.Condition[FExperiment.CurrentCondition].Points.OnStart.B;
199   - //FExperiment.Condition[FExperiment.CurrentCondition].Points.OnStart.G;
200   -
201   - // append which player
  216 + NextConditionSetup(FExperiment.CurrentConditionAsString);
202 217 end;
203 218  
204 219 procedure TGameControl.Interlocking(Sender: TObject);
... ... @@ -223,11 +238,6 @@ begin
223 238 {$ENDIF}
224 239 end;
225 240  
226   -procedure TGameControl.EndExperiment(Sender: TObject);
227   -begin
228   - FZMQActor.SendMessage([K_END]);
229   -end;
230   -
231 241 procedure TGameControl.StartExperiment;
232 242 begin
233 243 // all players arrived, lets begin
... ... @@ -532,6 +542,62 @@ begin
532 542 FormMatrixGame.btnConfirmRow.Visible := False;
533 543 end;
534 544  
  545 +procedure TGameControl.NextConditionSetup(S: string);
  546 +var
  547 + A, B, G : integer;
  548 + P : TPlayer;
  549 + PB : TPlayerBox;
  550 +begin
  551 + if FExperiment.ABPoints then
  552 + begin
  553 + A := StrToInt(ExtractDelimited(1,S,['|']));
  554 + B := StrToInt(ExtractDelimited(2,S,['|']));
  555 + G := StrToInt(ExtractDelimited(3,S,['|']));
  556 +
  557 + G += StrToInt(FormMatrixGame.LabelGroupCount.Caption);
  558 + FormMatrixGame.LabelGroupCount.Caption := IntToStr(G);
  559 + case FActor of
  560 + gaPlayer:
  561 + begin
  562 + A += StrToInt(FormMatrixGame.LabelIndACount.Caption);
  563 + B += StrToInt(FormMatrixGame.LabelIndBCount.Caption);
  564 +
  565 + FormMatrixGame.LabelIndACount.Caption := IntToStr(A);
  566 + FormMatrixGame.LabelIndBCount.Caption := IntToStr(B);
  567 + end;
  568 + gaAdmin:
  569 + for P in FExperiment.Players do
  570 + begin
  571 + PB := GetPlayerBox(P.ID);
  572 + A += StrToInt(PB.LabelPointsCount.Caption) + B;
  573 + PB.LabelPointsCount.Caption := IntToStr(A);
  574 + end;
  575 + end;
  576 + end
  577 + else
  578 + begin
  579 + A := StrToInt(ExtractDelimited(1,S,['|']));
  580 + G := StrToInt(ExtractDelimited(2,S,['|']));
  581 + G += StrToInt(FormMatrixGame.LabelGroupCount.Caption);
  582 + FormMatrixGame.LabelGroupCount.Caption := IntToStr(G);
  583 + case FActor of
  584 + gaPlayer:
  585 + begin
  586 + A += StrToInt(FormMatrixGame.LabelIndACount.Caption);
  587 + FormMatrixGame.LabelIndCount.Caption := IntToStr(A);
  588 + end;
  589 +
  590 + gaAdmin:
  591 + for P in FExperiment.Players do
  592 + begin
  593 + PB := GetPlayerBox(P.ID);
  594 + A += StrToInt(PB.LabelPointsCount.Caption) + B;
  595 + PB.LabelPointsCount.Caption := IntToStr(A);
  596 + end;
  597 + end;
  598 + end;
  599 +end;
  600 +
535 601 procedure TGameControl.EnablePlayerMatrix(AID:UTF8string; ATurn:integer; AEnabled:Boolean);
536 602 begin
537 603 if FExperiment.PlayerFromID[AID].Turn = ATurn then
... ... @@ -571,6 +637,7 @@ begin
571 637 FExperiment.OnEndExperiment:= @EndExperiment;
572 638 FExperiment.OnInterlocking:=@Interlocking;
573 639 FExperiment.OnConsequence:=@Consequence;
  640 + FExperiment.OnTargetInterlocking:=@TargetInterlocking;
574 641  
575 642 SendRequest(K_LOGIN); // admin cannot send requests
576 643 end;
... ... @@ -703,7 +770,8 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
703 770 , ' '
704 771 , GA_PLAYER+K_QUESTION
705 772 , AskQuestion(AMessage[1])
706   - , AMessage[2]
  773 + , AMessage[2] // generation
  774 + , AMessage[3] // conditions
707 775 ]);
708 776 end;
709 777  
... ... @@ -780,8 +848,13 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
780 848 end;
781 849  
782 850 procedure ReceiveChat;
  851 + var
  852 + ALn: string;
783 853 begin
784   - FormMatrixGame.ChatMemoRecv.Lines.Append(('['+AMessage[1]+']: ')+AMessage[2]);
  854 + ALn := '['+AMessage[1]+']: '+AMessage[2];
  855 + FormMatrixGame.ChatMemoRecv.Lines.Append(ALn);
  856 + if FActor = gaAdmin then
  857 + FExperiment.WriteChatLn(ALn);
785 858 end;
786 859  
787 860 procedure MovePlayerQueue;
... ... @@ -839,51 +912,7 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
839 912 end;
840 913 end;
841 914  
842   - procedure ResumeNextTurn;
843   - begin
844   - case FActor of
845   - gaPlayer:begin
846   - if AMessage[1] <> #32 then
847   - SayGoodBye(AMessage[1])
848   - else
849   - EnablePlayerMatrix(Self.ID,0, True);
850   -
851   - end;
852   - gaAdmin:begin
853   - if AMessage[1] <> #32 then
854   - begin
855   - DeletePlayerBox(AMessage[1]); // old player
856   - ShowPopUp(
857   - 'O participante '+
858   - FExperiment.PlayerFromID[AMessage[1]].Nicname+
859   - ' saiu. Aguardando a entrada do próximo participante.'
860   - );
861   - end;
862   - end;
863   - end;
864   - end;
865   -
866   - procedure QuestionMessages;
867   - var
868   - i : integer;
869   - MID : string;
870   - begin
871   - if AMessage.Count > 1 then
872   - begin
873   - for i := 2 to AMessage.Count -1 do
874   - begin
875   - MID := ExtractDelimited(1,AMessage[i],['+']);
876   - ShowConsequenceMessage(MID, ExtractDelimited(2,AMessage[i],['+']),MID = 'M');
877   -
878   - {$IFDEF DEBUG}
879   - WriteLn('A Prompt consequence should have shown.');
880   - {$ENDIF}
881   - end;
882   - end;
883   - ResumeNextTurn;
884   - end;
885   -
886   - procedure ShowPointsToPlayers;
  915 + procedure EndExperimentMessage;
887 916 var Pts : string;
888 917 begin
889 918 case FActor of
... ... @@ -901,16 +930,74 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
901 930 FormChooseActor.ShowPoints(
902 931 'A tarefa terminou, obrigado por sua participação! Você produziu ' +
903 932 Pts + ' pontos e ' +
904   - FormMatrixGame.LabelGroupCount.Caption + 'itens escolares serão doados!');
905   - FormChooseActor.Show;
906   - end;
907   - gaAdmin:
908   - begin
909   - Stop;
  933 + FormMatrixGame.LabelGroupCount.Caption + 'itens escolares serão doados! Parabéns!');
  934 + FormChooseActor.ShowModal;
  935 + FormChooseActor.Free;
  936 + FormMatrixGame.Close;
910 937 end;
  938 + gaAdmin:Stop;
911 939 end;
912 940 end;
913 941  
  942 + procedure ResumeNextTurn;
  943 + begin
  944 + if AMessage[2] <> #27 then
  945 + begin
  946 + case FActor of
  947 + gaPlayer:
  948 + begin
  949 + if AMessage[1] <> #32 then
  950 + SayGoodBye(AMessage[1])
  951 + else
  952 + EnablePlayerMatrix(Self.ID,0, True);
  953 + end;
  954 +
  955 + gaAdmin:
  956 + begin
  957 + if AMessage[1] <> #32 then
  958 + begin
  959 + DeletePlayerBox(AMessage[1]); // old player
  960 + ShowPopUp(
  961 + 'O participante '+
  962 + FExperiment.PlayerFromID[AMessage[1]].Nicname+
  963 + ' saiu. Aguardando a entrada do próximo participante.'
  964 + );
  965 + end;
  966 + end;
  967 +
  968 + end;
  969 + if AMessage[2] <> #32 then
  970 + NextConditionSetup(AMessage[2]);
  971 + end
  972 + else EndExperimentMessage;
  973 + end;
  974 +
  975 + procedure QuestionMessages;
  976 + var
  977 + i : integer;
  978 + MID : string;
  979 + begin
  980 + if AMessage[2] <> #27 then
  981 + begin
  982 + if AMessage.Count > 1 then
  983 + begin
  984 + for i := 3 to AMessage.Count -1 do
  985 + begin
  986 + MID := ExtractDelimited(1,AMessage[i],['+']);
  987 + ShowConsequenceMessage(MID, ExtractDelimited(2,AMessage[i],['+']),MID = 'M');
  988 +
  989 + {$IFDEF DEBUG}
  990 + WriteLn('A Prompt consequence should have shown.');
  991 + {$ENDIF}
  992 + end;
  993 + end;
  994 + ResumeNextTurn;
  995 + if AMessage[2] <> #32 then
  996 + NextConditionSetup(AMessage[2]);
  997 + end
  998 + else EndExperimentMessage;
  999 + end;
  1000 +
914 1001 begin
915 1002 if MHas(K_ARRIVED) then ReceiveActor;
916 1003 if MHas(K_CHAT_M) then ReceiveChat;
... ... @@ -921,7 +1008,8 @@ begin
921 1008 if MHas(K_MOVQUEUE) then MovePlayerQueue;
922 1009 if MHas(K_QMESSAGE) then QuestionMessages;
923 1010 if MHas(K_RESUME) then ResumeNextTurn;
924   - if MHAs(K_END) then ShowPointsToPlayers;
  1011 + if MHas(K_NXTCND) then NextConditionSetup(AMessage[1]);
  1012 + if MHAs(K_END) then EndExperimentMessage;
925 1013 end;
926 1014  
927 1015 // Here FActor is garanted to be a TZMQAdmin
... ... @@ -983,17 +1071,20 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList);
983 1071 if FExperiment.Player[i].ID <> P.ID then
984 1072 begin
985 1073 TS := FExperiment.PlayerAsString[FEXperiment.Player[i]];
986   - ARequest.Append(TS); // FROM 3 to COUNT-3
  1074 + ARequest.Append(TS); // FROM 3 to COUNT-4
987 1075 end;
988 1076  
989   - // append chat data if allowed at the last position
  1077 + // append chat data if allowed
990 1078 if FExperiment.SendChatHistoryForNewPlayers then
991   - ARequest.Append(FormMatrixGame.ChatMemoRecv.Lines.Text) // COUNT-2
  1079 + ARequest.Append(FormMatrixGame.ChatMemoRecv.Lines.Text) // COUNT-3
992 1080 else
993 1081 ARequest.Append('[CHAT]'); // must append something to keep the message envelop standard
994 1082  
995 1083 // append global configs.
996   - ARequest.Append(BoolToStr(FExperiment.ABPoints)); // COUNT-1
  1084 + ARequest.Append(BoolToStr(FExperiment.ABPoints)); // COUNT-2
  1085 +
  1086 + // append condition global data
  1087 + ARequest.Append(FExperiment.CurrentConditionAsString);
997 1088  
998 1089 // inform all players about the new player, including itself
999 1090 FZMQActor.SendMessage([K_ARRIVED,PS]);
... ... @@ -1019,7 +1110,9 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList);
1019 1110 LConsequences : string;
1020 1111 P : TPlayer;
1021 1112 S : string;
  1113 + LEndCondition,
1022 1114 LEndCycle : Boolean;
  1115 + LEndGeneration: string;
1023 1116 begin
1024 1117 {$IFDEF DEBUG}
1025 1118 WriteLn('Count:',FExperiment.Condition[FExperiment.CurrentCondition].Turn.Count, '<', FExperiment.Condition[FExperiment.CurrentCondition].Turn.Value);
... ... @@ -1038,10 +1131,13 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList);
1038 1131 if Pos('$NICNAME',S) > 0 then
1039 1132 S := ReplaceStr(S,'$NICNAME',P.Nicname);
1040 1133  
1041   - // update turn
  1134 + // "NextGeneration" and "ShouldEndCycle" methods must be called before Experiment.NextTurn
1042 1135 LEndCycle := ShouldEndCycle;
  1136 + LEndGeneration := FExperiment.NextGeneration;
1043 1137 if LEndCycle then
1044   - LConsequences := FExperiment.ConsequenceStringFromChoices;// AsString generates the pts result; must be called before next cycle
  1138 + LConsequences := FExperiment.ConsequenceStringFromChoices;
  1139 +
  1140 + // update turn
1045 1141 P.Turn := FExperiment.NextTurn;
1046 1142 FExperiment.Player[FExperiment.PlayerIndexFromID[P.ID]] := P;
1047 1143  
... ... @@ -1061,7 +1157,22 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList);
1061 1157 FExperiment.WriteReportRowPrompt;
1062 1158 FExperiment.Clean;
1063 1159 end;
1064   - ARequest.Append(FExperiment.NextGeneration); // 9, #32 no, else NextGeneration = PlayerToKick
  1160 +
  1161 + ARequest.Append(LEndGeneration); // 9, #32 resume, else NextGeneration = PlayerToKick AID
  1162 + LEndCondition := ShouldEndCondition;
  1163 + if IsLastCondition and LEndCondition then // 10
  1164 + // end experiment envelop
  1165 + ARequest.Append(#27)
  1166 + else
  1167 + if LEndCondition then
  1168 + begin
  1169 + FExperiment.NextCondition;
  1170 + // end condition envelop
  1171 + ARequest.Append(FExperiment.CurrentConditionAsString);
  1172 + end
  1173 + else
  1174 + // do nothing envelop
  1175 + ARequest.Append(#32);
1065 1176 end;
1066 1177 end;
1067 1178  
... ... @@ -1084,9 +1195,10 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList);
1084 1195  
1085 1196 // generate messages
1086 1197 LPromptConsequences := FExperiment.Condition[FExperiment.CurrentCondition].Prompt.AsString;
1087   - SetLength(M, 2+LPromptConsequences.Count);
  1198 + SetLength(M, 3+LPromptConsequences.Count);
1088 1199 M[0] := K_QMESSAGE;
1089   - M[1] := ARequest[4]; // generations
  1200 + M[1] := ARequest[4]; // generation envelop
  1201 + M[2] := ARequest[5]; // conditions
1090 1202 if LPromptConsequences.Count > 0 then
1091 1203 begin
1092 1204 for i := 0 to LPromptConsequences.Count-1 do
... ... @@ -1096,7 +1208,7 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList);
1096 1208 LPromptConsequences[i] := ReplaceStr(LPromptConsequences[i],'$NICNAME', P.Nicname);
1097 1209 end;
1098 1210 for i := 0 to LPromptConsequences.Count -1 do
1099   - M[i+2] := LPromptConsequences[i];
  1211 + M[i+3] := LPromptConsequences[i]; // messages envelop
1100 1212 end
1101 1213 else;
1102 1214  
... ... @@ -1147,7 +1259,7 @@ procedure TGameControl.ReceiveReply(AReply: TStringList);
1147 1259 begin
1148 1260 if Self.ID = AReply[0] then
1149 1261 begin
1150   - for i:= 3 to AReply.Count -3 do
  1262 + for i:= 3 to AReply.Count -4 do
1151 1263 begin
1152 1264 P := FExperiment.PlayerFromString[AReply[i]];
1153 1265 FExperiment.AppendPlayer(P);
... ... @@ -1156,11 +1268,15 @@ procedure TGameControl.ReceiveReply(AReply: TStringList);
1156 1268  
1157 1269 // add chat
1158 1270 FormMatrixGame.ChatMemoRecv.Lines.Clear;
1159   - FormMatrixGame.ChatMemoRecv.Lines.Add(AReply[AReply.Count-2]);
  1271 + FormMatrixGame.ChatMemoRecv.Lines.Add(AReply[AReply.Count-3]);
1160 1272  
1161 1273 // set global configs
1162   - FormMatrixGame.GBIndividualAB.Visible := StrToBool(AReply[AReply.Count-1]);
  1274 + FExperiment.ABPoints := StrToBool(AReply[AReply.Count-2]);
  1275 + FormMatrixGame.GBIndividualAB.Visible := FExperiment.ABPoints;
1163 1276 FormMatrixGame.GBIndividual.Visible:= not FormMatrixGame.GBIndividualAB.Visible;
  1277 +
  1278 + // set condition specific configurations
  1279 + NextConditionSetup(AReply[AReply.Count-1])
1164 1280 end
1165 1281 else
1166 1282 begin
... ... @@ -1184,12 +1300,17 @@ procedure TGameControl.ReceiveReply(AReply: TStringList);
1184 1300 {$IFDEF DEBUG}
1185 1301 WriteLn('LCount:',LCount);
1186 1302 {$ENDIF}
  1303 +
  1304 + // inform other players about self.id choice
1187 1305 FZMQActor.SendMessage([K_CHOICE,AReply[0],AReply[3],AReply[4],AReply[5]]);
1188 1306  
  1307 + // The Announcer sends a message, waits interval time until all messages have been sent and then destroys itself.
1189 1308 LAnnouncer := TIntervalarAnnouncer.Create(nil);
1190 1309 LAnnouncer.OnStart := @FZMQActor.SendMessage;
1191   - LAnnouncer.Interval := 2000;
  1310 + LAnnouncer.Interval := 500;
1192 1311 LCount := WordCount(AReply[6],['+']);
  1312 +
  1313 + // individual consequences
1193 1314 if LCount > 0 then
1194 1315 for i := 1 to LCount do
1195 1316 begin
... ... @@ -1208,6 +1329,7 @@ procedure TGameControl.ReceiveReply(AReply: TStringList);
1208 1329 {$ENDIF}
1209 1330 end;
1210 1331  
  1332 + // group consequence
1211 1333 if AReply.Count > 7 then
1212 1334 begin
1213 1335 LCount := WordCount(AReply[7],['+']);
... ... @@ -1223,12 +1345,21 @@ procedure TGameControl.ReceiveReply(AReply: TStringList);
1223 1345 {$ENDIF}
1224 1346 end;
1225 1347  
  1348 + // should ask question or just resume (going to the next turn)?
1226 1349 if AReply[8] <> #32 then
1227 1350 //FZMQActor.SendMessage([K_QUESTION,AReply[8],AReply[9]])
1228   - LAnnouncer.Append([K_QUESTION,AReply[8],AReply[9]])
  1351 + LAnnouncer.Append([K_QUESTION,AReply[8],AReply[9],AReply[10]])
1229 1352 else
1230 1353 //FZMQActor.SendMessage([K_RESUME,AReply[9]]);
1231   - LAnnouncer.Append([K_RESUME,AReply[9]]);
  1354 + LAnnouncer.Append([K_RESUME,AReply[9],AReply[10]]);
  1355 +
  1356 + // should end experiment or go to the next condition?
  1357 + if (AReply[10] = #27) and (AReply[8] = #32) then
  1358 + LAnnouncer.Append([K_END])
  1359 + else
  1360 + if (AReply[10] <> #32) then
  1361 + LAnnouncer.Append([K_NXTCND,AReply[10]])
  1362 +
1232 1363 end;
1233 1364  
1234 1365 LAnnouncer.Reversed;
... ...
units/game_experiment.pas
  Diff comments   View file @a1b6309
... ... @@ -13,6 +13,10 @@ unit game_experiment;
13 13  
14 14 interface
15 15  
  16 +
  17 + // TODO: REFACTORING. FILE METHODS MUST USE THE SAME METHODS FROM HERE WHEN LOADING CONDITONS, CONTINGENCIES AND SO ON. KEEP IT SIMPLE.
  18 +
  19 +
16 20 uses
17 21 Classes, SysUtils
18 22 , game_actors
... ... @@ -29,6 +33,8 @@ type
29 33  
30 34 TExperiment = class(TComponent)
31 35 private
  36 + FABPoints: Boolean;
  37 + //FChangeGeneration: string;
32 38 FExperimentAim,
33 39 FExperimentName,
34 40 FFilename,
... ... @@ -42,6 +48,7 @@ type
42 48 private
43 49 FLastReportColNames : string;
44 50 FRegData : TRegData;
  51 + FRegChat : TRegData;
45 52 FReportReader : TReportReader;
46 53 FPlayers : TPlayers;
47 54 FCurrentCondition : integer;
... ... @@ -57,10 +64,11 @@ type
57 64 function GetNextCycle:integer;
58 65 function GetNextCondition:integer;
59 66 function GetCurrentAbsoluteCycle : integer;
60   - function GetPlayer(I : integer): TPlayer; overload;
61   - function GetPlayer(AID : UTF8string): TPlayer; overload;
62 67 function AliasPlayerAsString(P: TPlayer): UTF8string;
63 68 function AliasPlayerFromString(s : UTF8string): TPlayer;
  69 + function GetPlayer(I : integer): TPlayer; overload;
  70 + function GetPlayer(AID : UTF8string): TPlayer; overload;
  71 + function GetPlayerToKick: string;
64 72 function GetPlayerIndexFromID(AID : UTF8string): integer;
65 73 function GetPlayerIsPlaying(AID : UTF8string): Boolean;
66 74 function GetPlayersCount: integer;
... ... @@ -69,26 +77,22 @@ type
69 77 function GetConsequenceStringFromChoices:UTF8String;
70 78 procedure CheckNeedForRandomTurns;
71 79 procedure EndExperiment;
  80 + procedure WriteReportHeader;
  81 + procedure WriteReportRowNames;
  82 + procedure WriteReportRow;
72 83 procedure SetCondition(I : Integer; AValue: TCondition);
73 84 procedure SetContingency(ACondition, I : integer; AValue: TContingency);
74 85 procedure SetMatrixType(AValue: TGameMatrixType);
75   - procedure SetOnConsequence(AValue: TNotifyEvent);
76   - procedure SetOnEndCondition(AValue: TNotifyEvent);
77   - procedure SetOnEndCycle(AValue: TNotifyEvent);
78   - procedure SetOnEndExperiment(AValue: TNotifyEvent);
79   - procedure SetOnEndGeneration(AValue: TNotifyEvent);
80   - procedure SetOnEndTurn(AValue: TNotifyEvent);
81   - procedure SetOnInterlocking(AValue: TNotifyEvent);
82 86 procedure SetPlayer(I : integer; AValue: TPlayer); overload;
83 87 procedure SetPlayer(S : UTF8string ; AValue: TPlayer); overload;
84 88 procedure SetResearcherCanChat(AValue: Boolean);
85 89 procedure SetResearcherCanPlay(AValue: Boolean);
86 90 procedure SetSendChatHistoryForNewPlayers(AValue: Boolean);
87 91 procedure SetState(AValue: TExperimentState);
88   - procedure SetTargetInterlocking;
  92 + procedure SetTargetInterlockingEvent;
  93 + procedure SetContingenciesEvents;
  94 + procedure SetPlayersQueue(AValue: string);
89 95 private
90   - FABPoints: Boolean;
91   - FChangeGeneration: string;
92 96 FOnConsequence: TNotifyEvent;
93 97 FOnInterlocking: TNotifyEvent;
94 98 FOnEndTurn: TNotifyEvent;
... ... @@ -98,14 +102,17 @@ type
98 102 FOnEndGeneration: TNotifyEvent;
99 103 FOnTargetInterlocking: TNotifyEvent;
100 104 procedure Consequence(Sender : TObject);
101   - function GetPlayerToKick: string;
102 105 procedure Interlocking(Sender : TObject);
  106 + procedure SetOnTargetInterlocking(AValue: TNotifyEvent);
103 107 procedure TargetInterlocking(Sender : TObject);
104   - procedure SetPlayersQueue(AValue: string);
105   - procedure WriteReportHeader;
106   - procedure WriteReportRowNames;
107   - procedure WriteReportRow;
108   - public
  108 + procedure SetOnConsequence(AValue: TNotifyEvent);
  109 + procedure SetOnEndCondition(AValue: TNotifyEvent);
  110 + procedure SetOnEndCycle(AValue: TNotifyEvent);
  111 + procedure SetOnEndExperiment(AValue: TNotifyEvent);
  112 + procedure SetOnEndGeneration(AValue: TNotifyEvent);
  113 + procedure SetOnEndTurn(AValue: TNotifyEvent);
  114 + procedure SetOnInterlocking(AValue: TNotifyEvent);
  115 + public // creation/ destruction
109 116 constructor Create(AOwner:TComponent);override;
110 117 constructor Create(AOwner:TComponent; AppPath:string);overload;
111 118 constructor Create(AOwner:TComponent; AFilename, AppPath:string); overload;
... ... @@ -114,9 +121,7 @@ type
114 121 function LoadFromGenerator:Boolean;
115 122 procedure SaveToFile(AFilename: string); overload;
116 123 procedure SaveToFile; overload;
117   - procedure Clean;
118   - procedure Play;
119   - procedure WriteReportRowPrompt;
  124 + public // global configuration
120 125 property ExperimentAim : string read FExperimentAim write FExperimentAim;
121 126 property ExperimentName : string read FExperimentName write FExperimentName;
122 127 property ABPoints : Boolean read FABPoints write FABPoints;
... ... @@ -127,7 +132,7 @@ type
127 132 property ShowChat : Boolean read FShowChat write FShowChat;
128 133 property SendChatHistoryForNewPlayers : Boolean read FSendChatHistoryForNewPlayers write SetSendChatHistoryForNewPlayers;
129 134 property MatrixType : TGameMatrixType read FMatrixType write SetMatrixType;
130   - public
  135 + public // manipulation/ self awareness
131 136 function AppendCondition : integer; overload;
132 137 function AppendCondition(ACondition : TCondition) : integer;overload;
133 138 function AppendContingency(ACondition : integer) : integer;overload;
... ... @@ -140,15 +145,22 @@ type
140 145 property Contingency[C, I : integer] : TContingency read GetContingency write SetContingency;
141 146 property ContingenciesCount[C:integer]:integer read GetContingenciesCount;
142 147 property Cycles : integer read GetCurrentAbsoluteCycle;
  148 + property InterlockingsInLastCycles:real read GetInterlockingPorcentageInLastCycles;
143 149 property Player[I : integer] : TPlayer read GetPlayer write SetPlayer;
  150 + property Players : TPlayers read FPlayers;
144 151 property PlayerFromID[S : UTF8string ] : TPlayer read GetPlayer write SetPlayer;
145 152 property PlayersCount : integer read GetPlayersCount;
146 153 property PlayerIsPlaying[s : UTF8string] : Boolean read GetPlayerIsPlaying;
147 154 property PlayerIndexFromID[s : UTF8string]: integer read GetPlayerIndexFromID;
148 155 property PlayerAsString[P:TPlayer]: UTF8string read AliasPlayerAsString;
149 156 property PlayerFromString[s : UTF8string]: TPlayer read AliasPlayerFromString;
150   - public
151   - property InterlockingsInLastCycles:real read GetInterlockingPorcentageInLastCycles;
  157 + public // standard control
  158 + function ShouldEndCondition:Boolean;
  159 + function CurrentConditionAsString:UTF8String;
  160 + procedure Clean;
  161 + procedure Play;
  162 + procedure WriteReportRowPrompt;
  163 + procedure WriteChatLn(ALn : string);
152 164 property ConsequenceStringFromChoice[P:Tplayer]:UTF8String read GetConsequenceStringFromChoice;
153 165 property ConsequenceStringFromChoices: UTF8String read GetConsequenceStringFromChoices;
154 166 property NextTurnPlayerID : UTF8string read GetNextTurnPlayerID;
... ... @@ -157,7 +169,7 @@ type
157 169 property NextCondition : integer read GetNextCondition;
158 170 property NextGeneration: string read GetPlayerToKick write SetPlayersQueue;
159 171 property State : TExperimentState read FState write SetState;
160   - public
  172 + public // events
161 173 property OnEndTurn : TNotifyEvent read FOnEndTurn write SetOnEndTurn;
162 174 property OnEndCycle : TNotifyEvent read FOnEndCycle write SetOnEndCycle;
163 175 property OnEndGeneration : TNotifyEvent read FOnEndGeneration write SetOnEndGeneration;
... ... @@ -165,7 +177,7 @@ type
165 177 property OnEndExperiment : TNotifyEvent read FOnEndExperiment write SetOnEndExperiment;
166 178 property OnConsequence : TNotifyEvent read FOnConsequence write SetOnConsequence;
167 179 property OnInterlocking : TNotifyEvent read FOnInterlocking write SetOnInterlocking;
168   - property OnTargetInterlocking : TNotifyEvent read FOnTargetInterlocking write FOnTargetInterlocking;
  180 + property OnTargetInterlocking : TNotifyEvent read FOnTargetInterlocking write SetOnTargetInterlocking;
169 181 end;
170 182  
171 183 resourcestring
... ... @@ -236,7 +248,6 @@ begin
236 248 FConditions[CurrentCondition].Cycles.Count := 0;
237 249 if Assigned(FOnEndGeneration) then FOnEndGeneration(Self);
238 250 Inc(FConditions[CurrentCondition].Cycles.Generation);
239   - NextCondition;
240 251 end;
241 252 {$IFDEF DEBUG}
242 253 WriteLn('TExperiment.GetNextCycle:',Result);
... ... @@ -244,45 +255,24 @@ begin
244 255 end;
245 256  
246 257 function TExperiment.GetNextCondition: integer;
247   -var
248   - LInterlocks : real;
249   -
250   - procedure EndCondition;
251   - begin
252   - if Assigned(FOnEndCondition) then FOnEndCondition(Self);
253   - Inc(FCurrentCondition);
254   - if FCurrentCondition = ConditionsCount then
255   - begin
256   - EndExperiment;
257   - Exit;
258   - end;
259   - FReportReader.Clean;
260   - FReportReader.SetXLastRows(Condition[CurrentCondition].EndCriterium.LastCycles);
261   - WriteReportRowNames;
262   - end;
263   -
264 258 begin
265 259 Result := CurrentCondition;
  260 + if Assigned(FOnEndCondition) then FOnEndCondition(Self);
  261 + if FCurrentCondition < ConditionsCount-1 then
  262 + begin
  263 + Inc(FCurrentCondition);
  264 + SetTargetInterlockingEvent;
  265 + SetContingenciesEvents;
  266 + FReportReader.Clean;
  267 + FReportReader.SetXLastRows(Condition[CurrentCondition].EndCriterium.LastCycles);
  268 + WriteReportRowNames;
  269 + end
  270 + else
  271 + begin
  272 + EndExperiment;
  273 + State:=xsWaiting;
  274 + end;
266 275  
267   - // interlockings in the last x cycles
268   - LInterlocks := InterlockingsInLastCycles;
269   - case FConditions[CurrentCondition].EndCriterium.Style of
270   - gecWhichComeFirst:
271   - begin
272   - if (GetCurrentAbsoluteCycle = FConditions[CurrentCondition].EndCriterium.AbsoluteCycles-1) or
273   - (LInterlocks >= FConditions[CurrentCondition].EndCriterium.InterlockingPorcentage) then
274   - EndCondition;
275   -
276   - end;
277   - gecAbsoluteCycles:
278   - if GetCurrentAbsoluteCycle = FConditions[CurrentCondition].EndCriterium.AbsoluteCycles-1 then
279   - EndCondition;
280   -
281   - gecInterlockingPorcentage:
282   - if LInterlocks >= FConditions[CurrentCondition].EndCriterium.InterlockingPorcentage then
283   - EndCondition;
284   -
285   - end;
286 276 {$IFDEF DEBUG}
287 277 WriteLn('TExperiment.GetNextCondition:',Result);
288 278 {$ENDIF}
... ... @@ -383,7 +373,7 @@ begin
383 373 if LContingencyResults.Count = Condition[c].EndCriterium.LastCycles then
384 374 begin
385 375  
386   - // count how many times interlocks in last X cycles
  376 + // count how many interlocks in last X cycles
387 377 for LRow in LContingencyResults do
388 378 if LRow = '1' then Inc(i);
389 379  
... ... @@ -456,10 +446,6 @@ end;
456 446 procedure TExperiment.SetContingency(ACondition, I : integer; AValue: TContingency);
457 447 begin
458 448 FConditions[ACondition].Contingencies[I] := AValue;
459   - if FConditions[ACondition].Contingencies[I].Meta then
460   - FConditions[ACondition].Contingencies[I].OnCriteria:=@Interlocking
461   - else
462   - FConditions[ACondition].Contingencies[I].OnCriteria:=@Consequence;
463 449 end;
464 450  
465 451 procedure TExperiment.SetMatrixType(AValue: TGameMatrixType);
... ... @@ -553,10 +539,10 @@ begin
553 539 FState:=AValue;
554 540 end;
555 541  
556   -procedure TExperiment.SetTargetInterlocking;
  542 +procedure TExperiment.SetTargetInterlockingEvent;
557 543 var i : integer;
558 544 begin
559   - for i:= 0 to ContingenciesCount[CurrentCondition] do
  545 + for i:= 0 to ContingenciesCount[CurrentCondition]-1 do
560 546 if Condition[CurrentCondition].Contingencies[i].Meta then
561 547 begin
562 548 Condition[CurrentCondition].Contingencies[i].OnTargetCriteria:=@TargetInterlocking;
... ... @@ -564,6 +550,17 @@ begin
564 550 end;
565 551 end;
566 552  
  553 +procedure TExperiment.SetContingenciesEvents;
  554 +var
  555 + i: Integer;
  556 +begin
  557 + for i := 0 to ContingenciesCount[CurrentCondition]-1 do
  558 + if FConditions[CurrentCondition].Contingencies[I].Meta then
  559 + FConditions[CurrentCondition].Contingencies[I].OnCriteria:=@Interlocking
  560 + else
  561 + FConditions[CurrentCondition].Contingencies[I].OnCriteria:=@Consequence;
  562 +end;
  563 +
567 564 procedure TExperiment.Consequence(Sender: TObject);
568 565 begin
569 566 if Assigned(FOnConsequence) then FOnConsequence(Sender);
... ... @@ -600,6 +597,12 @@ begin
600 597 if Assigned(FOnInterlocking) then FOnInterlocking(Sender);
601 598 end;
602 599  
  600 +procedure TExperiment.SetOnTargetInterlocking(AValue: TNotifyEvent);
  601 +begin
  602 + if FOnTargetInterlocking=AValue then Exit;
  603 + FOnTargetInterlocking:=AValue;
  604 +end;
  605 +
603 606  
604 607 procedure TExperiment.WriteReportHeader;
605 608 var
... ... @@ -733,6 +736,12 @@ begin
733 736 end;
734 737 end;
735 738  
  739 +procedure TExperiment.WriteChatLn(ALn: string);
  740 +begin
  741 + FRegChat.SaveData(ALn);
  742 + FRegChat.CloseAndOpen;
  743 +end;
  744 +
736 745 constructor TExperiment.Create(AOwner: TComponent);
737 746 begin
738 747 inherited Create(AOwner);
... ... @@ -742,14 +751,16 @@ begin
742 751 end;
743 752  
744 753 constructor TExperiment.Create(AOwner: TComponent;AppPath:string);
745   -var i : integer;
  754 +var LDataPath : string;
746 755 begin
747 756 inherited Create(AOwner);
  757 + LDataPath := AppPath+VAL_RESEARCHER+'es'+PathDelim+Researcher+PathDelim+ExperimentName+PathDelim;
748 758 FTurnsRandom := TStringList.Create;
749 759 LoadExperimentFromResource(Self);
750 760  
751 761 // TODO: Allow custom target interlocking. Now just taking the first meta, as usual in the lab.
752   - SetTargetInterlocking;
  762 + SetTargetInterlockingEvent;
  763 + SetContingenciesEvents;
753 764  
754 765 CheckNeedForRandomTurns;
755 766  
... ... @@ -757,7 +768,9 @@ begin
757 768 FReportReader.UseRange:=True;
758 769 FReportReader.SetXLastRows(Condition[CurrentCondition].EndCriterium.LastCycles);
759 770  
760   - FRegData := TRegData.Create(Self, AppPath+VAL_RESEARCHER+'es'+PathDelim+Researcher+PathDelim+ExperimentName+PathDelim+'000.dat');
  771 + FRegData := TRegData.Create(Self, LDataPath+'000.dat');
  772 + if ShowChat then
  773 + FRegChat := TRegData.Create(Self, LDataPath+'000.chat');
761 774 WriteReportHeader;
762 775 end;
763 776  
... ... @@ -835,6 +848,53 @@ begin
835 848 FPlayers[Result] := APlayer;
836 849 end;
837 850  
  851 +function TExperiment.ShouldEndCondition: Boolean;
  852 +var
  853 + LInterlocks: Real;
  854 + LAbsCycles: Integer;
  855 +begin
  856 + Result := False;
  857 + // interlockings in the last x cycles
  858 + LInterlocks := InterlockingsInLastCycles;
  859 +
  860 + // absolute cycles count
  861 + LAbsCycles := GetCurrentAbsoluteCycle;
  862 + case FConditions[CurrentCondition].EndCriterium.Style of
  863 + gecWhichComeFirst:
  864 + begin
  865 + if (LAbsCycles = FConditions[CurrentCondition].EndCriterium.AbsoluteCycles) or
  866 + (LInterlocks >= FConditions[CurrentCondition].EndCriterium.InterlockingPorcentage) then
  867 + Result := True;
  868 +
  869 + end;
  870 + gecAbsoluteCycles:
  871 + if LAbsCycles = FConditions[CurrentCondition].EndCriterium.AbsoluteCycles then
  872 + Result := True;
  873 +
  874 + gecInterlockingPorcentage:
  875 + if LInterlocks >= FConditions[CurrentCondition].EndCriterium.InterlockingPorcentage then
  876 + Result := True;
  877 + end;
  878 +end;
  879 +
  880 +function TExperiment.CurrentConditionAsString: UTF8String;
  881 +begin
  882 + if ABPoints then
  883 + Result :=
  884 + IntToStr(Condition[CurrentCondition].Points.OnStart.A)+'|'+
  885 + IntToStr(Condition[CurrentCondition].Points.OnStart.B)+'|'+
  886 + IntToStr(Condition[CurrentCondition].Points.OnStart.G)
  887 + else
  888 + Result:=
  889 + IntToStr(Condition[CurrentCondition].Points.OnStart.A)+'|'+
  890 + IntToStr(Condition[CurrentCondition].Points.OnStart.G);
  891 +end;
  892 +
  893 +//procedure TExperiment.TargetInterlocking;
  894 +//begin
  895 +// SetTargetInterlocking;
  896 +//end;
  897 +
838 898 procedure TExperiment.SaveToFile(AFilename: string);
839 899 begin
840 900 SaveExperimentToFile(Self,AFilename);
... ... @@ -868,7 +928,6 @@ begin
868 928 end;
869 929  
870 930 procedure TExperiment.Play;
871   -var i : integer;
872 931 begin
873 932 //for i := 0 to Condition[CurrentCondition].Turn.Value-1 do
874 933 // begin
... ...
units/game_file_methods.pas
  Diff comments   View file @a1b6309
... ... @@ -93,9 +93,9 @@ begin
93 93 Turn.Value:=2;
94 94 Turn.Random:=False;
95 95 Cycles.Count:=0;
96   - Cycles.Value:=4;
  96 + Cycles.Value:=20;
97 97 Cycles.Generation:=0;
98   - EndCriterium.AbsoluteCycles := 20;
  98 + EndCriterium.AbsoluteCycles := 15;
99 99 EndCriterium.InterlockingPorcentage := 80;
100 100 EndCriterium.LastCycles := 10;
101 101 EndCriterium.Style := gecWhichComeFirst;
... ... @@ -113,7 +113,6 @@ begin
113 113 LConcequence := TConsequence.Create(AExperiment,-1,[gscPoints, gscG, gscMessage],['','item escolar','itens escolares']);
114 114 Contingencies[3] := TContingency.Create(AExperiment,LConcequence,LCriteria4,True);
115 115 Contingencies[3].ContingencyName := 'MPUN -1G';
116   -
117 116 Prompt := TPrompt.Create(
118 117 AExperiment
119 118 , [gsAll,gsYes,gsMetacontingency,gsContingency,gsRevertPoints,gsBasA]
... ...
units/report_reader.pas
  Diff comments   View file @a1b6309
... ... @@ -38,6 +38,7 @@ type
38 38 VRow : string; //helper
39 39 constructor Create;
40 40 destructor Destroy; override;
  41 + function Dump : string;
41 42 procedure Append(ARow : string);
42 43 procedure Extend(ARowExtention : string);
43 44 procedure Clean;
... ... @@ -64,10 +65,10 @@ begin
64 65 if c > -1 then
65 66 if FUseRange and (FRowRange.Low <= FRowRange.High) and (FRowRange.Low > 0) then
66 67 for i := FRowRange.Low to FRowRange.High do
67   - Result.Append(ExtractDelimited(c+1, FRows[i],[#9,#10]))
  68 + Result.Append(ExtractDelimited(c+2, FRows[i],[#9,#10]));
68 69 else
69 70 for Row in FRows do
70   - Result.Append(ExtractDelimited(c+1, Row,[#9,#10]));
  71 + Result.Append(ExtractDelimited(c+2, Row,[#9,#10]));
71 72 end;
72 73  
73 74 constructor TReportReader.Create;
... ... @@ -87,6 +88,11 @@ begin
87 88 inherited Destroy;
88 89 end;
89 90  
  91 +function TReportReader.Dump: string;
  92 +begin
  93 + Result := FCols.Text+LineEnding+FRows.Text;
  94 +end;
  95 +
90 96 procedure TReportReader.Append(ARow: string);
91 97 begin
92 98 if FCols.Count = 0 then
... ...