Download as
Browse Code »

Commit 21d230654ef80ebc21dff540e00145a52a1d8a72

Authored by Carlos Picanco
1 parent f8cf50c5
Exists in master

add feedback of player points for admin and implement time interval between messages

Showing 2 changed files with 211 additions and 41 deletions   Show diff stats
units/game_control.pas
  Diff comments   View file @21d2306
... ... @@ -40,7 +40,7 @@ type
40 40 function GetSelectedColorF(AStringGrid : TStringGrid) : UTF8string;
41 41 function GetSelectedRowF(AStringGrid : TStringGrid) : UTF8string;
42 42 function MessageHas(const A_CONST : UTF8string; AMessage : TStringList; I:ShortInt=0): Boolean;
43   - procedure CreatePlayerBox(P:TPlayer; Me:Boolean);
  43 + procedure CreatePlayerBox(P:TPlayer; Me:Boolean;Admin:Boolean = False);
44 44 procedure DeletePlayerBox(AID : string);
45 45 procedure SetMatrixType(AStringGrid : TStringGrid; AMatrixType:TGameMatrixType;
46 46 var ARowBase:integer; var ADrawDots, ADrawClear : Boolean);
... ... @@ -58,7 +58,6 @@ type
58 58 procedure CleanMatrix(AEnabled : Boolean);
59 59 procedure EnablePlayerMatrix(AID:UTF8string; ATurn:integer; AEnabled:Boolean);
60 60 private
61   -
62 61 function ShouldStartExperiment: Boolean;
63 62 function ShouldEndCycle : Boolean;
64 63 function ShouldEndGeneration : Boolean;
... ... @@ -68,6 +67,7 @@ type
68 67 procedure NextLineage(Sender: TObject);
69 68 procedure NextCondition(Sender: TObject);
70 69 procedure Interlocking(Sender: TObject);
  70 + procedure TargetInterlocking(Sender: TObject);
71 71 procedure Consequence(Sender: TObject);
72 72 procedure EndExperiment(Sender: TObject);
73 73 procedure StartExperiment;
... ... @@ -116,9 +116,14 @@ const
116 116  
117 117 implementation
118 118  
119   -uses ButtonPanel,Controls,ExtCtrls,StdCtrls,
120   - LazUTF8, Forms, strutils, zhelpers,
121   - form_matrixgame, form_chooseactor, game_resources, string_methods ;
  119 +uses ButtonPanel,Controls,ExtCtrls,StdCtrls,LazUTF8, Forms, strutils
  120 + , zhelpers
  121 + , form_matrixgame
  122 + , presentation_classes
  123 + , form_chooseactor
  124 + , game_resources
  125 + , string_methods
  126 + ;
122 127  
123 128 const
124 129 GA_ADMIN = 'Admin';
... ... @@ -172,7 +177,7 @@ end;
172 177  
173 178 procedure TGameControl.NextCycle(Sender: TObject);
174 179 begin
175   - FormMatrixGame.LabelExpCountCycle.Caption:=IntToStr(FExperiment.Condition[FExperiment.CurrentCondition].Cycles.Count+1);
  180 + FormMatrixGame.LabelExpCountCycle.Caption:= IntToStr(FExperiment.Cycles+1);
176 181 {$IFDEF DEBUG}
177 182 WriteLn('cycle:>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>');
178 183 {$ENDIF}
... ... @@ -197,9 +202,17 @@ begin
197 202 end;
198 203  
199 204 procedure TGameControl.Interlocking(Sender: TObject);
  205 +var i : integer;
200 206 begin
201   - FormMatrixGame.LabelExpCountInterlocks.Caption:= IntToStr(FExperiment.Condition[FExperiment.CurrentCondition].Interlocks.Count+1);
  207 + i := StrToInt(FormMatrixGame.LabelExpCountInterlocks.Caption);
  208 + FormMatrixGame.LabelExpCountInterlocks.Caption:= IntToStr(i+1);
  209 +end;
