Download as
Browse Code »

Commit f8cf50c5d02595fd30edfb78693c0d6a2ef26ac4

Authored by Carlos Picanco
1 parent 4598d27c
Exists in master

work end of experiment and player feedback on change generation 

- also fix EndCriteria interlocks porcentage
Showing 12 changed files with 1127 additions and 65 deletions   Show diff stats
cultural_matrix.lpr
  Diff comments   View file @f8cf50c
... ... @@ -31,10 +31,6 @@ uses
31 31  
32 32  
33 33 var
34   - {$IFDEF DEBUG}
35   - I : integer;
36   - {$ENDIF}
37   - ID : TStringList;
38 34 ApplicationPath,
39 35 F : string;
40 36  
... ... @@ -71,6 +67,7 @@ const
71 67 {$ENDIF}
72 68  
73 69 function GetZMQNetworkID(var F:string):Boolean;
  70 + var ID : TStringList;
74 71 begin
75 72 Result := True;
76 73 ID := TStringList.Create;
... ...
form_chooseactor.pas
  Diff comments   View file @f8cf50c
... ... @@ -34,6 +34,8 @@ type
34 34 procedure btnPlayerResumeClick(Sender: TObject);
35 35 procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
36 36 procedure FormCreate(Sender: TObject);
  37 + procedure ExitApplication(Sender: TObject);
  38 + procedure ShowResumeButton(Sender: TObject);
37 39 private
38 40 FGameActor: TGameActor;
39 41 FCanClose : Boolean;
... ... @@ -41,8 +43,7 @@ type
41 43 procedure SetStyle(AValue: string);
42 44 { private declarations }
43 45 public
44   - procedure ShowPoints(A, B, G : string);
45   - procedure ShowResumeButton;
  46 + procedure ShowPoints(M : string);
46 47 property GameActor : TGameActor read FGameActor;
47 48 property Style : string read FStyle write SetStyle;
48 49 end;
... ... @@ -86,26 +87,62 @@ begin
86 87 FCanClose := True;
87 88 end;
88 89  
  90 +procedure TFormChooseActor.ExitApplication(Sender: TObject);
  91 +begin
  92 + Application.Terminate;
  93 +end;
  94 +
89 95 procedure TFormChooseActor.SetStyle(AValue: string);
90 96 begin
91 97 if FStyle=AValue then Exit;
  98 + FStyle:=AValue;
92 99 case AValue of
93 100 '.Arrived': btnPlayerResume.Visible:=False;
94   - '.Left': btnPlayerResume.Visible:=True;
  101 + '.Left', '.EndX':
  102 + begin
  103 + btnPlayerResume.Visible:=False;
  104 + btnAdmin.Visible:= False;
  105 + btnPlayer.Visible:= False;
  106 + BorderStyle:=bsNone;
  107 + Position:=poDesigned;
  108 + FormStyle:=fsNormal;
  109 + WindowState:=wsFullScreen;
  110 + end;
95 111 end;
96   - btnAdmin.Visible:= not btnPlayerResume.Visible;
97   - btnPlayer.Visible:= not btnPlayerResume.Visible;
98   - FStyle:=AValue;
99 112 end;
100 113  
101   -procedure TFormChooseActor.ShowPoints(A, B, G: string);
  114 +procedure TFormChooseActor.ShowPoints(M: string);
  115 +var L : TLabel;
102 116 begin
103   -
  117 + L := TLabel.Create(Self);
  118 + with L do
  119 + begin
  120 + Name := 'LabelGoodBye';
  121 + Align:=alClient;
  122 + Caption:= M;
  123 + Alignment := taCenter;
  124 + Anchors := [akLeft,akRight];
  125 + Layout := tlCenter;
  126 + WordWrap := True;
  127 + Parent:=Self;
  128 + Font.Size := 30;
  129 + case FStyle of
  130 + '.Left': OnClick := @ShowResumeButton;
  131 + '.EndX': OnClick := @ExitApplication;
  132 + end;
  133 + end;
104 134 end;
105 135  
106   -procedure TFormChooseActor.ShowResumeButton;
  136 +procedure TFormChooseActor.ShowResumeButton(Sender: TObject);
  137 +var i : integer;
107 138 begin
108   -
  139 + for i := 0 to ComponentCount-1 do
  140 + if Components[i].Name = 'LabelGoodBye' then
  141 + begin
  142 + TLabel(Components[i]).Visible:=False;
  143 + Break;
  144 + end;
  145 + btnPlayerResume.Visible:=True;
109 146 end;
110 147  
111 148 end.
... ...
units/backup/game_experiment.pas 0 → 100644
  Diff comments   View file @f8cf50c
