Download as
Browse Code »

Commit 2c96cce2eeab0877678e17b4d7f48dbe7242c8f9

Authored by Carlos Picanco
1 parent db82a015
Exists in master

basic generations workflow, fix prompt responses in report and dumps

Showing 9 changed files with 256 additions and 147 deletions   Show diff stats
form_chooseactor.pas
  Diff comments   View file @2c96cce
... ... @@ -41,6 +41,8 @@ type
41 41 procedure SetStyle(AValue: string);
42 42 { private declarations }
43 43 public
  44 + procedure ShowPoints(A, B, G : string);
  45 + procedure ShowResumeButton;
44 46 property GameActor : TGameActor read FGameActor;
45 47 property Style : string read FStyle write SetStyle;
46 48 end;
... ... @@ -96,5 +98,10 @@ begin
96 98 FStyle:=AValue;
97 99 end;
98 100  
  101 +procedure TFormChooseActor.ShowPoints(A, B, G: string);
  102 +begin
  103 +
  104 +end;
  105 +
99 106 end.
100 107  
... ...
form_matrixgame.lfm
  Diff comments   View file @2c96cce
... ... @@ -248,7 +248,7 @@ object FormMatrixGame: TFormMatrixGame
248 248 Height = 15
249 249 Top = 45
250 250 Width = 128
251   - Caption = 'Generação:'
  251 + Caption = 'Geração:'
252 252 ParentColor = False
253 253 end
254 254 object LabelExpCountGeneration: TLabel
... ...
units/game_actors.pas
  Diff comments   View file @2c96cce
... ... @@ -160,6 +160,7 @@ type
160 160 public
161 161 constructor Create(AOwner:TComponent; APStyle:TPromptStyle; APTarget : TContingencies; AMessage:string);reintroduce;
162 162 function ResponsesCount : integer;
  163 + function Response(I:integer):string;
163 164 function AsString: TStringList; overload;
164 165 procedure AppendResponse(AID,R:string);
165 166 procedure Clean;override;
... ... @@ -437,6 +438,11 @@ begin
437 438 Result := Length(FResponses);
438 439 end;
439 440  
  441 +function TPrompt.Response(I: integer): string;
  442 +begin
  443 + Result := FResponses[I]
  444 +end;
  445 +
440 446 procedure TPrompt.AppendResponse(AID, R: string);
441 447 begin
442 448 SetLength(FResponses,Length(FResponses)+1);
... ...
units/game_control.pas
  Diff comments   View file @2c96cce
... ... @@ -11,8 +11,6 @@ unit game_control;
11 11  
12 12 {$mode objfpc}{$H+}
13 13  
14   -//{$DEFINE DEBUG}
15   -
16 14 interface
17 15  
18 16 uses
... ... @@ -43,6 +41,7 @@ type
43 41 function GetSelectedRowF(AStringGrid : TStringGrid) : UTF8string;
44 42 function MessageHas(const A_CONST : UTF8string; AMessage : TStringList; I:ShortInt=0): Boolean;
45 43 procedure CreatePlayerBox(P:TPlayer; Me:Boolean);
  44 + procedure DeletePlayerBox(AID : string);
46 45 procedure SetMatrixType(AStringGrid : TStringGrid; AMatrixType:TGameMatrixType;
47 46 var ARowBase:integer; var ADrawDots, ADrawClear : Boolean);
48 47 procedure ReceiveMessage(AMessage : TStringList);
... ... @@ -62,8 +61,8 @@ type
62 61  
63 62 function ShouldStartExperiment: Boolean;
64 63 function ShouldEndCycle : Boolean;
  64 + function ShouldEndGeneration : Boolean;
65 65 function ShouldAskQuestion : Boolean;
66   - procedure KickPlayer(AID:string);
67 66 procedure NextTurn(Sender: TObject);
68 67 procedure NextCycle(Sender: TObject);
69 68 procedure NextLineage(Sender: TObject);
... ... @@ -91,6 +90,8 @@ type
91 90  
92 91 function GetRowColor(ARow : integer;ARowBase:integer) : TColor;
93 92  
  93 +// TODO: PUT MESSAGES IN RESOURCE STRING
  94 +
94 95 const
95 96 K_FULLROOM = '.Full';
96 97 K_PLAYING = '.Playing';
... ... @@ -100,17 +101,16 @@ const
100 101 K_CHOICE = '.Choice';
101 102 K_MESSAGE = '.Message';
102 103 K_START = '.Start';
103   - K_LEFT = '.Left';
104 104 K_RESUME = '.Resume';
105 105 K_DATA_A = '.Data';
106 106 K_LOGIN = '.Login';
107   - K_KICK = '.Kick';
108 107 K_QUESTION = '.Question';
109 108 K_QMESSAGE = '.QMessage';
  109 + K_MOVQUEUE = '.Queue';