202 210  
  211 +procedure TGameControl.TargetInterlocking(Sender: TObject);
  212 +var i : integer;
  213 +begin
  214 + i := StrToInt(FormMatrixGame.LabelExpCountTInterlocks.Caption);
  215 + FormMatrixGame.LabelExpCounTtInterlocks.Caption:= IntToStr(i+1);
203 216 end;
204 217  
205 218 procedure TGameControl.Consequence(Sender: TObject);
... ... @@ -242,7 +255,7 @@ begin
242 255 FormMatrixGame.LabelExpCountTurn.Caption:=IntToStr(FExperiment.Condition[FExperiment.CurrentCondition].Turn.Count+1);
243 256  
244 257 // cycle
245   - FormMatrixGame.LabelExpCountCycle.Caption:=IntToStr(FExperiment.Condition[FExperiment.CurrentCondition].Cycles.Count+1);
  258 + FormMatrixGame.LabelExpCountCycle.Caption := IntToStr(FExperiment.Cycles+1);
246 259  
247 260 // generation
248 261 FormMatrixGame.LabelExpCountGeneration.Caption:=IntToStr(FExperiment.Condition[FExperiment.CurrentCondition].Cycles.Generation+1);
... ... @@ -251,7 +264,10 @@ begin
251 264 FormMatrixGame.LabelExpCountCondition.Caption:= FExperiment.Condition[FExperiment.CurrentCondition].ConditionName;
252 265  
253 266 // interlocks
254   - FormMatrixGame.LabelExpCountInterlocks.Caption:= IntToStr(FExperiment.Condition[FExperiment.CurrentCondition].Interlocks.Count+1);
  267 + FormMatrixGame.LabelExpCountInterlocks.Caption:= '0';
  268 +
  269 + // target interlocks
  270 + FormMatrixGame.LabelExpCountTInterlocks.Caption:= '0';
255 271  
256 272 // wait for players
257 273 end;
... ... @@ -307,10 +323,10 @@ begin
307 323 Result := Pos(A_CONST,AMessage[I])>0;
308 324 end;
309 325  
310   -procedure TGameControl.CreatePlayerBox(P: TPlayer; Me: Boolean);
  326 +procedure TGameControl.CreatePlayerBox(P: TPlayer; Me: Boolean; Admin: Boolean);
311 327 var i1 : integer;
312 328 begin
313   - with TPlayerBox.Create(FormMatrixGame.GBLastChoice,P.ID) do
  329 + with TPlayerBox.Create(FormMatrixGame.GBLastChoice,P.ID,Admin) do
314 330 begin
315 331 if Me then
316 332 Caption := P.Nicname+SysToUtf8(' (Você)' )
... ... @@ -481,17 +497,23 @@ procedure TGameControl.ShowConsequenceMessage(AID, S: string; ForGroup: Boolean)
481 497 var
482 498 LConsequence : TConsequence;
483 499 begin
484   - if FActor = gaPlayer then
485   - begin
486   - LConsequence := TConsequence.Create(nil,S);
487   - LConsequence.GenerateMessage(ForGroup);
488   - LConsequence.PresentMessage;
  500 + LConsequence := TConsequence.Create(nil,S);
  501 + LConsequence.GenerateMessage(ForGroup);
  502 + LConsequence.PresentMessage;
  503 + case FActor of
  504 + gaPlayer:
489 505 if ForGroup then
490 506 LConsequence.PresentPoints
491 507 else
492 508 if Self.ID = AID then
493 509 LConsequence.PresentPoints;
494   - end;
  510 +
  511 + gaAdmin:
  512 + begin
  513 + WriteLn(S);
  514 + LConsequence.PresentPoints(GetPlayerBox(AID));
  515 + end;
  516 + end;
495 517 end;
496 518  
497 519 procedure TGameControl.DisableConfirmationButton;
... ... @@ -763,12 +785,12 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
763 785 end;
764 786  
765 787 procedure MovePlayerQueue;
766   - var P : TPlayer;
  788 + var
  789 + P : TPlayer;
