Download as
Browse Code »

Commit 653a4067a3a0421ed762562c4aad74e143bfc449

Authored by Carlos Picanco
1 parent eeff651b
Exists in master

choice system is done

Showing 4 changed files with 183 additions and 54 deletions   Show diff stats
form_matrixgame.lfm
  Diff comments   View file @653a406
1 1 object FormMatrixGame: TFormMatrixGame
2   - Left = 0
3   - Height = 560
4   - Top = 70
5   - Width = 1278
6   - HorzScrollBar.Page = 1278
  2 + Left = -621
  3 + Height = 565
  4 + Top = 124
  5 + Width = 1393
  6 + HorzScrollBar.Page = 1393
7 7 VertScrollBar.Page = 542
8 8 AutoScroll = True
9 9 Caption = 'FormMatrixGame'
10   - ClientHeight = 550
11   - ClientWidth = 1278
  10 + ClientHeight = 555
  11 + ClientWidth = 1393
12 12 Font.Name = 'Monospace'
13 13 OnActivate = FormActivate
14 14 LCLVersion = '1.6.2.0'
... ... @@ -184,7 +184,7 @@ object FormMatrixGame: TFormMatrixGame
184 184 AnchorSideBottom.Side = asrBottom
185 185 Left = 0
186 186 Height = 17
187   - Top = 533
  187 + Top = 538
188 188 Width = 1632
189 189 Anchors = [akLeft, akRight, akBottom]
190 190 AutoSize = True
... ... @@ -275,15 +275,15 @@ object FormMatrixGame: TFormMatrixGame
275 275 Caption = 'NA'
276 276 ParentColor = False
277 277 end
278   - object LabelExpNxtPlayer: TLabel
  278 + object LabelExpTurn: TLabel
279 279 Left = 10
280 280 Height = 15
281 281 Top = 95
282 282 Width = 128
283   - Caption = 'Prox. Jog.:'
  283 + Caption = 'Turno:'
284 284 ParentColor = False
285 285 end
286   - object LabelExpCountNxtPlayer: TLabel
  286 + object LabelExpCountTurn: TLabel
287 287 Left = 158
288 288 Height = 15
289 289 Top = 95
... ... @@ -451,4 +451,22 @@ object FormMatrixGame: TFormMatrixGame
451 451 left = 24
452 452 top = 360
453 453 end
  454 + object PopupNotifier: TPopupNotifier
  455 + Color = clTeal
  456 + Icon.Data = {
  457 + 07544269746D617000000000
  458 + }
  459 + Text = 'Text'
  460 + Visible = False
  461 + OnClose = PopupNotifierClose
  462 + left = 112
  463 + top = 360
  464 + end
  465 + object Timer: TTimer
  466 + Enabled = False
  467 + Interval = 8000
  468 + OnTimer = TimerTimer
  469 + left = 200
  470 + top = 360
  471 + end
454 472 end
... ...
form_matrixgame.pas
  Diff comments   View file @653a406
... ... @@ -15,7 +15,7 @@ interface
15 15  
16 16 uses
17 17 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Grids,
18   - StdCtrls, DBGrids, ExtCtrls
  18 + StdCtrls, DBGrids, ExtCtrls, PopupNotifier
19 19  
20 20 , game_zmq_actors
21 21 , game_actors
... ... @@ -46,8 +46,8 @@ type
46 46 LabelExpCountGeneration: TLabel;
47 47 LabelExpCycle: TLabel;
48 48 LabelExpCountCycle: TLabel;
49   - LabelExpNxtPlayer: TLabel;
50   - LabelExpCountNxtPlayer: TLabel;
  49 + LabelExpTurn: TLabel;
  50 + LabelExpCountTurn: TLabel;
51 51 LabelExpInterlocks: TLabel;
52 52 LabelExpCountInterlocks: TLabel;
53 53 LabelIndCount: TLabel;
... ... @@ -62,7 +62,9 @@ type
62 62 ChatPanel: TPanel;
63 63 ChatSplitter: TSplitter;
64 64 OpenDialog: TOpenDialog;
  65 + PopupNotifier: TPopupNotifier;
