From f8cf50c5d02595fd30edfb78693c0d6a2ef26ac4 Mon Sep 17 00:00:00 2001 From: cpicanco Date: Fri, 2 Dec 2016 22:35:08 -0300 Subject: [PATCH] work end of experiment and player feedback on change generation --- cultural_matrix.lpr | 5 +---- form_chooseactor.pas | 57 +++++++++++++++++++++++++++++++++++++++++++++++---------- units/backup/game_experiment.pas | 782 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ units/backup/report_reader.pas | 124 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ units/game_actors.pas | 2 +- units/game_control.pas | 165 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++---------------------------------------- units/game_experiment.pas | 22 ++++++++++++++++++---- units/game_file_methods.pas | 7 ++++++- units/game_resources.pas | 2 +- units/game_zmq_actors.pas | 2 ++ units/report_reader.pas | 16 ++++++++++++++++ units/string_methods.pas | 8 ++++---- 12 files changed, 1127 insertions(+), 65 deletions(-) create mode 100644 units/backup/game_experiment.pas create mode 100644 units/backup/report_reader.pas diff --git a/cultural_matrix.lpr b/cultural_matrix.lpr index a9e4523..ae2cef3 100644 --- a/cultural_matrix.lpr +++ b/cultural_matrix.lpr @@ -31,10 +31,6 @@ uses var - {$IFDEF DEBUG} - I : integer; - {$ENDIF} - ID : TStringList; ApplicationPath, F : string; @@ -71,6 +67,7 @@ const {$ENDIF} function GetZMQNetworkID(var F:string):Boolean; + var ID : TStringList; begin Result := True; ID := TStringList.Create; diff --git a/form_chooseactor.pas b/form_chooseactor.pas index a03cfbd..47c4b48 100644 --- a/form_chooseactor.pas +++ b/form_chooseactor.pas @@ -34,6 +34,8 @@ type procedure btnPlayerResumeClick(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: boolean); procedure FormCreate(Sender: TObject); + procedure ExitApplication(Sender: TObject); + procedure ShowResumeButton(Sender: TObject); private FGameActor: TGameActor; FCanClose : Boolean; @@ -41,8 +43,7 @@ type procedure SetStyle(AValue: string); { private declarations } public - procedure ShowPoints(A, B, G : string); - procedure ShowResumeButton; + procedure ShowPoints(M : string); property GameActor : TGameActor read FGameActor; property Style : string read FStyle write SetStyle; end; @@ -86,26 +87,62 @@ begin FCanClose := True; end; +procedure TFormChooseActor.ExitApplication(Sender: TObject); +begin + Application.Terminate; +end; + procedure TFormChooseActor.SetStyle(AValue: string); begin if FStyle=AValue then Exit; + FStyle:=AValue; case AValue of '.Arrived': btnPlayerResume.Visible:=False; - '.Left': btnPlayerResume.Visible:=True; + '.Left', '.EndX': + begin + btnPlayerResume.Visible:=False; + btnAdmin.Visible:= False; + btnPlayer.Visible:= False; + BorderStyle:=bsNone; + Position:=poDesigned; + FormStyle:=fsNormal; + WindowState:=wsFullScreen; + end; end; - btnAdmin.Visible:= not btnPlayerResume.Visible; - btnPlayer.Visible:= not btnPlayerResume.Visible; - FStyle:=AValue; end; -procedure TFormChooseActor.ShowPoints(A, B, G: string); +procedure TFormChooseActor.ShowPoints(M: string); +var L : TLabel; begin - + L := TLabel.Create(Self); + with L do + begin + Name := 'LabelGoodBye'; + Align:=alClient; + Caption:= M; + Alignment := taCenter; + Anchors := [akLeft,akRight]; + Layout := tlCenter; + WordWrap := True; + Parent:=Self; + Font.Size := 30; + case FStyle of + '.Left': OnClick := @ShowResumeButton; + '.EndX': OnClick := @ExitApplication; + end; + end; end; -procedure TFormChooseActor.ShowResumeButton; +procedure TFormChooseActor.ShowResumeButton(Sender: TObject); +var i : integer; begin - + for i := 0 to ComponentCount-1 do + if Components[i].Name = 'LabelGoodBye' then + begin + TLabel(Components[i]).Visible:=False; + Break; + end; + btnPlayerResume.Visible:=True; end; end. diff --git a/units/backup/game_experiment.pas b/units/backup/game_experiment.pas new file mode 100644 index 0000000..091c7ac --- /dev/null +++ b/units/backup/game_experiment.pas @@ -0,0 +1,782 @@ +{ + Stimulus Control + Copyright (C) 2014-2016 Carlos Rafael Fernandes Picanço, Universidade Federal do Pará. + + The present file is distributed under the terms of the GNU General Public License (GPL v3.0). + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +} +unit game_experiment; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils + , game_actors + , regdata + ; + +type + + { TExperiment } + + TExperimentState = (xsWaiting,xsRunning,xsPaused,xsCanceled); + TConditions = array of TCondition; + + TExperiment = class(TComponent) + private + FExperimentAim, + FExperimentName, + FFilename, + FResearcher : string; + FGenPlayersAsNeeded : Boolean; + FResearcherCanChat: Boolean; + FResearcherCanPlay: Boolean; + FSendChatHistoryForNewPlayers: Boolean; + FShowChat: Boolean; + FMatrixType: TGameMatrixType; + private + FLastReportColNames : string; + FRegData : TRegData; + FPlayers : TPlayers; + FCurrentCondition : integer; + FConditions : TConditions; + FState: TExperimentState; + FTurnsRandom : TStringList; + function GetCondition(I : Integer): TCondition; + function GetConditionsCount: integer; + function GetContingenciesCount(C: integer): integer; + function GetContingency(ACondition, I : integer): TContingency; + function GetNextTurn: integer; + function GetNextTurnPlayerID: UTF8string; + 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 GetPlayerIndexFromID(AID : UTF8string): integer; + function GetPlayerIsPlaying(AID : UTF8string): Boolean; + function GetPlayersCount: integer; + function GetInterlockingsIn(ALastCycles : integer):integer; + function GetConsequenceStringFromChoice(P:TPlayer): Utf8string; + function GetConsequenceStringFromChoices:UTF8String; + procedure CheckNeedForRandomTurns; + 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); + private + FChangeGeneration: string; + FOnConsequence: TNotifyEvent; + FOnInterlocking: TNotifyEvent; + FOnEndTurn: TNotifyEvent; + FOnEndCondition: TNotifyEvent; + FOnEndCycle: TNotifyEvent; + FOnEndExperiment: TNotifyEvent; + FOnEndGeneration: TNotifyEvent; + procedure Consequence(Sender : TObject); + function GetPlayerToKick: string; + procedure Interlocking(Sender : TObject); + procedure SetPlayersQueue(AValue: string); + procedure WriteReportHeader; + procedure WriteReportRowNames; + procedure WriteReportRow; + public + constructor Create(AOwner:TComponent);override; + constructor Create(AOwner:TComponent; AppPath:string);overload; + constructor Create(AOwner:TComponent; AFilename, AppPath:string); overload; + destructor Destroy; override; + function LoadFromFile(AFilename: string):Boolean; + function LoadFromGenerator:Boolean; + procedure SaveToFile(AFilename: string); overload; + procedure SaveToFile; overload; + procedure Clean; + procedure Play; + procedure WriteReportRowPrompt; + property ExperimentAim : string read FExperimentAim write FExperimentAim; + property ExperimentName : string read FExperimentName write FExperimentName; + property GenPlayersAsNeeded : Boolean read FGenPlayersAsNeeded write FGenPlayersAsNeeded; + property ResearcherCanPlay : Boolean read FResearcherCanPlay write SetResearcherCanPlay; + property ResearcherCanChat : Boolean read FResearcherCanChat write SetResearcherCanChat; + property Researcher : string read FResearcher write FResearcher; + property ShowChat : Boolean read FShowChat write FShowChat; + property SendChatHistoryForNewPlayers : Boolean read FSendChatHistoryForNewPlayers write SetSendChatHistoryForNewPlayers; + property MatrixType : TGameMatrixType read FMatrixType write SetMatrixType; + public + function AppendCondition : integer; overload; + function AppendCondition(ACondition : TCondition) : integer;overload; + function AppendContingency(ACondition : integer) : integer;overload; + function AppendContingency(ACondition : integer;AContingency : TContingency) : integer;overload; + function AppendPlayer : integer;overload; + function AppendPlayer(APlayer : TPlayer) : integer; overload; + property Condition[I : Integer]: TCondition read GetCondition write SetCondition; + property ConditionsCount : integer read GetConditionsCount; + property CurrentCondition : integer read FCurrentCondition write FCurrentCondition; + property Contingency[C, I : integer] : TContingency read GetContingency write SetContingency; + property ContingenciesCount[C:integer]:integer read GetContingenciesCount; + property Player[I : integer] : TPlayer read GetPlayer write SetPlayer; + 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 InterlockingsIn[i:integer]:integer read GetInterlockingsIn; + property ConsequenceStringFromChoice[P:Tplayer]:UTF8String read GetConsequenceStringFromChoice; + property ConsequenceStringFromChoices: UTF8String read GetConsequenceStringFromChoices; + property NextTurnPlayerID : UTF8string read GetNextTurnPlayerID; + property NextTurn : integer read GetNextTurn; + property NextCycle : integer read GetNextCycle; + property NextCondition : integer read GetNextCondition; + property NextGeneration: string read GetPlayerToKick write SetPlayersQueue; + property State : TExperimentState read FState write SetState; + public + property OnEndTurn : TNotifyEvent read FOnEndTurn write SetOnEndTurn; + property OnEndCycle : TNotifyEvent read FOnEndCycle write SetOnEndCycle; + property OnEndGeneration : TNotifyEvent read FOnEndGeneration write SetOnEndGeneration; + property OnEndCondition : TNotifyEvent read FOnEndCondition write SetOnEndCondition; + property OnEndExperiment : TNotifyEvent read FOnEndExperiment write SetOnEndExperiment; + property OnConsequence : TNotifyEvent read FOnConsequence write SetOnConsequence; + property OnInterlocking : TNotifyEvent read FOnInterlocking write SetOnInterlocking; + end; + +resourcestring + WARN_CANNOT_SAVE = 'O experimento não pode ser salvo.'; + +implementation + +uses game_file_methods, game_resources, string_methods; + +{ TExperiment } + +function TExperiment.GetCondition(I : Integer): TCondition; +begin + Result := FConditions[I]; +end; + +function TExperiment.GetConditionsCount: integer; +begin + Result := Length(FConditions); +end; + +function TExperiment.GetContingenciesCount(C: integer): integer; +begin + Result := Length(FConditions[C].Contingencies); +end; + +function TExperiment.GetContingency(ACondition, I : integer): TContingency; +begin + Result := FConditions[ACondition].Contingencies[I]; +end; + +function TExperiment.GetNextTurn: integer; // used during player arriving +begin + if FConditions[CurrentCondition].Turn.Random then + Result := StrToInt(FTurnsRandom.Names[FConditions[CurrentCondition].Turn.Count]) + else + Result := FConditions[CurrentCondition].Turn.Count; + + if Assigned(FOnEndTurn) then FOnEndTurn(Self); + + if FConditions[CurrentCondition].Turn.Count < FConditions[CurrentCondition].Turn.Value-1 then + Inc(FConditions[CurrentCondition].Turn.Count) + else + begin + FConditions[CurrentCondition].Turn.Count := 0; + NextCycle; + end; +{$IFDEF DEBUG} + WriteLn('TExperiment.GetNextTurn:',Result); +{$ENDIF} +end; + +function TExperiment.GetNextTurnPlayerID: UTF8string; // used during cycles +begin + Result := Player[FConditions[CurrentCondition].Turn.Count].ID; +end; + +function TExperiment.GetNextCycle: integer; +begin + Result := FConditions[CurrentCondition].Cycles.Count; + WriteReportRow; + if Assigned(FOnEndCycle) then FOnEndCycle(Self); + + if FConditions[CurrentCondition].Cycles.Count < FConditions[CurrentCondition].Cycles.Value-1 then + Inc(FConditions[CurrentCondition].Cycles.Count) + else + 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); + {$ENDIF} +end; + +function TExperiment.GetNextCondition: integer; +var + LInterlocks : integer; + + procedure EndCondition; + begin + if Assigned(FOnEndCondition) then FOnEndCondition(Self); + Inc(FCurrentCondition); + WriteReportRowNames; + end; + +begin + Result := CurrentCondition; + + // interlockings in the last x cycles + LInterlocks := InterlockingsIn[FConditions[CurrentCondition].EndCriterium.LastCycles]; + case FConditions[CurrentCondition].EndCriterium.Value of + gecWhichComeFirst: + begin + if (GetCurrentAbsoluteCycle = FConditions[CurrentCondition].EndCriterium.AbsoluteCycles) or + (LInterlocks = FConditions[CurrentCondition].EndCriterium.InterlockingPorcentage) then + EndCondition; + + end; + gecAbsoluteCycles: + if GetCurrentAbsoluteCycle = FConditions[CurrentCondition].EndCriterium.AbsoluteCycles then + EndCondition; + + gecInterlockingPorcentage: + if LInterlocks = FConditions[CurrentCondition].EndCriterium.InterlockingPorcentage then + EndCondition; + + end; + {$IFDEF DEBUG} + WriteLn('TExperiment.GetNextCondition:',Result); + {$ENDIF} +end; + +function TExperiment.GetCurrentAbsoluteCycle: integer; +var c:integer; +begin + c := CurrentCondition; + Result := (Condition[c].Cycles.Value*Condition[c].Cycles.Generation)+Condition[c].Cycles.Count; +end; + +function TExperiment.GetPlayer(I : integer): TPlayer; +begin + Result := FPlayers[i]; +end; + +function TExperiment.GetPlayer(AID: UTF8string): TPlayer; +var + i : integer; +begin + //Result.ID := ''; + if PlayersCount > 0 then + for i:= 0 to PlayersCount -1 do + if FPlayers[i].ID = AID then + begin + Result := FPlayers[i]; + Break; + end; +end; + +// fewer as possible data +function TExperiment.AliasPlayerAsString(P: TPlayer): UTF8string; +begin + Result:= GetPlayerAsString(P); +end; + +function TExperiment.AliasPlayerFromString(s: UTF8string): TPlayer; +begin + Result := GetPlayerFromString(S); +end; + +function TExperiment.GetPlayerIndexFromID(AID: UTF8string): integer; +var i : integer; +begin + Result := -1; + for i:= 0 to PlayersCount -1 do + if FPlayers[i].ID = AID then + begin + Result := i; + Break; + end; +end; + +function TExperiment.GetPlayerIsPlaying(AID: UTF8string): Boolean; +var i : integer; +begin + Result := PlayersCount > 0; + if Result then + for i := 0 to PlayersCount -1 do + if Player[i].ID = AID then + Exit; + Result:= False; +end; + + +function TExperiment.GetPlayersCount: integer; +begin + Result := Length(FPlayers); +end; + +function TExperiment.GetInterlockingsIn(ALastCycles: integer): integer; +var + S : TStringList; + LTargetMetaContingency : integer; +begin + S.LoadFromFile(FRegData.FileName); + +end; + +function TExperiment.GetConsequenceStringFromChoice(P: TPlayer): Utf8string; +var + i : integer; + c : integer; +begin + c := CurrentCondition; + PlayerFromID[P.ID] := P; + Result:= ''; + for i :=0 to ContingenciesCount[c] -1 do + if not Contingency[c,i].Meta then + if Contingency[c,i].ResponseMeetsCriteriaI(P.Choice.Row,P.Choice.Color) then + Result += Contingency[c,i].Consequence.AsString(P.ID); +end; + +function TExperiment.GetConsequenceStringFromChoices: UTF8String; +var + i : integer; + c : integer; +begin + c := CurrentCondition; + Result:= ''; + for i :=0 to ContingenciesCount[c] -1 do + if Contingency[c,i].Meta then + if Contingency[c,i].ResponseMeetsCriteriaG(FPlayers) then + Result += Contingency[c,i].Consequence.AsString(IntToStr(i)); +end; + +procedure TExperiment.CheckNeedForRandomTurns; +var c , + i, + r : integer; +begin + if Condition[CurrentCondition].Turn.Random then + begin + FTurnsRandom.Clear; + for i:= 0 to Condition[CurrentCondition].Turn.Value-1 do + FTurnsRandom.Add(IntToStr(i)); + + c := FTurnsRandom.Count - 1; + for i := 0 to c do + begin + r := Random(c); + while r = i do r := Random(c); + FTurnsRandom.Exchange(r,i); + end; + end; +end; + +procedure TExperiment.SetCondition(I : Integer; AValue: TCondition); +begin + FConditions[I] := AValue; +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); +begin + if FMatrixType=AValue then Exit; + FMatrixType:=AValue; +end; + +procedure TExperiment.SetOnConsequence(AValue: TNotifyEvent); +begin + if FOnConsequence=AValue then Exit; + FOnConsequence:=AValue; +end; + +procedure TExperiment.SetOnEndCondition(AValue: TNotifyEvent); +begin + if FOnEndCondition=AValue then Exit; + FOnEndCondition:=AValue; +end; + +procedure TExperiment.SetOnEndCycle(AValue: TNotifyEvent); +begin + if FOnEndCycle=AValue then Exit; + FOnEndCycle:=AValue; +end; + +procedure TExperiment.SetOnEndExperiment(AValue: TNotifyEvent); +begin + if FOnEndExperiment=AValue then Exit; + FOnEndExperiment:=AValue; +end; + +procedure TExperiment.SetOnEndGeneration(AValue: TNotifyEvent); +begin + if FOnEndGeneration=AValue then Exit; + FOnEndGeneration:=AValue; +end; + +procedure TExperiment.SetOnEndTurn(AValue: TNotifyEvent); +begin + if FOnEndTurn=AValue then Exit; + FOnEndTurn:=AValue; +end; + +procedure TExperiment.SetOnInterlocking(AValue: TNotifyEvent); +begin + if FOnInterlocking=AValue then Exit; + FOnInterlocking:=AValue; +end; + + +procedure TExperiment.SetPlayer(I : integer; AValue: TPlayer); +begin + FPlayers[I] := AValue; +end; + +procedure TExperiment.SetPlayer(S: UTF8string; AValue: TPlayer); +var i : integer; +begin + if PlayersCount > 0 then + for i:= 0 to PlayersCount -1 do + if FPlayers[i].ID = S then + begin + FPlayers[i] := AValue; + Exit; + end; + raise Exception.Create('TExperiment.SetPlayer: Could not set player.'); +end; + +procedure TExperiment.SetResearcherCanChat(AValue: Boolean); +begin + if FResearcherCanChat=AValue then Exit; + FResearcherCanChat:=AValue; +end; + +procedure TExperiment.SetResearcherCanPlay(AValue: Boolean); +begin + if FResearcherCanPlay=AValue then Exit; + FResearcherCanPlay:=AValue; +end; + +procedure TExperiment.SetSendChatHistoryForNewPlayers(AValue: Boolean); +begin + if FSendChatHistoryForNewPlayers=AValue then Exit; + FSendChatHistoryForNewPlayers:=AValue; +end; + +procedure TExperiment.SetState(AValue: TExperimentState); +begin + if FState=AValue then Exit; + FState:=AValue; +end; + +procedure TExperiment.Consequence(Sender: TObject); +begin + if Assigned(FOnConsequence) then FOnConsequence(Sender); +end; + +procedure TExperiment.Interlocking(Sender: TObject); +begin + if Assigned(FOnInterlocking) then FOnInterlocking(Sender); +end; + +procedure TExperiment.SetPlayersQueue(AValue: string); +var + i : integer; +begin + for i := 0 to PlayersCount-2 do + begin + FPlayers[i] := FPlayers[i+1]; + end; + FPlayers[High(FPlayers)] := PlayerFromString[AValue]; +end; + +function TExperiment.GetPlayerToKick: string; +var c : integer; +begin + c := CurrentCondition; + if Condition[c].Cycles.Count < Condition[c].Cycles.Value -1 then + Result := #32 + else + Result := FPlayers[0].ID; +end; + + +procedure TExperiment.WriteReportHeader; +var + LHeader : string; +begin + // header + LHeader := VAL_RESEARCHER+':' + #9 + FResearcher + #9 + LineEnding + + VAL_EXPERIMENT+':' + #9 + FExperimentName + #9 + LineEnding + + VAL_BEGIN_TIME+':' + #9 + DateTimeToStr(Date) + #9 + TimeToStr(Time) +#9+ LineEnding + #9 + LineEnding; + FRegData.SaveData(LHeader); + WriteReportRowNames; +end; + +procedure TExperiment.WriteReportRowNames; +var + c,j,i: integer; + LNames : string; +begin + c:= CurrentCondition; + + // column names, line 1 + LNames := 'Experimento'+#9+#9+#9; + for i:=0 to Condition[c].Turn.Value-1 do // player's response + begin + LNames += 'P'+IntToStr(i+1)+#9+#9; + for j:=0 to ContingenciesCount[c]-1 do + if not Contingency[c,j].Meta then + LNames += #9; + end; + + LNames += VAL_INTERLOCKING+'s'; + for i:=0 to ContingenciesCount[c]-1 do + if Contingency[c,i].Meta then + LNames += #9; + + if Assigned(Condition[c].Prompt) then + begin + LNames += 'Respostas à Pergunta'; + for i:=0 to Condition[c].Turn.Value-1 do + LNames += #9; + end; + LNames += LineEnding; + + // column names, line 2 + LNames += 'Condição'+#9+'Geração'+#9+'Ciclos'+#9; + for i:=0 to Condition[c].Turn.Value-1 do + begin + LNames += 'Linha'+#9+'Cor'+#9; + for j:=0 to ContingenciesCount[c]-1 do + if not Contingency[c,j].Meta then + LNames += Contingency[c,j].ContingencyName+#9; + end; + + for i:=0 to ContingenciesCount[c]-1 do + if Contingency[c,i].Meta then + LNames += Contingency[c,i].ContingencyName+#9; + + if Assigned(Condition[c].Prompt) then + for i:=0 to Condition[c].Turn.Value-1 do + LNames += 'R'+IntToStr(i+1)+#9; + + LNames += '|'+#9; + if FLastReportColNames <> LNames then + begin + FLastReportColNames := LNames; + FRegData.SaveData(LNames); + end; +end; + +procedure TExperiment.WriteReportRow; +var + c,j,i: integer; + LRow : string; +begin + c:= CurrentCondition; + + LRow := LineEnding + IntToStr(c+1)+#9+IntToStr(Condition[c].Cycles.Generation+1)+#9+IntToStr(GetCurrentAbsoluteCycle+1)+#9; + for i:=0 to Condition[c].Turn.Value-1 do + begin + LRow += GetRowString(FPlayers[i].Choice.Row)+#9+GetColorString(FPlayers[i].Choice.Color)+#9; + for j:=0 to ContingenciesCount[c]-1 do + if not Contingency[c,j].Meta then + if Contingency[c,j].ConsequenceFromPlayerID(FPlayers[i].ID) <> '' then + LRow += '1'+#9 + else + LRow += '0'+#9; + end; + + for i:=0 to ContingenciesCount[c]-1 do + if Contingency[c,i].Meta then + if Contingency[c,i].Fired then + LRow += '1'+#9 + else + LRow += '0'+#9; + + FRegData.SaveData(LRow); +end; + +procedure TExperiment.WriteReportRowPrompt; +var + c,i: integer; + LRow : string; +begin + c := CurrentCondition; + LRow := ''; + if Condition[c].Prompt.ResponsesCount = Condition[c].Turn.Value then + for i:=0 to Condition[c].Prompt.ResponsesCount-1 do + LRow += 'P'+IntToStr(PlayerIndexFromID[Delimited(1,Condition[c].Prompt.Response(i))]+1)+ + '|'+ + Delimited(2,Condition[c].Prompt.Response(i))+#9 + else + for i:=0 to Condition[c].Turn.Value-1 do + LRow += 'NA'+#9; + + FRegData.SaveData(LRow); +end; + +constructor TExperiment.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FTurnsRandom := TStringList.Create; + LoadExperimentFromResource(Self); + CheckNeedForRandomTurns; +end; + +constructor TExperiment.Create(AOwner: TComponent;AppPath:string); +begin + inherited Create(AOwner); + FTurnsRandom := TStringList.Create; + LoadExperimentFromResource(Self); + CheckNeedForRandomTurns; + FRegData := TRegData.Create(Self, AppPath+VAL_RESEARCHER+'es'+PathDelim+Researcher+PathDelim+ExperimentName+PathDelim+'000.dat'); + WriteReportHeader; +end; + +constructor TExperiment.Create(AOwner:TComponent;AFilename,AppPath:string); +begin + inherited Create(AOwner); + FTurnsRandom := TStringList.Create; + LoadExperimentFromFile(Self,AFilename); + CheckNeedForRandomTurns; +end; + +destructor TExperiment.Destroy; +begin + FTurnsRandom.Free; + inherited Destroy; +end; + +function TExperiment.LoadFromFile(AFilename: string): Boolean; +begin + Result := LoadExperimentFromFile(Self, AFilename); + if Result then + FFilename := AFilename; + CheckNeedForRandomTurns; +end; + +function TExperiment.LoadFromGenerator: Boolean; +begin + Result := LoadExperimentFromResource(Self); + if Result then + FFilename := GetCurrentDir + PathDelim + FResearcher + PathDelim; + CheckNeedForRandomTurns; +end; + +function TExperiment.AppendCondition: integer; +begin + SetLength(FConditions, Length(FConditions)+1); + Result := High(FConditions); +end; + +function TExperiment.AppendCondition(ACondition: TCondition): integer; +begin + SetLength(FConditions, Length(FConditions)+1); + Result := High(FConditions); + FConditions[Result] := ACondition; +end; + +function TExperiment.AppendContingency(ACondition: integer): integer; +begin + SetLength(FConditions[ACondition].Contingencies, Length(FConditions[ACondition].Contingencies)+1); + Result := High(FConditions[ACondition].Contingencies); +end; + +function TExperiment.AppendContingency(ACondition: integer; + AContingency: TContingency): integer; +begin + SetLength(FConditions[ACondition].Contingencies, Length(FConditions[ACondition].Contingencies)+1); + Result := High(FConditions[ACondition].Contingencies); + FConditions[ACondition].Contingencies[Result] := AContingency; +end; + +function TExperiment.AppendPlayer: integer; +begin + SetLength(FPlayers, Length(FPlayers)+1); + Result := High(FPlayers); +end; + +function TExperiment.AppendPlayer(APlayer: TPlayer): integer; +begin + SetLength(FPlayers, Length(FPlayers)+1); + Result := High(FPlayers); + FPlayers[Result] := APlayer; +end; + +procedure TExperiment.SaveToFile(AFilename: string); +begin + SaveExperimentToFile(Self,AFilename); +end; + +procedure TExperiment.SaveToFile; +begin + if FFilename <> '' then + SaveExperimentToFile(Self,FFilename) + else +{$IFDEF DEBUG} + WriteLn(WARN_CANNOT_SAVE) +{$ENDIF}; +end; + +procedure TExperiment.Clean; +var c,i : integer; +begin + for i := 0 to PlayersCount -1 do + begin + FPlayers[i].Choice.Row:=grNone; + FPlayers[i].Choice.Color:=gcNone; + end; + c := CurrentCondition; + for i := 0 to ContingenciesCount[c]-1 do + Contingency[c,i].Clean; + + Condition[c].Prompt.Clean; + + FRegData.CloseAndOpen; +end; + +procedure TExperiment.Play; +var i : integer; +begin + //for i := 0 to Condition[CurrentCondition].Turn.Value-1 do + // begin + // //TRegData.Save Header; + // end; + FState:=xsRunning; +end; + + +end. + diff --git a/units/backup/report_reader.pas b/units/backup/report_reader.pas new file mode 100644 index 0000000..393fe44 --- /dev/null +++ b/units/backup/report_reader.pas @@ -0,0 +1,124 @@ +unit report_reader; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils; + +type + + TRowRange = record + Low, + High : integer; + end; + + { TReportReader } + + TReportReader = class + private + FLastRowsX : integer; + FRows : TStringList; + FCols : TStringList; + FRowRange: TRowRange; + FUseRange: Boolean; + function GetColumnOf(AName: string): TStringList; + procedure RangeAsLastXRows; + public + VRow : string; //helper + constructor Create; + destructor Destroy; override; + procedure Append(ARow : string); + procedure Extend(ARowExtention : string); + procedure Clean; + procedure SetXLastRows(X:integer); + property Range : TRowRange read FRowRange; + property UseRange : Boolean read FUseRange write FUseRange; + property ColumnOf[AName:string]:TStringList read GetColumnOf; + end; + +implementation + +uses strutils; + +{ TReportReader } + +function TReportReader.GetColumnOf(AName: string): TStringList; +var + c, + i : integer; + Row : string; +begin + Result := TStringList.Create; + c := FCols.IndexOf(AName); + 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])) + else + for Row in FRows do + Result.Append(ExtractDelimited(c+1, Row,[#9,#10])); +end; + +constructor TReportReader.Create; +begin + inherited Create; + FUseRange := False; + FRows := TStringList.Create; + FCols := TStringList.Create; + FCols.Delimiter := #9; + FCols.StrictDelimiter := True; +end; + +destructor TReportReader.Destroy; +begin + FRows.Free; + FCols.Free; + inherited Destroy; +end; + +procedure TReportReader.Append(ARow: string); +begin + if FCols.Count = 0 then + FCols.DelimitedText := ARow + else + begin + FRows.Append(ARow); + RangeAsLastXRows; + end; +end; + +procedure TReportReader.Extend(ARowExtention: string); +begin + FRows[FRows.Count-1] := FRows[FRows.Count-1] + ARowExtention; +end; + +procedure TReportReader.Clean; +begin + FCols.Clear; + FRows.Clear; +end; + +procedure TReportReader.SetXLastRows(X: integer); +begin + FLastRowsX:=X; + RangeAsLastXRows; +end; + +procedure TReportReader.RangeAsLastXRows; +begin + FRowRange.High := FRows.Count-1; + FRowRange.Low := FRows.Count-FLastRowsX; + {$IFDEF DEBUG} + if FRowRange.Low > FRowRange.High then + WriteLn('Warning: FRowRange.Low > FRowRange.High, range will not be used'); + + if FRowRange.Low < 0 then + WriteLn('Warning: FRowRange.Low < 0, range will not be used'); + {$ENDIF} +end; + + +end. + diff --git a/units/game_actors.pas b/units/game_actors.pas index b8757d5..71a2d0a 100644 --- a/units/game_actors.pas +++ b/units/game_actors.pas @@ -171,7 +171,7 @@ type end; TEndConditionCriterium = record - Value : TGameEndCondition; + Style : TGameEndCondition; InterlockingPorcentage, LastCycles, AbsoluteCycles: integer; diff --git a/units/game_control.pas b/units/game_control.pas index 770ae88..73291eb 100644 --- a/units/game_control.pas +++ b/units/game_control.pas @@ -81,6 +81,7 @@ type procedure Start; procedure Pause; procedure Resume; + procedure Stop; property Experiment : TExperiment read FExperiment write FExperiment; property ID : UTF8string read FID; property RowBase : integer read FRowBase write SetRowBase; @@ -90,28 +91,28 @@ type function GetRowColor(ARow : integer;ARowBase:integer) : TColor; -// TODO: PUT MESSAGES IN RESOURCE STRING +// TODO: PUT NORMAL STRING MESSAGES IN RESOURCESTRING INSTEAD const - K_FULLROOM = '.Full'; - K_PLAYING = '.Playing'; K_ARRIVED = '.Arrived'; - K_REFUSED = '.Refused'; K_CHAT_M = '.ChatM'; K_CHOICE = '.Choice'; K_MESSAGE = '.Message'; K_START = '.Start'; K_RESUME = '.Resume'; - K_DATA_A = '.Data'; K_LOGIN = '.Login'; K_QUESTION = '.Question'; K_QMESSAGE = '.QMessage'; K_MOVQUEUE = '.Queue'; + K_END = '.EndX'; + // K_STATUS = '.Status'; K_LEFT = '.Left'; K_WAIT = '.Wait'; - //K_RESPONSE = + K_FULLROOM = '.Full'; + K_PLAYING = '.Playing'; + K_REFUSED = '.Refused'; implementation @@ -211,7 +212,7 @@ end; procedure TGameControl.EndExperiment(Sender: TObject); begin - + FZMQActor.SendMessage([K_END]); end; procedure TGameControl.StartExperiment; @@ -224,23 +225,54 @@ begin // enable matrix grid for the first player FZMQActor.SendMessage([K_START]); + + // + Start; end; procedure TGameControl.Start; begin - // basic data/csv setup - // wait for players + // basic gui setup + + // points + FormMatrixGame.GBIndividualAB.Visible := FExperiment.ABPoints; + FormMatrixGame.GBIndividual.Visible:= not FormMatrixGame.GBIndividualAB.Visible; + + // turns + FormMatrixGame.LabelExpCountTurn.Caption:=IntToStr(FExperiment.Condition[FExperiment.CurrentCondition].Turn.Count+1); + + // cycle + FormMatrixGame.LabelExpCountCycle.Caption:=IntToStr(FExperiment.Condition[FExperiment.CurrentCondition].Cycles.Count+1); + // generation + FormMatrixGame.LabelExpCountGeneration.Caption:=IntToStr(FExperiment.Condition[FExperiment.CurrentCondition].Cycles.Generation+1); + + // condition + FormMatrixGame.LabelExpCountCondition.Caption:= FExperiment.Condition[FExperiment.CurrentCondition].ConditionName; + + // interlocks + FormMatrixGame.LabelExpCountInterlocks.Caption:= IntToStr(FExperiment.Condition[FExperiment.CurrentCondition].Interlocks.Count+1); + + // wait for players end; procedure TGameControl.Pause; begin + // save to file + // inform players end; procedure TGameControl.Resume; begin + // load from file + // wait for players +end; + +procedure TGameControl.Stop; +begin + // cleaning end; function TGameControl.GetPlayerBox(AID: UTF8string): TPlayerBox; @@ -486,8 +518,8 @@ end; constructor TGameControl.Create(AOwner: TComponent;AppPath:string); begin + inherited Create(AOwner); FZMQActor := TZMQActor(AOwner); - inherited Create(FZMQActor.Owner); FID := FZMQActor.ID; FZMQActor.OnMessageReceived:=@ReceiveMessage; FZMQActor.OnRequestReceived:=@ReceiveRequest; @@ -518,14 +550,7 @@ begin FExperiment.OnInterlocking:=@Interlocking; FExperiment.OnConsequence:=@Consequence; - //NextTurn(Self); - //NextCycle(Self); - //NextLineage(Self); - //NextCondition(Self); - //Interlocking(Self); - //Consequence(Self); - - SendRequest(K_LOGIN); + SendRequest(K_LOGIN); // admin cannot send requests end; destructor TGameControl.Destroy; @@ -751,20 +776,33 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList); end; procedure SayGoodBye(AID:string); + var Pts : string; begin DeletePlayerBox(AID); // old player case FActor of gaPlayer:begin if Self.ID = AID then begin - // TODO: SHOW EARNED POINTS TO PARTICIPANT - //FormMatrixGame.LabelIndA.Caption; - //FormMatrixGame.LabelIndB.Caption; - //FormMatrixGame.LabelIndG.Caption; + if FExperiment.ABPoints then + begin + Pts := IntToStr(StrToInt(FormMatrixGame.LabelIndACount.Caption)+StrToInt(FormMatrixGame.LabelIndBCount.Caption)); + FormMatrixGame.LabelIndACount.Caption := '0'; + FormMatrixGame.LabelIndBCount.Caption := '0'; + end + else + begin + Pts := FormMatrixGame.LabelIndCount.Caption; + FormMatrixGame.LabelIndCount.Caption := '0'; + end; FormMatrixGame.Visible := False; FormChooseActor := TFormChooseActor.Create(nil); FormChooseActor.Style := K_LEFT; + FormChooseActor.ShowPoints( + 'A tarefa terminou, obrigado por sua participação! Você produziu ' + + Pts + ' pontos e ' + + FormMatrixGame.LabelGroupCount.Caption + ' itens escolares serão doados!'); + if FormChooseActor.ShowModal = 1 then begin FZMQActor.Request([AID,' ',K_RESUME]); @@ -774,22 +812,33 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList); FormChooseActor.Free; end else - ShowPopUp('O jogador '+FExperiment.PlayerFromID[ID].Nicname+ ' saiu. Por favor, aguarde...'); + ShowPopUp(FExperiment.PlayerFromID[AID].Nicname+ ' saiu. Por favor, aguarde a chegada de alguém para ocupar o lugar.'); end; - - gaAdmin:ShowPopUp( - 'O participante '+ - FExperiment.PlayerFromID[ID].Nicname+ - ' saiu. Aguardando a entrada do próximo participante.' - ); end; end; + procedure ResumeNextTurn; begin - if AMessage[1] <> #32 then - SayGoodBye(AMessage[1]) - else - EnablePlayerMatrix(Self.ID,0, True); + 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; @@ -816,6 +865,34 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList); ResumeNextTurn; end; + procedure ShowPointsToPlayers; + var Pts : string; + begin + case FActor of + gaPlayer: + begin + CleanMatrix(False); + FormChooseActor := TFormChooseActor.Create(FormMatrixGame); + FormChooseActor.Style := K_END; + + if FExperiment.ABPoints then + Pts := IntToStr(StrToInt(FormMatrixGame.LabelIndACount.Caption)+StrToInt(FormMatrixGame.LabelIndBCount.Caption)) + else + Pts := FormMatrixGame.LabelIndCount.Caption; + + 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; + end; + end; + end; + begin if MHas(K_ARRIVED) then ReceiveActor; if MHas(K_CHAT_M) then ReceiveChat; @@ -826,6 +903,7 @@ 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; end; // Here FActor is garanted to be a TZMQAdmin @@ -887,15 +965,18 @@ 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-2 + ARequest.Append(TS); // FROM 3 to COUNT-3 end; // append chat data if allowed at the last position if FExperiment.SendChatHistoryForNewPlayers then - ARequest.Append(FormMatrixGame.ChatMemoRecv.Lines.Text) // LAST + ARequest.Append(FormMatrixGame.ChatMemoRecv.Lines.Text) // COUNT-2 else ARequest.Append('[CHAT]'); // must append something to keep the message envelop standard + // append global configs. + ARequest.Append(BoolToStr(FExperiment.ABPoints)); // COUNT-1 + // inform all players about the new player, including itself FZMQActor.SendMessage([K_ARRIVED,PS]); @@ -962,7 +1043,7 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList); FExperiment.WriteReportRowPrompt; FExperiment.Clean; end; - ARequest.Append(FExperiment.NextGeneration); // #32 no, else NextGeneration = PlayerToKick + ARequest.Append(FExperiment.NextGeneration); // 9, #32 no, else NextGeneration = PlayerToKick end; end; @@ -1032,8 +1113,8 @@ begin if MHas(K_QUESTION) then ValidateQuestionResponse; end; -// Here FActor is garanted to be a TZMQPlayer, reply by: -// - sending private data to player player +// Here FActor is garanted to be a TZMQPlayer, replying by: +// - sending private data to player // - sending data from early history to income players procedure TGameControl.ReceiveReply(AReply: TStringList); function MHas(const C : UTF8string) : Boolean; @@ -1048,7 +1129,7 @@ procedure TGameControl.ReceiveReply(AReply: TStringList); begin if Self.ID = AReply[0] then begin - for i:= 3 to AReply.Count -2 do + for i:= 3 to AReply.Count -3 do begin P := FExperiment.PlayerFromString[AReply[i]]; FExperiment.AppendPlayer(P); @@ -1057,7 +1138,11 @@ procedure TGameControl.ReceiveReply(AReply: TStringList); // add chat FormMatrixGame.ChatMemoRecv.Lines.Clear; - FormMatrixGame.ChatMemoRecv.Lines.Add(AReply[AReply.Count-1]); + FormMatrixGame.ChatMemoRecv.Lines.Add(AReply[AReply.Count-2]); + + // set global configs + FormMatrixGame.GBIndividualAB.Visible := StrToBool(AReply[AReply.Count-1]); + FormMatrixGame.GBIndividual.Visible:= not FormMatrixGame.GBIndividualAB.Visible; end else begin diff --git a/units/game_experiment.pas b/units/game_experiment.pas index abccb0b..42d4c80 100644 --- a/units/game_experiment.pas +++ b/units/game_experiment.pas @@ -68,6 +68,7 @@ type function GetConsequenceStringFromChoice(P:TPlayer): Utf8string; function GetConsequenceStringFromChoices:UTF8String; procedure CheckNeedForRandomTurns; + procedure EndExperiment; procedure SetCondition(I : Integer; AValue: TCondition); procedure SetContingency(ACondition, I : integer; AValue: TContingency); procedure SetMatrixType(AValue: TGameMatrixType); @@ -85,6 +86,7 @@ type procedure SetSendChatHistoryForNewPlayers(AValue: Boolean); procedure SetState(AValue: TExperimentState); private + FABPoints: Boolean; FChangeGeneration: string; FOnConsequence: TNotifyEvent; FOnInterlocking: TNotifyEvent; @@ -114,6 +116,7 @@ type procedure WriteReportRowPrompt; property ExperimentAim : string read FExperimentAim write FExperimentAim; property ExperimentName : string read FExperimentName write FExperimentName; + property ABPoints : Boolean read FABPoints write FABPoints; property GenPlayersAsNeeded : Boolean read FGenPlayersAsNeeded write FGenPlayersAsNeeded; property ResearcherCanPlay : Boolean read FResearcherCanPlay write SetResearcherCanPlay; property ResearcherCanChat : Boolean read FResearcherCanChat write SetResearcherCanChat; @@ -243,6 +246,11 @@ var begin if Assigned(FOnEndCondition) then FOnEndCondition(Self); Inc(FCurrentCondition); + if FCurrentCondition = ConditionsCount-1 then + begin + EndExperiment; + Exit; + end; FReportReader.Clean; FReportReader.SetXLastRows(Condition[CurrentCondition].EndCriterium.LastCycles); WriteReportRowNames; @@ -253,11 +261,11 @@ begin // interlockings in the last x cycles LInterlocks := InterlockingsInLastCycles; - case FConditions[CurrentCondition].EndCriterium.Value of + case FConditions[CurrentCondition].EndCriterium.Style of gecWhichComeFirst: begin if (GetCurrentAbsoluteCycle = FConditions[CurrentCondition].EndCriterium.AbsoluteCycles) or - (LInterlocks = FConditions[CurrentCondition].EndCriterium.InterlockingPorcentage) then + (LInterlocks >= FConditions[CurrentCondition].EndCriterium.InterlockingPorcentage) then EndCondition; end; @@ -266,7 +274,7 @@ begin EndCondition; gecInterlockingPorcentage: - if LInterlocks = FConditions[CurrentCondition].EndCriterium.InterlockingPorcentage then + if LInterlocks >= FConditions[CurrentCondition].EndCriterium.InterlockingPorcentage then EndCondition; end; @@ -424,6 +432,11 @@ begin end; end; +procedure TExperiment.EndExperiment; +begin + if Assigned(FOnEndExperiment) then FOnEndExperiment(Self); +end; + procedure TExperiment.SetCondition(I : Integer; AValue: TCondition); begin FConditions[I] := AValue; @@ -628,7 +641,6 @@ begin for i:=0 to Condition[c].Turn.Value-1 do LNames += 'R'+IntToStr(i+1)+#9; - LNames += '|'+#9; if FLastReportColNames <> LNames then begin FLastReportColNames := LNames; @@ -667,6 +679,7 @@ begin LRow += '0'+#9; FRegData.SaveData(LRow); + FReportReader.Append(LRow); end; end; @@ -689,6 +702,7 @@ begin LRow += 'NA'+#9; FRegData.SaveData(LRow); + FReportReader.Extend(LRow); end; end; diff --git a/units/game_file_methods.pas b/units/game_file_methods.pas index a35e08d..2844c6a 100644 --- a/units/game_file_methods.pas +++ b/units/game_file_methods.pas @@ -81,7 +81,7 @@ begin GenPlayersAsNeeded:=True; CurrentCondition := 0; MatrixType:=[gmRows]; - + ABPoints := True; //AppendPlayer(C_PLAYER_TEMPLATE); //AppendPlayer(C_PLAYER_TEMPLATE); @@ -95,6 +95,11 @@ begin Cycles.Count:=0; Cycles.Value:=4; Cycles.Generation:=0; + EndCriterium.AbsoluteCycles := 20; + EndCriterium.InterlockingPorcentage := 80; + EndCriterium.LastCycles := 10; + EndCriterium.Style := gecWhichComeFirst; + SetLength(Contingencies, 4); LConcequence := TConsequence.Create(AExperiment,1,[gscPoints, gscB, gscMessage,gscBroadcastMessage],['$NICNAME','queijo','queijos']); Contingencies[0] := TContingency.Create(AExperiment,LConcequence,LCriteria1,False); diff --git a/units/game_resources.pas b/units/game_resources.pas index d341c2a..118f9e8 100644 --- a/units/game_resources.pas +++ b/units/game_resources.pas @@ -240,7 +240,7 @@ const Prompt : nil; EndCriterium : ( - Value : gecWhichComeFirst; + Style : gecWhichComeFirst; InterlockingPorcentage : 50; LastCycles : 4; AbsoluteCycles: 6; diff --git a/units/game_zmq_actors.pas b/units/game_zmq_actors.pas index 0df0a2e..7a474b0 100644 --- a/units/game_zmq_actors.pas +++ b/units/game_zmq_actors.pas @@ -11,6 +11,8 @@ unit game_zmq_actors; {$mode objfpc}{$H+} +{$DEFINE DEBUG} + interface uses diff --git a/units/report_reader.pas b/units/report_reader.pas index a2e77ec..e387e1a 100644 --- a/units/report_reader.pas +++ b/units/report_reader.pas @@ -1,3 +1,12 @@ +{ + Stimulus Control + Copyright (C) 2014-2016 Carlos Rafael Fernandes Picanço, Universidade Federal do Pará. + + The present file is distributed under the terms of the GNU General Public License (GPL v3.0). + + You should have received a copy of the GNU General Public License + along with this program. If not, see . +} unit report_reader; {$mode objfpc}{$H+} @@ -26,9 +35,11 @@ type function GetColumnOf(AName: string): TStringList; procedure RangeAsLastXRows; public + VRow : string; //helper constructor Create; destructor Destroy; override; procedure Append(ARow : string); + procedure Extend(ARowExtention : string); procedure Clean; procedure SetXLastRows(X:integer); property Range : TRowRange read FRowRange; @@ -87,6 +98,11 @@ begin end; end; +procedure TReportReader.Extend(ARowExtention: string); +begin + FRows[FRows.Count-1] := FRows[FRows.Count-1] + ARowExtention; +end; + procedure TReportReader.Clean; begin FCols.Clear; diff --git a/units/string_methods.pas b/units/string_methods.pas index 87247c4..23c1c8b 100644 --- a/units/string_methods.pas +++ b/units/string_methods.pas @@ -67,9 +67,9 @@ uses strutils; function GetEndCriteriaFromString(S:string) : TEndConditionCriterium; begin case StrToIntDef(ExtractDelimited(1,S,[',']),2) of - 0: Result.Value := gecAbsoluteCycles; - 1: Result.Value := gecInterlockingPorcentage; - 2: Result.Value := gecWhichComeFirst; + 0: Result.Style := gecAbsoluteCycles; + 1: Result.Style := gecInterlockingPorcentage; + 2: Result.Style := gecWhichComeFirst; end; Result.AbsoluteCycles := StrToIntDef(ExtractDelimited(2,S,[',']), 20); Result.InterlockingPorcentage := StrToIntDef(ExtractDelimited(3,S,[',']),10); @@ -367,7 +367,7 @@ function GetEndCriteriaString(AEndCriterium: TEndConditionCriterium ): string; begin // 2,20,10,10, - case AEndCriterium.Value of + case AEndCriterium.Style of gecAbsoluteCycles: Result := '0'; gecInterlockingPorcentage: Result := '1'; gecWhichComeFirst: Result := '2'; -- libgit2 0.21.2