767 790 begin
768 791 P := FExperiment.PlayerFromString[AMessage[1]]; // new
769   - CreatePlayerBox(P,Self.ID = P.ID);
770   -
771   - if FActor = gaPlayer then
  792 + CreatePlayerBox(P,Self.ID = P.ID, FActor=gaAdmin);
  793 + if FActor=gaPlayer then
772 794 begin
773 795 FExperiment.Player[FExperiment.PlayerIndexFromID[AMessage[2]]] := P;
774 796 EnablePlayerMatrix(Self.ID,0, True);
... ... @@ -846,22 +868,18 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
846 868 i : integer;
847 869 MID : string;
848 870 begin
849   - case FActor of
850   - gaPlayer:begin
851   - if AMessage.Count > 1 then
  871 + if AMessage.Count > 1 then
  872 + begin
  873 + for i := 2 to AMessage.Count -1 do
852 874 begin
853   - for i := 2 to AMessage.Count -1 do
854   - begin
855   - MID := ExtractDelimited(1,AMessage[i],['+']);
856   - ShowConsequenceMessage(MID, ExtractDelimited(2,AMessage[i],['+']),MID = 'M');
  875 + MID := ExtractDelimited(1,AMessage[i],['+']);
  876 + ShowConsequenceMessage(MID, ExtractDelimited(2,AMessage[i],['+']),MID = 'M');
857 877  
858   - {$IFDEF DEBUG}
859   - WriteLn('A Prompt consequence should have shown.');
860   - {$ENDIF}
861   - end;
  878 + {$IFDEF DEBUG}
  879 + WriteLn('A Prompt consequence should have shown.');
  880 + {$ENDIF}
862 881 end;
863 882 end;
864   - end;
865 883 ResumeNextTurn;
866 884 end;
867 885  
... ... @@ -949,7 +967,7 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList);
949 967 end;
950 968  
951 969 // create/config playerbox
952   - CreatePlayerBox(P,False);
  970 + CreatePlayerBox(P,False,True);
953 971  
954 972 // Request is now a reply with the following standard:
955 973 // [Requester.ID 0, ' ' 1, ReplyTag 2, PlayerData 3, PlayersPlaying 4 .. n, ChatData Last]
... ... @@ -1157,6 +1175,7 @@ procedure TGameControl.ReceiveReply(AReply: TStringList);
1157 1175 LConsequence : TConsequence;
1158 1176 LCount,
1159 1177 i : integer;
  1178 + LAnnouncer : TIntervalarAnnouncer;
1160 1179 //P : TPlayer;
1161 1180 begin
1162 1181 if Self.ID = AReply[0] then
... ... @@ -1167,6 +1186,9 @@ procedure TGameControl.ReceiveReply(AReply: TStringList);
1167 1186 {$ENDIF}
1168 1187 FZMQActor.SendMessage([K_CHOICE,AReply[0],AReply[3],AReply[4],AReply[5]]);
1169 1188  
  1189 + LAnnouncer := TIntervalarAnnouncer.Create(nil);
  1190 + LAnnouncer.OnStart := @FZMQActor.SendMessage;
  1191 + LAnnouncer.Interval := 2000;
1170 1192 LCount := WordCount(AReply[6],['+']);
1171 1193 if LCount > 0 then
1172 1194 for i := 1 to LCount do
... ... @@ -1174,7 +1196,8 @@ procedure TGameControl.ReceiveReply(AReply: TStringList);
1174 1196 LConsequence := TConsequence.Create(nil,ExtractDelimited(i,AReply[6],['+']));
1175 1197 LConsequence.GenerateMessage(False);
1176 1198 if LConsequence.ShouldPublishMessage then
1177   - FZMQActor.SendMessage([K_MESSAGE,Self.ID,ExtractDelimited(i,AReply[6],['+']),BoolToStr(False)])
  1199 + //FZMQActor.SendMessage([K_MESSAGE,Self.ID,ExtractDelimited(i,AReply[6],['+']),BoolToStr(False)])
  1200 + LAnnouncer.Append([K_MESSAGE,Self.ID,ExtractDelimited(i,AReply[6],['+']),BoolToStr(False)])