... ... @@ -0,0 +1,782 @@
  1 +{
  2 + Stimulus Control
  3 + Copyright (C) 2014-2016 Carlos Rafael Fernandes Picanço, Universidade Federal do Pará.
  4 +
  5 + The present file is distributed under the terms of the GNU General Public License (GPL v3.0).
  6 +
  7 + You should have received a copy of the GNU General Public License
  8 + along with this program. If not, see <http://www.gnu.org/licenses/>.
  9 +}
  10 +unit game_experiment;
  11 +
  12 +{$mode objfpc}{$H+}
  13 +
  14 +interface
  15 +
  16 +uses
  17 + Classes, SysUtils
  18 + , game_actors
  19 + , regdata
  20 + ;
  21 +
  22 +type
  23 +
  24 + { TExperiment }
  25 +
  26 + TExperimentState = (xsWaiting,xsRunning,xsPaused,xsCanceled);
  27 + TConditions = array of TCondition;
  28 +
  29 + TExperiment = class(TComponent)
  30 + private
  31 + FExperimentAim,
  32 + FExperimentName,
  33 + FFilename,
  34 + FResearcher : string;
  35 + FGenPlayersAsNeeded : Boolean;
  36 + FResearcherCanChat: Boolean;
  37 + FResearcherCanPlay: Boolean;
  38 + FSendChatHistoryForNewPlayers: Boolean;
  39 + FShowChat: Boolean;
  40 + FMatrixType: TGameMatrixType;
  41 + private
  42 + FLastReportColNames : string;
  43 + FRegData : TRegData;
  44 + FPlayers : TPlayers;
  45 + FCurrentCondition : integer;
  46 + FConditions : TConditions;
  47 + FState: TExperimentState;
  48 + FTurnsRandom : TStringList;
  49 + function GetCondition(I : Integer): TCondition;
  50 + function GetConditionsCount: integer;
  51 + function GetContingenciesCount(C: integer): integer;
  52 + function GetContingency(ACondition, I : integer): TContingency;
  53 + function GetNextTurn: integer;
  54 + function GetNextTurnPlayerID: UTF8string;
  55 + function GetNextCycle:integer;
  56 + function GetNextCondition:integer;
  57 + function GetCurrentAbsoluteCycle : integer;
  58 + function GetPlayer(I : integer): TPlayer; overload;
  59 + function GetPlayer(AID : UTF8string): TPlayer; overload;
  60 + function AliasPlayerAsString(P: TPlayer): UTF8string;
  61 + function AliasPlayerFromString(s : UTF8string): TPlayer;
  62 + function GetPlayerIndexFromID(AID : UTF8string): integer;
  63 + function GetPlayerIsPlaying(AID : UTF8string): Boolean;
  64 + function GetPlayersCount: integer;
  65 + function GetInterlockingsIn(ALastCycles : integer):integer;
  66 + function GetConsequenceStringFromChoice(P:TPlayer): Utf8string;
  67 + function GetConsequenceStringFromChoices:UTF8String;
  68 + procedure CheckNeedForRandomTurns;
  69 + procedure SetCondition(I : Integer; AValue: TCondition);
  70 + procedure SetContingency(ACondition, I : integer; AValue: TContingency);
  71 + procedure SetMatrixType(AValue: TGameMatrixType);
  72 + procedure SetOnConsequence(AValue: TNotifyEvent);
  73 + procedure SetOnEndCondition(AValue: TNotifyEvent);
  74 + procedure SetOnEndCycle(AValue: TNotifyEvent);
  75 + procedure SetOnEndExperiment(AValue: TNotifyEvent);
  76 + procedure SetOnEndGeneration(AValue: TNotifyEvent);
  77 + procedure SetOnEndTurn(AValue: TNotifyEvent);
  78 + procedure SetOnInterlocking(AValue: TNotifyEvent);
  79 + procedure SetPlayer(I : integer; AValue: TPlayer); overload;
  80 + procedure SetPlayer(S : UTF8string ; AValue: TPlayer); overload;
  81 + procedure SetResearcherCanChat(AValue: Boolean);
  82 + procedure SetResearcherCanPlay(AValue: Boolean);
  83 + procedure SetSendChatHistoryForNewPlayers(AValue: Boolean);
  84 + procedure SetState(AValue: TExperimentState);
  85 + private
  86 + FChangeGeneration: string;
  87 + FOnConsequence: TNotifyEvent;
  88 + FOnInterlocking: TNotifyEvent;
  89 + FOnEndTurn: TNotifyEvent;
  90 + FOnEndCondition: TNotifyEvent;
  91 + FOnEndCycle: TNotifyEvent;
  92 + FOnEndExperiment: TNotifyEvent;
  93 + FOnEndGeneration: TNotifyEvent;
  94 + procedure Consequence(Sender : TObject);
  95 + function GetPlayerToKick: string;
  96 + procedure Interlocking(Sender : TObject);
  97 + procedure SetPlayersQueue(AValue: string);
  98 + procedure WriteReportHeader;
  99 + procedure WriteReportRowNames;
  100 + procedure WriteReportRow;
  101 + public
  102 + constructor Create(AOwner:TComponent);override;
  103 + constructor Create(AOwner:TComponent; AppPath:string);overload;
  104 + constructor Create(AOwner:TComponent; AFilename, AppPath:string); overload;
  105 + destructor Destroy; override;
  106 + function LoadFromFile(AFilename: string):Boolean;
  107 + function LoadFromGenerator:Boolean;
  108 + procedure SaveToFile(AFilename: string); overload;
  109 + procedure SaveToFile; overload;
  110 + procedure Clean;
  111 + procedure Play;
  112 + procedure WriteReportRowPrompt;
  113 + property ExperimentAim : string read FExperimentAim write FExperimentAim;
  114 + property ExperimentName : string read FExperimentName write FExperimentName;
  115 + property GenPlayersAsNeeded : Boolean read FGenPlayersAsNeeded write FGenPlayersAsNeeded;
  116 + property ResearcherCanPlay : Boolean read FResearcherCanPlay write SetResearcherCanPlay;
  117 + property ResearcherCanChat : Boolean read FResearcherCanChat write SetResearcherCanChat;
  118 + property Researcher : string read FResearcher write FResearcher;
  119 + property ShowChat : Boolean read FShowChat write FShowChat;
  120 + property SendChatHistoryForNewPlayers : Boolean read FSendChatHistoryForNewPlayers write SetSendChatHistoryForNewPlayers;
  121 + property MatrixType : TGameMatrixType read FMatrixType write SetMatrixType;
  122 + public
  123 + function AppendCondition : integer; overload;
  124 + function AppendCondition(ACondition : TCondition) : integer;overload;
  125 + function AppendContingency(ACondition : integer) : integer;overload;
  126 + function AppendContingency(ACondition : integer;AContingency : TContingency) : integer;overload;
  127 + function AppendPlayer : integer;overload;
  128 + function AppendPlayer(APlayer : TPlayer) : integer; overload;
  129 + property Condition[I : Integer]: TCondition read GetCondition write SetCondition;
  130 + property ConditionsCount : integer read GetConditionsCount;
  131 + property CurrentCondition : integer read FCurrentCondition write FCurrentCondition;
  132 + property Contingency[C, I : integer] : TContingency read GetContingency write SetContingency;
  133 + property ContingenciesCount[C:integer]:integer read GetContingenciesCount;
  134 + property Player[I : integer] : TPlayer read GetPlayer write SetPlayer;
  135 + property PlayerFromID[S : UTF8string ] : TPlayer read GetPlayer write SetPlayer;
  136 + property PlayersCount : integer read GetPlayersCount;
  137 + property PlayerIsPlaying[s : UTF8string] : Boolean read GetPlayerIsPlaying;
  138 + property PlayerIndexFromID[s : UTF8string]: integer read GetPlayerIndexFromID;
  139 + property PlayerAsString[P:TPlayer]: UTF8string read AliasPlayerAsString;
  140 + property PlayerFromString[s : UTF8string]: TPlayer read AliasPlayerFromString;
  141 + public
  142 + property InterlockingsIn[i:integer]:integer read GetInterlockingsIn;
  143 + property ConsequenceStringFromChoice[P:Tplayer]:UTF8String read GetConsequenceStringFromChoice;
  144 + property ConsequenceStringFromChoices: UTF8String read GetConsequenceStringFromChoices;
  145 + property NextTurnPlayerID : UTF8string read GetNextTurnPlayerID;
  146 + property NextTurn : integer read GetNextTurn;
  147 + property NextCycle : integer read GetNextCycle;
  148 + property NextCondition : integer read GetNextCondition;
  149 + property NextGeneration: string read GetPlayerToKick write SetPlayersQueue;
  150 + property State : TExperimentState read FState write SetState;
  151 + public
  152 + property OnEndTurn : TNotifyEvent read FOnEndTurn write SetOnEndTurn;
  153 + property OnEndCycle : TNotifyEvent read FOnEndCycle write SetOnEndCycle;
  154 + property OnEndGeneration : TNotifyEvent read FOnEndGeneration write SetOnEndGeneration;
  155 + property OnEndCondition : TNotifyEvent read FOnEndCondition write SetOnEndCondition;
  156 + property OnEndExperiment : TNotifyEvent read FOnEndExperiment write SetOnEndExperiment;
  157 + property OnConsequence : TNotifyEvent read FOnConsequence write SetOnConsequence;
  158 + property OnInterlocking : TNotifyEvent read FOnInterlocking write SetOnInterlocking;
  159 + end;
  160 +
  161 +resourcestring
  162 + WARN_CANNOT_SAVE = 'O experimento não pode ser salvo.';
  163 +
  164 +implementation
  165 +
  166 +uses game_file_methods, game_resources, string_methods;
  167 +
  168 +{ TExperiment }
  169 +
  170 +function TExperiment.GetCondition(I : Integer): TCondition;
  171 +begin
  172 + Result := FConditions[I];
  173 +end;
  174 +
  175 +function TExperiment.GetConditionsCount: integer;
  176 +begin
  177 + Result := Length(FConditions);
  178 +end;
  179 +
  180 +function TExperiment.GetContingenciesCount(C: integer): integer;
  181 +begin
  182 + Result := Length(FConditions[C].Contingencies);
  183 +end;
  184 +
  185 +function TExperiment.GetContingency(ACondition, I : integer): TContingency;
  186 +begin
  187 + Result := FConditions[ACondition].Contingencies[I];
  188 +end;
  189 +
  190 +function TExperiment.GetNextTurn: integer; // used during player arriving
  191 +begin
  192 + if FConditions[CurrentCondition].Turn.Random then
  193 + Result := StrToInt(FTurnsRandom.Names[FConditions[CurrentCondition].Turn.Count])
  194 + else
  195 + Result := FConditions[CurrentCondition].Turn.Count;
  196 +
  197 + if Assigned(FOnEndTurn) then FOnEndTurn(Self);
  198 +
  199 + if FConditions[CurrentCondition].Turn.Count < FConditions[CurrentCondition].Turn.Value-1 then
  200 + Inc(FConditions[CurrentCondition].Turn.Count)
  201 + else
  202 + begin
  203 + FConditions[CurrentCondition].Turn.Count := 0;
  204 + NextCycle;
  205 + end;
  206 +{$IFDEF DEBUG}
  207 + WriteLn('TExperiment.GetNextTurn:',Result);
  208 +{$ENDIF}
  209 +end;
  210 +
  211 +function TExperiment.GetNextTurnPlayerID: UTF8string; // used during cycles
  212 +begin
  213 + Result := Player[FConditions[CurrentCondition].Turn.Count].ID;
  214 +end;
  215 +
  216 +function TExperiment.GetNextCycle: integer;
  217 +begin
  218 + Result := FConditions[CurrentCondition].Cycles.Count;
  219 + WriteReportRow;
  220 + if Assigned(FOnEndCycle) then FOnEndCycle(Self);
  221 +
  222 + if FConditions[CurrentCondition].Cycles.Count < FConditions[CurrentCondition].Cycles.Value-1 then
  223 + Inc(FConditions[CurrentCondition].Cycles.Count)
  224 + else
  225 + begin
  226 + FConditions[CurrentCondition].Cycles.Count := 0;
  227 + if Assigned(FOnEndGeneration) then FOnEndGeneration(Self);
  228 + Inc(FConditions[CurrentCondition].Cycles.Generation);
  229 + NextCondition;
  230 + end;
  231 + {$IFDEF DEBUG}
  232 + WriteLn('TExperiment.GetNextCycle:',Result);
  233 + {$ENDIF}
  234 +end;
  235 +
  236 +function TExperiment.GetNextCondition: integer;
  237 +var
  238 + LInterlocks : integer;
  239 +
  240 + procedure EndCondition;
  241 + begin
  242 + if Assigned(FOnEndCondition) then FOnEndCondition(Self);
  243 + Inc(FCurrentCondition);
  244 + WriteReportRowNames;
  245 + end;
  246 +
  247 +begin
  248 + Result := CurrentCondition;
  249 +
  250 + // interlockings in the last x cycles
  251 + LInterlocks := InterlockingsIn[FConditions[CurrentCondition].EndCriterium.LastCycles];
  252 + case FConditions[CurrentCondition].EndCriterium.Value of
  253 + gecWhichComeFirst:
  254 + begin
  255 + if (GetCurrentAbsoluteCycle = FConditions[CurrentCondition].EndCriterium.AbsoluteCycles) or
  256 + (LInterlocks = FConditions[CurrentCondition].EndCriterium.InterlockingPorcentage) then
  257 + EndCondition;
  258 +
  259 + end;
  260 + gecAbsoluteCycles:
  261 + if GetCurrentAbsoluteCycle = FConditions[CurrentCondition].EndCriterium.AbsoluteCycles then
  262 + EndCondition;
  263 +
  264 + gecInterlockingPorcentage:
  265 + if LInterlocks = FConditions[CurrentCondition].EndCriterium.InterlockingPorcentage then
  266 + EndCondition;
  267 +
  268 + end;
  269 + {$IFDEF DEBUG}
  270 + WriteLn('TExperiment.GetNextCondition:',Result);
  271 + {$ENDIF}
  272 +end;
  273 +
  274 +function TExperiment.GetCurrentAbsoluteCycle: integer;
  275 +var c:integer;
  276 +begin
  277 + c := CurrentCondition;
  278 + Result := (Condition[c].Cycles.Value*Condition[c].Cycles.Generation)+Condition[c].Cycles.Count;
  279 +end;
  280 +
  281 +function TExperiment.GetPlayer(I : integer): TPlayer;
  282 +begin
  283 + Result := FPlayers[i];
  284 +end;
  285 +
  286 +function TExperiment.GetPlayer(AID: UTF8string): TPlayer;
  287 +var
  288 + i : integer;
  289 +begin
  290 + //Result.ID := '';
  291 + if PlayersCount > 0 then
  292 + for i:= 0 to PlayersCount -1 do
  293 + if FPlayers[i].ID = AID then
  294 + begin
  295 + Result := FPlayers[i];
  296 + Break;
  297 + end;
  298 +end;
  299 +
  300 +// fewer as possible data
  301 +function TExperiment.AliasPlayerAsString(P: TPlayer): UTF8string;
  302 +begin
  303 + Result:= GetPlayerAsString(P);
  304 +end;
  305 +
  306 +function TExperiment.AliasPlayerFromString(s: UTF8string): TPlayer;
  307 +begin
  308 + Result := GetPlayerFromString(S);
  309 +end;
  310 +
  311 +function TExperiment.GetPlayerIndexFromID(AID: UTF8string): integer;
  312 +var i : integer;
  313 +begin
  314 + Result := -1;
  315 + for i:= 0 to PlayersCount -1 do
  316 + if FPlayers[i].ID = AID then
  317 + begin
  318 + Result := i;
  319 + Break;
  320 + end;
  321 +end;
  322 +
  323 +function TExperiment.GetPlayerIsPlaying(AID: UTF8string): Boolean;
  324 +var i : integer;
  325 +begin
  326 + Result := PlayersCount > 0;
  327 + if Result then
  328 + for i := 0 to PlayersCount -1 do
  329 + if Player[i].ID = AID then
  330 + Exit;
  331 + Result:= False;
  332 +end;
  333 +
  334 +
  335 +function TExperiment.GetPlayersCount: integer;
  336 +begin
  337 + Result := Length(FPlayers);
  338 +end;
  339 +
  340 +function TExperiment.GetInterlockingsIn(ALastCycles: integer): integer;
  341 +var
  342 + S : TStringList;
  343 + LTargetMetaContingency : integer;
  344 +begin
  345 + S.LoadFromFile(FRegData.FileName);
  346 +
  347 +end;
  348 +
  349 +function TExperiment.GetConsequenceStringFromChoice(P: TPlayer): Utf8string;
  350 +var
  351 + i : integer;
  352 + c : integer;
  353 +begin
  354 + c := CurrentCondition;
  355 + PlayerFromID[P.ID] := P;
  356 + Result:= '';
  357 + for i :=0 to ContingenciesCount[c] -1 do
  358 + if not Contingency[c,i].Meta then
  359 + if Contingency[c,i].ResponseMeetsCriteriaI(P.Choice.Row,P.Choice.Color) then
  360 + Result += Contingency[c,i].Consequence.AsString(P.ID);
  361 +end;
  362 +
  363 +function TExperiment.GetConsequenceStringFromChoices: UTF8String;
  364 +var
  365 + i : integer;
  366 + c : integer;
  367 +begin
  368 + c := CurrentCondition;
  369 + Result:= '';
  370 + for i :=0 to ContingenciesCount[c] -1 do
  371 + if Contingency[c,i].Meta then
  372 + if Contingency[c,i].ResponseMeetsCriteriaG(FPlayers) then
  373 + Result += Contingency[c,i].Consequence.AsString(IntToStr(i));
  374 +end;
  375 +
  376 +procedure TExperiment.CheckNeedForRandomTurns;
  377 +var c ,
  378 + i,
  379 + r : integer;
  380 +begin
  381 + if Condition[CurrentCondition].Turn.Random then
  382 + begin
  383 + FTurnsRandom.Clear;
  384 + for i:= 0 to Condition[CurrentCondition].Turn.Value-1 do
  385 + FTurnsRandom.Add(IntToStr(i));
  386 +
  387 + c := FTurnsRandom.Count - 1;
  388 + for i := 0 to c do
  389 + begin
  390 + r := Random(c);
  391 + while r = i do r := Random(c);
  392 + FTurnsRandom.Exchange(r,i);
  393 + end;
  394 + end;
  395 +end;
  396 +
  397 +procedure TExperiment.SetCondition(I : Integer; AValue: TCondition);
  398 +begin
  399 + FConditions[I] := AValue;
  400 +end;
  401 +
  402 +procedure TExperiment.SetContingency(ACondition, I : integer; AValue: TContingency);
  403 +begin
  404 + FConditions[ACondition].Contingencies[I] := AValue;
  405 + if FConditions[ACondition].Contingencies[I].Meta then
  406 + FConditions[ACondition].Contingencies[I].OnCriteria:=@Interlocking
  407 + else
  408 + FConditions[ACondition].Contingencies[I].OnCriteria:=@Consequence;
  409 +end;
  410 +
  411 +procedure TExperiment.SetMatrixType(AValue: TGameMatrixType);
  412 +begin
  413 + if FMatrixType=AValue then Exit;
  414 + FMatrixType:=AValue;
  415 +end;
  416 +
  417 +procedure TExperiment.SetOnConsequence(AValue: TNotifyEvent);
  418 +begin
  419 + if FOnConsequence=AValue then Exit;
  420 + FOnConsequence:=AValue;
  421 +end;
  422 +
  423 +procedure TExperiment.SetOnEndCondition(AValue: TNotifyEvent);
  424 +begin
  425 + if FOnEndCondition=AValue then Exit;
  426 + FOnEndCondition:=AValue;
  427 +end;
  428 +
  429 +procedure TExperiment.SetOnEndCycle(AValue: TNotifyEvent);
  430 +begin
  431 + if FOnEndCycle=AValue then Exit;
  432 + FOnEndCycle:=AValue;
  433 +end;
  434 +
  435 +procedure TExperiment.SetOnEndExperiment(AValue: TNotifyEvent);
  436 +begin
  437 + if FOnEndExperiment=AValue then Exit;
  438 + FOnEndExperiment:=AValue;
  439 +end;
  440 +
  441 +procedure TExperiment.SetOnEndGeneration(AValue: TNotifyEvent);
  442 +begin
  443 + if FOnEndGeneration=AValue then Exit;
  444 + FOnEndGeneration:=AValue;
  445 +end;
  446 +
  447 +procedure TExperiment.SetOnEndTurn(AValue: TNotifyEvent);
  448 +begin
  449 + if FOnEndTurn=AValue then Exit;
  450 + FOnEndTurn:=AValue;
  451 +end;
  452 +
  453 +procedure TExperiment.SetOnInterlocking(AValue: TNotifyEvent);
  454 +begin
  455 + if FOnInterlocking=AValue then Exit;
  456 + FOnInterlocking:=AValue;
  457 +end;
  458 +
  459 +
  460 +procedure TExperiment.SetPlayer(I : integer; AValue: TPlayer);
  461 +begin
  462 + FPlayers[I] := AValue;
  463 +end;
  464 +
  465 +procedure TExperiment.SetPlayer(S: UTF8string; AValue: TPlayer);
  466 +var i : integer;
  467 +begin
  468 + if PlayersCount > 0 then
  469 + for i:= 0 to PlayersCount -1 do
  470 + if FPlayers[i].ID = S then
  471 + begin
  472 + FPlayers[i] := AValue;
  473 + Exit;
  474 + end;
  475 + raise Exception.Create('TExperiment.SetPlayer: Could not set player.');
  476 +end;
  477 +
  478 +procedure TExperiment.SetResearcherCanChat(AValue: Boolean);
  479 +begin
  480 + if FResearcherCanChat=AValue then Exit;
  481 + FResearcherCanChat:=AValue;
  482 +end;
  483 +
  484 +procedure TExperiment.SetResearcherCanPlay(AValue: Boolean);
  485 +begin
  486 + if FResearcherCanPlay=AValue then Exit;
  487 + FResearcherCanPlay:=AValue;
  488 +end;
  489 +
  490 +procedure TExperiment.SetSendChatHistoryForNewPlayers(AValue: Boolean);
  491 +begin
  492 + if FSendChatHistoryForNewPlayers=AValue then Exit;
  493 + FSendChatHistoryForNewPlayers:=AValue;
  494 +end;
  495 +
  496 +procedure TExperiment.SetState(AValue: TExperimentState);
  497 +begin
  498 + if FState=AValue then Exit;
  499 + FState:=AValue;
  500 +end;
  501 +
  502 +procedure TExperiment.Consequence(Sender: TObject);
  503 +begin
  504 + if Assigned(FOnConsequence) then FOnConsequence(Sender);
  505 +end;
  506 +
  507 +procedure TExperiment.Interlocking(Sender: TObject);
  508 +begin
  509 + if Assigned(FOnInterlocking) then FOnInterlocking(Sender);
  510 +end;
  511 +
  512 +procedure TExperiment.SetPlayersQueue(AValue: string);
  513 +var
  514 + i : integer;
  515 +begin
  516 + for i := 0 to PlayersCount-2 do
  517 + begin
  518 + FPlayers[i] := FPlayers[i+1];
  519 + end;
  520 + FPlayers[High(FPlayers)] := PlayerFromString[AValue];
  521 +end;
  522 +
  523 +function TExperiment.GetPlayerToKick: string;
  524 +var c : integer;
  525 +begin
  526 + c := CurrentCondition;
  527 + if Condition[c].Cycles.Count < Condition[c].Cycles.Value -1 then
  528 + Result := #32
  529 + else
  530 + Result := FPlayers[0].ID;
  531 +end;
  532 +
  533 +
  534 +procedure TExperiment.WriteReportHeader;
  535 +var
  536 + LHeader : string;
  537 +begin
  538 + // header
  539 + LHeader := VAL_RESEARCHER+':' + #9 + FResearcher + #9 + LineEnding +
  540 + VAL_EXPERIMENT+':' + #9 + FExperimentName + #9 + LineEnding +
  541 + VAL_BEGIN_TIME+':' + #9 + DateTimeToStr(Date) + #9 + TimeToStr(Time) +#9+ LineEnding + #9 + LineEnding;
  542 + FRegData.SaveData(LHeader);
  543 + WriteReportRowNames;
  544 +end;
  545 +
  546 +procedure TExperiment.WriteReportRowNames;
  547 +var
  548 + c,j,i: integer;
  549 + LNames : string;
  550 +begin
  551 + c:= CurrentCondition;
  552 +
  553 + // column names, line 1
  554 + LNames := 'Experimento'+#9+#9+#9;
  555 + for i:=0 to Condition[c].Turn.Value-1 do // player's response
  556 + begin
  557 + LNames += 'P'+IntToStr(i+1)+#9+#9;
  558 + for j:=0 to ContingenciesCount[c]-1 do
  559 + if not Contingency[c,j].Meta then
  560 + LNames += #9;
  561 + end;
  562 +
  563 + LNames += VAL_INTERLOCKING+'s';
  564 + for i:=0 to ContingenciesCount[c]-1 do
  565 + if Contingency[c,i].Meta then
  566 + LNames += #9;
  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;
  575 +
  576 + // column names, line 2
  577 + LNames += 'Condição'+#9+'Geração'+#9+'Ciclos'+#9;
  578 + for i:=0 to Condition[c].Turn.Value-1 do
  579 + begin
  580 + LNames += 'Linha'+#9+'Cor'+#9;
  581 + for j:=0 to ContingenciesCount[c]-1 do
  582 + if not Contingency[c,j].Meta then
  583 + LNames += Contingency[c,j].ContingencyName+#9;
  584 + end;
  585 +
  586 + for i:=0 to ContingenciesCount[c]-1 do
  587 + if Contingency[c,i].Meta then
  588 + LNames += Contingency[c,i].ContingencyName+#9;
  589 +
  590 + if Assigned(Condition[c].Prompt) then
  591 + for i:=0 to Condition[c].Turn.Value-1 do
  592 + LNames += 'R'+IntToStr(i+1)+#9;
  593 +
  594 + LNames += '|'+#9;
  595 + if FLastReportColNames <> LNames then
  596 + begin
  597 + FLastReportColNames := LNames;
  598 + FRegData.SaveData(LNames);
  599 + end;
  600 +end;
  601 +
  602 +procedure TExperiment.WriteReportRow;
  603 +var
  604 + c,j,i: integer;
  605 + LRow : string;
  606 +begin
  607 + c:= CurrentCondition;
  608 +
  609 + LRow := LineEnding + IntToStr(c+1)+#9+IntToStr(Condition[c].Cycles.Generation+1)+#9+IntToStr(GetCurrentAbsoluteCycle+1)+#9;
  610 + for i:=0 to Condition[c].Turn.Value-1 do
  611 + begin
  612 + LRow += GetRowString(FPlayers[i].Choice.Row)+#9+GetColorString(FPlayers[i].Choice.Color)+#9;
  613 + for j:=0 to ContingenciesCount[c]-1 do
  614 + if not Contingency[c,j].Meta then
  615 + if Contingency[c,j].ConsequenceFromPlayerID(FPlayers[i].ID) <> '' then
  616 + LRow += '1'+#9
  617 + else
  618 + LRow += '0'+#9;
  619 + end;
  620 +
  621 + for i:=0 to ContingenciesCount[c]-1 do
  622 + if Contingency[c,i].Meta then
  623 + if Contingency[c,i].Fired then
  624 + LRow += '1'+#9
  625 + else
  626 + LRow += '0'+#9;
  627 +
  628 + FRegData.SaveData(LRow);
  629 +end;
  630 +
  631 +procedure TExperiment.WriteReportRowPrompt;
  632 +var
  633 + c,i: integer;
  634 + LRow : string;
  635 +begin
  636 + c := CurrentCondition;
  637 + LRow := '';
  638 + if Condition[c].Prompt.ResponsesCount = Condition[c].Turn.Value then
  639 + for i:=0 to Condition[c].Prompt.ResponsesCount-1 do
  640 + LRow += 'P'+IntToStr(PlayerIndexFromID[Delimited(1,Condition[c].Prompt.Response(i))]+1)+
  641 + '|'+
  642 + Delimited(2,Condition[c].Prompt.Response(i))+#9
  643 + else
  644 + for i:=0 to Condition[c].Turn.Value-1 do
  645 + LRow += 'NA'+#9;
  646 +
  647 + FRegData.SaveData(LRow);
  648 +end;
  649 +
  650 +constructor TExperiment.Create(AOwner: TComponent);
  651 +begin
  652 + inherited Create(AOwner);
  653 + FTurnsRandom := TStringList.Create;
  654 + LoadExperimentFromResource(Self);
  655 + CheckNeedForRandomTurns;
  656 +end;
  657 +
  658 +constructor TExperiment.Create(AOwner: TComponent;AppPath:string);
  659 +begin
  660 + inherited Create(AOwner);
  661 + FTurnsRandom := TStringList.Create;
  662 + LoadExperimentFromResource(Self);
  663 + CheckNeedForRandomTurns;
  664 + FRegData := TRegData.Create(Self, AppPath+VAL_RESEARCHER+'es'+PathDelim+Researcher+PathDelim+ExperimentName+PathDelim+'000.dat');
  665 + WriteReportHeader;
  666 +end;
  667 +
  668 +constructor TExperiment.Create(AOwner:TComponent;AFilename,AppPath:string);
  669 +begin
  670 + inherited Create(AOwner);
  671 + FTurnsRandom := TStringList.Create;
  672 + LoadExperimentFromFile(Self,AFilename);
  673 + CheckNeedForRandomTurns;
  674 +end;
  675 +
  676 +destructor TExperiment.Destroy;
  677 +begin
  678 + FTurnsRandom.Free;
  679 + inherited Destroy;
  680 +end;
  681 +
  682 +function TExperiment.LoadFromFile(AFilename: string): Boolean;
  683 +begin
  684 + Result := LoadExperimentFromFile(Self, AFilename);
  685 + if Result then
  686 + FFilename := AFilename;
  687 + CheckNeedForRandomTurns;
  688 +end;
  689 +
  690 +function TExperiment.LoadFromGenerator: Boolean;
  691 +begin
  692 + Result := LoadExperimentFromResource(Self);
  693 + if Result then
  694 + FFilename := GetCurrentDir + PathDelim + FResearcher + PathDelim;
  695 + CheckNeedForRandomTurns;
  696 +end;
  697 +
  698 +function TExperiment.AppendCondition: integer;
  699 +begin
  700 + SetLength(FConditions, Length(FConditions)+1);
  701 + Result := High(FConditions);
  702 +end;
  703 +
  704 +function TExperiment.AppendCondition(ACondition: TCondition): integer;
  705 +begin
  706 + SetLength(FConditions, Length(FConditions)+1);
  707 + Result := High(FConditions);
  708 + FConditions[Result] := ACondition;
  709 +end;
  710 +
  711 +function TExperiment.AppendContingency(ACondition: integer): integer;
  712 +begin
  713 + SetLength(FConditions[ACondition].Contingencies, Length(FConditions[ACondition].Contingencies)+1);
  714 + Result := High(FConditions[ACondition].Contingencies);
  715 +end;
  716 +
  717 +function TExperiment.AppendContingency(ACondition: integer;
  718 + AContingency: TContingency): integer;
  719 +begin
  720 + SetLength(FConditions[ACondition].Contingencies, Length(FConditions[ACondition].Contingencies)+1);
  721 + Result := High(FConditions[ACondition].Contingencies);
  722 + FConditions[ACondition].Contingencies[Result] := AContingency;
  723 +end;
  724 +
  725 +function TExperiment.AppendPlayer: integer;
  726 +begin
  727 + SetLength(FPlayers, Length(FPlayers)+1);
  728 + Result := High(FPlayers);
  729 +end;
  730 +
  731 +function TExperiment.AppendPlayer(APlayer: TPlayer): integer;
  732 +begin
  733 + SetLength(FPlayers, Length(FPlayers)+1);
  734 + Result := High(FPlayers);
  735 + FPlayers[Result] := APlayer;
  736 +end;
  737 +
  738 +procedure TExperiment.SaveToFile(AFilename: string);
  739 +begin
  740 + SaveExperimentToFile(Self,AFilename);
  741 +end;
  742 +
  743 +procedure TExperiment.SaveToFile;
  744 +begin
  745 + if FFilename <> '' then
  746 + SaveExperimentToFile(Self,FFilename)
  747 + else
  748 +{$IFDEF DEBUG}
  749 + WriteLn(WARN_CANNOT_SAVE)
  750 +{$ENDIF};
  751 +end;
  752 +
  753 +procedure TExperiment.Clean;
  754 +var c,i : integer;
  755 +begin
  756 + for i := 0 to PlayersCount -1 do
  757 + begin
  758 + FPlayers[i].Choice.Row:=grNone;
  759 + FPlayers[i].Choice.Color:=gcNone;
  760 + end;
  761 + c := CurrentCondition;
  762 + for i := 0 to ContingenciesCount[c]-1 do
  763 + Contingency[c,i].Clean;
  764 +
  765 + Condition[c].Prompt.Clean;
  766 +
  767 + FRegData.CloseAndOpen;
  768 +end;
  769 +
  770 +procedure TExperiment.Play;
  771 +var i : integer;
  772 +begin
  773 + //for i := 0 to Condition[CurrentCondition].Turn.Value-1 do
  774 + // begin
  775 + // //TRegData.Save Header;
  776 + // end;
  777 + FState:=xsRunning;
  778 +end;
  779 +
  780 +
  781 +end.
  782 +