110 110 //
111 111 K_STATUS = '.Status';
112   - K_CYCLES = '.OnEndCycle';
113   -
  112 + K_LEFT = '.Left';
  113 + K_WAIT = '.Wait';
114 114 //K_RESPONSE =
115 115  
116 116 implementation
... ... @@ -152,14 +152,14 @@ begin
152 152 Result := FExperiment.Condition[FExperiment.CurrentCondition].Turn.Count = FExperiment.Condition[FExperiment.CurrentCondition].Turn.Value-1;
153 153 end;
154 154  
155   -function TGameControl.ShouldAskQuestion: Boolean;
  155 +function TGameControl.ShouldEndGeneration: Boolean;
156 156 begin
157   - Result := Assigned(FExperiment.Condition[FExperiment.CurrentCondition].Prompt) and FExperiment.Condition[FExperiment.CurrentCondition].Contingencies[3].Fired;
  157 + Result := FExperiment.Condition[FExperiment.CurrentCondition].Cycles.Count = FExperiment.Condition[FExperiment.CurrentCondition].Cycles.Value-1;
158 158 end;
159 159  
160   -procedure TGameControl.KickPlayer(AID: string);
  160 +function TGameControl.ShouldAskQuestion: Boolean;
161 161 begin
162   - FZMQActor.SendMessage([K_KICK, AID]);
  162 + Result := Assigned(FExperiment.Condition[FExperiment.CurrentCondition].Prompt) and FExperiment.Condition[FExperiment.CurrentCondition].Contingencies[3].Fired;
163 163 end;
164 164  
165 165 procedure TGameControl.NextTurn(Sender: TObject);
... ... @@ -295,6 +295,18 @@ begin
295 295 end;
296 296 end;
297 297  
  298 +procedure TGameControl.DeletePlayerBox(AID: string);
  299 +var i : integer;
  300 +begin
  301 + for i := 0 to FormMatrixGame.GBLastChoice.ComponentCount -1 do
  302 + if FormMatrixGame.GBLastChoice.Components[i] is TPlayerBox then
  303 + if TPlayerBox(FormMatrixGame.GBLastChoice.Components[i]).ID = AID then
  304 + begin
  305 + TPlayerBox(FormMatrixGame.GBLastChoice.Components[i]).Free;
  306 + Break;
  307 + end;
  308 +end;
  309 +
298 310 procedure TGameControl.SetMatrixType(AStringGrid: TStringGrid;
299 311 AMatrixType: TGameMatrixType; var ARowBase: integer; var ADrawDots,
300 312 ADrawClear: Boolean);
... ... @@ -437,15 +449,17 @@ procedure TGameControl.ShowConsequenceMessage(AID, S: string; ForGroup: Boolean)
437 449 var
438 450 LConsequence : TConsequence;
439 451 begin
440   - LConsequence := TConsequence.Create(nil,S);
441   - LConsequence.GenerateMessage(ForGroup);
442   - LConsequence.PresentMessage;
443   - if ForGroup then
444   - LConsequence.PresentPoints
445   - else
446   - if Self.ID = AID then
447   - LConsequence.PresentPoints;
448   -
  452 + if FActor = gaPlayer then
  453 + begin
  454 + LConsequence := TConsequence.Create(nil,S);
  455 + LConsequence.GenerateMessage(ForGroup);
  456 + LConsequence.PresentMessage;
  457 + if ForGroup then
  458 + LConsequence.PresentPoints
  459 + else
  460 + if Self.ID = AID then
  461 + LConsequence.PresentPoints;
  462 + end;
449 463 end;
450 464  
451 465 procedure TGameControl.DisableConfirmationButton;
... ... @@ -629,12 +643,7 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
629 643 begin
630 644 P := FExperiment.PlayerFromString[AMessage[1]];
631 645 FExperiment.AppendPlayer(P);
632   - if Self.ID = P.ID then
633   - begin
634   - CreatePlayerBox(P, True)
635   - end
636   - else
637   - CreatePlayerBox(P,False);
  646 + CreatePlayerBox(P, Self.ID = P.ID)
638 647 end;
639 648 end;
640 649 end;
... ... @@ -647,8 +656,10 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
647 656 , ' '
648 657 , GA_PLAYER+K_QUESTION
649 658 , AskQuestion(AMessage[1])
  659 + , AMessage[2]
650 660 ]);
651 661 end;
  662 +