1178 1201 else
1179 1202 begin
1180 1203 LConsequence.PresentMessage;
... ... @@ -1183,7 +1206,6 @@ procedure TGameControl.ReceiveReply(AReply: TStringList);
1183 1206 {$IFDEF DEBUG}
1184 1207 WriteLn('A consequence should have shown.');
1185 1208 {$ENDIF}
1186   - //Sleep(1000);
1187 1209 end;
1188 1210  
1189 1211 if AReply.Count > 7 then
... ... @@ -1194,19 +1216,23 @@ procedure TGameControl.ReceiveReply(AReply: TStringList);
1194 1216 begin
1195 1217 LConsequence := TConsequence.Create(nil,ExtractDelimited(i,AReply[7],['+']));
1196 1218 LConsequence.GenerateMessage(True);
1197   - FZMQActor.SendMessage([K_MESSAGE,'',ExtractDelimited(i,AReply[7],['+']),BoolToStr(True)]);
1198   -
  1219 + //FZMQActor.SendMessage([K_MESSAGE,'',ExtractDelimited(i,AReply[7],['+']),BoolToStr(True)]);
  1220 + LAnnouncer.Append([K_MESSAGE,'',ExtractDelimited(i,AReply[7],['+']),BoolToStr(True)]);
1199 1221 {$IFDEF DEBUG}
1200 1222 WriteLn('A metaconsequence should have shown.');
1201 1223 {$ENDIF}
1202   - //Sleep(1000);
1203 1224 end;
1204 1225  
1205 1226 if AReply[8] <> #32 then
1206   - FZMQActor.SendMessage([K_QUESTION,AReply[8],AReply[9]])
  1227 + //FZMQActor.SendMessage([K_QUESTION,AReply[8],AReply[9]])
  1228 + LAnnouncer.Append([K_QUESTION,AReply[8],AReply[9]])
1207 1229 else
1208   - FZMQActor.SendMessage([K_RESUME,AReply[9]]);
  1230 + //FZMQActor.SendMessage([K_RESUME,AReply[9]]);
  1231 + LAnnouncer.Append([K_RESUME,AReply[9]]);
1209 1232 end;
  1233 +
  1234 + LAnnouncer.Reversed;
  1235 + LAnnouncer.Enabled := True;
1210 1236 end;
1211 1237 end;
1212 1238  
... ...
units/presentation_classes.pas 0 → 100644
  Diff comments   View file @21d2306
