diff --git a/cultural_matrix.lpi b/cultural_matrix.lpi index b86008a..ef34a6d 100644 --- a/cultural_matrix.lpi +++ b/cultural_matrix.lpi @@ -55,7 +55,7 @@ - + @@ -117,6 +117,10 @@ + + + + diff --git a/cultural_matrix.lpr b/cultural_matrix.lpr index ec636ca..a9e4523 100644 --- a/cultural_matrix.lpr +++ b/cultural_matrix.lpr @@ -35,7 +35,9 @@ var I : integer; {$ENDIF} ID : TStringList; + ApplicationPath, F : string; + const PAdmin : array [0..3] of string = ('--admin','--adm','-admin','-adm'); PPlayer : array [0..3] of string = ('--player','--play','-player','-play'); @@ -43,50 +45,68 @@ const {$R *.res} + +{$IFDEF DEBUG} + function CreateDebugFoldersForPlayers:Boolean; + var + i : integer; + begin + Result := True; + for i := 0 to 2 do + begin + if Pos((PathDelim+'P'+IntToStr(i+1)+PathDelim), Application.ExeName) > 0 then + Break; + F := ApplicationPath+'P'+IntToStr(i+1); + WriteLn(F); + if ForceDirectoriesUTF8(F) then // ensure we have always the newer version for tests + begin + CopyFile(Application.ExeName,F+PathDelim+ApplicationName,[cffOverwriteFile]); + {$IFDEF LINUX} + FpChmod(F+PathDelim+ApplicationName,S_IRWXU); + {$ENDIF} + end + else Result := False; + end; + end; +{$ENDIF} + + function GetZMQNetworkID(var F:string):Boolean; + begin + Result := True; + ID := TStringList.Create; + if FileExists(F) then + try + ID.LoadFromFile(F); + F := Copy(ID.Text,0,Length(ID.Text)-2); + finally + ID.Free; + end + else + try + ID.Text := s_random(32); + ID.SaveToFile(F); + F := Copy(ID.Text,0,Length(ID.Text)-2); + except + on E: Exception do + begin + ID.Free; + {$IFDEF DEBUG} + ShowMessage(E.Message); + {$ENDIF} + Result := False; + end; + end; + end; + begin + ApplicationPath := ExtractFilePath(Application.ExeName); {$IFDEF DEBUG} - for i:= 0 to 2 do - begin - if Pos((PathDelim+'P'+IntToStr(i+1)+PathDelim), Application.ExeName) > 0 then - Break; - F := ExtractFilePath(Application.ExeName)+'P'+IntToStr(i+1); - WriteLn(F); - if ForceDirectoriesUTF8(F) then // ensure we have always the newer version for tests - begin - CopyFile(Application.ExeName,F+PathDelim+ApplicationName,[cffOverwriteFile]); - {$IFDEF LINUX} - FpChmod(F+PathDelim+ApplicationName,S_IRWXU); - {$ENDIF} - end - else Exit; - end; + if not CreateDebugFoldersForPlayers then Exit; {$ENDIF} Application.Initialize; - F := ExtractFilePath(Application.ExeName)+PathDelim+'id'; - ID := TStringList.Create; - if FileExists(F) then - try - ID.LoadFromFile(F); - F := Copy(ID.Text,0,Length(ID.Text)-2); - finally - ID.Free; - end - else - try - ID.Text := s_random(32); - ID.SaveToFile(F); - F := Copy(ID.Text,0,Length(ID.Text)-2); - except - on E: Exception do - begin - ID.Free; - {$IFDEF DEBUG} - ShowMessage(E.Message); - {$ENDIF} - Exit; - end; - end; - Application.CreateForm(TFormMatrixGame, FormMatrixGame); + F := ApplicationPath+PathDelim+'id'; + if not GetZMQNetworkID(F) then Exit; + Application.CreateForm(TFormMatrixGame, FormMatrixGame); FormMatrixGame.SetID(F); if Paramcount > 0 then diff --git a/form_matrixgame.pas b/form_matrixgame.pas index e64f132..47c93b4 100644 --- a/form_matrixgame.pas +++ b/form_matrixgame.pas @@ -72,14 +72,14 @@ type procedure ButtonExpStartClick(Sender: TObject); procedure ChatMemoSendKeyPress(Sender: TObject; var Key: char); procedure FormActivate(Sender: TObject); - procedure PopupNotifierClose(Sender: TObject; var CloseAction: TCloseAction - ); + procedure PopupNotifierClose(Sender: TObject; var CloseAction: TCloseAction); procedure StringGridMatrixClick(Sender: TObject); procedure StringGridMatrixDrawCell(Sender: TObject; aCol, aRow: integer; aRect: TRect; aState: TGridDrawState); procedure TimerTimer(Sender: TObject); private FGameControl : TGameControl; + FAppPath, FID: string; public procedure SetID(S : string); @@ -106,7 +106,6 @@ procedure TFormMatrixGame.StringGridMatrixDrawCell(Sender: TObject; aCol, aRow: aRect: TRect; aState: TGridDrawState); var OldCanvas: TCanvas; - RowBase : integer; procedure SaveOldCanvas; begin @@ -157,8 +156,8 @@ var TStringGrid(Sender).Canvas.Rectangle(aRect); if Assigned(FGameControl) then if FGameControl.MustDrawDots then - if (Odd(aRow + RowBase) and not Odd(aCol)) or - (not Odd(aRow + RowBase) and Odd(aCol)) then + if (Odd(aRow + FGameControl.RowBase) and not Odd(aCol)) or + (not Odd(aRow + FGameControl.RowBase) and Odd(aCol)) then DrawDots; end; //function GetTextX(S : String): Longint; @@ -167,15 +166,14 @@ var //end; begin - if Assigned(FGameControl) then - RowBase:=FGameControl.RowBase; + if not Assigned(FGameControl) then Exit; SaveOldCanvas; try //if (aRow >= RowBase) and (aCol = 10) then // DrawLines(clWhite); - if (aCol <> 0) and (aRow > (RowBase-1)) then + if (aCol <> 0) and (aRow > (FGameControl.RowBase-1)) then begin - DrawLines(GetRowColor(aRow,RowBase)); + DrawLines(GetRowColor(aRow,FGameControl.RowBase)); if (gdSelected in aState) and (goRowSelect in TStringGrid(Sender).Options)then begin @@ -226,13 +224,13 @@ procedure TFormMatrixGame.SetGameActor(AValue: TGameActor); procedure SetZMQAdmin; begin - FGameControl := TGameControl.Create(TZMQAdmin.Create(Self,FID)); + FGameControl := TGameControl.Create(TZMQAdmin.Create(Self,FID),ExtractFilePath(Application.ExeName)); GBAdmin.Visible:= True; end; procedure SetZMQPlayer; begin - FGameControl := TGameControl.Create(TZMQPlayer.Create(Self,FID)); + FGameControl := TGameControl.Create(TZMQPlayer.Create(Self,FID),ExtractFilePath(Application.ExeName)); //StringGridMatrix.Enabled := True; end; @@ -257,24 +255,27 @@ end; procedure TFormMatrixGame.FormActivate(Sender: TObject); begin - FormChooseActor := TFormChooseActor.Create(Self); - FormChooseActor.Style := '.Arrived'; - try - if FormChooseActor.ShowModal = 1 then - begin - case FormChooseActor.GameActor of - gaAdmin:FormMatrixGame.SetGameActor(gaAdmin); - gaPlayer: FormMatrixGame.SetGameActor(gaPlayer); - gaWatcher: FormMatrixGame.SetGameActor(gaWatcher); - end; - StringGridMatrix.ClearSelections; - StringGridMatrix.FocusRectVisible := False; - FGameControl.SetMatrix; - end - else Close; - finally - FormChooseActor.Free; - end; + if not Assigned(FGameControl) then + begin + FormChooseActor := TFormChooseActor.Create(Self); + FormChooseActor.Style := '.Arrived'; + try + if FormChooseActor.ShowModal = 1 then + begin + case FormChooseActor.GameActor of + gaAdmin:FormMatrixGame.SetGameActor(gaAdmin); + gaPlayer: FormMatrixGame.SetGameActor(gaPlayer); + gaWatcher: FormMatrixGame.SetGameActor(gaWatcher); + end; + StringGridMatrix.ClearSelections; + StringGridMatrix.FocusRectVisible := False; + FGameControl.SetMatrix; + end + else Close; + finally + FormChooseActor.Free; + end; + end; end; procedure TFormMatrixGame.PopupNotifierClose(Sender: TObject; diff --git a/units/csv_writer.pas b/units/csv_writer.pas new file mode 100644 index 0000000..9c0403a --- /dev/null +++ b/units/csv_writer.pas @@ -0,0 +1,98 @@ +unit csv_writer; + +{$mode objfpc}{$H+} + +interface + +uses SysUtils, Classes, LazFileUtils; + +type + + { TCSVWriter } + + TCSVWriter = class(TComponent) + private + FFileName: string; + FFile: TextFile; + FSessionNumber: integer; + procedure Close; + procedure UpdateFileName(ANewFileName : string); + function OpenNoOverride(AFilename : string):string; + public + constructor Create(AOwner: TComponent; AFileName: String); reintroduce; + destructor Destroy; override; + procedure Write(AData: array of const); + end; + + + + +implementation + +{ TCSVWriter } + +procedure TCSVWriter.Close; +begin + if FFilename <> '' then + if TextRec(FFile).Mode = 55218 then // file is opened read/write + begin + CloseFile(FFile); + end +end; + +procedure TCSVWriter.UpdateFileName(ANewFileName: string); +begin + if (ANewFileName = '') or (ANewFileName = FFilename) then Exit; + Close; + FFileName := OpenNoOverride(ANewFileName); +end; + +function TCSVWriter.OpenNoOverride(AFilename: string): string; +var + i : Integer; + FilePath, LExtension: string; +begin + if AFileName <> '' then + begin + ForceDirectoriesUTF8(ExtractFilePath(AFilename)); + FilePath := ExtractFilePath(AFilename); + LExtension := ExtractFileExt(AFilename); + i := 0; + + // ensure to never override an existing file + while FileExistsUTF8(AFilename) do begin + Inc(i); + AFilename := FilePath + StringOfChar(#48, 3 - Length(IntToStr(i))) + IntToStr(i) + LExtension; + end; + + FSessionNumber := i; + + // as override is impossible, don't mind about an Assign/Rewrite conditional + AssignFile(FFile, AFilename); + Rewrite(FFile); + {$ifdef DEBUG} + WriteLn(FFile, mt_Debug + 'Saving data to:' + AFilename ); + {$endif} + Result := AFilename; + end; +end; + +constructor TCSVWriter.Create(AOwner: TComponent; AFileName: String); +begin + inherited Create(AOwner); + FFilename := OpenNoOverride(AFilename); +end; + +destructor TCSVWriter.Destroy; +begin + Close; + inherited Destroy; +end; + +procedure TCSVWriter.Write(AData: array of const); +begin + +end; + +end. + diff --git a/units/game_actors.pas b/units/game_actors.pas index dbfeea0..329b70e 100644 --- a/units/game_actors.pas +++ b/units/game_actors.pas @@ -106,6 +106,7 @@ type destructor Destroy;override; function AsString(AID :string): string; function GenerateMessage(ForGroup: Boolean):string; + procedure Clean; virtual; procedure PresentMessage; procedure PresentPoints; property ShouldPublishMessage : Boolean read GetShouldPublishMessage; @@ -123,6 +124,7 @@ type FMeta : Boolean; //True: Consequence occurs OnEndTurn, False: Consequence occurs OnEndCycle FConsequence : TConsequence; FCriteria : TCriteria; + FName: string; FOnCriteria: TNotifyEvent; function RowMod(R:TGameRow):TGameRow; procedure CriteriaEvent; @@ -131,11 +133,14 @@ type function CriteriaString : string; function ResponseMeetsCriteriaI(R : TGameRow; C : TGameColor):Boolean; // Does response meets operant criteria? function ResponseMeetsCriteriaG(Players : TPlayers):Boolean; + function ConsequenceFromPlayerID(AID:string):string; + procedure Clean; property OnCriteria : TNotifyEvent read FOnCriteria write FOncriteria; property Fired : Boolean read FFired; property Consequence : TConsequence read FConsequence; property Criteria : TCriteria read FCriteria; property Meta : Boolean read FMeta; + property ContingencyName : string read FName write FName; end; { TContingencies } @@ -155,8 +160,9 @@ type public constructor Create(AOwner:TComponent; APStyle:TPromptStyle; APTarget : TContingencies; AMessage:string);reintroduce; function ResponsesCount : integer; - procedure AppendResponse(AID,R:string); function AsString: TStringList; overload; + procedure AppendResponse(AID,R:string); + procedure Clean;override; property Question: string read FPromptMessage; property PromptResult:string read FResult; @@ -398,6 +404,17 @@ begin // All -> (Diff,Equal,Even, Odd) or not all CriteriaEvent; end; +function TContingency.ConsequenceFromPlayerID(AID: string): string; +begin + Result := Consequence.ConsequenseByPlayerID.Values[AID]; +end; + +procedure TContingency.Clean; +begin + FFired := False; + Consequence.Clean; +end; + { TPrompt } @@ -426,6 +443,12 @@ begin FResponses[High(FResponses)] := AID+'|'+R+'|'; end; +procedure TPrompt.Clean; +begin + //inherited Clean; + FResponses := nil; +end; + function TPrompt.AsString: TStringList; var j,i : integer; @@ -454,8 +477,8 @@ var if (gscB in LCsqStyle) and (gsBasA in FPromptStyle) then begin - LCsqStyle += [gscB]; - LCsqStyle -= [gscA]; + LCsqStyle += [gscA]; + LCsqStyle -= [gscB]; end; if IsMeta then @@ -471,17 +494,22 @@ var ExtractDelimited(5,LConsequence, ['|']); end; begin + Result := TStringList.Create; // to do, sanitize FPromptStyle first Pts:= 0; if (gsAll in FPromptStyle) and (gsYes in FPromptStyle) then if AllPlayersClickedYes then for i := 0 to Length(FPromptTargets)-1 do - for j := 0 to FPromptTargets[i].Consequence.ConsequenseByPlayerID.Count do + for j := 0 to FPromptTargets[i].Consequence.ConsequenseByPlayerID.Count-1 do begin LID := FPromptTargets[i].Consequence.ConsequenseByPlayerID.Names[j]; LConsequence := FPromptTargets[i].Consequence.ConsequenseByPlayerID.Values[LID]; LCsqStyle := GetConsequenceStylesFromString(ExtractDelimited(2,LConsequence, ['|'])); + // TODO: should BasA revert appendices? right now reverting points only + //LAppendiceSingular:= + //LAppendicePlural:= + if gsContingency in FPromptStyle then if (FPromptTargets[i].Fired) and (not FPromptTargets[i].Meta) then if (gscA in LCsqStyle) or (gscB in LCsqStyle) then @@ -493,7 +521,7 @@ begin if gscG in LCsqStyle then ApplyPointsConditions(True); - Result := TStringList.Create; + Result.Add(LConsequence); end; @@ -541,7 +569,7 @@ begin FMessage := TPopupNotifier.Create(Self); FTimer := TTimer.Create(Self); FTimer.Enabled:=False; - FTimer.Interval:=6000; + FTimer.Interval:=10000; FTimer.OnTimer:=@SelfDestroy; FConsequenceByPlayerID := TStringList.Create; end; @@ -568,27 +596,25 @@ begin FMessage.Text := Result; end; +procedure TConsequence.Clean; +begin + FConsequenceByPlayerID.Clear; +end; + procedure TConsequence.PresentMessage; var PopUpPos : TPoint; begin + PopUpPos.X := FormMatrixGame.GBIndividualAB.Left; if gscA in FStyle then - begin - PopUpPos.X := FormMatrixGame.GBIndividualAB.Left-110; - PopUpPos.Y := FormMatrixGame.GBIndividualAB.Top+FormMatrixGame.GBIndividual.Height-10; - end; + PopUpPos.Y := FormMatrixGame.GBIndividualAB.Top+FormMatrixGame.GBIndividualAB.Height-20; if gscB in FStyle then - begin - PopUpPos.X := FormMatrixGame.GBIndividualAB.Left+110; - PopUpPos.Y := FormMatrixGame.GBIndividualAB.Top+FormMatrixGame.GBIndividual.Height-10; - end; + PopUpPos.Y := FormMatrixGame.GBIndividualAB.Top+FormMatrixGame.GBIndividualAB.Height+150; if gscG in FStyle then - begin - PopUpPos.X := FormMatrixGame.GBIndividualAB.Left-110; - PopUpPos.Y := FormMatrixGame.GBIndividualAB.Top+FormMatrixGame.GBIndividual.Height+100; - end; + PopUpPos.Y := FormMatrixGame.GBIndividualAB.Top+FormMatrixGame.GBIndividualAB.Height+300; + PopUpPos := FormMatrixGame.ClientToScreen(PopUpPos); FMessage.Color:=clTeal; FMessage.Title:=''; diff --git a/units/game_actors_point.pas b/units/game_actors_point.pas index d516f24..aa2be19 100644 --- a/units/game_actors_point.pas +++ b/units/game_actors_point.pas @@ -73,7 +73,7 @@ end; function TGamePoint.GetResultAsString: string; begin - Result := IntToStr(FResult); + Result := IntToStr(abs(FResult)); end; constructor TGamePoint.Create(AOwner: TComponent; AValue: integer); @@ -111,7 +111,7 @@ begin case FResult of -MaxInt..-2: Result += ' produziram a perda de '+Self.AsString+ ' pontos para o grupo'; -1 : Result += ' produziram a perda de 1 ponto para o grupo'; - 0 : Result += ' pontos do grupo não foram produzidos nem perdidos'; + 0 : Result += ' não produziram nem perderam pontos para o grupo'; 1 : Result += ' produziram 1 ponto para o grupo'; 2..MaxInt: Result += ' produziram '+Self.AsString+' pontos para o grupo' end; @@ -119,11 +119,11 @@ begin else begin case FResult of - -MaxInt..-2: Result += ' produziram a perda de '+Self.AsString+ ' ' + AAppendicePlural; - -1 : Result += ' produziram a perda de 1'+ ' ' + AAppendiceSingular; - 0 : Result += ' não produziram ' + AAppendicePlural; + -MaxInt..-2: Result += ' produziram a perda de ' + Self.AsString + ' ' + AAppendicePlural; + -1 : Result += ' produziram a perda de 1 ' + AAppendiceSingular; + 0 : Result += ' não produziram nem perderam ' + AAppendicePlural; 1 : Result += ' produziram 1 ' + AAppendiceSingular; - 2..MaxInt: Result += ' produziram '+Self.AsString+ ' ' + AAppendicePlural; + 2..MaxInt: Result += ' produziram ' + Self.AsString + ' ' + AAppendicePlural; end; end; end @@ -148,7 +148,7 @@ begin begin case FResult of -MaxInt..-2: Result += ' perdeu '+Self.AsString+ ' ' + AAppendicePlural; - -1 : Result += ' ponto 1 ' + AAppendiceSingular; + -1 : Result += ' perdeu 1 ' + AAppendiceSingular; 0 : Result += ' não perdeu nem ganhou ' + AAppendicePlural; 1 : Result += ' ganhou 1 ' + AAppendiceSingular; 2..MaxInt: Result += ' ganhou '+Self.AsString+ ' ' + AAppendicePlural; diff --git a/units/game_control.pas b/units/game_control.pas index 349abf3..a9d9d06 100644 --- a/units/game_control.pas +++ b/units/game_control.pas @@ -54,10 +54,12 @@ type private function AskQuestion(AQuestion:string):UTF8string; procedure ShowPopUp(AText:string); + procedure ShowConsequenceMessage(AID,S:string;ForGroup:Boolean); procedure DisableConfirmationButton; procedure CleanMatrix(AEnabled : Boolean); procedure EnablePlayerMatrix(AID:UTF8string; ATurn:integer; AEnabled:Boolean); private + function ShouldStartExperiment: Boolean; function ShouldEndCycle : Boolean; function ShouldAskQuestion : Boolean; @@ -71,7 +73,7 @@ type procedure EndExperiment(Sender: TObject); procedure StartExperiment; public - constructor Create(AOwner : TComponent);override; + constructor Create(AOwner : TComponent;AppPath:string);overload; destructor Destroy; override; procedure SetMatrix; procedure SendRequest(ARequest : UTF8string); @@ -145,15 +147,14 @@ begin Result := FExperiment.PlayersCount = FExperiment.Condition[FExperiment.CurrentCondition].Turn.Value; end; -function TGameControl.ShouldEndCycle: Boolean; +function TGameControl.ShouldEndCycle: Boolean; //CAUTION: MUST BE CALLED BEFORE EXPERIMENT.NEXTCYCLE begin Result := FExperiment.Condition[FExperiment.CurrentCondition].Turn.Count = FExperiment.Condition[FExperiment.CurrentCondition].Turn.Value-1; end; -function TGameControl.ShouldAskQuestion: Boolean; // end cycle, restart alias +function TGameControl.ShouldAskQuestion: Boolean; begin - // TODO: prompt only when an odd row was selected - Result := ShouldEndCycle and FExperiment.Condition[FExperiment.CurrentCondition].Contingencies[3].Fired; + Result := Assigned(FExperiment.Condition[FExperiment.CurrentCondition].Prompt) and FExperiment.Condition[FExperiment.CurrentCondition].Contingencies[3].Fired; end; procedure TGameControl.KickPlayer(AID: string); @@ -169,24 +170,11 @@ begin end; procedure TGameControl.NextCycle(Sender: TObject); -var - i, - LCount : integer; - LConsequences : string; begin - // prompt question to all players FormMatrixGame.LabelExpCountCycle.Caption:=IntToStr(FExperiment.Condition[FExperiment.CurrentCondition].Cycles.Count+1); {$IFDEF DEBUG} WriteLn('cycle:>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>'); {$ENDIF} - - - //P := FExperiment.PlayerFromID[Self.ID]; - LConsequences := FExperiment.ConsequenceStringFromChoices; - LCount := WordCount(LConsequences,['+']); - if LCount > 0 then - for i := 1 to LCount do - FZMQActor.SendMessage([K_CYCLES,ExtractDelimited(i,LConsequences,['+'])]); // as string generates the pts result end; procedure TGameControl.NextLineage(Sender: TObject); @@ -229,7 +217,7 @@ end; procedure TGameControl.StartExperiment; begin // all players arrived, lets begin - FExperiment.State:=xsRunning; + FExperiment.Play; // wait some time, we just sent a message earlier Sleep(5); @@ -445,6 +433,21 @@ begin FormMatrixGame.Timer.Enabled:=True; end; +procedure TGameControl.ShowConsequenceMessage(AID, S: string; ForGroup: Boolean); +var + LConsequence : TConsequence; +begin + LConsequence := TConsequence.Create(nil,S); + LConsequence.GenerateMessage(ForGroup); + LConsequence.PresentMessage; + if ForGroup then + LConsequence.PresentPoints + else + if Self.ID = AID then + LConsequence.PresentPoints; + +end; + procedure TGameControl.DisableConfirmationButton; begin FormMatrixGame.StringGridMatrix.Enabled:= False; @@ -467,7 +470,7 @@ begin CleanMatrix(AEnabled); end; -constructor TGameControl.Create(AOwner: TComponent); +constructor TGameControl.Create(AOwner: TComponent;AppPath:string); begin FZMQActor := TZMQActor(AOwner); inherited Create(FZMQActor.Owner); @@ -487,8 +490,11 @@ begin RowBase:= 0; MustDrawDots:=False; MustDrawDotsClear:=False; - - FExperiment := TExperiment.Create(FZMQActor.Owner); + case FActor of + gaAdmin:FExperiment := TExperiment.Create(FZMQActor.Owner,AppPath); + gaPlayer:FExperiment := TExperiment.Create(FZMQActor.Owner); + gaWatcher:FExperiment := TExperiment.Create(FZMQActor.Owner); + end; FExperiment.State:=xsWaiting; FExperiment.OnEndTurn := @NextTurn; FExperiment.OnEndCycle := @NextCycle; @@ -633,8 +639,21 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList); end; end; + procedure ShowQuestion; + begin + case FActor of + gaPlayer:FZMQActor.Request([ + FZMQActor.ID + , ' ' + , GA_PLAYER+K_QUESTION + , AskQuestion(AMessage[1]) + ]); + end; + end; + procedure ReceiveChoice; - var P : TPlayer; + var + P : TPlayer; begin P := FExperiment.PlayerFromID[AMessage[1]]; @@ -648,6 +667,8 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList); case FActor of gaPlayer:begin + + // last turn// end cycle if P.Turn = FExperiment.PlayersCount-1 then begin // update next turn @@ -657,16 +678,20 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList); FExperiment.Player[Self.ID] := P; end; - //CleanMatrix; CleanMatrix(False); + // no wait turns - EnablePlayerMatrix(Self.ID,0, True); + // if should continue then + //if StrToBool(AMessage[6]) then + //EnablePlayerMatrix(Self.ID,0, True) + // wait for server Exit; end; + // else if Self.ID = P.ID then begin // update confirmation button @@ -697,20 +722,21 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList); end; end; - procedure OnEndCycle; - var - LConsequence : TConsequence; - begin - case FActor of - gaPlayer: - begin - LConsequence := TConsequence.Create(nil,AMessage[1]); - LConsequence.GenerateMessage(True); - LConsequence.PresentPoints; - LConsequence.PresentMessage; - end; - end; - end; + //procedure OnEndCycle; + //var + // LConsequence : TConsequence; + //begin + // case FActor of + // gaPlayer: + // begin + // LConsequence := TConsequence.Create(nil,AMessage[1]); + // LConsequence.GenerateMessage(True); + // + // LConsequence.PresentPoints; + // LConsequence.PresentMessage; + // end; + // end; + //end; procedure ReceiveChat; begin @@ -736,80 +762,55 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList); end; end; - procedure ShowQuestion; + procedure QuestionMessages; + var + i : integer; + MID : string; begin case FActor of - gaPlayer:FZMQActor.Request([ - FZMQActor.ID - , ' ' - , GA_PLAYER+K_QUESTION - , AskQuestion(AMessage[1]) - ]); + gaPlayer:begin + if AMessage.Count > 1 then + begin + for i := 1 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; + EnablePlayerMatrix(Self.ID,0, True); + WriteLn('>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>'); + end; end; end; -// -// procedure ResumeActor; -// begin -// case FActor of -// gaPlayer:begin -// -// end; -// gaAdmin:begin -// -// end; -// end; -// end; - - - //procedure QuestionMessages; - //var - // LConsequence : TConsequence; - // i : integer; - // MID : string; - //begin - // case FActor of - // // AMessage[i] := - // // S + '+' + - // // IntToStr(Pts) +'|'+ - // // GetConsequenceStylesString(LCsqStyle) +'|'+ - // // ExtractDelimited(3,LConsequence, ['|']) +'|'+ - // // ExtractDelimited(4,LConsequence, ['|']) +'|'+ - // // ExtractDelimited(5,LConsequence, ['|']); - // gaPlayer:begin - // if AMessage.Count > 1 then - // begin - // for i := 1 to AMessage.Count -1 do - // begin - // MID := ExtractDelimited(1,AMessage[i],['+']); - // if (MID = 'M') or (MID = Self.ID) then - // begin - // LConsequence := TConsequence.Create(FormMatrixGame,ExtractDelimited(2,AMessage[i],['+'])); - // //LConsequence.PlayerNicname := P.Nicname; - // ShowPopUp(LConsequence.PointMessage(MID = 'M')); - // while FormMatrixGame.PopupNotifier.Visible do - // Application.ProcessMessages; + + + // procedure ResumeActor; + // begin + // case FActor of + // gaPlayer:begin // - // {$IFDEF DEBUG} - // WriteLn('A consequence should have shown.'); - // {$ENDIF} - // end; - // end; - // end; + // end; + // gaAdmin:begin + // + // end; // end; // end; - //end; - begin if MHas(K_ARRIVED) then ReceiveActor; if MHas(K_CHAT_M) then ReceiveChat; if MHas(K_CHOICE) then ReceiveChoice; - if MHas(K_MESSAGE) then ShowPopUp(AMessage[1]); + if MHas(K_MESSAGE) then ShowConsequenceMessage(AMessage[1],AMessage[2],StrToBool(AMessage[3])); if MHas(K_KICK) then SayGoodBye; if MHas(K_START) then NotifyPlayers; - if MHas(K_CYCLES) then OnEndCycle; - //if MHas(K_QUESTION) then ShowQuestion; - //if MHas(K_QMESSAGE) then QuestionMessages; + if MHas(K_QUESTION) then ShowQuestion; + if MHAS(K_RESUME) then EnablePlayerMatrix(Self.ID,0, True); + //if MHas(K_CYCLES) then OnEndCycle; + if MHas(K_QMESSAGE) then QuestionMessages; end; // Here FActor is garanted to be a TZMQAdmin @@ -900,11 +901,14 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList); end; procedure ValidateChoice; - var P : TPlayer; - S : string; + var + LConsequences : string; + P : TPlayer; + S : string; + LEndCycle : Boolean; begin {$IFDEF DEBUG} - WriteLn('Count:>>>>>>>>>>>>>>>>>>>>>>>>>>>',FExperiment.Condition[FExperiment.CurrentCondition].Turn.Count, '<', FExperiment.Condition[FExperiment.CurrentCondition].Turn.Value); + WriteLn('Count:',FExperiment.Condition[FExperiment.CurrentCondition].Turn.Count, '<', FExperiment.Condition[FExperiment.CurrentCondition].Turn.Value); {$ENDIF} P := FExperiment.PlayerFromID[ARequest[0]]; P.Choice.Row:= GetRowFromString(ARequest[3]); // row @@ -919,65 +923,70 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList); if Pos('$NICNAME',S) > 0 then S := ReplaceStr(S,'$NICNAME',P.Nicname); - ARequest.Append(S); // update turn + LEndCycle:=ShouldEndCycle; P.Turn := FExperiment.NextTurn; FExperiment.Player[P.ID] := P; - // broadcast choice - FZMQActor.SendMessage([K_CHOICE,P.ID,ARequest[3],ARequest[4],IntToStr(P.Turn)]); - - if ShouldEndCycle then + // append results + ARequest.Append(IntToStr(P.Turn)); + ARequest.Append(S); + if LEndCycle then begin - while FormMatrixGame.PopupNotifier.Visible do - Application.ProcessMessages; - - //if ShouldAskQuestion then // TODO: prompt only when an odd row was selected - // begin - // P.Turn := 0; - // FZMQActor.SendMessage([K_QUESTION,FExperiment.Condition[FExperiment.CurrentCondition].Prompt.Question]); - // end; + LConsequences := FExperiment.ConsequenceStringFromChoices;// AsString generates the pts result + ARequest.Append(LConsequences); + + if ShouldAskQuestion then // TODO: prompt only when an odd row was selected + ARequest.Append(FExperiment.Condition[FExperiment.CurrentCondition].Prompt.Question) + else + FExperiment.Clean; end; end; - //procedure ValidateQuestionResponse; - //var - // P : TPlayer; - // M : array of UTF8string; - // i : integer; - // LPromptConsequences : TStringList; - //begin - // P := FExperiment.PlayerFromID[ARequest[0]]; - // ARequest[2] := K_QUESTION+K_ARRIVED; - // - // // append response of each player - // FExperiment.Condition[FExperiment.CurrentCondition].Prompt.AppendResponse(P.ID,ARequest[3]); - // - // // return to experiment and present the prompt consequence, if any - // if FExperiment.Condition[FExperiment.CurrentCondition].Prompt.ResponsesCount = Experiment.PlayersCount then - // begin - // // M setup - // - // - // // generate messages - // LPromptConsequences := FExperiment.Condition[FExperiment.CurrentCondition].Prompt.AsString; - // if LPromptConsequences.Count > 0 then - // begin - // SetLength(M, 1+LPromptConsequences.Count); - // M[0] := GA_ADMIN+K_QUESTION+K_QMESSAGE; - // for i := 0 to LPromptConsequences.Count -1 do - // M[i+1] := LPromptConsequences[i] - // end; - // - // // send identified messages; each player takes only its own message and ignore the rest - // FZMQActor.SendMessage(M); - // end; - //end; + procedure ValidateQuestionResponse; + var + P : TPlayer; + M : array of UTF8string; + i : integer; + LPromptConsequences : TStringList; + begin + P := FExperiment.PlayerFromID[ARequest[0]]; + ARequest[2] := K_QUESTION+K_ARRIVED; + + // append response of each player + FExperiment.Condition[FExperiment.CurrentCondition].Prompt.AppendResponse(P.ID,ARequest[3]); + + // return to experiment and present the prompt consequence, if any + if FExperiment.Condition[FExperiment.CurrentCondition].Prompt.ResponsesCount = FExperiment.PlayersCount then + begin + + // generate messages + LPromptConsequences := FExperiment.Condition[FExperiment.CurrentCondition].Prompt.AsString; + SetLength(M, 1+LPromptConsequences.Count); + M[0] := K_QMESSAGE; + if LPromptConsequences.Count > 0 then + begin + for i := 0 to LPromptConsequences.Count-1 do + if Pos('$NICNAME',LPromptConsequences[i]) > 0 then + begin + P := FExperiment.PlayerFromID[ExtractDelimited(1,LPromptConsequences[i],['+'])]; + LPromptConsequences[i] := ReplaceStr(LPromptConsequences[i],'$NICNAME', P.Nicname); + end; + for i := 0 to LPromptConsequences.Count -1 do + M[i+1] := LPromptConsequences[i]; + end + else; + + // send identified messages; each player takes only its own message and ignore the rest + FZMQActor.SendMessage(M); + FExperiment.Clean; + end; + end; begin if MHas(K_LOGIN) then ReplyLoginRequest; if MHas(K_CHOICE) then ValidateChoice; - //if MHas(K_QUESTION) then ValidateQuestionResponse; + if MHas(K_QUESTION) then ValidateQuestionResponse; end; // Here FActor is garanted to be a TZMQPlayer, reply by: @@ -1020,31 +1029,56 @@ procedure TGameControl.ReceiveReply(AReply: TStringList); LConsequence : TConsequence; LCount, i : integer; - M : string; //P : TPlayer; begin if Self.ID = AReply[0] then begin //P := FExperiment.PlayerFromID[Self.ID]; - LCount := WordCount(AReply[5],['+']); {$IFDEF DEBUG} WriteLn('LCount:',LCount); {$ENDIF} + FZMQActor.SendMessage([K_CHOICE,AReply[0],AReply[3],AReply[4],AReply[5]]); + + LCount := WordCount(AReply[6],['+']); if LCount > 0 then for i := 1 to LCount do begin - LConsequence := TConsequence.Create(nil,ExtractDelimited(i,AReply[5],['+'])); - M := LConsequence.GenerateMessage(False); + LConsequence := TConsequence.Create(nil,ExtractDelimited(i,AReply[6],['+'])); + LConsequence.GenerateMessage(False); if LConsequence.ShouldPublishMessage then - FZMQActor.SendMessage([K_MESSAGE,M]) + FZMQActor.SendMessage([K_MESSAGE,Self.ID,ExtractDelimited(i,AReply[6],['+']),BoolToStr(False)]) else - LConsequence.PresentMessage; - LConsequence.PresentPoints; + begin + LConsequence.PresentMessage; + LConsequence.PresentPoints; + end; {$IFDEF DEBUG} WriteLn('A consequence should have shown.'); {$ENDIF} + //Sleep(1000); end; + if AReply.Count > 7 then + begin + LCount := WordCount(AReply[7],['+']); + if LCount > 0 then + for i := 1 to LCount do + begin + LConsequence := TConsequence.Create(nil,ExtractDelimited(i,AReply[7],['+'])); + LConsequence.GenerateMessage(True); + FZMQActor.SendMessage([K_MESSAGE,'',ExtractDelimited(i,AReply[7],['+']),BoolToStr(True)]); + + {$IFDEF DEBUG} + WriteLn('A metaconsequence should have shown.'); + {$ENDIF} + //Sleep(1000); + end; + + if AReply.Count > 8 then + FZMQActor.SendMessage([K_QUESTION,AReply[8]]) + else + FZMQActor.SendMessage([K_RESUME]); + end; end; end; @@ -1053,13 +1087,13 @@ procedure TGameControl.ReceiveReply(AReply: TStringList); // // wait //end; - procedure ResumePlayer; - begin - - end; + //procedure ResumePlayer; + //begin + // + //end; begin - if MHas(K_RESUME+K_ARRIVED) then ResumePlayer; + //if MHas(K_RESUME+K_ARRIVED) then ResumePlayer; if MHas(K_LOGIN+K_ARRIVED) then LoginAccepted; if MHas(K_CHOICE+K_ARRIVED) then ChoiceValidated; //if MHas(K_QUESTION+K_ARRIVED) then QuestionValidated; diff --git a/units/game_experiment.pas b/units/game_experiment.pas index 1679c73..9206079 100644 --- a/units/game_experiment.pas +++ b/units/game_experiment.pas @@ -30,28 +30,23 @@ type TExperiment = class(TComponent) private - FExperimentStart : Boolean; FExperimentAim, FExperimentName, FFilename, - FResearcher : UTF8string; - FOnConsequence: TNotifyEvent; - FOnInterlocking: TNotifyEvent; - FOnEndTurn: TNotifyEvent; - FOnEndCondition: TNotifyEvent; - FOnEndCycle: TNotifyEvent; - FOnEndExperiment: TNotifyEvent; - FOnEndGeneration: TNotifyEvent; - FMatrixType: TGameMatrixType; - FRegData : TRegData; + FResearcher : string; + FExperimentStart : Boolean; FGenPlayersAsNeeded : Boolean; - FPlayers : TPlayers; - FCurrentCondition : integer; - FConditions : TConditions; 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; @@ -90,36 +85,50 @@ type procedure SetSendChatHistoryForNewPlayers(AValue: Boolean); procedure SetState(AValue: TExperimentState); private + FOnConsequence: TNotifyEvent; + FOnInterlocking: TNotifyEvent; + FOnEndTurn: TNotifyEvent; + FOnEndCondition: TNotifyEvent; + FOnEndCycle: TNotifyEvent; + FOnEndExperiment: TNotifyEvent; + FOnEndGeneration: TNotifyEvent; procedure Consequence(Sender : TObject); procedure Interlocking(Sender : TObject); + procedure WriteReportHeader; + procedure WriteReportRowNames; + procedure WriteReportRow; public constructor Create(AOwner:TComponent);override; - constructor Create(AFilename: string; AOwner:TComponent); overload; + 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; - 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; procedure SaveToFile(AFilename: string); overload; procedure SaveToFile; overload; procedure Clean; procedure Play; + 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 : UTF8string read FResearcher write FResearcher; + 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 ExperimentAim : UTF8string read FExperimentAim write FExperimentAim; - property ExperimentName : UTF8string read FExperimentName write FExperimentName; - property GenPlayersAsNeeded : Boolean read FGenPlayersAsNeeded write FGenPlayersAsNeeded; - property InterlockingsIn[i:integer]:integer read GetInterlockingsIn; property Player[I : integer] : TPlayer read GetPlayer write SetPlayer; property PlayerFromID[S : UTF8string ] : TPlayer read GetPlayer write SetPlayer; property PlayersCount : integer read GetPlayersCount; @@ -127,11 +136,10 @@ type 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 ShowChat : Boolean read FShowChat write FShowChat; - property SendChatHistoryForNewPlayers : Boolean read FSendChatHistoryForNewPlayers write SetSendChatHistoryForNewPlayers; - property MatrixType : TGameMatrixType read FMatrixType write SetMatrixType; property NextTurnPlayerID : UTF8string read GetNextTurnPlayerID; property NextTurn : integer read GetNextTurn; property NextCycle : integer read GetNextCycle; @@ -143,7 +151,6 @@ type property OnEndGeneration : TNotifyEvent read FOnEndGeneration write SetOnEndGeneration; property OnEndCondition : TNotifyEvent read FOnEndCondition write SetOnEndCondition; property OnEndExperiment : TNotifyEvent read FOnEndExperiment write SetOnEndExperiment; - public property OnConsequence : TNotifyEvent read FOnConsequence write SetOnConsequence; property OnInterlocking : TNotifyEvent read FOnInterlocking write SetOnInterlocking; end; @@ -489,6 +496,96 @@ begin if Assigned(FOnInterlocking) then FOnInterlocking(Sender); end; +procedure TExperiment.WriteReportHeader; +var + LHeader : string; +begin + // header + LHeader := VAL_RESEARCHER+':'+#9+FResearcher + LineEnding + + VAL_EXPERIMENT+':' + #9 + FExperimentName + LineEnding + + VAL_BEGIN_TIME+':' + #9 + DateTimeToStr(Date) + #9 + TimeToStr(Time) + LineEnding + LineEnding; + FRegData.SaveData(LHeader); + WriteReportRowNames; +end; + +procedure TExperiment.WriteReportRowNames; +var + c,j,i: integer; + LHeader : string; +begin + c:= CurrentCondition; + // column names, line 1 + LHeader := 'Experimento'+#9+#9; + for i:=0 to Condition[c].Turn.Value-1 do // player's response + LHeader += 'P'+IntToStr(i+1)+#9+#9; + + for i:=0 to ContingenciesCount[c]-1 do + if not Contingency[c,i].Meta then + begin + LHeader += Contingency[c,i].ContingencyName; + for j:=0 to Condition[c].Turn.Value-1 do + LHeader += #9; + end; + + LHeader += VAL_INTERLOCKING+'s'; + for i:=0 to ContingenciesCount[c]-1 do + if Contingency[c,i].Meta then + LHeader += #9; + + LHeader += LineEnding; + + + // column names, line 2 + LHeader += 'Condição'+#9+'Ciclo'+#9; + for i:=0 to Condition[c].Turn.Value-1 do + LHeader += 'Linha'+#9+'Cor'+#9; + + for i:=0 to ContingenciesCount[c]-1 do + if not Contingency[c,i].Meta then + for j:=0 to Condition[c].Turn.Value-1 do + LHeader += 'P'+IntToStr(j+1)+#9; + + for i:=0 to ContingenciesCount[c]-1 do + if Contingency[c,i].Meta then + LHeader += Contingency[c,i].ContingencyName+#9; + LHeader += LineEnding; + + FLastReportColNames := LHeader; + FRegData.SaveData(LHeader); +end; + +procedure TExperiment.WriteReportRow; +var + c,j,i: integer; + LHeader : string; +begin + c:= CurrentCondition; + + LHeader := IntToStr(c+1)+#9+IntToStr(Condition[c].Cycles.Count+1)+#9; + for i:=0 to Condition[c].Turn.Value-1 do + LHeader += GetRowString(FPlayers[i].Choice.Row)+#9+GetColorString(FPlayers[i].Choice.Color)+#9; + + for i:=0 to ContingenciesCount[c]-1 do + if not Contingency[c,i].Meta then + for j:=0 to Condition[c].Turn.Value-1 do + if Contingency[c,i].ConsequenceFromPlayerID(FPlayers[j].ID) <> '' then + LHeader += '1'+#9 + else + LHeader += '0'+#9; + + for i:=0 to ContingenciesCount[c]-1 do + if Contingency[c,i].Meta then + if Contingency[c,i].Fired then + LHeader += '1'+#9 + else + LHeader += '0'+#9; + LHeader += LineEnding; + + FLastReportColNames := LHeader; + FRegData.SaveData(LHeader); + +end; + constructor TExperiment.Create(AOwner: TComponent); begin inherited Create(AOwner); @@ -497,7 +594,17 @@ begin CheckNeedForRandomTurns; end; -constructor TExperiment.Create(AFilename: string;AOwner:TComponent); +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; @@ -583,13 +690,31 @@ begin end; procedure TExperiment.Clean; +var c,i : integer; begin + WriteReportRow; + 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/game_file_methods.pas b/units/game_file_methods.pas index 79f2fe5..5e184d9 100644 --- a/units/game_file_methods.pas +++ b/units/game_file_methods.pas @@ -76,7 +76,7 @@ begin ResearcherCanPlay:=False; ResearcherCanChat:=True; SendChatHistoryForNewPlayers:=True; - ExperimentName:='Test Experiment'; + ExperimentName:='test_experiment'; ExperimentAim:='This is a test experiment.'; GenPlayersAsNeeded:=True; CurrentCondition := 0; @@ -98,12 +98,16 @@ begin SetLength(Contingencies, 4); LConcequence := TConsequence.Create(AExperiment,1,[gscPoints, gscB, gscMessage,gscBroadcastMessage],['$NICNAME','queijo','queijos']); Contingencies[0] := TContingency.Create(AExperiment,LConcequence,LCriteria1,False); + Contingencies[0].ContingencyName := 'CRF 1B'; LConcequence := TConsequence.Create(AExperiment,3,[gscPoints, gscA, gscMessage,gscBroadcastMessage],['$NICNAME','pão','pães']); Contingencies[1] := TContingency.Create(AExperiment,LConcequence,LCriteria2,False); + Contingencies[1].ContingencyName := 'CRF 1A'; LConcequence := TConsequence.Create(AExperiment,1,[gscPoints, gscG, gscMessage],['','item escolar','itens escolares']); Contingencies[2] := TContingency.Create(AExperiment,LConcequence,LCriteria3,True); + Contingencies[2].ContingencyName := 'MCRF 1G'; 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 @@ -129,57 +133,6 @@ var // if not (APath[Length(APath)] = PathDelim) then APath:= APath + PathDelim; //end; - function GetEndCriteria(S:string) : TEndConditionCriterium; - begin - case StrToIntDef(ExtractDelimited(1,S,[',']),2) of - 0: Result.Value := gecAbsoluteCycles; - 1: Result.Value := gecInterlockingPorcentage; - 2: Result.Value := gecWhichComeFirst; - end; - Result.AbsoluteCycles := StrToIntDef(ExtractDelimited(2,S,[',']), 20); - Result.InterlockingPorcentage := StrToIntDef(ExtractDelimited(3,S,[',']),10); - Result.LastCycles := StrToIntDef(ExtractDelimited(4,S,[',']), 10); - end; - - function GetPoints(S: string) : TPoints; - begin - Result.A := StrToIntDef(ExtractDelimited(1,S,[',']),0); - Result.B := StrToIntDef(ExtractDelimited(2,S,[',']),0); - Result.G := StrToIntDef(ExtractDelimited(3,S,[',']),0); - end; - - - function GetChoiceFromString(S:string) : TPlayerChoice; - begin - Result.Row := GetRowFromString(ExtractDelimited(1,S,[','])); - Result.Color := GetGameColorFromString(ExtractDelimited(2,S,[','])); - end; - - function GetPPointsFromString(S:string) : TPlayerPoints; - begin - Result.A := StrToIntDef(ExtractDelimited(1,S,[',']),0); - Result.B := StrToIntDef(ExtractDelimited(2,S,[',']),0); - end; - - function GetStatusFromString(S : string): TGamePlayerStatus; - begin - case ExtractDelimited(1,S,[',']) of - 'esperando': Result := gpsWaiting; - 'jogou': Result := gpsPlayed; - 'jogando': Result := gpsPlaying; - end; - end; - - function GetPromptStyle(S:string):TPromptStyle; - var - i : integer; - begin - // Yes,All,Metacontingency,RecoverLostPoints, - Result := []; - for i := 1 to 4 do - Result := Result + GetPromptStyleFromString(ExtractDelimited(i,S,[','])); - end; - procedure ReadExperiment; begin // Experiment; @@ -231,33 +184,6 @@ var LConsequence : TConsequence; LCriteria:TCriteria; - function GetCriteriaFromString(S:string):TCriteria; - var - LS : string; - i, - LCount: integer; - begin - LS := ExtractDelimited(1,S,['|']); - LCount := WordCount(LS,[#0,',']); - Result.Rows := []; - for i := 1 to LCount do - Result.Rows += [GetRowFromString(ExtractDelimited(i,LS,[',']))]; - - case ExtractDelimited(2,S,['|'])of - 'NONE':Result.Style:=gtNone; - 'CORES':Result.Style:=gtColorsOnly; - 'E':Result.Style:=gtRowsAndColors; - 'LINHAS':Result.Style:=gtRowsOnly; - 'OU':Result.Style:=gtRowsOrColors; - end; - - LS := ExtractDelimited(3,S,['|']); - LCount := WordCount(LS,[#0,',']); - Result.Colors := []; - for i := 1 to LCount do - Result.Colors += [GetGameColorFromString(ExtractDelimited(i,LS,[',']))]; - end; - procedure SetLCK(i:integer); begin if IsMeta then @@ -304,10 +230,10 @@ var {$ENDIF} s1 := DEF_END; end; - EndCriterium := GetEndCriteria(s1); + EndCriterium := GetEndCriteriaFromString(s1); ConditionName := ReadString(LS,KEY_COND_NAME,LS); - Points.Count := GetPoints(ReadString(LS, KEY_POINTS_COUNT,DEF_POINTS)); - Points.OnStart := GetPoints(ReadString(LS, KEY_POINTS_ONSTART,DEF_POINTS)); + Points.Count := GetPointsFromString(ReadString(LS, KEY_POINTS_COUNT,DEF_POINTS)); + Points.OnStart := GetPointsFromString(ReadString(LS, KEY_POINTS_ONSTART,DEF_POINTS)); Turn.Count:= ReadInteger(LS, KEY_TURN_COUNT,1); Turn.Value:= ReadInteger(LS, KEY_TURN_VALUE,2); Turn.Random:= ReadBool(LS, KEY_TURN_RANDOM,False); @@ -322,7 +248,7 @@ var Prompt := TPrompt.Create( AExperiment - , GetPromptStyle(ReadString(LS,KEY_PROMPT_STYLE,'todos,sim,metacontingência,recuperar pontos,')) + , GetPromptStyleFromString(ReadString(LS,KEY_PROMPT_STYLE,'todos,sim,metacontingência,recuperar pontos,')) , Contingencies , ReadString(LS,KEY_PROMPT_MESSAGE,DEF_PROMPTMESSAGE) ); diff --git a/units/game_resources.pas b/units/game_resources.pas index 94f0084..6b18edd 100644 --- a/units/game_resources.pas +++ b/units/game_resources.pas @@ -72,8 +72,12 @@ resourcestring KEY_CONSEQUE_MESSAGE_APPENDS = '.Consequência.Mensagem.Sufixo.Singular'; KEY_CONSEQUE_MESSAGE_APPENDP = '.Consequência.Mensagem.Sufixo.Plural'; - + VAL_CONSEQUENCE = 'Cosequência'; VAL_RESEARCHER = 'Pesquisador'; + VAL_EXPERIMENT = 'Experimento'; + VAL_INTERLOCKING = 'Entrelaçamento'; + + VAL_BEGIN_TIME = 'Começo'; DEF_END = '2,20,10,10,'; // which come first, 20 cycles | 10% entrelaçamentos in the last 10 cycles DEF_POINTS = '0,0,0,'; diff --git a/units/string_methods.pas b/units/string_methods.pas index 9994902..e9418d2 100644 --- a/units/string_methods.pas +++ b/units/string_methods.pas @@ -19,8 +19,6 @@ uses , game_resources ; -function GetAndDelFirstValue(var S: string;Sep:Char=','):string; deprecated 'Use ExtracteDelimited from strutils instead'; - function GetRowString(ARow : TGameRow) : string; function GetRowFromString(S : string):TGameRow; @@ -31,6 +29,7 @@ function GetGameColorFromString(S : string) : TGameColor; function GetPromptStyleFromString(S : string) : TPromptStyle; function GetPromptStyleString(AStyle : TPromptStyle) : string; +function GetGamePromptStyleFromString(S : string) : TGamePromptStyle; function GetConsequenceStyleFromString(s : string):TGameConsequenceStyle; function GetConsequenceStyleString(AStyle : TGameConsequenceStyle): string; @@ -42,10 +41,19 @@ function GetCriteriaFromString(S : string) : TCriteria; function GetCriteriaStyleString(AStyle: TGameStyle) : string; function GetStatusString(AStatus : TGamePlayerStatus): string; +function GetStatusFromString(S : string): TGamePlayerStatus; + +function GetPPointsFromString(S:string) : TPlayerPoints; function GetPPointsString(APPoints : TPlayerPoints) : string; -function GetChoiceString(AChoice : TPlayerChoice) : string; +function GetPointsFromString(S: string) : TPoints; function GetPointsString(APoints : TPoints) : string; + +function GetChoiceString(AChoice : TPlayerChoice) : string; +function GetChoiceFromString(S:string) : TPlayerChoice; + function GetEndCriteriaString(AEndCriterium:TEndConditionCriterium) : string; +function GetEndCriteriaFromString(S:string) : TEndConditionCriterium; + function GetPlayerFromString(s: string): TPlayer; function GetPlayerAsString(P: TPlayer): string; @@ -54,6 +62,57 @@ implementation 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; + end; + Result.AbsoluteCycles := StrToIntDef(ExtractDelimited(2,S,[',']), 20); + Result.InterlockingPorcentage := StrToIntDef(ExtractDelimited(3,S,[',']),10); + Result.LastCycles := StrToIntDef(ExtractDelimited(4,S,[',']), 10); +end; + +function GetPointsFromString(S: string) : TPoints; +begin + Result.A := StrToIntDef(ExtractDelimited(1,S,[',']),0); + Result.B := StrToIntDef(ExtractDelimited(2,S,[',']),0); + Result.G := StrToIntDef(ExtractDelimited(3,S,[',']),0); +end; + + +function GetChoiceFromString(S:string) : TPlayerChoice; +begin + Result.Row := GetRowFromString(ExtractDelimited(1,S,[','])); + Result.Color := GetGameColorFromString(ExtractDelimited(2,S,[','])); +end; + +function GetPPointsFromString(S:string) : TPlayerPoints; +begin + Result.A := StrToIntDef(ExtractDelimited(1,S,[',']),0); + Result.B := StrToIntDef(ExtractDelimited(2,S,[',']),0); +end; + +function GetStatusFromString(S : string): TGamePlayerStatus; +begin + case ExtractDelimited(1,S,[',']) of + 'esperando': Result := gpsWaiting; + 'jogou': Result := gpsPlayed; + 'jogando': Result := gpsPlaying; + end; +end; + +function GetPromptStyleFromString(S:string):TPromptStyle; +var + i : integer; +begin + // Yes,All,Metacontingency,RecoverLostPoints, + Result := []; + for i := 1 to 4 do + Result := Result + [GetGamePromptStyleFromString(ExtractDelimited(i,S,[',']))]; +end; + function GetAndDelFirstValue(var S: string;Sep:Char=','): string; begin Result := Copy(S, 0, pos(Sep, S)-1); @@ -128,18 +187,18 @@ begin end; -function GetPromptStyleFromString(S: string): TPromptStyle; +function GetGamePromptStyleFromString(S: string): TGamePromptStyle; begin // todos,sim,metacontingência,recuperar pontos, case UpperCase(S) of //'NENHUM','NONE': Result:=[gsNone]; - 'TODOS', 'ALL' : Result:=[gsAll]; - 'SIM', 'YES','S','Y': Result:=[gsYes]; - 'NÃO','NAO','N' : Result:=[gsNo]; - 'CONTINGÊNCIA','CONTINGENCIA','CONTINGENCY','OPERANTE', 'OPERANT': Result:=[gsContingency]; - 'METACONTINGÊNCIA','METACONTINGENCIA','METACONTINGENCY','META': Result:=[gsMetacontingency]; - 'RECUPERA','RECUPERAR','RECUPERAR PONTOS','RECOVER','RESETAR', 'RESET': Result:=[gsRevertPoints]; - 'TIRAR DE A AO INVES DE B','TIRAR DE A AO INVÉS DE B', 'B as A' : Result:=[gsBasA]; + 'TODOS', 'ALL' : Result := gsAll; + 'SIM', 'YES','S','Y': Result := gsYes; + 'NÃO','NAO','N' : Result := gsNo; + 'CONTINGÊNCIA','CONTINGENCIA','CONTINGENCY','OPERANTE', 'OPERANT': Result := gsContingency; + 'METACONTINGÊNCIA','METACONTINGENCIA','METACONTINGENCY','META': Result := gsMetacontingency; + 'RECUPERA','RECUPERAR','RECUPERAR PONTOS','RECOVER','RESETAR', 'RESET': Result := gsRevertPoints; + 'TIRAR DE A AO INVES DE B','TIRAR DE A AO INVÉS DE B', 'B as A' : Result := gsBasA; end; end; @@ -197,33 +256,31 @@ begin Result += '|'; end; -function GetCriteriaFromString(S: string): TCriteria; +function GetCriteriaFromString(S:string):TCriteria; var - s1 : string; - i : integer; + LS : string; + i, + LCount: integer; begin - s1 := ExtractDelimited(1,S,['|']); + LS := ExtractDelimited(1,S,['|']); + LCount := WordCount(LS,[#0,',']); Result.Rows := []; - - for i := 1 to WordCount(s1,[#0,',']) do - if ExtractDelimited(i,s1,[',']) <> '' then - Result.Rows += [GetRowFromString(ExtractDelimited(i,s1,[',']))] - else Break; - - s1 := ExtractDelimited(2,S,['|']); - case UpperCase(s1) of - '','INDIFERENTE', 'NONE' : Result.Style := gtNone; - 'E', 'AND' : Result.Style := gtRowsAndColors; - 'OU', 'OR' : Result.Style := gtRowsOrColors; - + for i := 1 to LCount do + Result.Rows += [GetRowFromString(ExtractDelimited(i,LS,[',']))]; + + case ExtractDelimited(2,S,['|'])of + 'NONE':Result.Style:=gtNone; + 'CORES':Result.Style:=gtColorsOnly; + 'E':Result.Style:=gtRowsAndColors; + 'LINHAS':Result.Style:=gtRowsOnly; + 'OU':Result.Style:=gtRowsOrColors; end; - s1 := ExtractDelimited(3,S,['|']); + LS := ExtractDelimited(3,S,['|']); + LCount := WordCount(LS,[#0,',']); Result.Colors := []; - for i := 1 to WordCount(s1,[#0,',']) do - if ExtractDelimited(i,s1,[',']) <> '' then - Result.Colors += [GetGameColorFromString(ExtractDelimited(i,s1,[',']))] - else Break; + for i := 1 to LCount do + Result.Colors += [GetGameColorFromString(ExtractDelimited(i,LS,[',']))]; end; function GetCriteriaStyleString(AStyle: TGameStyle): string; -- libgit2 0.21.2