652 663 end;
653 664  
654 665 procedure ReceiveChoice;
... ... @@ -656,7 +667,6 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
656 667 P : TPlayer;
657 668 begin
658 669 P := FExperiment.PlayerFromID[AMessage[1]];
659   -
660 670 // add last responses to player box
661 671 with GetPlayerBox(P.ID) do
662 672 begin
... ... @@ -722,45 +732,65 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
722 732 end;
723 733 end;
724 734  
725   - //procedure OnEndCycle;
726   - //var
727   - // LConsequence : TConsequence;
728   - //begin
729   - // case FActor of
730   - // gaPlayer:
731   - // begin
732   - // LConsequence := TConsequence.Create(nil,AMessage[1]);
733   - // LConsequence.GenerateMessage(True);
734   - //
735   - // LConsequence.PresentPoints;
736   - // LConsequence.PresentMessage;
737   - // end;
738   - // end;
739   - //end;
740   -
741 735 procedure ReceiveChat;
742 736 begin
743 737 FormMatrixGame.ChatMemoRecv.Lines.Append(('['+AMessage[1]+']: ')+AMessage[2]);
744 738 end;
745 739  
746   - procedure SayGoodBye;
  740 + procedure MovePlayerQueue;
  741 + var P : TPlayer;
  742 + begin
  743 + P := FExperiment.PlayerFromString[AMessage[1]]; // new
  744 + CreatePlayerBox(P,Self.ID = P.ID);
  745 +
  746 + if FActor = gaPlayer then
  747 + begin
  748 + FExperiment.Player[FExperiment.PlayerIndexFromID[AMessage[2]]] := P;
  749 + EnablePlayerMatrix(Self.ID,0, True);
  750 + end;
  751 + end;
  752 +
  753 + procedure SayGoodBye(AID:string);
747 754 begin
  755 + DeletePlayerBox(AID); // old player
748 756 case FActor of
749 757 gaPlayer:begin
750   - if Self.ID <> AMessage[1] then Exit;
751   - FormMatrixGame.Visible := False;
752   - FormChooseActor := TFormChooseActor.Create(nil);
753   - FormChooseActor.Style := K_LEFT;
754   - if FormChooseActor.ShowModal = 1 then
  758 + if Self.ID = AID then
755 759 begin
756   - FZMQActor.Request([K_RESUME,Self.ID]);
757   - FormMatrixGame.Visible := True;
  760 + // TODO: SHOW EARNED POINTS TO PARTICIPANT
  761 + //FormMatrixGame.LabelIndA.Caption;
  762 + //FormMatrixGame.LabelIndB.Caption;
  763 + //FormMatrixGame.LabelIndG.Caption;
  764 +
  765 + FormMatrixGame.Visible := False;
  766 + FormChooseActor := TFormChooseActor.Create(nil);
  767 + FormChooseActor.Style := K_LEFT;
  768 + if FormChooseActor.ShowModal = 1 then
  769 + begin
  770 + FZMQActor.Request([AID,' ',K_RESUME]);
  771 + FormMatrixGame.Visible := True;
  772 + end
  773 + else;
  774 + FormChooseActor.Free;
758 775 end
759   - else;
760   - FormChooseActor.Free;
  776 + else
  777 + ShowPopUp('O jogador '+FExperiment.PlayerFromID[ID].Nicname+ ' saiu. Por favor, aguarde...');
761 778 end;
  779 +
  780 + gaAdmin:ShowPopUp(
  781 + 'O participante '+
  782 + FExperiment.PlayerFromID[ID].Nicname+
  783 + ' saiu. Aguardando a entrada do próximo participante.'
  784 + );
762 785 end;
763 786 end;
  787 + procedure ResumeNextTurn;
  788 + begin
  789 + if AMessage[1] <> #32 then
  790 + SayGoodBye(AMessage[1])
  791 + else
  792 + EnablePlayerMatrix(Self.ID,0, True);
  793 + end;
764 794  
765 795 procedure QuestionMessages;
766 796 var
... ... @@ -771,7 +801,7 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
771 801 gaPlayer:begin
772 802 if AMessage.Count > 1 then
773 803 begin
774   - for i := 1 to AMessage.Count -1 do
  804 + for i := 2 to AMessage.Count -1 do
775 805 begin
776 806 MID := ExtractDelimited(1,AMessage[i],['+']);
777 807 ShowConsequenceMessage(MID, ExtractDelimited(2,AMessage[i],['+']),MID = 'M');
... ... @@ -781,36 +811,21 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
781 811 {$ENDIF}
782 812 end;
783 813 end;
784   - EnablePlayerMatrix(Self.ID,0, True);
785   - WriteLn('>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>');
786 814 end;
787 815 end;
  816 + ResumeNextTurn;