... ... @@ -0,0 +1,144 @@
  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 presentation_classes;
  11 +
  12 +{$mode objfpc}{$H+}
  13 +
  14 +interface
  15 +
  16 +uses
  17 + Classes, SysUtils, ExtCtrls;
  18 +
  19 +type
  20 +
  21 + { TAnnouncerStartEvent }
  22 +
  23 + TAnnouncerStartEvent = procedure (AMessage : array of UTF8String) of object;
  24 +
  25 + { TAnnoucerMessages }
  26 +
  27 + TAnnoucerMessages = array of array of UTF8String;
  28 +
  29 + { TIntervalarAnnouncer }
  30 +
  31 + TIntervalarAnnouncer = class(TComponent)
  32 + private
  33 + FMessages: TAnnoucerMessages;
  34 + FTimer : TTimer;
  35 + FOnStart: TAnnouncerStartEvent;
  36 + function GetEnabled: Boolean;
  37 + function GetInterval: integer;
  38 + procedure NextMessage;
  39 + procedure SetEnabled(AValue: Boolean);
  40 + procedure SelfDestroy(Sender: TObject);
  41 + procedure SetInterval(AValue: integer);
  42 + procedure StartTimer(Sender:TObject);
  43 + public
  44 + constructor Create(AOwner : TComponent); override;
  45 + procedure Append(M : array of UTF8String);
  46 + procedure Reversed;
  47 + property Messages : TAnnoucerMessages read FMessages write FMessages;
  48 + property OnStart : TAnnouncerStartEvent read FOnStart write FOnStart;
  49 + property Interval : integer read GetInterval write SetInterval;
  50 + property Enabled : Boolean read GetEnabled write SetEnabled;
  51 + end;
  52 +
  53 +implementation
  54 +
  55 +{ TIntervalarAnnouncer }
  56 +
  57 +procedure TIntervalarAnnouncer.SetEnabled(AValue: Boolean);
  58 +begin
  59 + if FTimer.Enabled=AValue then Exit;
  60 + FTimer.Enabled:= AValue;
  61 +end;
  62 +
  63 +function TIntervalarAnnouncer.GetEnabled: Boolean;
  64 +begin
  65 + Result := FTimer.Enabled;
  66 +end;
  67 +
  68 +function TIntervalarAnnouncer.GetInterval: integer;
  69 +begin
  70 + Result := FTimer.Interval;
  71 +end;
  72 +
  73 +procedure TIntervalarAnnouncer.NextMessage;
  74 +begin
  75 + SetLength(FMessages,Length(FMessages)-1);
  76 +end;
  77 +
  78 +procedure TIntervalarAnnouncer.SelfDestroy(Sender : TObject);
  79 +var LAnnouncer : TIntervalarAnnouncer;
  80 +begin
  81 + if Length(FMessages) > 0 then
  82 + begin
  83 + LAnnouncer := TIntervalarAnnouncer.Create(nil);
  84 + LAnnouncer.Messages := FMessages;
  85 + LAnnouncer.OnStart:= FOnStart;
  86 + LAnnouncer.Enabled:=True;
  87 + end;
  88 + Free;
  89 +end;
  90 +
  91 +procedure TIntervalarAnnouncer.SetInterval(AValue: integer);
  92 +begin
  93 + if FTimer.Interval=AValue then Exit;
  94 + FTimer.Interval:= AValue;
  95 +end;
  96 +
  97 +procedure TIntervalarAnnouncer.StartTimer(Sender: TObject);
  98 +var M : array of UTF8String;
  99 +begin
  100 + M := FMessages[High(FMessages)];
  101 + NextMessage;
  102 + if Assigned(FOnStart) then FOnStart(M);
  103 +end;
  104 +
  105 +constructor TIntervalarAnnouncer.Create(AOwner: TComponent);
  106 +begin
  107 + inherited Create(AOwner);
  108 + FTimer := TTimer.Create(Self);
  109 + FTimer.Enabled := False;
  110 + FTimer.Interval := 5000;
  111 + FTimer.OnTimer:=@SelfDestroy;
  112 + //FTimer.OnStopTimer:=@SelfDestroy;
  113 + FTimer.OnStartTimer:=@StartTimer;
  114 +end;
  115 +
  116 +procedure TIntervalarAnnouncer.Append(M: array of UTF8String);
  117 +var
  118 + H : TAnnoucerMessages;
  119 + i: Integer;
  120 +begin
  121 + SetLength(H,1,Length(M));
  122 +
  123 + for i := Low(M) to High(M) do
  124 + H[0,i] := M[i];
  125 +
  126 + SetLength(FMessages,Length(FMessages)+1);
  127 + FMessages[High(FMessages)] := H[0];
  128 +end;
  129 +
  130 +procedure TIntervalarAnnouncer.Reversed;
  131 +var
  132 + i : integer;
  133 + M : TAnnoucerMessages;
  134 +begin
  135 + for i := High(FMessages) downto Low(FMessages) do
  136 + begin
  137 + SetLength(M,Length(M)+1);
  138 + M[High(M)] := FMessages[i]
  139 + end;
  140 + FMessages := M;
  141 +end;
  142 +
  143 +end.
  144 +
... ...