Download as
Browse Code »

Commit 9aef9a30daf6441b6bf230757da81a5468462eea

Authored by Carlos Picanco
1 parent ce113e9d
Exists in master

implement login

Showing 7 changed files with 462 additions and 175 deletions   Show diff stats
units/game_actors.pas
  Diff comments   View file @9aef9a3
... ... @@ -40,13 +40,6 @@ type
40 40 TGamePromptStyle = (gsYes, gsNo, gsAll, gsMetacontingency, gsContingency, gsBasA, gsRevertPoints);
41 41 TPromptStyle = set of TGamePromptStyle;
42 42  
43   -const
44   - // colors
45   - ccYellow = $00FFFF;
46   - ccRed = $FF0018;
47   - ccGreen = $006400;
48   - ccBlue = $0000FF;
49   - ccMagenta = $8B008B;
50 43  
51 44 type
52 45  
... ...
units/game_control.pas
  Diff comments   View file @9aef9a3
... ... @@ -27,12 +27,11 @@ type
27 27 FActor : TGameActor;
28 28 FZMQActor : TZMQActor;
29 29 FExperiment : TExperiment;
30   - function CanStartCycle : Boolean;
31 30 function GetPlayerBox(AID:string) : TPlayerBox;
32 31 function GetActorNicname(AID:string) : string;
33 32 function GetSelectedColorF(AStringGrid : TStringGrid) : UTF8string;
34 33 function GetSelectedRowF(AStringGrid : TStringGrid) : UTF8string;
35   - function MessageHas(const A_CONST : string; AMessage : TStringList): Boolean;
  34 + function MessageHas(const A_CONST : string; AMessage : TStringList; I:ShortInt=0): Boolean;
36 35 procedure SetMatrixType(AStringGrid : TStringGrid; AMatrixType:TGameMatrixType;
37 36 var ARowBase:integer; var ADrawDots, ADrawClear : Boolean);
38 37 procedure ReceiveMessage(AMessage : TStringList);
... ... @@ -41,7 +40,11 @@ type
41 40 procedure SetMustDrawDots(AValue: Boolean);
42 41 procedure SetMustDrawDotsClear(AValue: Boolean);
43 42 procedure SetRowBase(AValue: integer);
44   - procedure SendSystemMessage(AMessage: array of UTF8String);
  43 + private
  44 + function CanStartExperiment : Boolean;
  45 + procedure StartCycle;
  46 + procedure StartCondition;
  47 + procedure StartExperiment;
45 48 public
46 49 constructor Create(AOwner : TComponent);override;
47 50 destructor Destroy; override;
... ... @@ -57,7 +60,10 @@ type
57 60 function GetRowColor(ARow : integer;ARowBase:integer) : TColor;
58 61  
59 62 const
  63 + K_FULLROOM = '.Full';
  64 + K_PLAYING = '.Playing';
60 65 K_ARRIVED = '.Arrived';
  66 + K_REFUSED = '.Refused';
61 67 K_CHAT_M = '.ChatM';
62 68 K_CHOICE = '.Choice';
63 69 K_LEFT = '.Left';
... ... @@ -98,7 +104,7 @@ end;
98 104  
99 105 { TGameControl }
100 106  
101   -function TGameControl.CanStartCycle: Boolean;
  107 +function TGameControl.CanStartExperiment: Boolean;
102 108 begin
103 109 Result := FExperiment.PlayersPlaying.Count = FExperiment.Condition[FExperiment.CurrentCondition].Turn.Value;
104 110 end;
... ... @@ -127,11 +133,12 @@ begin
127 133 end;
128 134 end;
129 135  
130   -function TGameControl.MessageHas(const A_CONST: string; AMessage: TStringList): Boolean;
  136 +function TGameControl.MessageHas(const A_CONST: string; AMessage: TStringList;
  137 + I: ShortInt): Boolean;
131 138 begin
132 139 Result:= False;
133 140 if not Assigned(AMessage) then Exit;
134   - Result := Pos(A_CONST,AMessage[0])>0;
  141 + Result := Pos(A_CONST,AMessage[I])>0;