788 817 end;
789 818  
790   -
791   - // procedure ResumeActor;
792   - // begin
793   - // case FActor of
794   - // gaPlayer:begin
795   - //
796   - // end;
797   - // gaAdmin:begin
798   - //
799   - // end;
800   - // end;
801   - // end;
802   -
803 819 begin
804 820 if MHas(K_ARRIVED) then ReceiveActor;
805 821 if MHas(K_CHAT_M) then ReceiveChat;
806 822 if MHas(K_CHOICE) then ReceiveChoice;
807 823 if MHas(K_MESSAGE) then ShowConsequenceMessage(AMessage[1],AMessage[2],StrToBool(AMessage[3]));
808   - if MHas(K_KICK) then SayGoodBye;
809 824 if MHas(K_START) then NotifyPlayers;
810 825 if MHas(K_QUESTION) then ShowQuestion;
811   - if MHAS(K_RESUME) then EnablePlayerMatrix(Self.ID,0, True);
812   - //if MHas(K_CYCLES) then OnEndCycle;
  826 + if MHas(K_MOVQUEUE) then MovePlayerQueue;
813 827 if MHas(K_QMESSAGE) then QuestionMessages;
  828 + if MHas(K_RESUME) then ResumeNextTurn;
814 829 end;
815 830  
816 831 // Here FActor is garanted to be a TZMQAdmin
... ... @@ -925,22 +940,29 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList);
925 940 S := ReplaceStr(S,'$NICNAME',P.Nicname);
926 941  
927 942 // update turn
928   - LEndCycle:=ShouldEndCycle;
  943 + LEndCycle := ShouldEndCycle;
929 944 P.Turn := FExperiment.NextTurn;
930   - FExperiment.Player[P.ID] := P;
  945 + FExperiment.Player[FExperiment.PlayerIndexFromID[P.ID]] := P;
931 946  
932 947 // append results
933   - ARequest.Append(IntToStr(P.Turn));
934   - ARequest.Append(S);
935   - if LEndCycle then
  948 + ARequest.Append(IntToStr(P.Turn)); //5
  949 + ARequest.Append(S); //6
  950 + if LEndCycle then // >7 = EndCycle
936 951 begin
  952 +
937 953 LConsequences := FExperiment.ConsequenceStringFromChoices;// AsString generates the pts result
938   - ARequest.Append(LConsequences);
  954 + ARequest.Append(LConsequences); //7
939 955  
940   - if ShouldAskQuestion then // TODO: prompt only when an odd row was selected
941   - ARequest.Append(FExperiment.Condition[FExperiment.CurrentCondition].Prompt.Question)
  956 + if ShouldAskQuestion then // DONE: prompt only when an odd row was selected
  957 + ARequest.Append(FExperiment.Condition[FExperiment.CurrentCondition].Prompt.Question) //8
942 958 else
943   - FExperiment.Clean;
  959 + begin
  960 + ARequest.Append(#32); // 8
  961 + if Assigned(FExperiment.Condition[FExperiment.CurrentCondition].Prompt) then
  962 + FExperiment.WriteReportRowPrompt;
  963 + FExperiment.Clean;
  964 + end;
  965 + ARequest.Append(FExperiment.NextGeneration); // #32 no, else NextGeneration = PlayerToKick
944 966 end;
945 967 end;
946 968  
... ... @@ -963,8 +985,9 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList);
963 985  
964 986 // generate messages
965 987 LPromptConsequences := FExperiment.Condition[FExperiment.CurrentCondition].Prompt.AsString;
966   - SetLength(M, 1+LPromptConsequences.Count);
  988 + SetLength(M, 2+LPromptConsequences.Count);
967 989 M[0] := K_QMESSAGE;
  990 + M[1] := ARequest[4]; // generations
968 991 if LPromptConsequences.Count > 0 then
969 992 begin
970 993 for i := 0 to LPromptConsequences.Count-1 do
... ... @@ -974,17 +997,37 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList);
974 997 LPromptConsequences[i] := ReplaceStr(LPromptConsequences[i],'$NICNAME', P.Nicname);
975 998 end;
976 999 for i := 0 to LPromptConsequences.Count -1 do
977   - M[i+1] := LPromptConsequences[i];
  1000 + M[i+2] := LPromptConsequences[i];
978 1001 end
979 1002 else;
980 1003  
981 1004 // send identified messages; each player takes only its own message and ignore the rest
982 1005 FZMQActor.SendMessage(M);
  1006 + FExperiment.WriteReportRowPrompt;
983 1007 FExperiment.Clean;
984 1008 end;
985 1009 end;
  1010 +
  1011 + procedure ReplyResume;// old player becomes a new player
  1012 + var
  1013 + P : TPlayer;
  1014 + S : string;
  1015 + begin
  1016 + P := FExperiment.PlayerFromID[ARequest[0]];
  1017 + ARequest[2] := K_RESUME+K_ARRIVED;
  1018 + if AskQuestion(
  1019 + 'Um novo participante entrou no lugar do participante mais antigo. Criar um novo apelido para o novo participante?'
  1020 + ) = 'S' then
  1021 + P.Nicname := GenResourceName(-1);
  1022 +
  1023 + S := FExperiment.PlayerAsString[P];
  1024 + ARequest.Append(S); // 3
  1025 + FExperiment.NextGeneration := S;
  1026 + end;
  1027 +
