From a1b6309a11f729e97e4031b5468f794029636ded Mon Sep 17 00:00:00 2001 From: cpicanco Date: Mon, 5 Dec 2016 00:00:33 -0300 Subject: [PATCH] implement next condition and experiment end --- form_chooseactor.pas | 5 +++-- units/game_control.pas | 297 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++----------------------------------------------------------------------------------- units/game_experiment.pas | 207 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-------------------------------------------------------------------------- units/game_file_methods.pas | 5 ++--- units/report_reader.pas | 10 ++++++++-- 5 files changed, 360 insertions(+), 164 deletions(-) diff --git a/form_chooseactor.pas b/form_chooseactor.pas index 47c4b48..e822255 100644 --- a/form_chooseactor.pas +++ b/form_chooseactor.pas @@ -126,9 +126,10 @@ begin WordWrap := True; Parent:=Self; Font.Size := 30; + OnClick := @ShowResumeButton; case FStyle of - '.Left': OnClick := @ShowResumeButton; - '.EndX': OnClick := @ExitApplication; + '.Left': btnPlayerResume.Caption := 'Entrar'; + '.EndX': btnPlayerResume.Caption := 'Sair'; end; end; end; diff --git a/units/game_control.pas b/units/game_control.pas index 5fae8cf..d5aa996 100644 --- a/units/game_control.pas +++ b/units/game_control.pas @@ -56,11 +56,14 @@ type procedure ShowConsequenceMessage(AID,S:string;ForGroup:Boolean); procedure DisableConfirmationButton; procedure CleanMatrix(AEnabled : Boolean); + procedure NextConditionSetup(S : string); procedure EnablePlayerMatrix(AID:UTF8string; ATurn:integer; AEnabled:Boolean); private + function IsLastCondition : Boolean; function ShouldStartExperiment: Boolean; function ShouldEndCycle : Boolean; - function ShouldEndGeneration : Boolean; + function ShouldEndCondition : Boolean; + //function ShouldEndGeneration : Boolean; function ShouldAskQuestion : Boolean; procedure NextTurn(Sender: TObject); procedure NextCycle(Sender: TObject); @@ -105,6 +108,7 @@ const K_QMESSAGE = '.QMessage'; K_MOVQUEUE = '.Queue'; K_END = '.EndX'; + K_NXTCND = '.NextCond'; // K_STATUS = '.Status'; @@ -158,16 +162,31 @@ begin Result := FExperiment.Condition[FExperiment.CurrentCondition].Turn.Count = FExperiment.Condition[FExperiment.CurrentCondition].Turn.Value-1; end; -function TGameControl.ShouldEndGeneration: Boolean; +function TGameControl.IsLastCondition: Boolean; begin - Result := FExperiment.Condition[FExperiment.CurrentCondition].Cycles.Count = FExperiment.Condition[FExperiment.CurrentCondition].Cycles.Value-1; + Result := FExperiment.CurrentCondition = FExperiment.ConditionsCount-1; end; +function TGameControl.ShouldEndCondition: Boolean; +begin + Result := FExperiment.ShouldEndCondition; +end; + +//function TGameControl.ShouldEndGeneration: Boolean; +//begin +// Result := FExperiment.Condition[FExperiment.CurrentCondition].Cycles.Count = FExperiment.Condition[FExperiment.CurrentCondition].Cycles.Value-1; +//end; + function TGameControl.ShouldAskQuestion: Boolean; begin Result := Assigned(FExperiment.Condition[FExperiment.CurrentCondition].Prompt) and FExperiment.Condition[FExperiment.CurrentCondition].Contingencies[3].Fired; end; +procedure TGameControl.EndExperiment(Sender: TObject); +begin + ShowPopUp('O Experimento terminou.'); +end; + procedure TGameControl.NextTurn(Sender: TObject); begin // update admin view @@ -194,11 +213,7 @@ begin FormMatrixGame.LabelExpCountCondition.Caption:= FExperiment.Condition[FExperiment.CurrentCondition].ConditionName; // append OnStart data - //FExperiment.Condition[FExperiment.CurrentCondition].Points.OnStart.A; - //FExperiment.Condition[FExperiment.CurrentCondition].Points.OnStart.B; - //FExperiment.Condition[FExperiment.CurrentCondition].Points.OnStart.G; - - // append which player + NextConditionSetup(FExperiment.CurrentConditionAsString); end; procedure TGameControl.Interlocking(Sender: TObject); @@ -223,11 +238,6 @@ begin {$ENDIF} end; -procedure TGameControl.EndExperiment(Sender: TObject); -begin - FZMQActor.SendMessage([K_END]); -end; - procedure TGameControl.StartExperiment; begin // all players arrived, lets begin @@ -532,6 +542,62 @@ begin FormMatrixGame.btnConfirmRow.Visible := False; end; +procedure TGameControl.NextConditionSetup(S: string); +var + A, B, G : integer; + P : TPlayer; + PB : TPlayerBox; +begin + if FExperiment.ABPoints then + begin + A := StrToInt(ExtractDelimited(1,S,['|'])); + B := StrToInt(ExtractDelimited(2,S,['|'])); + G := StrToInt(ExtractDelimited(3,S,['|'])); + + G += StrToInt(FormMatrixGame.LabelGroupCount.Caption); + FormMatrixGame.LabelGroupCount.Caption := IntToStr(G); + case FActor of + gaPlayer: + begin + A += StrToInt(FormMatrixGame.LabelIndACount.Caption); + B += StrToInt(FormMatrixGame.LabelIndBCount.Caption); + + FormMatrixGame.LabelIndACount.Caption := IntToStr(A); + FormMatrixGame.LabelIndBCount.Caption := IntToStr(B); + end; + gaAdmin: + for P in FExperiment.Players do + begin + PB := GetPlayerBox(P.ID); + A += StrToInt(PB.LabelPointsCount.Caption) + B; + PB.LabelPointsCount.Caption := IntToStr(A); + end; + end; + end + else + begin + A := StrToInt(ExtractDelimited(1,S,['|'])); + G := StrToInt(ExtractDelimited(2,S,['|'])); + G += StrToInt(FormMatrixGame.LabelGroupCount.Caption); + FormMatrixGame.LabelGroupCount.Caption := IntToStr(G); + case FActor of + gaPlayer: + begin + A += StrToInt(FormMatrixGame.LabelIndACount.Caption); + FormMatrixGame.LabelIndCount.Caption := IntToStr(A); + end; + + gaAdmin: + for P in FExperiment.Players do + begin + PB := GetPlayerBox(P.ID); + A += StrToInt(PB.LabelPointsCount.Caption) + B; + PB.LabelPointsCount.Caption := IntToStr(A); + end; + end; + end; +end; + procedure TGameControl.EnablePlayerMatrix(AID:UTF8string; ATurn:integer; AEnabled:Boolean); begin if FExperiment.PlayerFromID[AID].Turn = ATurn then @@ -571,6 +637,7 @@ begin FExperiment.OnEndExperiment:= @EndExperiment; FExperiment.OnInterlocking:=@Interlocking; FExperiment.OnConsequence:=@Consequence; + FExperiment.OnTargetInterlocking:=@TargetInterlocking; SendRequest(K_LOGIN); // admin cannot send requests end; @@ -703,7 +770,8 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList); , ' ' , GA_PLAYER+K_QUESTION , AskQuestion(AMessage[1]) - , AMessage[2] + , AMessage[2] // generation + , AMessage[3] // conditions ]); end; @@ -780,8 +848,13 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList); end; procedure ReceiveChat; + var + ALn: string; begin - FormMatrixGame.ChatMemoRecv.Lines.Append(('['+AMessage[1]+']: ')+AMessage[2]); + ALn := '['+AMessage[1]+']: '+AMessage[2]; + FormMatrixGame.ChatMemoRecv.Lines.Append(ALn); + if FActor = gaAdmin then + FExperiment.WriteChatLn(ALn); end; procedure MovePlayerQueue; @@ -839,51 +912,7 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList); end; end; - procedure ResumeNextTurn; - begin - case FActor of - gaPlayer:begin - if AMessage[1] <> #32 then - SayGoodBye(AMessage[1]) - else - EnablePlayerMatrix(Self.ID,0, True); - - end; - gaAdmin:begin - if AMessage[1] <> #32 then - begin - DeletePlayerBox(AMessage[1]); // old player - ShowPopUp( - 'O participante '+ - FExperiment.PlayerFromID[AMessage[1]].Nicname+ - ' saiu. Aguardando a entrada do próximo participante.' - ); - end; - end; - end; - end; - - procedure QuestionMessages; - var - i : integer; - MID : string; - begin - if AMessage.Count > 1 then - begin - for i := 2 to AMessage.Count -1 do - begin - MID := ExtractDelimited(1,AMessage[i],['+']); - ShowConsequenceMessage(MID, ExtractDelimited(2,AMessage[i],['+']),MID = 'M'); - - {$IFDEF DEBUG} - WriteLn('A Prompt consequence should have shown.'); - {$ENDIF} - end; - end; - ResumeNextTurn; - end; - - procedure ShowPointsToPlayers; + procedure EndExperimentMessage; var Pts : string; begin case FActor of @@ -901,16 +930,74 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList); FormChooseActor.ShowPoints( 'A tarefa terminou, obrigado por sua participação! Você produziu ' + Pts + ' pontos e ' + - FormMatrixGame.LabelGroupCount.Caption + 'itens escolares serão doados!'); - FormChooseActor.Show; - end; - gaAdmin: - begin - Stop; + FormMatrixGame.LabelGroupCount.Caption + 'itens escolares serão doados! Parabéns!'); + FormChooseActor.ShowModal; + FormChooseActor.Free; + FormMatrixGame.Close; end; + gaAdmin:Stop; end; end; + procedure ResumeNextTurn; + begin + if AMessage[2] <> #27 then + begin + case FActor of + gaPlayer: + begin + if AMessage[1] <> #32 then + SayGoodBye(AMessage[1]) + else + EnablePlayerMatrix(Self.ID,0, True); + end; + + gaAdmin: + begin + if AMessage[1] <> #32 then + begin + DeletePlayerBox(AMessage[1]); // old player + ShowPopUp( + 'O participante '+ + FExperiment.PlayerFromID[AMessage[1]].Nicname+ + ' saiu. Aguardando a entrada do próximo participante.' + ); + end; + end; + + end; + if AMessage[2] <> #32 then + NextConditionSetup(AMessage[2]); + end + else EndExperimentMessage; + end; + + procedure QuestionMessages; + var + i : integer; + MID : string; + begin + if AMessage[2] <> #27 then + begin + if AMessage.Count > 1 then + begin + for i := 3 to AMessage.Count -1 do + begin + MID := ExtractDelimited(1,AMessage[i],['+']); + ShowConsequenceMessage(MID, ExtractDelimited(2,AMessage[i],['+']),MID = 'M'); + + {$IFDEF DEBUG} + WriteLn('A Prompt consequence should have shown.'); + {$ENDIF} + end; + end; + ResumeNextTurn; + if AMessage[2] <> #32 then + NextConditionSetup(AMessage[2]); + end + else EndExperimentMessage; + end; + begin if MHas(K_ARRIVED) then ReceiveActor; if MHas(K_CHAT_M) then ReceiveChat; @@ -921,7 +1008,8 @@ begin if MHas(K_MOVQUEUE) then MovePlayerQueue; if MHas(K_QMESSAGE) then QuestionMessages; if MHas(K_RESUME) then ResumeNextTurn; - if MHAs(K_END) then ShowPointsToPlayers; + if MHas(K_NXTCND) then NextConditionSetup(AMessage[1]); + if MHAs(K_END) then EndExperimentMessage; end; // Here FActor is garanted to be a TZMQAdmin @@ -983,17 +1071,20 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList); if FExperiment.Player[i].ID <> P.ID then begin TS := FExperiment.PlayerAsString[FEXperiment.Player[i]]; - ARequest.Append(TS); // FROM 3 to COUNT-3 + ARequest.Append(TS); // FROM 3 to COUNT-4 end; - // append chat data if allowed at the last position + // append chat data if allowed if FExperiment.SendChatHistoryForNewPlayers then - ARequest.Append(FormMatrixGame.ChatMemoRecv.Lines.Text) // COUNT-2 + ARequest.Append(FormMatrixGame.ChatMemoRecv.Lines.Text) // COUNT-3 else ARequest.Append('[CHAT]'); // must append something to keep the message envelop standard // append global configs. - ARequest.Append(BoolToStr(FExperiment.ABPoints)); // COUNT-1 + ARequest.Append(BoolToStr(FExperiment.ABPoints)); // COUNT-2 + + // append condition global data + ARequest.Append(FExperiment.CurrentConditionAsString); // inform all players about the new player, including itself FZMQActor.SendMessage([K_ARRIVED,PS]); @@ -1019,7 +1110,9 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList); LConsequences : string; P : TPlayer; S : string; + LEndCondition, LEndCycle : Boolean; + LEndGeneration: string; begin {$IFDEF DEBUG} WriteLn('Count:',FExperiment.Condition[FExperiment.CurrentCondition].Turn.Count, '<', FExperiment.Condition[FExperiment.CurrentCondition].Turn.Value); @@ -1038,10 +1131,13 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList); if Pos('$NICNAME',S) > 0 then S := ReplaceStr(S,'$NICNAME',P.Nicname); - // update turn + // "NextGeneration" and "ShouldEndCycle" methods must be called before Experiment.NextTurn LEndCycle := ShouldEndCycle; + LEndGeneration := FExperiment.NextGeneration; if LEndCycle then - LConsequences := FExperiment.ConsequenceStringFromChoices;// AsString generates the pts result; must be called before next cycle + LConsequences := FExperiment.ConsequenceStringFromChoices; + + // update turn P.Turn := FExperiment.NextTurn; FExperiment.Player[FExperiment.PlayerIndexFromID[P.ID]] := P; @@ -1061,7 +1157,22 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList); FExperiment.WriteReportRowPrompt; FExperiment.Clean; end; - ARequest.Append(FExperiment.NextGeneration); // 9, #32 no, else NextGeneration = PlayerToKick + + ARequest.Append(LEndGeneration); // 9, #32 resume, else NextGeneration = PlayerToKick AID + LEndCondition := ShouldEndCondition; + if IsLastCondition and LEndCondition then // 10 + // end experiment envelop + ARequest.Append(#27) + else + if LEndCondition then + begin + FExperiment.NextCondition; + // end condition envelop + ARequest.Append(FExperiment.CurrentConditionAsString); + end + else + // do nothing envelop + ARequest.Append(#32); end; end; @@ -1084,9 +1195,10 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList); // generate messages LPromptConsequences := FExperiment.Condition[FExperiment.CurrentCondition].Prompt.AsString; - SetLength(M, 2+LPromptConsequences.Count); + SetLength(M, 3+LPromptConsequences.Count); M[0] := K_QMESSAGE; - M[1] := ARequest[4]; // generations + M[1] := ARequest[4]; // generation envelop + M[2] := ARequest[5]; // conditions if LPromptConsequences.Count > 0 then begin for i := 0 to LPromptConsequences.Count-1 do @@ -1096,7 +1208,7 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList); LPromptConsequences[i] := ReplaceStr(LPromptConsequences[i],'$NICNAME', P.Nicname); end; for i := 0 to LPromptConsequences.Count -1 do - M[i+2] := LPromptConsequences[i]; + M[i+3] := LPromptConsequences[i]; // messages envelop end else; @@ -1147,7 +1259,7 @@ procedure TGameControl.ReceiveReply(AReply: TStringList); begin if Self.ID = AReply[0] then begin - for i:= 3 to AReply.Count -3 do + for i:= 3 to AReply.Count -4 do begin P := FExperiment.PlayerFromString[AReply[i]]; FExperiment.AppendPlayer(P); @@ -1156,11 +1268,15 @@ procedure TGameControl.ReceiveReply(AReply: TStringList); // add chat FormMatrixGame.ChatMemoRecv.Lines.Clear; - FormMatrixGame.ChatMemoRecv.Lines.Add(AReply[AReply.Count-2]); + FormMatrixGame.ChatMemoRecv.Lines.Add(AReply[AReply.Count-3]); // set global configs - FormMatrixGame.GBIndividualAB.Visible := StrToBool(AReply[AReply.Count-1]); + FExperiment.ABPoints := StrToBool(AReply[AReply.Count-2]); + FormMatrixGame.GBIndividualAB.Visible := FExperiment.ABPoints; FormMatrixGame.GBIndividual.Visible:= not FormMatrixGame.GBIndividualAB.Visible; + + // set condition specific configurations + NextConditionSetup(AReply[AReply.Count-1]) end else begin @@ -1184,12 +1300,17 @@ procedure TGameControl.ReceiveReply(AReply: TStringList); {$IFDEF DEBUG} WriteLn('LCount:',LCount); {$ENDIF} + + // inform other players about self.id choice FZMQActor.SendMessage([K_CHOICE,AReply[0],AReply[3],AReply[4],AReply[5]]); + // The Announcer sends a message, waits interval time until all messages have been sent and then destroys itself. LAnnouncer := TIntervalarAnnouncer.Create(nil); LAnnouncer.OnStart := @FZMQActor.SendMessage; - LAnnouncer.Interval := 2000; + LAnnouncer.Interval := 500; LCount := WordCount(AReply[6],['+']); + + // individual consequences if LCount > 0 then for i := 1 to LCount do begin @@ -1208,6 +1329,7 @@ procedure TGameControl.ReceiveReply(AReply: TStringList); {$ENDIF} end; + // group consequence if AReply.Count > 7 then begin LCount := WordCount(AReply[7],['+']); @@ -1223,12 +1345,21 @@ procedure TGameControl.ReceiveReply(AReply: TStringList); {$ENDIF} end; + // should ask question or just resume (going to the next turn)? if AReply[8] <> #32 then //FZMQActor.SendMessage([K_QUESTION,AReply[8],AReply[9]]) - LAnnouncer.Append([K_QUESTION,AReply[8],AReply[9]]) + LAnnouncer.Append([K_QUESTION,AReply[8],AReply[9],AReply[10]]) else //FZMQActor.SendMessage([K_RESUME,AReply[9]]); - LAnnouncer.Append([K_RESUME,AReply[9]]); + LAnnouncer.Append([K_RESUME,AReply[9],AReply[10]]); + + // should end experiment or go to the next condition? + if (AReply[10] = #27) and (AReply[8] = #32) then + LAnnouncer.Append([K_END]) + else + if (AReply[10] <> #32) then + LAnnouncer.Append([K_NXTCND,AReply[10]]) + end; LAnnouncer.Reversed; diff --git a/units/game_experiment.pas b/units/game_experiment.pas index 4a860ed..2c0e55f 100644 --- a/units/game_experiment.pas +++ b/units/game_experiment.pas @@ -13,6 +13,10 @@ unit game_experiment; interface + + // TODO: REFACTORING. FILE METHODS MUST USE THE SAME METHODS FROM HERE WHEN LOADING CONDITONS, CONTINGENCIES AND SO ON. KEEP IT SIMPLE. + + uses Classes, SysUtils , game_actors @@ -29,6 +33,8 @@ type TExperiment = class(TComponent) private + FABPoints: Boolean; + //FChangeGeneration: string; FExperimentAim, FExperimentName, FFilename, @@ -42,6 +48,7 @@ type private FLastReportColNames : string; FRegData : TRegData; + FRegChat : TRegData; FReportReader : TReportReader; FPlayers : TPlayers; FCurrentCondition : integer; @@ -57,10 +64,11 @@ type function GetNextCycle:integer; function GetNextCondition:integer; function GetCurrentAbsoluteCycle : integer; - function GetPlayer(I : integer): TPlayer; overload; - function GetPlayer(AID : UTF8string): TPlayer; overload; function AliasPlayerAsString(P: TPlayer): UTF8string; function AliasPlayerFromString(s : UTF8string): TPlayer; + function GetPlayer(I : integer): TPlayer; overload; + function GetPlayer(AID : UTF8string): TPlayer; overload; + function GetPlayerToKick: string; function GetPlayerIndexFromID(AID : UTF8string): integer; function GetPlayerIsPlaying(AID : UTF8string): Boolean; function GetPlayersCount: integer; @@ -69,26 +77,22 @@ type function GetConsequenceStringFromChoices:UTF8String; procedure CheckNeedForRandomTurns; procedure EndExperiment; + procedure WriteReportHeader; + procedure WriteReportRowNames; + procedure WriteReportRow; procedure SetCondition(I : Integer; AValue: TCondition); procedure SetContingency(ACondition, I : integer; AValue: TContingency); procedure SetMatrixType(AValue: TGameMatrixType); - procedure SetOnConsequence(AValue: TNotifyEvent); - procedure SetOnEndCondition(AValue: TNotifyEvent); - procedure SetOnEndCycle(AValue: TNotifyEvent); - procedure SetOnEndExperiment(AValue: TNotifyEvent); - procedure SetOnEndGeneration(AValue: TNotifyEvent); - procedure SetOnEndTurn(AValue: TNotifyEvent); - procedure SetOnInterlocking(AValue: TNotifyEvent); procedure SetPlayer(I : integer; AValue: TPlayer); overload; procedure SetPlayer(S : UTF8string ; AValue: TPlayer); overload; procedure SetResearcherCanChat(AValue: Boolean); procedure SetResearcherCanPlay(AValue: Boolean); procedure SetSendChatHistoryForNewPlayers(AValue: Boolean); procedure SetState(AValue: TExperimentState); - procedure SetTargetInterlocking; + procedure SetTargetInterlockingEvent; + procedure SetContingenciesEvents; + procedure SetPlayersQueue(AValue: string); private - FABPoints: Boolean; - FChangeGeneration: string; FOnConsequence: TNotifyEvent; FOnInterlocking: TNotifyEvent; FOnEndTurn: TNotifyEvent; @@ -98,14 +102,17 @@ type FOnEndGeneration: TNotifyEvent; FOnTargetInterlocking: TNotifyEvent; procedure Consequence(Sender : TObject); - function GetPlayerToKick: string; procedure Interlocking(Sender : TObject); + procedure SetOnTargetInterlocking(AValue: TNotifyEvent); procedure TargetInterlocking(Sender : TObject); - procedure SetPlayersQueue(AValue: string); - procedure WriteReportHeader; - procedure WriteReportRowNames; - procedure WriteReportRow; - public + procedure SetOnConsequence(AValue: TNotifyEvent); + procedure SetOnEndCondition(AValue: TNotifyEvent); + procedure SetOnEndCycle(AValue: TNotifyEvent); + procedure SetOnEndExperiment(AValue: TNotifyEvent); + procedure SetOnEndGeneration(AValue: TNotifyEvent); + procedure SetOnEndTurn(AValue: TNotifyEvent); + procedure SetOnInterlocking(AValue: TNotifyEvent); + public // creation/ destruction constructor Create(AOwner:TComponent);override; constructor Create(AOwner:TComponent; AppPath:string);overload; constructor Create(AOwner:TComponent; AFilename, AppPath:string); overload; @@ -114,9 +121,7 @@ type function LoadFromGenerator:Boolean; procedure SaveToFile(AFilename: string); overload; procedure SaveToFile; overload; - procedure Clean; - procedure Play; - procedure WriteReportRowPrompt; + public // global configuration property ExperimentAim : string read FExperimentAim write FExperimentAim; property ExperimentName : string read FExperimentName write FExperimentName; property ABPoints : Boolean read FABPoints write FABPoints; @@ -127,7 +132,7 @@ type property ShowChat : Boolean read FShowChat write FShowChat; property SendChatHistoryForNewPlayers : Boolean read FSendChatHistoryForNewPlayers write SetSendChatHistoryForNewPlayers; property MatrixType : TGameMatrixType read FMatrixType write SetMatrixType; - public + public // manipulation/ self awareness function AppendCondition : integer; overload; function AppendCondition(ACondition : TCondition) : integer;overload; function AppendContingency(ACondition : integer) : integer;overload; @@ -140,15 +145,22 @@ type property Contingency[C, I : integer] : TContingency read GetContingency write SetContingency; property ContingenciesCount[C:integer]:integer read GetContingenciesCount; property Cycles : integer read GetCurrentAbsoluteCycle; + property InterlockingsInLastCycles:real read GetInterlockingPorcentageInLastCycles; property Player[I : integer] : TPlayer read GetPlayer write SetPlayer; + property Players : TPlayers read FPlayers; property PlayerFromID[S : UTF8string ] : TPlayer read GetPlayer write SetPlayer; property PlayersCount : integer read GetPlayersCount; property PlayerIsPlaying[s : UTF8string] : Boolean read GetPlayerIsPlaying; property PlayerIndexFromID[s : UTF8string]: integer read GetPlayerIndexFromID; property PlayerAsString[P:TPlayer]: UTF8string read AliasPlayerAsString; property PlayerFromString[s : UTF8string]: TPlayer read AliasPlayerFromString; - public - property InterlockingsInLastCycles:real read GetInterlockingPorcentageInLastCycles; + public // standard control + function ShouldEndCondition:Boolean; + function CurrentConditionAsString:UTF8String; + procedure Clean; + procedure Play; + procedure WriteReportRowPrompt; + procedure WriteChatLn(ALn : string); property ConsequenceStringFromChoice[P:Tplayer]:UTF8String read GetConsequenceStringFromChoice; property ConsequenceStringFromChoices: UTF8String read GetConsequenceStringFromChoices; property NextTurnPlayerID : UTF8string read GetNextTurnPlayerID; @@ -157,7 +169,7 @@ type property NextCondition : integer read GetNextCondition; property NextGeneration: string read GetPlayerToKick write SetPlayersQueue; property State : TExperimentState read FState write SetState; - public + public // events property OnEndTurn : TNotifyEvent read FOnEndTurn write SetOnEndTurn; property OnEndCycle : TNotifyEvent read FOnEndCycle write SetOnEndCycle; property OnEndGeneration : TNotifyEvent read FOnEndGeneration write SetOnEndGeneration; @@ -165,7 +177,7 @@ type property OnEndExperiment : TNotifyEvent read FOnEndExperiment write SetOnEndExperiment; property OnConsequence : TNotifyEvent read FOnConsequence write SetOnConsequence; property OnInterlocking : TNotifyEvent read FOnInterlocking write SetOnInterlocking; - property OnTargetInterlocking : TNotifyEvent read FOnTargetInterlocking write FOnTargetInterlocking; + property OnTargetInterlocking : TNotifyEvent read FOnTargetInterlocking write SetOnTargetInterlocking; end; resourcestring @@ -236,7 +248,6 @@ begin FConditions[CurrentCondition].Cycles.Count := 0; if Assigned(FOnEndGeneration) then FOnEndGeneration(Self); Inc(FConditions[CurrentCondition].Cycles.Generation); - NextCondition; end; {$IFDEF DEBUG} WriteLn('TExperiment.GetNextCycle:',Result); @@ -244,45 +255,24 @@ begin end; function TExperiment.GetNextCondition: integer; -var - LInterlocks : real; - - procedure EndCondition; - begin - if Assigned(FOnEndCondition) then FOnEndCondition(Self); - Inc(FCurrentCondition); - if FCurrentCondition = ConditionsCount then - begin - EndExperiment; - Exit; - end; - FReportReader.Clean; - FReportReader.SetXLastRows(Condition[CurrentCondition].EndCriterium.LastCycles); - WriteReportRowNames; - end; - begin Result := CurrentCondition; + if Assigned(FOnEndCondition) then FOnEndCondition(Self); + if FCurrentCondition < ConditionsCount-1 then + begin + Inc(FCurrentCondition); + SetTargetInterlockingEvent; + SetContingenciesEvents; + FReportReader.Clean; + FReportReader.SetXLastRows(Condition[CurrentCondition].EndCriterium.LastCycles); + WriteReportRowNames; + end + else + begin + EndExperiment; + State:=xsWaiting; + end; - // interlockings in the last x cycles - LInterlocks := InterlockingsInLastCycles; - case FConditions[CurrentCondition].EndCriterium.Style of - gecWhichComeFirst: - begin - if (GetCurrentAbsoluteCycle = FConditions[CurrentCondition].EndCriterium.AbsoluteCycles-1) or - (LInterlocks >= FConditions[CurrentCondition].EndCriterium.InterlockingPorcentage) then - EndCondition; - - end; - gecAbsoluteCycles: - if GetCurrentAbsoluteCycle = FConditions[CurrentCondition].EndCriterium.AbsoluteCycles-1 then - EndCondition; - - gecInterlockingPorcentage: - if LInterlocks >= FConditions[CurrentCondition].EndCriterium.InterlockingPorcentage then - EndCondition; - - end; {$IFDEF DEBUG} WriteLn('TExperiment.GetNextCondition:',Result); {$ENDIF} @@ -383,7 +373,7 @@ begin if LContingencyResults.Count = Condition[c].EndCriterium.LastCycles then begin - // count how many times interlocks in last X cycles + // count how many interlocks in last X cycles for LRow in LContingencyResults do if LRow = '1' then Inc(i); @@ -456,10 +446,6 @@ end; procedure TExperiment.SetContingency(ACondition, I : integer; AValue: TContingency); begin FConditions[ACondition].Contingencies[I] := AValue; - if FConditions[ACondition].Contingencies[I].Meta then - FConditions[ACondition].Contingencies[I].OnCriteria:=@Interlocking - else - FConditions[ACondition].Contingencies[I].OnCriteria:=@Consequence; end; procedure TExperiment.SetMatrixType(AValue: TGameMatrixType); @@ -553,10 +539,10 @@ begin FState:=AValue; end; -procedure TExperiment.SetTargetInterlocking; +procedure TExperiment.SetTargetInterlockingEvent; var i : integer; begin - for i:= 0 to ContingenciesCount[CurrentCondition] do + for i:= 0 to ContingenciesCount[CurrentCondition]-1 do if Condition[CurrentCondition].Contingencies[i].Meta then begin Condition[CurrentCondition].Contingencies[i].OnTargetCriteria:=@TargetInterlocking; @@ -564,6 +550,17 @@ begin end; end; +procedure TExperiment.SetContingenciesEvents; +var + i: Integer; +begin + for i := 0 to ContingenciesCount[CurrentCondition]-1 do + if FConditions[CurrentCondition].Contingencies[I].Meta then + FConditions[CurrentCondition].Contingencies[I].OnCriteria:=@Interlocking + else + FConditions[CurrentCondition].Contingencies[I].OnCriteria:=@Consequence; +end; + procedure TExperiment.Consequence(Sender: TObject); begin if Assigned(FOnConsequence) then FOnConsequence(Sender); @@ -600,6 +597,12 @@ begin if Assigned(FOnInterlocking) then FOnInterlocking(Sender); end; +procedure TExperiment.SetOnTargetInterlocking(AValue: TNotifyEvent); +begin + if FOnTargetInterlocking=AValue then Exit; + FOnTargetInterlocking:=AValue; +end; + procedure TExperiment.WriteReportHeader; var @@ -733,6 +736,12 @@ begin end; end; +procedure TExperiment.WriteChatLn(ALn: string); +begin + FRegChat.SaveData(ALn); + FRegChat.CloseAndOpen; +end; + constructor TExperiment.Create(AOwner: TComponent); begin inherited Create(AOwner); @@ -742,14 +751,16 @@ begin end; constructor TExperiment.Create(AOwner: TComponent;AppPath:string); -var i : integer; +var LDataPath : string; begin inherited Create(AOwner); + LDataPath := AppPath+VAL_RESEARCHER+'es'+PathDelim+Researcher+PathDelim+ExperimentName+PathDelim; FTurnsRandom := TStringList.Create; LoadExperimentFromResource(Self); // TODO: Allow custom target interlocking. Now just taking the first meta, as usual in the lab. - SetTargetInterlocking; + SetTargetInterlockingEvent; + SetContingenciesEvents; CheckNeedForRandomTurns; @@ -757,7 +768,9 @@ begin FReportReader.UseRange:=True; FReportReader.SetXLastRows(Condition[CurrentCondition].EndCriterium.LastCycles); - FRegData := TRegData.Create(Self, AppPath+VAL_RESEARCHER+'es'+PathDelim+Researcher+PathDelim+ExperimentName+PathDelim+'000.dat'); + FRegData := TRegData.Create(Self, LDataPath+'000.dat'); + if ShowChat then + FRegChat := TRegData.Create(Self, LDataPath+'000.chat'); WriteReportHeader; end; @@ -835,6 +848,53 @@ begin FPlayers[Result] := APlayer; end; +function TExperiment.ShouldEndCondition: Boolean; +var + LInterlocks: Real; + LAbsCycles: Integer; +begin + Result := False; + // interlockings in the last x cycles + LInterlocks := InterlockingsInLastCycles; + + // absolute cycles count + LAbsCycles := GetCurrentAbsoluteCycle; + case FConditions[CurrentCondition].EndCriterium.Style of + gecWhichComeFirst: + begin + if (LAbsCycles = FConditions[CurrentCondition].EndCriterium.AbsoluteCycles) or + (LInterlocks >= FConditions[CurrentCondition].EndCriterium.InterlockingPorcentage) then + Result := True; + + end; + gecAbsoluteCycles: + if LAbsCycles = FConditions[CurrentCondition].EndCriterium.AbsoluteCycles then + Result := True; + + gecInterlockingPorcentage: + if LInterlocks >= FConditions[CurrentCondition].EndCriterium.InterlockingPorcentage then + Result := True; + end; +end; + +function TExperiment.CurrentConditionAsString: UTF8String; +begin + if ABPoints then + Result := + IntToStr(Condition[CurrentCondition].Points.OnStart.A)+'|'+ + IntToStr(Condition[CurrentCondition].Points.OnStart.B)+'|'+ + IntToStr(Condition[CurrentCondition].Points.OnStart.G) + else + Result:= + IntToStr(Condition[CurrentCondition].Points.OnStart.A)+'|'+ + IntToStr(Condition[CurrentCondition].Points.OnStart.G); +end; + +//procedure TExperiment.TargetInterlocking; +//begin +// SetTargetInterlocking; +//end; + procedure TExperiment.SaveToFile(AFilename: string); begin SaveExperimentToFile(Self,AFilename); @@ -868,7 +928,6 @@ begin end; procedure TExperiment.Play; -var i : integer; begin //for i := 0 to Condition[CurrentCondition].Turn.Value-1 do // begin diff --git a/units/game_file_methods.pas b/units/game_file_methods.pas index 2844c6a..169dfef 100644 --- a/units/game_file_methods.pas +++ b/units/game_file_methods.pas @@ -93,9 +93,9 @@ begin Turn.Value:=2; Turn.Random:=False; Cycles.Count:=0; - Cycles.Value:=4; + Cycles.Value:=20; Cycles.Generation:=0; - EndCriterium.AbsoluteCycles := 20; + EndCriterium.AbsoluteCycles := 15; EndCriterium.InterlockingPorcentage := 80; EndCriterium.LastCycles := 10; EndCriterium.Style := gecWhichComeFirst; @@ -113,7 +113,6 @@ begin LConcequence := TConsequence.Create(AExperiment,-1,[gscPoints, gscG, gscMessage],['','item escolar','itens escolares']); Contingencies[3] := TContingency.Create(AExperiment,LConcequence,LCriteria4,True); Contingencies[3].ContingencyName := 'MPUN -1G'; - Prompt := TPrompt.Create( AExperiment , [gsAll,gsYes,gsMetacontingency,gsContingency,gsRevertPoints,gsBasA] diff --git a/units/report_reader.pas b/units/report_reader.pas index e387e1a..98b43b3 100644 --- a/units/report_reader.pas +++ b/units/report_reader.pas @@ -38,6 +38,7 @@ type VRow : string; //helper constructor Create; destructor Destroy; override; + function Dump : string; procedure Append(ARow : string); procedure Extend(ARowExtention : string); procedure Clean; @@ -64,10 +65,10 @@ begin if c > -1 then if FUseRange and (FRowRange.Low <= FRowRange.High) and (FRowRange.Low > 0) then for i := FRowRange.Low to FRowRange.High do - Result.Append(ExtractDelimited(c+1, FRows[i],[#9,#10])) + Result.Append(ExtractDelimited(c+2, FRows[i],[#9,#10])); else for Row in FRows do - Result.Append(ExtractDelimited(c+1, Row,[#9,#10])); + Result.Append(ExtractDelimited(c+2, Row,[#9,#10])); end; constructor TReportReader.Create; @@ -87,6 +88,11 @@ begin inherited Destroy; end; +function TReportReader.Dump: string; +begin + Result := FCols.Text+LineEnding+FRows.Text; +end; + procedure TReportReader.Append(ARow: string); begin if FCols.Count = 0 then -- libgit2 0.21.2