65 66 StringGridMatrix: TStringGrid;
  67 + Timer: TTimer;
66 68 procedure btnConfirmRowClick(Sender: TObject);
67 69 procedure Button3Click(Sender: TObject);
68 70 procedure ButtonExpCancelClick(Sender: TObject);
... ... @@ -70,9 +72,12 @@ type
70 72 procedure ButtonExpStartClick(Sender: TObject);
71 73 procedure ChatMemoSendKeyPress(Sender: TObject; var Key: char);
72 74 procedure FormActivate(Sender: TObject);
  75 + procedure PopupNotifierClose(Sender: TObject; var CloseAction: TCloseAction
  76 + );
73 77 procedure StringGridMatrixClick(Sender: TObject);
74 78 procedure StringGridMatrixDrawCell(Sender: TObject; aCol, aRow: integer;
75 79 aRect: TRect; aState: TGridDrawState);
  80 + procedure TimerTimer(Sender: TObject);
76 81 private
77 82 FGameControl : TGameControl;
78 83 FID: string;
... ... @@ -212,6 +217,12 @@ begin
212 217 end;
213 218 end;
214 219  
  220 +procedure TFormMatrixGame.TimerTimer(Sender: TObject);
  221 +begin
  222 + PopupNotifier.Visible:=False;
  223 + Timer.Enabled := False;
  224 +end;
  225 +
215 226 procedure TFormMatrixGame.SetGameActor(AValue: TGameActor);
216 227  
217 228 procedure SetZMQAdmin;
... ... @@ -223,7 +234,7 @@ procedure TFormMatrixGame.SetGameActor(AValue: TGameActor);
223 234 procedure SetZMQPlayer;
224 235 begin
225 236 FGameControl := TGameControl.Create(TZMQPlayer.Create(Self,FID));
226   - StringGridMatrix.Enabled := True;
  237 + //StringGridMatrix.Enabled := True;
227 238 end;
228 239  
229 240 procedure SetZMQWatcher;
... ... @@ -267,6 +278,12 @@ begin
267 278 end;
268 279 end;
269 280  
  281 +procedure TFormMatrixGame.PopupNotifierClose(Sender: TObject;
  282 + var CloseAction: TCloseAction);
  283 +begin
  284 + // do nothing for now
  285 +end;
  286 +
270 287 procedure TFormMatrixGame.StringGridMatrixClick(Sender: TObject);
271 288 begin
272 289 if goRowSelect in StringGridMatrix.Options then Exit;
... ... @@ -292,9 +309,6 @@ end;
292 309  
293 310 procedure TFormMatrixGame.btnConfirmRowClick(Sender: TObject);
294 311 begin
295   - StringGridMatrix.Enabled:= False;
296   - btnConfirmRow.Enabled:=False;
297   - btnConfirmRow.Caption:='OK';
298 312 FGameControl.SendMessage(K_CHOICE);
299 313 end;
300 314  
... ...
units/game_control.pas
  Diff comments   View file @653a406
... ... @@ -43,13 +43,14 @@ type
43 43 procedure SetMustDrawDotsClear(AValue: Boolean);
44 44 procedure SetRowBase(AValue: integer);
45 45 private
46   - function CanStartExperiment : Boolean;
  46 + function ShouldStartExperiment : Boolean;
47 47 procedure KickPlayer(AID:string);
48 48 procedure NextTurn(Sender: TObject);
49 49 procedure NextCycle(Sender: TObject);
50 50 procedure NextLineage(Sender: TObject);
51 51 procedure NextCondition(Sender: TObject);
52 52 procedure EndExperiment(Sender: TObject);
  53 + procedure StartExperiment;
53 54 public
54 55 constructor Create(AOwner : TComponent);override;
55 56 destructor Destroy; override;
... ... @@ -76,6 +77,7 @@ const
76 77 K_REFUSED = '.Refused';
77 78 K_CHAT_M = '.ChatM';
78 79 K_CHOICE = '.Choice';
  80 + K_START = '.Start';
79 81 K_LEFT = '.Left';
80 82 K_RESUME = '.Resume';
81 83 K_DATA_A = '.Data';
... ... @@ -115,7 +117,7 @@ end;
115 117  
116 118 { TGameControl }
117 119  
118   -function TGameControl.CanStartExperiment: Boolean;
  120 +function TGameControl.ShouldStartExperiment: Boolean;