986 1028 begin
987 1029 if MHas(K_LOGIN) then ReplyLoginRequest;
  1030 + if MHas(K_RESUME) then ReplyResume;
988 1031 if MHas(K_CHOICE) then ValidateChoice;
989 1032 if MHas(K_QUESTION) then ValidateQuestionResponse;
990 1033 end;
... ... @@ -1074,29 +1117,23 @@ procedure TGameControl.ReceiveReply(AReply: TStringList);
1074 1117 //Sleep(1000);
1075 1118 end;
1076 1119  
1077   - if AReply.Count > 8 then
1078   - FZMQActor.SendMessage([K_QUESTION,AReply[8]])
  1120 + if AReply[8] <> #32 then
  1121 + FZMQActor.SendMessage([K_QUESTION,AReply[8],AReply[9]])
1079 1122 else
1080   - FZMQActor.SendMessage([K_RESUME]);
  1123 + FZMQActor.SendMessage([K_RESUME,AReply[9]]);
1081 1124 end;
1082 1125 end;
1083 1126 end;
1084 1127  
1085   - //procedure QuestionValidated;
1086   - //begin
1087   - // // wait
1088   - //end;
1089   -
1090   - //procedure ResumePlayer;
1091   - //begin
1092   - //
1093   - //end;
  1128 + procedure ResumePlayer;
  1129 + begin
  1130 + FZMQActor.SendMessage([K_MOVQUEUE, AReply[3],AReply[0]]); //new player,old player (self.id)
  1131 + end;
1094 1132  
1095 1133 begin
1096   - //if MHas(K_RESUME+K_ARRIVED) then ResumePlayer;
  1134 + if MHas(K_RESUME+K_ARRIVED) then ResumePlayer;
1097 1135 if MHas(K_LOGIN+K_ARRIVED) then LoginAccepted;
1098 1136 if MHas(K_CHOICE+K_ARRIVED) then ChoiceValidated;
1099   - //if MHas(K_QUESTION+K_ARRIVED) then QuestionValidated;
1100 1137 end;
1101 1138  
1102 1139  
... ...
units/game_experiment.pas
  Diff comments   View file @2c96cce
... ... @@ -11,8 +11,6 @@ unit game_experiment;
11 11  
12 12 {$mode objfpc}{$H+}
13 13  
14   -//{$DEFINE DEBUG}
15   -
16 14 interface
17 15  
18 16 uses
... ... @@ -34,7 +32,6 @@ type
34 32 FExperimentName,
35 33 FFilename,
36 34 FResearcher : string;
37   - FExperimentStart : Boolean;
38 35 FGenPlayersAsNeeded : Boolean;
39 36 FResearcherCanChat: Boolean;
40 37 FResearcherCanPlay: Boolean;
... ... @@ -57,6 +54,7 @@ type
57 54 function GetNextTurnPlayerID: UTF8string;
58 55 function GetNextCycle:integer;
59 56 function GetNextCondition:integer;
  57 + function GetCurrentAbsoluteCycle : integer;
60 58 function GetPlayer(I : integer): TPlayer; overload;
61 59 function GetPlayer(AID : UTF8string): TPlayer; overload;
62 60 function AliasPlayerAsString(P: TPlayer): UTF8string;
... ... @@ -85,6 +83,7 @@ type
85 83 procedure SetSendChatHistoryForNewPlayers(AValue: Boolean);
86 84 procedure SetState(AValue: TExperimentState);
87 85 private
  86 + FChangeGeneration: string;
88 87 FOnConsequence: TNotifyEvent;
89 88 FOnInterlocking: TNotifyEvent;
90 89 FOnEndTurn: TNotifyEvent;
... ... @@ -93,7 +92,9 @@ type
93 92 FOnEndExperiment: TNotifyEvent;
94 93 FOnEndGeneration: TNotifyEvent;
95 94 procedure Consequence(Sender : TObject);
  95 + function GetPlayerToKick: string;
96 96 procedure Interlocking(Sender : TObject);
  97 + procedure SetPlayersQueue(AValue: string);
97 98 procedure WriteReportHeader;
98 99 procedure WriteReportRowNames;
99 100 procedure WriteReportRow;
... ... @@ -108,6 +109,7 @@ type
108 109 procedure SaveToFile; overload;
109 110 procedure Clean;
110 111 procedure Play;
  112 + procedure WriteReportRowPrompt;