... ...
units/backup/report_reader.pas 0 → 100644
  Diff comments   View file @f8cf50c
... ... @@ -0,0 +1,124 @@
  1 +unit report_reader;
  2 +
  3 +{$mode objfpc}{$H+}
  4 +
  5 +interface
  6 +
  7 +uses
  8 + Classes, SysUtils;
  9 +
  10 +type
  11 +
  12 + TRowRange = record
  13 + Low,
  14 + High : integer;
  15 + end;
  16 +
  17 + { TReportReader }
  18 +
  19 + TReportReader = class
  20 + private
  21 + FLastRowsX : integer;
  22 + FRows : TStringList;
  23 + FCols : TStringList;
  24 + FRowRange: TRowRange;
  25 + FUseRange: Boolean;
  26 + function GetColumnOf(AName: string): TStringList;
  27 + procedure RangeAsLastXRows;
  28 + public
  29 + VRow : string; //helper
  30 + constructor Create;
  31 + destructor Destroy; override;
  32 + procedure Append(ARow : string);
  33 + procedure Extend(ARowExtention : string);
  34 + procedure Clean;
  35 + procedure SetXLastRows(X:integer);
  36 + property Range : TRowRange read FRowRange;
  37 + property UseRange : Boolean read FUseRange write FUseRange;
  38 + property ColumnOf[AName:string]:TStringList read GetColumnOf;
  39 + end;
  40 +
  41 +implementation
  42 +
  43 +uses strutils;
  44 +
  45 +{ TReportReader }
  46 +
  47 +function TReportReader.GetColumnOf(AName: string): TStringList;
  48 +var
  49 + c,
  50 + i : integer;
  51 + Row : string;
  52 +begin
  53 + Result := TStringList.Create;
  54 + c := FCols.IndexOf(AName);
  55 + if c > -1 then
  56 + if FUseRange and (FRowRange.Low <= FRowRange.High) and (FRowRange.Low > 0) then
  57 + for i := FRowRange.Low to FRowRange.High do
  58 + Result.Append(ExtractDelimited(c+1, FRows[i],[#9,#10]))
  59 + else
  60 + for Row in FRows do
  61 + Result.Append(ExtractDelimited(c+1, Row,[#9,#10]));
  62 +end;
  63 +
  64 +constructor TReportReader.Create;
  65 +begin
  66 + inherited Create;
  67 + FUseRange := False;
  68 + FRows := TStringList.Create;
  69 + FCols := TStringList.Create;
  70 + FCols.Delimiter := #9;
  71 + FCols.StrictDelimiter := True;
  72 +end;
  73 +
  74 +destructor TReportReader.Destroy;
  75 +begin
  76 + FRows.Free;
  77 + FCols.Free;
  78 + inherited Destroy;
  79 +end;
  80 +
  81 +procedure TReportReader.Append(ARow: string);
  82 +begin
  83 + if FCols.Count = 0 then
  84 + FCols.DelimitedText := ARow
  85 + else
  86 + begin
  87 + FRows.Append(ARow);
  88 + RangeAsLastXRows;
  89 + end;
  90 +end;
  91 +
  92 +procedure TReportReader.Extend(ARowExtention: string);
  93 +begin
  94 + FRows[FRows.Count-1] := FRows[FRows.Count-1] + ARowExtention;
  95 +end;
  96 +
  97 +procedure TReportReader.Clean;
  98 +begin
  99 + FCols.Clear;
  100 + FRows.Clear;
  101 +end;
  102 +
  103 +procedure TReportReader.SetXLastRows(X: integer);
  104 +begin
  105 + FLastRowsX:=X;
  106 + RangeAsLastXRows;
  107 +end;
  108 +
  109 +procedure TReportReader.RangeAsLastXRows;
  110 +begin
  111 + FRowRange.High := FRows.Count-1;
  112 + FRowRange.Low := FRows.Count-FLastRowsX;
  113 + {$IFDEF DEBUG}
  114 + if FRowRange.Low > FRowRange.High then
  115 + WriteLn('Warning: FRowRange.Low > FRowRange.High, range will not be used');
  116 +
  117 + if FRowRange.Low < 0 then
  118 + WriteLn('Warning: FRowRange.Low < 0, range will not be used');
  119 + {$ENDIF}
  120 +end;
  121 +
  122 +
  123 +end.
  124 +
... ...
units/game_actors.pas
  Diff comments   View file @f8cf50c
... ... @@ -171,7 +171,7 @@ type
171 171 end;
172 172  
173 173 TEndConditionCriterium = record
174   - Value : TGameEndCondition;
  174 + Style : TGameEndCondition;
175 175 InterlockingPorcentage,
176 176 LastCycles,
177 177 AbsoluteCycles: integer;
... ...
units/game_control.pas
  Diff comments   View file @f8cf50c
... ... @@ -81,6 +81,7 @@ type
81 81 procedure Start;
82 82 procedure Pause;
83 83 procedure Resume;
  84 + procedure Stop;
84 85 property Experiment : TExperiment read FExperiment write FExperiment;
85 86 property ID : UTF8string read FID;
86 87 property RowBase : integer read FRowBase write SetRowBase;
... ... @@ -90,28 +91,28 @@ type
90 91  
91 92 function GetRowColor(ARow : integer;ARowBase:integer) : TColor;
92 93  
93   -// TODO: PUT MESSAGES IN RESOURCE STRING
  94 +// TODO: PUT NORMAL STRING MESSAGES IN RESOURCESTRING INSTEAD
94 95  
95 96 const
96   - K_FULLROOM = '.Full';
97   - K_PLAYING = '.Playing';
98 97 K_ARRIVED = '.Arrived';
99   - K_REFUSED = '.Refused';
100 98 K_CHAT_M = '.ChatM';
101 99 K_CHOICE = '.Choice';
102 100 K_MESSAGE = '.Message';
103 101 K_START = '.Start';
104 102 K_RESUME = '.Resume';
105   - K_DATA_A = '.Data';
106 103 K_LOGIN = '.Login';
107 104 K_QUESTION = '.Question';
108 105 K_QMESSAGE = '.QMessage';
109 106 K_MOVQUEUE = '.Queue';
  107 + K_END = '.EndX';
  108 +
110 109 //
111 110 K_STATUS = '.Status';
112 111 K_LEFT = '.Left';
113 112 K_WAIT = '.Wait';
114   - //K_RESPONSE =
  113 + K_FULLROOM = '.Full';
  114 + K_PLAYING = '.Playing';
  115 + K_REFUSED = '.Refused';
115 116  
116 117 implementation
117 118  
... ... @@ -211,7 +212,7 @@ end;
211 212  
212 213 procedure TGameControl.EndExperiment(Sender: TObject);
213 214 begin
214   -
  215 + FZMQActor.SendMessage([K_END]);
215 216 end;
216 217  
217 218 procedure TGameControl.StartExperiment;
... ... @@ -224,23 +225,54 @@ begin
224 225  
225 226 // enable matrix grid for the first player
226 227 FZMQActor.SendMessage([K_START]);
  228 +
  229 + //
  230 + Start;
227 231 end;
228 232  
229 233 procedure TGameControl.Start;
230 234 begin
231   - // basic data/csv setup
232   - // wait for players
  235 + // basic gui setup
  236 +
  237 + // points
  238 + FormMatrixGame.GBIndividualAB.Visible := FExperiment.ABPoints;
  239 + FormMatrixGame.GBIndividual.Visible:= not FormMatrixGame.GBIndividualAB.Visible;
  240 +
  241 + // turns
  242 + FormMatrixGame.LabelExpCountTurn.Caption:=IntToStr(FExperiment.Condition[FExperiment.CurrentCondition].Turn.Count+1);
  243 +
  244 + // cycle
  245 + FormMatrixGame.LabelExpCountCycle.Caption:=IntToStr(FExperiment.Condition[FExperiment.CurrentCondition].Cycles.Count+1);
233 246  
  247 + // generation
  248 + FormMatrixGame.LabelExpCountGeneration.Caption:=IntToStr(FExperiment.Condition[FExperiment.CurrentCondition].Cycles.Generation+1);
  249 +
  250 + // condition
  251 + FormMatrixGame.LabelExpCountCondition.Caption:= FExperiment.Condition[FExperiment.CurrentCondition].ConditionName;
  252 +
  253 + // interlocks
  254 + FormMatrixGame.LabelExpCountInterlocks.Caption:= IntToStr(FExperiment.Condition[FExperiment.CurrentCondition].Interlocks.Count+1);
  255 +
  256 + // wait for players
234 257 end;
235 258  
236 259 procedure TGameControl.Pause;
237 260 begin
  261 + // save to file
238 262  
  263 + // inform players
239 264 end;
240 265  
241 266 procedure TGameControl.Resume;
242 267 begin
  268 + // load from file
243 269  
  270 + // wait for players
  271 +end;
  272 +
  273 +procedure TGameControl.Stop;
  274 +begin
  275 + // cleaning
244 276 end;
245 277  
246 278 function TGameControl.GetPlayerBox(AID: UTF8string): TPlayerBox;
... ... @@ -486,8 +518,8 @@ end;
486 518  
487 519 constructor TGameControl.Create(AOwner: TComponent;AppPath:string);
488 520 begin
  521 + inherited Create(AOwner);
489 522 FZMQActor := TZMQActor(AOwner);
490   - inherited Create(FZMQActor.Owner);
491 523 FID := FZMQActor.ID;
492 524 FZMQActor.OnMessageReceived:=@ReceiveMessage;
493 525 FZMQActor.OnRequestReceived:=@ReceiveRequest;
... ... @@ -518,14 +550,7 @@ begin
518 550 FExperiment.OnInterlocking:=@Interlocking;
519 551 FExperiment.OnConsequence:=@Consequence;
520 552  
521   - //NextTurn(Self);
522   - //NextCycle(Self);
523   - //NextLineage(Self);
524   - //NextCondition(Self);
525   - //Interlocking(Self);
526   - //Consequence(Self);
527   -
528   - SendRequest(K_LOGIN);
  553 + SendRequest(K_LOGIN); // admin cannot send requests
529 554 end;
530 555  
531 556 destructor TGameControl.Destroy;
... ... @@ -751,20 +776,33 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
751 776 end;
752 777  
753 778 procedure SayGoodBye(AID:string);
  779 + var Pts : string;
754 780 begin
755 781 DeletePlayerBox(AID); // old player
756 782 case FActor of
757 783 gaPlayer:begin
758 784 if Self.ID = AID then
759 785 begin
760   - // TODO: SHOW EARNED POINTS TO PARTICIPANT
761   - //FormMatrixGame.LabelIndA.Caption;
762   - //FormMatrixGame.LabelIndB.Caption;
763   - //FormMatrixGame.LabelIndG.Caption;
  786 + if FExperiment.ABPoints then
  787 + begin
  788 + Pts := IntToStr(StrToInt(FormMatrixGame.LabelIndACount.Caption)+StrToInt(FormMatrixGame.LabelIndBCount.Caption));
  789 + FormMatrixGame.LabelIndACount.Caption := '0';
  790 + FormMatrixGame.LabelIndBCount.Caption := '0';
  791 + end
  792 + else
  793 + begin
  794 + Pts := FormMatrixGame.LabelIndCount.Caption;
  795 + FormMatrixGame.LabelIndCount.Caption := '0';
  796 + end;
764 797  
765 798 FormMatrixGame.Visible := False;
766 799 FormChooseActor := TFormChooseActor.Create(nil);
767 800 FormChooseActor.Style := K_LEFT;
  801 + FormChooseActor.ShowPoints(
  802 + 'A tarefa terminou, obrigado por sua participação! Você produziu ' +
  803 + Pts + ' pontos e ' +
  804 + FormMatrixGame.LabelGroupCount.Caption + ' itens escolares serão doados!');
  805 +
768 806 if FormChooseActor.ShowModal = 1 then
769 807 begin
770 808 FZMQActor.Request([AID,' ',K_RESUME]);
... ... @@ -774,22 +812,33 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
774 812 FormChooseActor.Free;
775 813 end
776 814 else
777   - ShowPopUp('O jogador '+FExperiment.PlayerFromID[ID].Nicname+ ' saiu. Por favor, aguarde...');
  815 + ShowPopUp(FExperiment.PlayerFromID[AID].Nicname+ ' saiu. Por favor, aguarde a chegada de alguém para ocupar o lugar.');
778 816 end;
779   -
780   - gaAdmin:ShowPopUp(
781   - 'O participante '+
782   - FExperiment.PlayerFromID[ID].Nicname+
783   - ' saiu. Aguardando a entrada do próximo participante.'
784   - );
785 817 end;
786 818 end;
  819 +
787 820 procedure ResumeNextTurn;
788 821 begin
789   - if AMessage[1] <> #32 then
790   - SayGoodBye(AMessage[1])
791   - else
792   - EnablePlayerMatrix(Self.ID,0, True);
  822 + case FActor of
  823 + gaPlayer:begin
  824 + if AMessage[1] <> #32 then
  825 + SayGoodBye(AMessage[1])
  826 + else
  827 + EnablePlayerMatrix(Self.ID,0, True);
  828 +
  829 + end;
  830 + gaAdmin:begin
  831 + if AMessage[1] <> #32 then
  832 + begin
  833 + DeletePlayerBox(AMessage[1]); // old player
  834 + ShowPopUp(
  835 + 'O participante '+
  836 + FExperiment.PlayerFromID[AMessage[1]].Nicname+
  837 + ' saiu. Aguardando a entrada do próximo participante.'
  838 + );
  839 + end;
  840 + end;
  841 + end;
793 842 end;
794 843  
795 844 procedure QuestionMessages;
... ... @@ -816,6 +865,34 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
816 865 ResumeNextTurn;
817 866 end;
818 867  
  868 + procedure ShowPointsToPlayers;
  869 + var Pts : string;
  870 + begin
  871 + case FActor of
  872 + gaPlayer:
  873 + begin
  874 + CleanMatrix(False);
  875 + FormChooseActor := TFormChooseActor.Create(FormMatrixGame);
  876 + FormChooseActor.Style := K_END;
  877 +
  878 + if FExperiment.ABPoints then
  879 + Pts := IntToStr(StrToInt(FormMatrixGame.LabelIndACount.Caption)+StrToInt(FormMatrixGame.LabelIndBCount.Caption))
  880 + else
  881 + Pts := FormMatrixGame.LabelIndCount.Caption;
  882 +
  883 + FormChooseActor.ShowPoints(
  884 + 'A tarefa terminou, obrigado por sua participação! Você produziu ' +
  885 + Pts + ' pontos e ' +
  886 + FormMatrixGame.LabelGroupCount.Caption + 'itens escolares serão doados!');
  887 + FormChooseActor.Show;
  888 + end;
  889 + gaAdmin:
  890 + begin
  891 + Stop;
  892 + end;
  893 + end;
  894 + end;
  895 +
819 896 begin
820 897 if MHas(K_ARRIVED) then ReceiveActor;
821 898 if MHas(K_CHAT_M) then ReceiveChat;
... ... @@ -826,6 +903,7 @@ begin
826 903 if MHas(K_MOVQUEUE) then MovePlayerQueue;
827 904 if MHas(K_QMESSAGE) then QuestionMessages;
828 905 if MHas(K_RESUME) then ResumeNextTurn;
  906 + if MHAs(K_END) then ShowPointsToPlayers;
829 907 end;
830 908  
831 909 // Here FActor is garanted to be a TZMQAdmin
... ... @@ -887,15 +965,18 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList);
887 965 if FExperiment.Player[i].ID <> P.ID then
888 966 begin
889 967 TS := FExperiment.PlayerAsString[FEXperiment.Player[i]];
890   - ARequest.Append(TS); // FROM 3 to COUNT-2
  968 + ARequest.Append(TS); // FROM 3 to COUNT-3
891 969 end;
892 970  
893 971 // append chat data if allowed at the last position
894 972 if FExperiment.SendChatHistoryForNewPlayers then
895   - ARequest.Append(FormMatrixGame.ChatMemoRecv.Lines.Text) // LAST
  973 + ARequest.Append(FormMatrixGame.ChatMemoRecv.Lines.Text) // COUNT-2
896 974 else
897 975 ARequest.Append('[CHAT]'); // must append something to keep the message envelop standard
898 976  
  977 + // append global configs.
  978 + ARequest.Append(BoolToStr(FExperiment.ABPoints)); // COUNT-1
  979 +
899 980 // inform all players about the new player, including itself
900 981 FZMQActor.SendMessage([K_ARRIVED,PS]);
901 982  
... ... @@ -962,7 +1043,7 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList);
962 1043 FExperiment.WriteReportRowPrompt;
963 1044 FExperiment.Clean;
964 1045 end;
965   - ARequest.Append(FExperiment.NextGeneration); // #32 no, else NextGeneration = PlayerToKick
  1046 + ARequest.Append(FExperiment.NextGeneration); // 9, #32 no, else NextGeneration = PlayerToKick
966 1047 end;
967 1048 end;
968 1049  
... ... @@ -1032,8 +1113,8 @@ begin
1032 1113 if MHas(K_QUESTION) then ValidateQuestionResponse;
1033 1114 end;
1034 1115  
1035   -// Here FActor is garanted to be a TZMQPlayer, reply by:
1036   -// - sending private data to player player
  1116 +// Here FActor is garanted to be a TZMQPlayer, replying by:
  1117 +// - sending private data to player
1037 1118 // - sending data from early history to income players
1038 1119 procedure TGameControl.ReceiveReply(AReply: TStringList);
1039 1120 function MHas(const C : UTF8string) : Boolean;
... ... @@ -1048,7 +1129,7 @@ procedure TGameControl.ReceiveReply(AReply: TStringList);
1048 1129 begin
1049 1130 if Self.ID = AReply[0] then
1050 1131 begin
1051   - for i:= 3 to AReply.Count -2 do
  1132 + for i:= 3 to AReply.Count -3 do
1052 1133 begin
1053 1134 P := FExperiment.PlayerFromString[AReply[i]];
1054 1135 FExperiment.AppendPlayer(P);
... ... @@ -1057,7 +1138,11 @@ procedure TGameControl.ReceiveReply(AReply: TStringList);
1057 1138  
1058 1139 // add chat
1059 1140 FormMatrixGame.ChatMemoRecv.Lines.Clear;
1060   - FormMatrixGame.ChatMemoRecv.Lines.Add(AReply[AReply.Count-1]);
  1141 + FormMatrixGame.ChatMemoRecv.Lines.Add(AReply[AReply.Count-2]);
  1142 +
  1143 + // set global configs
  1144 + FormMatrixGame.GBIndividualAB.Visible := StrToBool(AReply[AReply.Count-1]);
  1145 + FormMatrixGame.GBIndividual.Visible:= not FormMatrixGame.GBIndividualAB.Visible;
1061 1146 end
1062 1147 else
1063 1148 begin
... ...
units/game_experiment.pas
  Diff comments   View file @f8cf50c
... ... @@ -68,6 +68,7 @@ type
68 68 function GetConsequenceStringFromChoice(P:TPlayer): Utf8string;
69 69 function GetConsequenceStringFromChoices:UTF8String;
70 70 procedure CheckNeedForRandomTurns;
  71 + procedure EndExperiment;
71 72 procedure SetCondition(I : Integer; AValue: TCondition);
72 73 procedure SetContingency(ACondition, I : integer; AValue: TContingency);
73 74 procedure SetMatrixType(AValue: TGameMatrixType);
... ... @@ -85,6 +86,7 @@ type
85 86 procedure SetSendChatHistoryForNewPlayers(AValue: Boolean);
86 87 procedure SetState(AValue: TExperimentState);
87 88 private
  89 + FABPoints: Boolean;
88 90 FChangeGeneration: string;
89 91 FOnConsequence: TNotifyEvent;
90 92 FOnInterlocking: TNotifyEvent;
... ... @@ -114,6 +116,7 @@ type
114 116 procedure WriteReportRowPrompt;
115 117 property ExperimentAim : string read FExperimentAim write FExperimentAim;
116 118 property ExperimentName : string read FExperimentName write FExperimentName;
  119 + property ABPoints : Boolean read FABPoints write FABPoints;
117 120 property GenPlayersAsNeeded : Boolean read FGenPlayersAsNeeded write FGenPlayersAsNeeded;
118 121 property ResearcherCanPlay : Boolean read FResearcherCanPlay write SetResearcherCanPlay;
119 122 property ResearcherCanChat : Boolean read FResearcherCanChat write SetResearcherCanChat;
... ... @@ -243,6 +246,11 @@ var
243 246 begin
244 247 if Assigned(FOnEndCondition) then FOnEndCondition(Self);
245 248 Inc(FCurrentCondition);
  249 + if FCurrentCondition = ConditionsCount-1 then
  250 + begin
  251 + EndExperiment;
  252 + Exit;
  253 + end;
246 254 FReportReader.Clean;
247 255 FReportReader.SetXLastRows(Condition[CurrentCondition].EndCriterium.LastCycles);
248 256 WriteReportRowNames;
... ... @@ -253,11 +261,11 @@ begin
253 261  
254 262 // interlockings in the last x cycles
255 263 LInterlocks := InterlockingsInLastCycles;
256   - case FConditions[CurrentCondition].EndCriterium.Value of
  264 + case FConditions[CurrentCondition].EndCriterium.Style of
257 265 gecWhichComeFirst:
258 266 begin
259 267 if (GetCurrentAbsoluteCycle = FConditions[CurrentCondition].EndCriterium.AbsoluteCycles) or
260   - (LInterlocks = FConditions[CurrentCondition].EndCriterium.InterlockingPorcentage) then
  268 + (LInterlocks >= FConditions[CurrentCondition].EndCriterium.InterlockingPorcentage) then
261 269 EndCondition;
262 270  
263 271 end;
... ... @@ -266,7 +274,7 @@ begin
266 274 EndCondition;
267 275  
268 276 gecInterlockingPorcentage:
269   - if LInterlocks = FConditions[CurrentCondition].EndCriterium.InterlockingPorcentage then
  277 + if LInterlocks >= FConditions[CurrentCondition].EndCriterium.InterlockingPorcentage then
270 278 EndCondition;
271 279  
272 280 end;
... ... @@ -424,6 +432,11 @@ begin
424 432 end;
425 433 end;
426 434  
  435 +procedure TExperiment.EndExperiment;
  436 +begin
  437 + if Assigned(FOnEndExperiment) then FOnEndExperiment(Self);
  438 +end;
  439 +
427 440 procedure TExperiment.SetCondition(I : Integer; AValue: TCondition);
428 441 begin
429 442 FConditions[I] := AValue;
... ... @@ -628,7 +641,6 @@ begin
628 641 for i:=0 to Condition[c].Turn.Value-1 do
629 642 LNames += 'R'+IntToStr(i+1)+#9;
630 643  
631   - LNames += '|'+#9;
632 644 if FLastReportColNames <> LNames then
633 645 begin
634 646 FLastReportColNames := LNames;
... ... @@ -667,6 +679,7 @@ begin
667 679 LRow += '0'+#9;
668 680  
669 681 FRegData.SaveData(LRow);
  682 + FReportReader.Append(LRow);
670 683 end;
671 684 end;
672 685  
... ... @@ -689,6 +702,7 @@ begin
689 702 LRow += 'NA'+#9;
690 703  
691 704 FRegData.SaveData(LRow);
  705 + FReportReader.Extend(LRow);
692 706 end;
693 707 end;
694 708  
... ...
units/game_file_methods.pas
  Diff comments   View file @f8cf50c
... ... @@ -81,7 +81,7 @@ begin
81 81 GenPlayersAsNeeded:=True;
82 82 CurrentCondition := 0;
83 83 MatrixType:=[gmRows];
84   -
  84 + ABPoints := True;
85 85 //AppendPlayer(C_PLAYER_TEMPLATE);
86 86 //AppendPlayer(C_PLAYER_TEMPLATE);
87 87  
... ... @@ -95,6 +95,11 @@ begin
95 95 Cycles.Count:=0;
96 96 Cycles.Value:=4;
97 97 Cycles.Generation:=0;
  98 + EndCriterium.AbsoluteCycles := 20;
  99 + EndCriterium.InterlockingPorcentage := 80;
  100 + EndCriterium.LastCycles := 10;
  101 + EndCriterium.Style := gecWhichComeFirst;
  102 +
98 103 SetLength(Contingencies, 4);
99 104 LConcequence := TConsequence.Create(AExperiment,1,[gscPoints, gscB, gscMessage,gscBroadcastMessage],['$NICNAME','queijo','queijos']);
100 105 Contingencies[0] := TContingency.Create(AExperiment,LConcequence,LCriteria1,False);
... ...
units/game_resources.pas
  Diff comments   View file @f8cf50c
... ... @@ -240,7 +240,7 @@ const
240 240  
241 241 Prompt : nil;
242 242 EndCriterium : (
243   - Value : gecWhichComeFirst;
  243 + Style : gecWhichComeFirst;
244 244 InterlockingPorcentage : 50;
245 245 LastCycles : 4;
246 246 AbsoluteCycles: 6;
... ...
units/game_zmq_actors.pas
  Diff comments   View file @f8cf50c
... ... @@ -11,6 +11,8 @@ unit game_zmq_actors;
11 11  
12 12 {$mode objfpc}{$H+}
13 13  
  14 +{$DEFINE DEBUG}
  15 +
14 16 interface
15 17  
16 18 uses
... ...
units/report_reader.pas
  Diff comments   View file @f8cf50c
  1 +{
  2 + Stimulus Control
  3 + Copyright (C) 2014-2016 Carlos Rafael Fernandes Picanço, Universidade Federal do Pará.
  4 +
  5 + The present file is distributed under the terms of the GNU General Public License (GPL v3.0).
  6 +
  7 + You should have received a copy of the GNU General Public License
  8 + along with this program. If not, see <http://www.gnu.org/licenses/>.
  9 +}
1 10 unit report_reader;
2 11  
3 12 {$mode objfpc}{$H+}
... ... @@ -26,9 +35,11 @@ type
26 35 function GetColumnOf(AName: string): TStringList;
27 36 procedure RangeAsLastXRows;
28 37 public
  38 + VRow : string; //helper
29 39 constructor Create;
30 40 destructor Destroy; override;
31 41 procedure Append(ARow : string);
  42 + procedure Extend(ARowExtention : string);
32 43 procedure Clean;
33 44 procedure SetXLastRows(X:integer);
34 45 property Range : TRowRange read FRowRange;
... ... @@ -87,6 +98,11 @@ begin
87 98 end;
88 99 end;
89 100  
  101 +procedure TReportReader.Extend(ARowExtention: string);
  102 +begin
  103 + FRows[FRows.Count-1] := FRows[FRows.Count-1] + ARowExtention;
  104 +end;
  105 +
90 106 procedure TReportReader.Clean;
91 107 begin
92 108 FCols.Clear;
... ...
units/string_methods.pas
  Diff comments   View file @f8cf50c
... ... @@ -67,9 +67,9 @@ uses strutils;
67 67 function GetEndCriteriaFromString(S:string) : TEndConditionCriterium;
68 68 begin
69 69 case StrToIntDef(ExtractDelimited(1,S,[',']),2) of
70   - 0: Result.Value := gecAbsoluteCycles;
71   - 1: Result.Value := gecInterlockingPorcentage;
72   - 2: Result.Value := gecWhichComeFirst;
  70 + 0: Result.Style := gecAbsoluteCycles;
  71 + 1: Result.Style := gecInterlockingPorcentage;
  72 + 2: Result.Style := gecWhichComeFirst;
73 73 end;
74 74 Result.AbsoluteCycles := StrToIntDef(ExtractDelimited(2,S,[',']), 20);
75 75 Result.InterlockingPorcentage := StrToIntDef(ExtractDelimited(3,S,[',']),10);
... ... @@ -367,7 +367,7 @@ function GetEndCriteriaString(AEndCriterium: TEndConditionCriterium
367 367 ): string;
368 368 begin
369 369 // 2,20,10,10,
370   - case AEndCriterium.Value of
  370 + case AEndCriterium.Style of
371 371 gecAbsoluteCycles: Result := '0';
372 372 gecInterlockingPorcentage: Result := '1';
373 373 gecWhichComeFirst: Result := '2';
... ...