119 121 begin
120 122 Result := FExperiment.PlayersCount = FExperiment.Condition[FExperiment.CurrentCondition].Turn.Value;
121 123 end;
... ... @@ -127,21 +129,29 @@ end;
127 129  
128 130 procedure TGameControl.NextTurn(Sender: TObject);
129 131 begin
  132 + // update admin view
  133 + FormMatrixGame.LabelExpCountTurn.Caption:=IntToStr(FExperiment.Condition[FExperiment.CurrentCondition].Turn.Count);
  134 +
130 135 // inform players
  136 +
131 137 end;
132 138  
133 139 procedure TGameControl.NextCycle(Sender: TObject);
134 140 begin
135 141 // prompt question to all players
  142 + FormMatrixGame.LabelExpCountCycle.Caption:=IntToStr(FExperiment.Condition[FExperiment.CurrentCondition].Cycles.Count);
136 143 end;
137 144  
138 145 procedure TGameControl.NextLineage(Sender: TObject);
139 146 begin
140   -
  147 + // pause, kick older player, wait for new player, resume
  148 + FormMatrixGame.LabelExpCountGeneration.Caption:=IntToStr(FExperiment.Condition[FExperiment.CurrentCondition].Cycles.Generation);
141 149 end;
142 150  
143 151 procedure TGameControl.NextCondition(Sender: TObject);
144 152 begin
  153 + FormMatrixGame.LabelExpCountCondition.Caption:= FExperiment.Condition[FExperiment.CurrentCondition].ConditionName;
  154 +
145 155 // append OnStart data
146 156 //FExperiment.Condition[FExperiment.CurrentCondition].Points.OnStart.A;
147 157 //FExperiment.Condition[FExperiment.CurrentCondition].Points.OnStart.B;
... ... @@ -155,10 +165,23 @@ begin
155 165  
156 166 end;
157 167  
  168 +procedure TGameControl.StartExperiment;
  169 +begin
  170 + // all players arrived, lets begin
  171 + FExperiment.State:=xsRunning;
  172 +
  173 + // wait some time, we just sent a message earlier
  174 + Sleep(5);
  175 +
  176 + // enable matrix grid for the first player
  177 + FZMQActor.SendMessage([K_START]);
  178 +end;
  179 +
158 180 procedure TGameControl.Start;
159 181 begin
160 182 // basic data/csv setup
161 183 // wait for players
  184 +
162 185 end;
163 186  
164 187 procedure TGameControl.Pause;
... ... @@ -303,14 +326,6 @@ begin
303 326 FRowBase:=AValue;
304 327 end;
305 328  
306   -procedure TGameControl.StartTurn;
307   -begin
308   - FormMatrixGame.btnConfirmRow.Enabled:=True;
309   - FormMatrixGame.StringGridMatrix.Options := FormMatrixGame.StringGridMatrix.Options-[goRowSelect];
310   - FormMatrixGame.btnConfirmRow.Caption:='Confirmar';
311   - FormMatrixGame.btnConfirmRow.Visible := False;
312   -end;
313   -
314 329 constructor TGameControl.Create(AOwner: TComponent);
315 330 begin
316 331 FZMQActor := TZMQActor(AOwner);
... ... @@ -333,12 +348,18 @@ begin
333 348 MustDrawDotsClear:=False;
334 349  
335 350 FExperiment := TExperiment.Create(FZMQActor.Owner);
  351 + FExperiment.State:=xsWaiting;
336 352 FExperiment.OnEndTurn := @NextTurn;
337 353 FExperiment.OnEndCycle := @NextCycle;
338 354 FExperiment.OnEndGeneration:=@NextLineage;
339 355 FExperiment.OnEndCondition:= @NextCondition;
340 356 FExperiment.OnEndExperiment:= @EndExperiment;
341 357  
  358 + NextTurn(Self);
  359 + NextCycle(Self);
  360 + NextLineage(Self);
  361 + NextCondition(Self);
  362 +