111 113 property ExperimentAim : string read FExperimentAim write FExperimentAim;
112 114 property ExperimentName : string read FExperimentName write FExperimentName;
113 115 property GenPlayersAsNeeded : Boolean read FGenPlayersAsNeeded write FGenPlayersAsNeeded;
... ... @@ -144,6 +146,8 @@ type
144 146 property NextTurn : integer read GetNextTurn;
145 147 property NextCycle : integer read GetNextCycle;
146 148 property NextCondition : integer read GetNextCondition;
  149 + property NextGeneration: string read GetPlayerToKick write SetPlayersQueue;
  150 + property ChangeGeneration : string read FChangeGeneration write FChangeGeneration; // helper
147 151 property State : TExperimentState read FState write SetState;
148 152 public
149 153 property OnEndTurn : TNotifyEvent read FOnEndTurn write SetOnEndTurn;
... ... @@ -213,6 +217,7 @@ end;
213 217 function TExperiment.GetNextCycle: integer;
214 218 begin
215 219 Result := FConditions[CurrentCondition].Cycles.Count;
  220 + WriteReportRow;
216 221 if Assigned(FOnEndCycle) then FOnEndCycle(Self);
217 222  
218 223 if FConditions[CurrentCondition].Cycles.Count < FConditions[CurrentCondition].Cycles.Value-1 then
... ... @@ -231,32 +236,30 @@ end;
231 236  
232 237 function TExperiment.GetNextCondition: integer;
233 238 var
234   - LAbsCycles : integer;
235 239 LInterlocks : integer;
236 240  
237 241 procedure EndCondition;
238 242 begin
239 243 if Assigned(FOnEndCondition) then FOnEndCondition(Self);
240 244 Inc(FCurrentCondition);
  245 + WriteReportRowNames;
241 246 end;
242 247  
243 248 begin
244 249 Result := CurrentCondition;
245   - LAbsCycles := (FConditions[CurrentCondition].Cycles.Value *
246   - FConditions[CurrentCondition].Cycles.Generation) + FConditions[CurrentCondition].Cycles.Count;
247 250  
248 251 // interlockings in last x cycles
249 252 LInterlocks := InterlockingsIn[FConditions[CurrentCondition].EndCriterium.LastCycles];
250 253 case FConditions[CurrentCondition].EndCriterium.Value of
251 254 gecWhichComeFirst:
252 255 begin
253   - if (LAbsCycles = FConditions[CurrentCondition].EndCriterium.AbsoluteCycles) or
  256 + if (GetCurrentAbsoluteCycle = FConditions[CurrentCondition].EndCriterium.AbsoluteCycles) or
254 257 (LInterlocks = FConditions[CurrentCondition].EndCriterium.InterlockingPorcentage) then
255 258 EndCondition;
256 259  
257 260 end;
258 261 gecAbsoluteCycles:
259   - if LAbsCycles = FConditions[CurrentCondition].EndCriterium.AbsoluteCycles then
  262 + if GetCurrentAbsoluteCycle = FConditions[CurrentCondition].EndCriterium.AbsoluteCycles then
260 263 EndCondition;
261 264  
262 265 gecInterlockingPorcentage:
... ... @@ -269,6 +272,13 @@ begin
269 272 {$ENDIF}
270 273 end;
271 274  
  275 +function TExperiment.GetCurrentAbsoluteCycle: integer;
  276 +var c:integer;
  277 +begin
  278 + c := CurrentCondition;
  279 + Result := (Condition[c].Cycles.Value*Condition[c].Cycles.Generation)+Condition[c].Cycles.Count;
  280 +end;
  281 +
272 282 function TExperiment.GetPlayer(I : integer): TPlayer;
273 283 begin
274 284 Result := FPlayers[i];
... ... @@ -496,6 +506,28 @@ begin
496 506 if Assigned(FOnInterlocking) then FOnInterlocking(Sender);
497 507 end;
498 508  
  509 +procedure TExperiment.SetPlayersQueue(AValue: string);
  510 +var
  511 + i : integer;
  512 +begin
  513 + for i := 0 to PlayersCount-2 do
  514 + begin
  515 + FPlayers[i] := FPlayers[i+1];
  516 + end;
  517 + FPlayers[High(FPlayers)] := PlayerFromString[AValue];
  518 +end;
  519 +
  520 +function TExperiment.GetPlayerToKick: string;
  521 +var c : integer;
  522 +begin
  523 + c := CurrentCondition;
  524 + if Condition[c].Cycles.Count < Condition[c].Cycles.Value -1 then
  525 + Result := #32
  526 + else
  527 + Result := FPlayers[0].ID;
  528 +end;
  529 +
  530 +