135 142 end;
136 143  
137 144 procedure TGameControl.SetMatrixType(AStringGrid: TStringGrid;
... ... @@ -210,9 +217,24 @@ begin
210 217 FRowBase:=AValue;
211 218 end;
212 219  
213   -procedure TGameControl.SendSystemMessage(AMessage: array of UTF8String);
  220 +procedure TGameControl.StartCycle;
214 221 begin
215   - //TZMQAdmin(FZMQActor).SendMessage(AMessage);
  222 +
  223 +end;
  224 +
  225 +procedure TGameControl.StartCondition;
  226 +begin
  227 + // append OnStart data
  228 + //FExperiment.Condition[FExperiment.CurrentCondition].Points.OnStart.A;
  229 + //FExperiment.Condition[FExperiment.CurrentCondition].Points.OnStart.B;
  230 + //FExperiment.Condition[FExperiment.CurrentCondition].Points.OnStart.G;
  231 +
  232 + // append which player
  233 +end;
  234 +
  235 +procedure TGameControl.StartExperiment;
  236 +begin
  237 +
216 238 end;
217 239  
218 240 constructor TGameControl.Create(AOwner: TComponent);
... ... @@ -297,10 +319,10 @@ var
297 319 end;
298 320 begin
299 321 case AMessage of
300   - K_ARRIVED : SetM([
301   - AMessage
302   - , FZMQActor.ID
303   - ]);
  322 + //K_ARRIVED : SetM([
  323 + // AMessage
  324 + // , FZMQActor.ID
  325 + //]);
304 326  
305 327 K_CHOICE : SetM([
306 328 AMessage
... ... @@ -342,112 +364,53 @@ begin
342 364 FZMQActor.SendMessage(M);
343 365 end;
344 366  
  367 +// Here FActor is garanted to be a TZMQPlayer
345 368 procedure TGameControl.ReceiveMessage(AMessage: TStringList);
346   -{$IFDEF DEBUG}
347   -var
348   - i : integer;
349   -{$ENDIF}
350 369 function MHas(const C : string) : Boolean;
351 370 begin
352 371 Result := MessageHas(C,AMessage);
353 372 end;
354 373  
355 374 procedure ReceiveActor;
356   - var i : integer;
357   - P : TPlayer;
  375 + var P : TPlayer;
358 376 begin
359   - //if FExperiment.PlayerIsPlaying[AMessage[1]] then Exit;
360   - //if FExperiment.PlayersPlaying.Count < FExperiment.Condition[FExperiment.CurrentCondition].Turn.Value then
361   - // begin
362   - // if FExperiment.GenPlayersAsNeeded then
363   - // if FExperiment.PlayerFromID[AMessage[1]].ID = '' then
364   - // begin
365   - // TPlayerBox.Create(FormMatrixGame.GBLastChoice,AMessage[1]).Parent := FormMatrixGame.GBLastChoice;
366   - // i := FExperiment.AppendPlayer;
367   - // end;
368   - //
369   - // case FActor of
370   - // gaPlayer:begin
371   - // // nothing special
372   - // end;
373   - //
374   - // gaAdmin:begin
375   - // P.ID := AMessage[1];
376   - // P.Nicname := GenResourceName(i);
377   - // P.Turn := FExperiment.NextTurn;
378   - // FExperiment.Player[i] := P;
379   - //
380   - // with GetPlayerBox(P.ID) do
381   - // begin
382   - // ID := P.ID;
383   - // if FExperiment.PlayerFromID[ID].ID <> '' then
384   - // begin
385   - // Caption := FExperiment.PlayerFromID[ID].Nicname;
386   - // Parent := FormMatrixGame.GBLastChoice;
387   - // SendSystemMessage([ // here we need to use admin as a repeater/switch, because it is acting as a resource generator
388   - // GA_ADMIN+K_STATUS
389   - // , ID
390   - // , Caption
391   - // , IntToStr(P.Turn)
392   - // , IntToStr(i)
393   - // ]);
394   - // end;
395   - // end;
396   - // end;
397   - // end;
398   - // end
399   - //else
400   - // WriteLn('Room is full, Player must wait someone''s leaving.');
401   -end;
  377 + case FActor of
  378 + gaAdmin:
  379 + begin
  380 + // do nothing
  381 + end;
  382 +
  383 + gaPlayer:
  384 + begin
  385 + P := FExperiment.PlayerFromString[AMessage[1]];
  386 + if Self.ID = P.ID then Exit;
  387 + with TPlayerBox.Create(FormMatrixGame.GBLastChoice,P.ID) do
  388 + begin
  389 + Caption := P.Nicname;
  390 + LabelLastRowCount.Caption := IntToStr(ShortInt(P.Choice.Last.Row));
  391 + PanelLastColor.Color := GetColorFromCode(P.Choice.Last.Color);
  392 + Enabled := True;
  393 + Parent := FormMatrixGame.GBLastChoice;
  394 + end;
  395 + end;
  396 + end;
  397 +
  398 + end;
402 399  
403 400  
404 401 procedure ReceiveStatus;
405   - var P : PPlayer;
406   - i : integer;
  402 + //var P : PPlayer;
  403 + // i : integer;
407 404 begin
408 405 //P := New(PPlayer);
409 406 //case FActor of
410 407 // gaPlayer:begin
411   - // with P^ do
412   - // begin // local asignment of the admin's generated data
413   - // ID := AMessage[1];
414   - // Nicname:=AMessage[2];
415   - // Turn:= StrToInt(AMessage[3]);
416   - // end;
417   - // i := StrToInt(AMessage[4]);
418   - // FExperiment.Player[i] := P^;
419   - // with GetPlayerBox(P^.ID) do
420   - // begin
421   - // if Self.ID = ID then
422   - // begin
423   - // Caption := P^.Nicname + ' (Você)';
424   - // WriteLn(P^.Nicname +' Said: I am ready.');
425   - // end
426   - // else
427   - // begin
428   - // Caption := P^.Nicname;
429   - // WriteLn(Self.ID +' said '+ P^.Nicname +' is ready.');
430   - // end;
431   - // Enabled := True;
432   - // end;
  408 +
433 409 //
434 410 // end;
435 411 //
436 412 // gaAdmin:begin
437   - // P^ := FExperiment.PlayerFromID[AMessage[1]];
438   - // // turns by entrance order
439   - // //P^.Turn := FExperiment.PlayersPlaying.Count;
440   - // FExperiment.PlayersPlaying.Add(P);
441   - // with GetPlayerBox(AMessage[1]) do
442   - // Enabled := True;
443   - //
444   - // WriteLn(AMessage[2]+' is ready.');
445   - // if CanStartCycle then
446   - // SendSystemMessage([
447   - // GA_ADMIN+K_CYCLES
448   - // , FExperiment.NextTurnPlayerID
449   - // ]);
450   - // end;
  413 +
451 414 //end;
452 415 //Dispose(P);
453 416 end;
... ... @@ -479,10 +442,6 @@ end;
479 442  
480 443 end;
481 444 end;
482   - {$IFDEF DEBUG}
483   - WriteLn('Good Bye');
484   - {$ENDIF}
485   -
486 445 end;
487 446  
488 447 procedure ResumeActor;
... ... @@ -495,9 +454,6 @@ end;
495 454  
496 455 end;
497 456 end;
498   - {$IFDEF DEBUG}
499   - WriteLn('Resumed.');
500   - {$ENDIF}
501 457 end;
502 458  
503 459 procedure ReceiveLogin;
... ... @@ -510,9 +466,6 @@ end;
510 466  
511 467 end;
512 468 end;
513   - {$IFDEF DEBUG}
514   - WriteLn('login');
515   - {$ENDIF}
516 469 end;
517 470  
518 471 procedure ReceiveLogout;
... ... @@ -525,9 +478,6 @@ end;
525 478  
526 479 end;
527 480 end;
528   - {$IFDEF DEBUG}
529   - WriteLn('logout');
530   - {$ENDIF}
531 481 end;
532 482  
533 483 begin
... ... @@ -537,44 +487,171 @@ begin
537 487 if MHas(K_LEFT) then SayGoodBye;
538 488 if MHas(K_RESUME) then ResumeActor;
539 489 if MHas(K_STATUS) then ReceiveStatus;
540   -
541   - {$IFDEF DEBUG}
542   - for i:= 0 to AMessage.Count-1 do
543   - WriteLn(i,':',AMessage[i]);
544   - {$ENDIF}
545 490 end;
546 491  
  492 +// Here FActor is garanted to be a TZMQAdmin
547 493 procedure TGameControl.ReceiveRequest(var ARequest: TStringList);
548   -{$IFDEF DEBUG}
549   -var
550   - i : integer;
551   -{$ENDIF}
552 494 function MHas(const C : string) : Boolean;
553 495 begin
554   - Result := MessageHas(C,ARequest);
  496 + Result := MessageHas(C,ARequest, 2);
555 497 end;
556 498  
557   - procedure ReplyLogin;
  499 + procedure ReplyLoginRequest;
  500 + var i : integer;
  501 + P : TPlayer;
  502 + PS : string;
558 503 begin
559   -
  504 + if not FExperiment.PlayerIsPlaying[ARequest[0]] then
  505 + begin
  506 + if FExperiment.PlayersPlaying.Count < FExperiment.Condition[FExperiment.CurrentCondition].Turn.Value then
  507 + begin
  508 + // ok, let player login
  509 + P.ID := ARequest[0];
  510 +
  511 + // check if we already know this player
  512 + i := FExperiment.PlayerIndexFromID[P.ID];
  513 + if i > -1then
  514 + begin
  515 + // then load p data
  516 + P := FExperiment.Player[i]
  517 + end
  518 + else
  519 + begin
  520 + // if not save p data
  521 + i := FExperiment.AppendPlayer;
  522 + P.Nicname := GenResourceName(i);
  523 + P.Turn := FExperiment.NextTurn;
  524 + P.Points.A:=0;
  525 + P.Points.B:=0;
  526 + P.Status:=gpsPlaying;
  527 + P.Choice.Current.Color:=gcNone;
  528 + P.Choice.Current.Row:=grNone;
  529 + P.Choice.Last.Color:=gcNone;
  530 + P.Choice.Last.Row:=grNone;
  531 + // turns by entrance order
  532 + P.Turn := FExperiment.PlayersPlaying.Count;
  533 + FExperiment.Player[i] := P;
  534 + end;
  535 +
  536 + // add player to playing list
  537 + FExperiment.PlayersPlaying.Add(FExperiment.PlayerPointer[i]);
  538 +
  539 + // create/config playerbox
  540 + with TPlayerBox.Create(FormMatrixGame.GBLastChoice,P.ID) do
  541 + begin
  542 + Caption := P.Nicname;
  543 + i := Integer(P.Choice.Last.Row);
  544 + if i > 0 then
  545 + LabelLastRowCount.Caption := Format('%-*.*d', [1,2,i]);
  546 +
  547 + PanelLastColor.Color := GetColorFromCode(P.Choice.Last.Color);
  548 + Enabled := True;
  549 + Parent := FormMatrixGame.GBLastChoice;
  550 + end;
  551 +
  552 + // Request is now a reply with the following standard:
  553 + // [Requester.ID 0, ' ' 1, ReplyTag 2, PlayerData 3, PlayersPlaying 4 .. n, ChatData Last]
  554 + ARequest[2] := GA_ADMIN+ARequest[2]+K_ARRIVED;
  555 +
  556 + // append player
  557 + PS := FExperiment.PlayerAsString[P];
  558 + ARequest.Append(PS); // 3
  559 +
  560 + // append current players playing
  561 + if FExperiment.PlayersPlaying.Count > 0 then
  562 + for i:=0 to FExperiment.PlayersPlaying.Count -1 do
  563 + if PPlayer(FExperiment.PlayersPlaying[i])^.ID <> P.ID then
  564 + ARequest.Append(FExperiment.PlayerAsString[PPlayer(FExperiment.PlayersPlaying[i])^]); // FROM 4 to COUNT-2
  565 +
  566 + // send chat data if allowed at the last position
  567 + if FExperiment.SendChatHistoryForNewPlayers then
  568 + ARequest.Append(FormMatrixGame.ChatMemoRecv.Lines.Text) // LAST
  569 + else
  570 + ARequest.Append('[CHAT]'); // must append something to keep the message envelop standard
  571 +
  572 + // inform other players about the new player
  573 + FZMQActor.SendMessage([K_ARRIVED,PS]);
  574 +
  575 + // start cycle if allowed
  576 + if CanStartExperiment then
  577 + StartExperiment;
  578 +
  579 + end
  580 + else
  581 + begin
  582 + ARequest[2] := GA_ADMIN+ARequest[2]+K_REFUSED+K_FULLROOM;
  583 + end;
  584 + end
  585 + else
  586 + begin
  587 + ARequest[2] := GA_ADMIN+ARequest[2]+K_REFUSED+K_PLAYING;
  588 + end;
560 589 end;
561   -begin
562   - if MHas(K_LOGIN) then ReplyLogin;
563 590  
564   - {$IFDEF DEBUG}
565   - ARequest.Append(FZMQActor.ClassType.ClassName+':'+'AppendToRequest');
566   - {$ENDIF}
  591 +begin
  592 + if MHas(K_LOGIN) then ReplyLoginRequest;
567 593 end;
568 594  
569   -
570   -// player
  595 +// Here FActor is garanted to be a TZMQPlayer
571 596 procedure TGameControl.ReceiveReply(AReply: TStringList);
572   -var i: integer;
  597 + function MHas(const C : string) : Boolean;
  598 + begin
  599 + Result := MessageHas(C,AReply,2);
  600 + end;
  601 + procedure CreatePlayerBox(P:TPlayer; Me:Boolean);
  602 + var i1 : integer;
  603 + begin
  604 + with TPlayerBox.Create(FormMatrixGame.GBLastChoice,P.ID) do
  605 + begin
  606 + if Me then
  607 + Caption := P.Nicname+'Você'
  608 + else
  609 + Caption := P.Nicname;
  610 + i1 := Integer(P.Choice.Last.Row);
  611 + if i1 > 0 then
  612 + LabelLastRowCount.Caption := Format('%-*.*d', [1,2,i1])
  613 + else
  614 + LabelLastRowCount.Caption := 'NA';
  615 + PanelLastColor.Color := GetColorFromCode(P.Choice.Last.Color);
  616 + Enabled := True;
  617 + Parent := FormMatrixGame.GBLastChoice;
  618 + end;
  619 + end;
  620 +
  621 + procedure LoginAccepted;
  622 + var
  623 + i: integer;
  624 + P : TPlayer;
  625 + begin
  626 + {$IFDEF DEBUG}
  627 + WriteLn(Self.ID +' self' + AReply[0] +' reply');
  628 + {$ENDIF}
  629 + if Self.ID = AReply[0] then
  630 + begin
  631 + P := FExperiment.PlayerFromString[AReply[3]];
  632 + FExperiment.AppendPlayer(P);
  633 + CreatePlayerBox(P, True);
  634 +
  635 + for i:= 4 to AReply.Count -2 do
  636 + begin
  637 + P := FExperiment.PlayerFromString[AReply[i]];
  638 + CreatePlayerBox(P, False);
  639 + end;
  640 +
  641 + // add chat
  642 + FormMatrixGame.ChatMemoRecv.Lines.Clear;
  643 + FormMatrixGame.ChatMemoRecv.Lines.Add(AReply[AReply.Count-1]);
  644 + end
  645 + else
  646 + begin
  647 + {$IFDEF DEBUG}
  648 + WriteLn(Self.ID +' sent but' + AReply[0] +' received. This must not occur.');
  649 + {$ENDIF}
  650 + end;
  651 + end;
  652 +
573 653 begin
574   - {$IFDEF DEBUG}
575   - for i:= 0 to AReply.Count-1 do
576   - WriteLn(i,':',AReply[i]);
577   - {$ENDIF}
  654 + if MHas(K_LOGIN+K_ARRIVED) then LoginAccepted;
578 655 end;
579 656  
580 657  
... ...
units/game_experiment.pas
  Diff comments   View file @9aef9a3
... ... @@ -32,6 +32,7 @@ type
32 32 FConditions : TConditions;
33 33 FResearcherCanChat: Boolean;
34 34 FResearcherCanPlay: Boolean;
  35 + FSendChatHistoryForNewPlayers: Boolean;
35 36 FShowChat: Boolean;
36 37 function GetCondition(I : Integer): TCondition;
37 38 function GetConditionsCount: integer;
... ... @@ -40,9 +41,13 @@ type
40 41 function GetNextTurnPlayerID: UTF8string;
41 42 function GetPlayer(I : integer): TPlayer; overload;
42 43 function GetPlayer(AID : string): TPlayer; overload;
  44 + function GetPlayerAsString(P: TPlayer): UTF8string;
  45 + function GetPlayerFromString(s : string): TPlayer;
  46 + function GetPlayerIndexFromID(AID : string): integer;
43 47 function GetPlayerIsPlaying(AID : string): Boolean;
  48 + function GetPlayerPointer(i: integer): PPlayer;
44 49 function GetPlayersCount: integer;
45   - function GetPlayersPlaying: TList;
  50 + //function GetPlayersPlaying: TList;
46 51 procedure SetCondition(I : Integer; AValue: TCondition);
47 52 procedure SetContingency(ACondition, I : integer; AValue: TContingency);
48 53 procedure SetMatrixType(AValue: TGameMatrixType);
... ... @@ -51,6 +56,7 @@ type
51 56 procedure SetPlayersPlaying(AValue: TList);
52 57 procedure SetResearcherCanChat(AValue: Boolean);
53 58 procedure SetResearcherCanPlay(AValue: Boolean);
  59 + procedure SetSendChatHistoryForNewPlayers(AValue: Boolean);
54 60 public
55 61 constructor Create(AOwner:TComponent);override;
56 62 constructor Create(AFilename: string; AOwner:TComponent); overload;
... ... @@ -78,9 +84,14 @@ type
78 84 property Player[I : integer] : TPlayer read GetPlayer write SetPlayer;
79 85 property PlayerFromID[S : string ] : TPlayer read GetPlayer write SetPlayer;
80 86 property PlayersCount : integer read GetPlayersCount; // how many players per turn?
81   - property PlayersPlaying : TList read GetPlayersPlaying write SetPlayersPlaying; // how many players are playing?
82   - property PlayerIsPlaying[s : string] : Boolean read GetPlayerIsPlaying; // is
  87 + property PlayersPlaying : TList read FPlayersPlaying write SetPlayersPlaying; // how many players are playing?
  88 + property PlayerIsPlaying[s : string] : Boolean read GetPlayerIsPlaying;
  89 + property PlayerIndexFromID[s : string]: integer read GetPlayerIndexFromID;
  90 + property PlayerAsString[P:TPlayer]: UTF8string read GetPlayerAsString;
  91 + property PlayerFromString[s : string]: TPlayer read GetPlayerFromString;
  92 + property PlayerPointer[i:integer]: PPlayer read GetPlayerPointer;
83 93 property ShowChat : Boolean read FShowChat write FShowChat;
  94 + property SendChatHistoryForNewPlayers : Boolean read FSendChatHistoryForNewPlayers write SetSendChatHistoryForNewPlayers;
84 95 property MatrixType : TGameMatrixType read FMatrixType write SetMatrixType;
85 96 property NextTurnPlayerID : UTF8string read GetNextTurnPlayerID;
86 97 property NextTurn : integer read GetNextTurn;
... ... @@ -91,7 +102,7 @@ resourcestring
91 102  
92 103 implementation
93 104  
94   -uses game_file_methods, game_actors_point,Dialogs;
  105 +uses game_file_methods, game_actors_point, game_resources, strutils;
95 106  
96 107 { TExperiment }
97 108  
... ... @@ -139,9 +150,9 @@ function TExperiment.GetPlayer(AID: string): TPlayer;
139 150 var
140 151 i : integer;
141 152 begin
142   - Result.ID := '';
  153 + //Result.ID := '';
143 154 if PlayersCount > 0 then
144   - for i:= 0 to PlayersCount do
  155 + for i:= 0 to PlayersCount -1 do
145 156 if FPlayers[i].ID = AID then
146 157 begin
147 158 Result := FPlayers[i];
... ... @@ -149,6 +160,162 @@ begin
149 160 end;
150 161 end;
151 162  
  163 +// fewer as possible data
  164 +function TExperiment.GetPlayerAsString(P: TPlayer): UTF8string;
  165 +var
  166 + i : integer;
  167 + M : array of UTF8String;
  168 +
  169 + procedure SetM(A : array of UTF8String);
  170 + var i : integer;
  171 + begin
  172 + SetLength(M,Length(A));
  173 + for i := 0 to Length(A) -1 do
  174 + M[i] := A[i];
  175 + end;
  176 +
  177 + function GetPPointsString(APPoints : TPlayerPoints) : string;
  178 + begin
  179 + Result := IntToStr(APPoints.A)+VV_SEP+IntToStr(APPoints.B);
  180 + end;
  181 +
  182 + function GetStatusString(AStatus : TGamePlayerStatus): string;
  183 + begin
  184 + case AStatus of
  185 + gpsWaiting: Result := '0';
  186 + gpsPlayed: Result := '1';
  187 + gpsPlaying: Result := '2';
  188 + end;
  189 + end;
  190 +
  191 + function GetRowString(ARow: TGameRow): string;
  192 + begin
  193 + case ARow of
  194 + grNone : Result := '.';
  195 + grOne : Result := '1';
  196 + grTwo : Result := '2';
  197 + grThree : Result :='3';
  198 + grFour : Result := '4';
  199 + grFive : Result := '5';
  200 + grSix : Result := '6';
  201 + grSeven : Result := '7';
  202 + grEight : Result := '8';
  203 + grNine : Result := '9';
  204 + grTen : Result := '0';
  205 + end;
  206 + end;
  207 +
  208 + function GetColorString(AColor: TGameColor): string;
  209 + begin
  210 + case AColor of
  211 + gcNone :Result := '0';
  212 + gcYellow :Result := '1';
  213 + gcRed :Result := '2';
  214 + gcMagenta :Result := '3';
  215 + gcBlue :Result := '4';
  216 + gcGreen :Result := '5';
  217 + end;
  218 + end;
  219 +
  220 + function GetChoiceString(AChoice : TPlayerChoice) : string;
  221 + begin
  222 + Result := GetRowString(AChoice.Row) + VV_SEP;
  223 + Result := Result+ GetColorString(AChoice.Color);
  224 + end;
  225 +
  226 +begin
  227 + Result := '';
  228 + SetM([P.ID
  229 + , P.Nicname
  230 + , GetPPointsString(P.Points)
  231 + , GetStatusString(P.Status)
  232 + , GetChoiceString(P.Choice.Current)
  233 + , GetChoiceString(P.Choice.Last)
  234 + ]);
  235 + for i := 0 to Length(M)-1 do
  236 + Result += M[i] + '|';
  237 +end;
  238 +
  239 +function TExperiment.GetPlayerFromString(s : string): TPlayer;
  240 +
  241 + function GetRowFromString(S: string): TGameRow;
  242 + begin
  243 + case S of
  244 + '.' : Result := grNone;
  245 + '1' : Result := grOne;
  246 + '2' : Result := grTwo;
  247 + '3' : Result := grThree;
  248 + '4' : Result := grFour;
  249 + '5' : Result := grFive;
  250 + '6' : Result := grSix;
  251 + '7' : Result := grSeven;
  252 + '8' : Result := grEight;
  253 + '9' : Result := grNine;
  254 + '0' : Result := grTen;
  255 + end;
  256 + end;
  257 +
  258 + function GetColorFromString(S: string): TGameColor;
  259 + begin
  260 + case S of
  261 + '0' : Result := gcNone;
  262 + '1' : Result := gcYellow;
  263 + '2' : Result := gcRed;
  264 + '3' : Result := gcMagenta;
  265 + '4' : Result := gcBlue;
  266 + '5' : Result := gcGreen;
  267 + end;
  268 + end;
  269 +
  270 + function GetChoiceFromString(S:string) : TPlayerChoice;
  271 + begin
  272 + Result.Row := GetRowFromString(ExtractDelimited(1,S,[',']));
  273 + Result.Color := GetColorFromString(ExtractDelimited(2,S,[',']));
  274 + end;
  275 +
  276 + function GetPPointsFromString(S:string) : TPlayerPoints;
  277 + begin
  278 + Result.A := StrToInt(ExtractDelimited(1,S,[',']));
  279 + Result.B := StrToInt(ExtractDelimited(2,S,[',']));
  280 + end;
  281 +
  282 + function GetStatusFromString(S : string): TGamePlayerStatus;
  283 + begin
  284 + case S of
  285 + '0': Result := gpsWaiting;
  286 + '1': Result := gpsPlayed;
  287 + '2': Result := gpsPlaying;
  288 + end;
  289 + end;
  290 +begin
  291 + {$IFDEF DEBUG}
  292 + WriteLn(ExtractDelimited(1,s,['|']));
  293 + WriteLn(ExtractDelimited(2,s,['|']));
  294 + WriteLn(ExtractDelimited(3,s,['|']));
  295 + WriteLn(ExtractDelimited(4,s,['|']));
  296 + WriteLn(ExtractDelimited(5,s,['|']));
  297 + WriteLn(ExtractDelimited(6,s,['|']));
  298 + {$ENDIF}
  299 + Result.ID := ExtractDelimited(1,s,['|']);
  300 + Result.Nicname := ExtractDelimited(2,s,['|']);
  301 + Result.Points := GetPPointsFromString(ExtractDelimited(3,s,['|']));
  302 + Result.Status := GetStatusFromString(ExtractDelimited(4,s,['|']));
  303 + Result.Choice.Current := GetChoiceFromString(ExtractDelimited(5,s,['|']));
  304 + Result.Choice.Last := GetChoiceFromString(ExtractDelimited(6,s,['|']));
  305 +end;
  306 +
  307 +function TExperiment.GetPlayerIndexFromID(AID: string): integer;
  308 +var i : integer;
  309 +begin
  310 + Result := -1;
  311 + for i:= 0 to PlayersCount -1 do
  312 + if FPlayers[i].ID = AID then
  313 + begin
  314 + Result := i;
  315 + Break;
  316 + end;
  317 +end;
  318 +
152 319 function TExperiment.GetPlayerIsPlaying(AID: string): Boolean;
153 320 var i : integer;
154 321 begin
... ... @@ -160,30 +327,35 @@ begin
160 327 Result:= False;
161 328 end;
162 329  
163   -function TExperiment.GetPlayersCount: integer;
  330 +function TExperiment.GetPlayerPointer(i: integer): PPlayer;
164 331 begin
165   - Result := Length(FPlayers)
  332 + Result := @FPlayers[i];
166 333 end;
167 334  
168   -function TExperiment.GetPlayersPlaying: TList;
169   -var
170   - i:integer;
171   - P:PPlayer;
  335 +function TExperiment.GetPlayersCount: integer;
172 336 begin
173   - P := New(PPlayer);
174   - if FPlayersPlaying.Count > 0 then
175   - FPlayersPlaying.Clear;
176   -
177   - for i := Low(FPlayers) to High(FPlayers) do
178   - if FPlayers[i].Status = gpsPlaying then
179   - begin
180   - P := @FPlayers[i];
181   - FPlayersPlaying.Add(P);
182   - end;
183   - Dispose(P);
184   - Result := FPlayersPlaying;
  337 + Result := Length(FPlayers);
185 338 end;
186 339  
  340 +//function TExperiment.GetPlayersPlaying: TList;
  341 +//var
  342 +// //i:integer;
  343 +// //P:PPlayer;
  344 +//begin
  345 +// //P := New(PPlayer);
  346 +// //if FPlayersPlaying.Count > 0 then
  347 +// // FPlayersPlaying.Clear;
  348 +// //
  349 +// //for i := Low(FPlayers) to High(FPlayers) do
  350 +// // if FPlayers[i].Status = gpsPlaying then
  351 +// // begin
  352 +// // P := @FPlayers[i];
  353 +// // FPlayersPlaying.Add(P);
  354 +// // end;
  355 +// //Dispose(P);
  356 +// Result := FPlayersPlaying;
  357 +//end;
  358 +
187 359 procedure TExperiment.SetCondition(I : Integer; AValue: TCondition);
188 360 begin
189 361 FConditions[I] := AValue;
... ... @@ -210,7 +382,7 @@ procedure TExperiment.SetPlayer(S : string ; AValue: TPlayer);
210 382 var i : integer;
211 383 begin
212 384 if PlayersCount > 0 then
213   - for i:= 0 to PlayersCount do
  385 + for i:= 0 to PlayersCount -1 do
214 386 if FPlayers[i].ID = S then
215 387 begin
216 388 FPlayers[i] := AValue;
... ... @@ -237,6 +409,12 @@ begin
237 409 FResearcherCanPlay:=AValue;
238 410 end;
239 411  
  412 +procedure TExperiment.SetSendChatHistoryForNewPlayers(AValue: Boolean);
  413 +begin
  414 + if FSendChatHistoryForNewPlayers=AValue then Exit;
  415 + FSendChatHistoryForNewPlayers:=AValue;
  416 +end;
  417 +
240 418 constructor TExperiment.Create(AOwner: TComponent);
241 419 begin
242 420 inherited Create(AOwner);
... ... @@ -267,7 +445,7 @@ function TExperiment.LoadFromGenerator: Boolean;
267 445 begin
268 446 Result := LoadExperimentFromResource(Self);
269 447 if Result then
270   - FFilename := GetCurrentDir + PathDelim + FResearcher + PathDelim;
  448 + FFilename := GetCurrentDir + PathDelim + FResearcher + PathDelim;
271 449 end;
272 450  
273 451 function TExperiment.AppendCondition: integer;
... ...
units/game_file_methods.pas
  Diff comments   View file @9aef9a3
... ... @@ -41,11 +41,13 @@ begin
41 41 Researcher := VAL_RESEARCHER;
42 42 ResearcherCanPlay:=False;
43 43 ResearcherCanChat:=True;
  44 + SendChatHistoryForNewPlayers:=True;
44 45 ExperimentName:='Test Experiment';
45 46 ExperimentAim:='This is a test experiment.';
46 47 GenPlayersAsNeeded:=True;
47 48 CurrentCondition := 0;
48 49 MatrixType:=[gmRows];
  50 + PlayersPlaying := TList.Create;
49 51 //AppendPlayer(C_PLAYER_TEMPLATE);
50 52 //AppendPlayer(C_PLAYER_TEMPLATE);
51 53 i := AppendCondition(C_CONDITION_TEMPLATE);
... ...
units/game_resources.pas
  Diff comments   View file @9aef9a3
... ... @@ -5,11 +5,12 @@ unit game_resources;
5 5 interface
6 6  
7 7 uses
8   - Classes, SysUtils
  8 + Classes, SysUtils, Graphics
9 9 , game_actors
10 10 ;
11 11  
12 12 function GenResourceName(i : integer) : UTF8string;
  13 +function GetColorFromCode(ACode : TGameColor) : TColor;
13 14  
14 15 resourcestring
15 16 KV_SEP = '=';
... ... @@ -71,6 +72,15 @@ resourcestring
71 72 DEF_METARESPONSE = 'IMPAR,E,DIFERENTES,';
72 73 DEF_RESPONSE = 'PAR,E,INDIFERENTE,';
73 74 DEF_PROMPTMESSAGE = 'Vocês perderam <$G> item escolar. Desejam recuperá-lo gastando pontos do Tipo A?';
  75 +
  76 +const
  77 + // grid colors
  78 + ccYellow = $00FFFF;
  79 + ccRed = $FF0018;
  80 + ccGreen = $006400;
  81 + ccBlue = $0000FF;
  82 + ccMagenta = $8B008B;
  83 +
74 84 const
75 85  
76 86 CPlayerNamesMale : array [0..49] of UTF8String =
... ... @@ -302,5 +312,17 @@ begin
302 312 else s_random(10);
303 313 end;
304 314  
  315 +function GetColorFromCode(ACode: TGameColor): TColor;
  316 +begin
  317 + case ACode of
  318 + gcNone :Result := clInactiveCaption;
  319 + gcYellow :Result := ccYellow;
  320 + gcRed :Result := ccRed;
  321 + gcMagenta :Result := ccMagenta;
  322 + gcBlue :Result := ccBlue;
  323 + gcGreen :Result := ccGreen;
  324 + end;
  325 +end;
  326 +
305 327 end.
306 328  
... ...
units/game_visual_elements.pas
  Diff comments   View file @9aef9a3
... ... @@ -24,7 +24,7 @@ type
24 24 end;
25 25  
26 26 resourcestring
27   - CAP_ROW = 'Linhas:';
  27 + CAP_ROW = 'Linha:';
28 28 CAP_COLOR = 'Cor:';
29 29 CAP_NA = 'NA';
30 30 CAP_WAINTING_FOR_PLAYER = 'Esperando Jogador...';
... ... @@ -54,7 +54,7 @@ begin
54 54 LabelLastColor.Parent := Self;
55 55  
56 56 PanelLastColor := TPanel.Create(Self);
57   - PanelLastColor.Caption:='';
  57 + PanelLastColor.Caption:=CAP_NA;
58 58 //PanelLastColor.Color:= $0;
59 59 PanelLastColor.Parent:= Self;
60 60  
... ... @@ -62,9 +62,9 @@ begin
62 62 LabelLastRow.Caption:=CAP_ROW;
63 63 LabelLastRow.Parent := Self;
64 64  
65   - LabelLastRow:= TLabel.Create(Self);
66   - LabelLastRow.Caption:=CAP_NA;
67   - LabelLastRow.Parent := Self;
  65 + LabelLastRowCount:= TLabel.Create(Self);
  66 + LabelLastRowCount.Caption:=CAP_NA;
  67 + LabelLastRowCount.Parent := Self;
68 68 Enabled:= False;
69 69 //LabelLastRow.AutoSize := False;
70 70 end;
... ...
units/game_zmq_actors.pas
  Diff comments   View file @9aef9a3
... ... @@ -160,25 +160,34 @@ end;
160 160 { TZMQActor }
161 161  
162 162 procedure TZMQActor.MessageReceived(AMultipartMessage: TStringList);
  163 +var i : integer;
163 164 begin
164 165 {$IFDEF DEBUG}
165 166 WriteLn(ClassType.ClassName+':'+'ReceivedAMessage');
  167 + for i:= 0 to AMultipartMessage.Count-1 do
  168 + WriteLn(i,':',AMultipartMessage[i]);
166 169 {$ENDIF}
167 170 if Assigned(FOnMessageReceived) then FOnMessageReceived(AMultipartMessage);
168 171 end;
169 172  
170 173 procedure TZMQActor.ReplyReceived(AMultipartMessage: TStringList);
  174 +var i : integer;
171 175 begin
172 176 {$IFDEF DEBUG}
173 177 WriteLn(ClassType.ClassName+':'+'ReceivedAReply');
  178 + for i:= 0 to AMultipartMessage.Count-1 do
  179 + WriteLn(i,':',AMultipartMessage[i]);
174 180 {$ENDIF}
175 181 if Assigned(FOnReplyReceived) then FOnReplyReceived(AMultipartMessage);
176 182 end;
177 183  
178 184 procedure TZMQActor.RequestReceived(var AMultipartMessage: TStringList);
  185 +var i : integer;
179 186 begin
180 187 {$IFDEF DEBUG}
181 188 WriteLn(ClassType.ClassName+':'+'ReceivedARequest');
  189 + for i:= 0 to AMultipartMessage.Count-1 do
  190 + WriteLn(i,':',AMultipartMessage[i]);
182 191 {$ENDIF}
183 192 if Assigned(FOnRequestReceived) then FOnRequestReceived(AMultipartMessage);
184 193 end;
... ... @@ -196,16 +205,22 @@ begin
196 205 end;
197 206  
198 207 procedure TZMQActor.SendMessage(AMessage: array of UTF8string);
  208 +var i : integer;
199 209 begin
200 210 {$IFDEF DEBUG}
201 211 WriteLn(ClassType.ClassName+':'+'SendingMessage:'+AMessage[1]);
  212 + for i:= 0 to Length(AMessage)-1 do
  213 + WriteLn(i,':',AMessage[i]);
202 214 {$ENDIF}
203 215 end;
204 216  
205 217 procedure TZMQActor.Request(ARequest: array of UTF8string);
  218 +var i : integer;
206 219 begin
207 220 {$IFDEF DEBUG}
208 221 WriteLn(ClassType.ClassName+':'+'SendingRequest:'+ARequest[2]);
  222 + for i:= 0 to Length(ARequest)-1 do
  223 + WriteLn(i,':',ARequest[i]);
209 224 {$ENDIF}
210 225 end;
211 226  
... ...