342 363 SendRequest(K_LOGIN);
343 364 end;
344 365  
... ... @@ -453,10 +474,10 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
453 474 gaPlayer:
454 475 begin
455 476 P := FExperiment.PlayerFromString[AMessage[1]];
  477 + FExperiment.AppendPlayer(P);
456 478 if Self.ID = P.ID then
457 479 begin
458   - FExperiment.AppendPlayer(P);
459   - CreatePlayerBox(P, True);
  480 + CreatePlayerBox(P, True)
460 481 end
461 482 else
462 483 CreatePlayerBox(P,False);
... ... @@ -465,27 +486,76 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
465 486  
466 487 end;
467 488  
  489 + procedure EnableMatrix(ATurn:integer);
  490 + begin
  491 + if FExperiment.PlayerFromID[Self.ID].Turn = ATurn then
  492 + begin
  493 + FormMatrixGame.StringGridMatrix.Enabled:=True;
  494 + FormMatrixGame.StringGridMatrix.Options := FormMatrixGame.StringGridMatrix.Options-[goRowSelect];
  495 + FormMatrixGame.btnConfirmRow.Enabled:=True;
  496 + FormMatrixGame.btnConfirmRow.Caption:='Confirmar';
  497 + FormMatrixGame.btnConfirmRow.Visible := False;
  498 + end;
  499 + end;
  500 +
468 501 procedure ReceiveChoice;
  502 + var P : TPlayer;
469 503 begin
470   - with GetPlayerBox(AMessage[1]) do
  504 + P := FExperiment.PlayerFromID[AMessage[1]];
  505 +
  506 + // add last responses to player box
  507 + with GetPlayerBox(P.ID) do
471 508 begin
472   - LabelLastRowCount.Caption := Format('%-*.*d', [1,2,StrToInt(AMessage[2])]);
  509 + LabelLastRowCount.Caption := AMessage[2];
473 510 PanelLastColor.Color := GetRowColorFromString(AMessage[3]);
474   - FormMatrixGame.Caption:='';
  511 + PanelLastColor.Caption:='';
475 512 end;
476 513  
477 514 case FActor of
478 515 gaPlayer:begin
479   -
  516 + if Self.ID = P.ID then
  517 + begin
  518 + FormMatrixGame.StringGridMatrix.Enabled:= False;
  519 + FormMatrixGame.btnConfirmRow.Enabled:=False;
  520 + FormMatrixGame.btnConfirmRow.Caption:='OK';
  521 + end
  522 + else
  523 + EnableMatrix(P.Turn+1);
480 524 end;
481 525  
482 526 gaAdmin:begin
483   - // if last choice in cycle then end cycle
484 527 FExperiment.NextTurn;
485 528 end;
486 529 end;
487 530 end;
488 531  
  532 + procedure NotifyPlayers;
  533 + var PopUpPos : TPoint;
  534 + begin
  535 + case FActor of
  536 + gaPlayer:
  537 + begin
  538 + PopUpPos.X := FormMatrixGame.StringGridMatrix.Left+FormMatrixGame.StringGridMatrix.Width;
  539 + PopUpPos.Y := FormMatrixGame.StringGridMatrix.Top;
  540 + PopUpPos := FormMatrixGame.StringGridMatrix.ClientToScreen(PopUpPos);
  541 + if FExperiment.PlayerFromID[Self.ID].Turn = 0 then
  542 + begin
  543 + PopUpPos.X := FormMatrixGame.StringGridMatrix.Left+FormMatrixGame.StringGridMatrix.Width;
  544 + PopUpPos.Y := FormMatrixGame.StringGridMatrix.Top;
  545 + EnableMatrix(0);
  546 + FormMatrixGame.PopupNotifier.Text:='É sua vez! Clique sobre uma linha da matrix e confirme sua escolha.';
  547 + FormMatrixGame.PopupNotifier.ShowAtPos(PopUpPos.X,PopUpPos.Y);
  548 + end
  549 + else
  550 + begin
  551 + FormMatrixGame.PopupNotifier.Text:='Começou! Aguarde sua vez.';
  552 + FormMatrixGame.PopupNotifier.ShowAtPos(PopUpPos.X,PopUpPos.Y);
  553 + end;
  554 + FormMatrixGame.Timer.Enabled:=True;
  555 + end;
  556 + end;
  557 + end;
  558 +