499 531 procedure TExperiment.WriteReportHeader;
500 532 var
501 533 LHeader : string;
... ... @@ -511,79 +543,105 @@ end;
511 543 procedure TExperiment.WriteReportRowNames;
512 544 var
513 545 c,j,i: integer;
514   - LHeader : string;
  546 + LNames : string;
515 547 begin
516 548 c:= CurrentCondition;
  549 +
517 550 // column names, line 1
518   - LHeader := 'Experimento'+#9+#9;
  551 + LNames := 'Experimento'+#9+#9+#9;
519 552 for i:=0 to Condition[c].Turn.Value-1 do // player's response
520   - LHeader += 'P'+IntToStr(i+1)+#9+#9;
  553 + LNames += 'P'+IntToStr(i+1)+#9+#9;
521 554  
522 555 for i:=0 to ContingenciesCount[c]-1 do
523 556 if not Contingency[c,i].Meta then
524 557 begin
525   - LHeader += Contingency[c,i].ContingencyName;
  558 + LNames += Contingency[c,i].ContingencyName;
526 559 for j:=0 to Condition[c].Turn.Value-1 do
527   - LHeader += #9;
  560 + LNames += #9;
528 561 end;
529 562  
530   - LHeader += VAL_INTERLOCKING+'s';
  563 + LNames += VAL_INTERLOCKING+'s';
531 564 for i:=0 to ContingenciesCount[c]-1 do
532 565 if Contingency[c,i].Meta then
533   - LHeader += #9;
534   -
535   - LHeader += LineEnding;
  566 + LNames += #9;
536 567  
  568 + if Assigned(Condition[c].Prompt) then
  569 + begin
  570 + LNames += 'Respostas à Pergunta';
  571 + for i:=0 to Condition[c].Turn.Value-1 do
  572 + LNames += #9;
  573 + end;
  574 + LNames += LineEnding;
537 575  
538 576 // column names, line 2
539   - LHeader += 'Condição'+#9+'Ciclo'+#9;
  577 + LNames += 'Condição'+#9+'Ciclo (Absoluto)'+#9+'Ciclo (Geração)'+#9;
540 578 for i:=0 to Condition[c].Turn.Value-1 do
541   - LHeader += 'Linha'+#9+'Cor'+#9;
  579 + LNames += 'Linha'+#9+'Cor'+#9;
542 580  
543 581 for i:=0 to ContingenciesCount[c]-1 do
544 582 if not Contingency[c,i].Meta then
545 583 for j:=0 to Condition[c].Turn.Value-1 do
546   - LHeader += 'P'+IntToStr(j+1)+#9;
  584 + LNames += 'P'+IntToStr(j+1)+#9;
547 585  
548 586 for i:=0 to ContingenciesCount[c]-1 do
549 587 if Contingency[c,i].Meta then
550   - LHeader += Contingency[c,i].ContingencyName+#9;
551   - LHeader += LineEnding;
  588 + LNames += Contingency[c,i].ContingencyName+#9;
552 589  
553   - FLastReportColNames := LHeader;
554   - FRegData.SaveData(LHeader);
  590 + if Assigned(Condition[c].Prompt) then
  591 + for i:=0 to Condition[c].Turn.Value-1 do
  592 + LNames += 'P'+IntToStr(i+1)+#9;
  593 +
  594 + if FLastReportColNames <> LNames then
  595 + begin
  596 + FLastReportColNames := LNames;
  597 + FRegData.SaveData(LNames);
  598 + end;
555 599 end;
556 600  
557 601 procedure TExperiment.WriteReportRow;
558 602 var
559 603 c,j,i: integer;
560   - LHeader : string;
  604 + LRow : string;
561 605 begin
562 606 c:= CurrentCondition;
563 607  
564   - LHeader := IntToStr(c+1)+#9+IntToStr(Condition[c].Cycles.Count+1)+#9;
  608 + LRow := LineEnding + IntToStr(c+1)+#9+IntToStr(GetCurrentAbsoluteCycle)+#9+IntToStr(Condition[c].Cycles.Count+1)+#9;
565 609 for i:=0 to Condition[c].Turn.Value-1 do
566   - LHeader += GetRowString(FPlayers[i].Choice.Row)+#9+GetColorString(FPlayers[i].Choice.Color)+#9;
  610 + LRow += GetRowString(FPlayers[i].Choice.Row)+#9+GetColorString(FPlayers[i].Choice.Color)+#9;
567 611  
568 612 for i:=0 to ContingenciesCount[c]-1 do
569 613 if not Contingency[c,i].Meta then
570 614 for j:=0 to Condition[c].Turn.Value-1 do
571 615 if Contingency[c,i].ConsequenceFromPlayerID(FPlayers[j].ID) <> '' then
572   - LHeader += '1'+#9
  616 + LRow += '1'+#9
573 617 else
574   - LHeader += '0'+#9;
  618 + LRow += '0'+#9;
575 619  
576 620 for i:=0 to ContingenciesCount[c]-1 do
577 621 if Contingency[c,i].Meta then
578 622 if Contingency[c,i].Fired then
579   - LHeader += '1'+#9
  623 + LRow += '1'+#9
580 624 else
581   - LHeader += '0'+#9;
582   - LHeader += LineEnding;
  625 + LRow += '0'+#9;
583 626  
584   - FLastReportColNames := LHeader;
585   - FRegData.SaveData(LHeader);
  627 + FRegData.SaveData(LRow);
  628 +end;
586 629  
  630 +procedure TExperiment.WriteReportRowPrompt;
  631 +var
  632 + c,i: integer;
  633 + LRow : string;
  634 +begin
  635 + c := CurrentCondition;
  636 + LRow := '';
  637 + if Condition[c].Prompt.ResponsesCount = Condition[c].Turn.Value then
  638 + for i:=0 to Condition[c].Prompt.ResponsesCount-1 do
  639 + LRow += Condition[c].Prompt.Response(i)+#9
  640 + else
  641 + for i:=0 to Condition[c].Turn.Value-1 do
  642 + LRow += 'NA'+#9;
  643 +
  644 + FRegData.SaveData(LRow);
587 645 end;
588 646  
589 647 constructor TExperiment.Create(AOwner: TComponent);
... ... @@ -692,7 +750,6 @@ end;
692 750 procedure TExperiment.Clean;
693 751 var c,i : integer;
694 752 begin
695   - WriteReportRow;
696 753 for i := 0 to PlayersCount -1 do
697 754 begin
698 755 FPlayers[i].Choice.Row:=grNone;
... ... @@ -717,5 +774,6 @@ begin
717 774 FState:=xsRunning;
718 775 end;
719 776  
  777 +
720 778 end.
721 779  
... ...
units/game_file_methods.pas
  Diff comments   View file @2c96cce
... ... @@ -101,7 +101,7 @@ begin
101 101 Contingencies[0].ContingencyName := 'CRF 1B';
102 102 LConcequence := TConsequence.Create(AExperiment,3,[gscPoints, gscA, gscMessage,gscBroadcastMessage],['$NICNAME','pão','pães']);
103 103 Contingencies[1] := TContingency.Create(AExperiment,LConcequence,LCriteria2,False);
104   - Contingencies[1].ContingencyName := 'CRF 1A';
  104 + Contingencies[1].ContingencyName := 'CRF 3A';
105 105 LConcequence := TConsequence.Create(AExperiment,1,[gscPoints, gscG, gscMessage],['','item escolar','itens escolares']);
106 106 Contingencies[2] := TContingency.Create(AExperiment,LConcequence,LCriteria3,True);
107 107 Contingencies[2].ContingencyName := 'MCRF 1G';
... ...
units/game_resources.pas
  Diff comments   View file @2c96cce
... ... @@ -252,16 +252,17 @@ implementation
252 252 uses zhelpers;
253 253  
254 254 function GenResourceName(i: integer): string;
  255 +var r :integer;
255 256 begin
256   - Randomize;
257   - if (i <= 49) and (i>=0) then
258   - begin
259   - if Random>0.5 then
260   - Result := CPlayerNamesMale[i]
261   - else
262   - Result := CPlayerNamesFemale[i];
263   - end
264   - else s_random(10);
  257 + if (i >= 0) and (i <= 49) then
  258 + r := i
  259 + else r := Random(50);
  260 +
  261 + if Random > 0.5 then
  262 + Result := CPlayerNamesMale[r]
  263 + else
  264 + Result := CPlayerNamesFemale[r];
  265 +
265 266 end;
266 267  
267 268 function GetColorFromCode(ACode: TGameColor): TColor;
... ... @@ -276,5 +277,9 @@ begin
276 277 end;
277 278 end;
278 279  
  280 +initialization
  281 +
  282 + Randomize;
  283 +
279 284 end.
280 285  
... ...
units/game_zmq_actors.pas
  Diff comments   View file @2c96cce
... ... @@ -19,8 +19,6 @@ uses
19 19 //, zmq_client
20 20 ;
21 21  
22   - {$DEFINE DEBUG}
23   -
24 22 type
25 23  
26 24 { TZMQActor }
... ...
units/zmq_network.pas
  Diff comments   View file @2c96cce
... ... @@ -11,8 +11,6 @@ unit zmq_network;
11 11  
12 12 {$mode objfpc}{$H+}
13 13  
14   -//{$DEFINE DEBUG}
15   -
16 14 interface
17 15  
18 16 uses Classes, SysUtils, Process
... ...