489 559 procedure ReceiveChat;
490 560 begin
491 561 FormMatrixGame.ChatMemoRecv.Lines.Append(('['+AMessage[1]+']: ')+AMessage[2]);
... ... @@ -551,6 +621,7 @@ begin
551 621 if MHas(K_CHAT_M) then ReceiveChat;
552 622 if MHas(K_CHOICE) then ReceiveChoice;
553 623 if MHas(K_KICK) then SayGoodBye;
  624 + if MHas(K_START) then NotifyPlayers;
554 625 end;
555 626  
556 627 // Here FActor is garanted to be a TZMQAdmin
... ... @@ -585,10 +656,9 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList);
585 656 end
586 657 else
587 658 begin
588   - // if not generate and save p data
  659 + // if not then generate and save p data
589 660 i := FExperiment.AppendPlayer;
590 661 P.Nicname := GenResourceName(i);
591   - P.Turn := FExperiment.NextTurn;
592 662 P.Points.A:=0;
593 663 P.Points.B:=0;
594 664 P.Status:=gpsPlaying;
... ... @@ -596,8 +666,8 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList);
596 666 P.Choice.Current.Row:=grNone;
597 667 P.Choice.Last.Color:=gcNone;
598 668 P.Choice.Last.Row:=grNone;
599   - // turns by entrance order
600   - P.Turn := FExperiment.PlayersCount;
  669 + // turns by entrance order or by random order
  670 + P.Turn := FExperiment.NextTurn;
601 671 FExperiment.Player[i] := P;
602 672 end;
603 673  
... ... @@ -631,7 +701,7 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList);
631 701 FZMQActor.SendMessage([K_ARRIVED,PS]);
632 702  
633 703 // start Experiment if allowed
634   - if CanStartExperiment then
  704 + if ShouldStartExperiment then
635 705 StartExperiment;
636 706  
637 707 end
... ... @@ -671,6 +741,7 @@ procedure TGameControl.ReceiveReply(AReply: TStringList);
671 741 for i:= 3 to AReply.Count -2 do
672 742 begin
673 743 P := FExperiment.PlayerFromString[AReply[i]];
  744 + FExperiment.AppendPlayer(P);
674 745 CreatePlayerBox(P, False);
675 746 end;
676 747  
... ...
units/game_experiment.pas
  Diff comments   View file @653a406
... ... @@ -40,6 +40,7 @@ type
40 40 FSendChatHistoryForNewPlayers: Boolean;
41 41 FShowChat: Boolean;
42 42 FState: TExperimentState;
  43 + FTurnsRandom : TStringList;
43 44 function GetCondition(I : Integer): TCondition;
44 45 function GetConditionsCount: integer;
45 46 function GetContingency(ACondition, I : integer): TContingency;
... ... @@ -146,12 +147,14 @@ end;
146 147  
147 148 function TExperiment.GetNextTurn: integer; // used during player arriving
148 149 begin
149   - Result := FConditions[CurrentCondition].Turn.Count;
  150 + if FConditions[CurrentCondition].Turn.Random then
  151 + Result := StrToInt(FTurnsRandom.Names[FConditions[CurrentCondition].Turn.Count])
  152 + else
  153 + Result := FConditions[CurrentCondition].Turn.Count;
  154 + if Assigned(FOnEndTurn) then FOnEndTurn(Self);
  155 +
150 156 if FConditions[CurrentCondition].Turn.Count < FConditions[CurrentCondition].Turn.Value then
151   - begin
152   - Inc(FConditions[CurrentCondition].Turn.Count);
153   - if Assigned(FOnEndTurn) then FOnEndTurn(Self);
154   - end
  157 + Inc(FConditions[CurrentCondition].Turn.Count)
155 158 else
156 159 begin
157 160 FConditions[CurrentCondition].Turn.Count := 0;
... ... @@ -174,8 +177,11 @@ begin
174 177 else
175 178 begin
176 179 FConditions[CurrentCondition].Cycles.Count := 0;
177   - if Assigned(FOnEndGeneration) then FOnEndGeneration(Self);
178   - NextCondition;
  180 + if State = xsRunning then
  181 + begin
  182 + if Assigned(FOnEndGeneration) then FOnEndGeneration(Self);
  183 + NextCondition;
  184 + end;
179 185 end;
180 186 end;
181 187  
... ... @@ -186,7 +192,7 @@ var
186 192  
187 193 procedure EndCondition;
188 194 begin
189   - Inc(CurrentCondition);
  195 + Inc(FCurrentCondition);
190 196 if Assigned(FOnEndCondition) then FOnEndCondition(Self);
191 197 end;
192 198  
... ... @@ -197,7 +203,7 @@ begin
197 203 FConditions[CurrentCondition].Cycles.Generation) + FConditions[CurrentCondition].Cycles.Count;
198 204  
199 205 // interlockings in last x cycles
200   - LInterlocks := InterlockingsIn(FConditions[CurrentCondition].EndCriterium.LastCycles);
  206 + LInterlocks := InterlockingsIn[FConditions[CurrentCondition].EndCriterium.LastCycles];
201 207 case FConditions[CurrentCondition].EndCriterium.Value of
202 208 gecWhichComeFirst:
203 209 begin
... ... @@ -260,8 +266,8 @@ var
260 266 begin
261 267 case AStatus of
262 268 gpsWaiting: Result := '0';
263   - gpsPlayed: Result := '1';
264   - gpsPlaying: Result := '2';
  269 + gpsPlaying: Result := '1';
  270 + gpsPlayed: Result := '2';
265 271 end;
266 272 end;
267 273  
... ... @@ -308,6 +314,7 @@ begin
308 314 , GetStatusString(P.Status)
309 315 , GetChoiceString(P.Choice.Current)
310 316 , GetChoiceString(P.Choice.Last)
  317 + , IntToStr(P.Turn)
311 318 ]);
312 319 for i := 0 to Length(M)-1 do
313 320 Result += M[i] + '|';
... ... @@ -360,8 +367,8 @@ function TExperiment.GetPlayerFromString(s: UTF8string): TPlayer;
360 367 begin
361 368 case S of
362 369 '0': Result := gpsWaiting;
363   - '1': Result := gpsPlayed;
364   - '2': Result := gpsPlaying;
  370 + '1': Result := gpsPlaying;
  371 + '2': Result := gpsPlayed;
365 372 end;
366 373 end;
367 374 begin
... ... @@ -379,6 +386,7 @@ begin
379 386 Result.Status := GetStatusFromString(ExtractDelimited(4,s,['|']));
380 387 Result.Choice.Current := GetChoiceFromString(ExtractDelimited(5,s,['|']));
381 388 Result.Choice.Last := GetChoiceFromString(ExtractDelimited(6,s,['|']));
  389 + Result.Turn:=StrToInt(ExtractDelimited(7,s,['|']));
382 390 end;
383 391  
384 392 function TExperiment.GetPlayerIndexFromID(AID: UTF8string): integer;
... ... @@ -511,13 +519,31 @@ begin
511 519 end;
512 520  
513 521 constructor TExperiment.Create(AFilename: string;AOwner:TComponent);
  522 +var c ,
  523 + i,
  524 + r : integer;
514 525 begin
515 526 inherited Create(AOwner);
  527 + FTurnsRandom := TStringList.Create;
516 528 LoadExperimentFromFile(Self,AFilename);
  529 + if Condition[CurrentCondition].Turn.Random then
  530 + begin
  531 + for i:= 0 to Condition[CurrentCondition].Turn.Value-1 do
  532 + FTurnsRandom.Add(IntToStr(i));
  533 +
  534 + c := FTurnsRandom.Count - 1;
  535 + for i := 0 to c do
  536 + begin
  537 + r := Random(c);
  538 + while r = i do r := Random(c);
  539 + FTurnsRandom.Exchange(r,i);
  540 + end;
  541 + end;
517 542 end;
518 543  
519 544 destructor TExperiment.Destroy;
520 545 begin
  546 + FTurnsRandom.Free;
521 547 inherited Destroy;
522 548 end;
523 549  
... ...