Download as
Browse Code »

Commit 1722c6f81bf5f93dac6f8431a6cd70a3daa57e96

Authored by Carlos Picanco
1 parent 1a5f5479
Exists in master

work on criteria, prompt, messages and refac dumps

Showing 7 changed files with 893 additions and 599 deletions   Show diff stats
units/game_actors.pas
  Diff comments   View file @1722c6f
... ... @@ -80,23 +80,30 @@ type
80 80 private
81 81 FAppendicePlural: UTF8String;
82 82 FAppendiceSingular: UTF8String;
  83 + FLastPresentedMessage: UTF8string;
83 84 FNicname: UTF8String;
84   - protected
85 85 FStyle : TConsequenceStyle;
86 86 FP : TGamePoint;
87 87 FMessage : TPopupNotifier;
  88 + function GetShouldPublishMessage: Boolean;
  89 + protected
  90 + FConsequenceByPlayerID : TStringList;
88 91 procedure StopTimer(Sender:TObject;var ACloseAction:TCloseAction);
89 92 procedure TimerTimer(Sender:TOBject);virtual;
90 93 public
91 94 constructor Create(AOwner:TComponent; AP:TGamePoint; AStyle:TConsequenceStyle; AAppendiceSingular,AAppendicePlural:UTF8String);overload;
92 95 constructor Create(AOwner:TComponent; AP:integer; AStyle: TConsequenceStyle; AMessage:array of UTF8string);overload;
93   - constructor Create(AOwner:TComponent; AConsequenceString: UTF8String);overload;
  96 + constructor Create(AOwner:TComponent; AConsequenceString: UTF8String);virtual;overload;
94 97 destructor Destroy;override;
95   - function AsString: utf8string;
96   - procedure Present(Sender:TObject;ForGroup:Boolean);virtual;
  98 + function AsString(AID :UTF8String): UTF8String;
  99 + function PointMessage(ForGroup: Boolean):UTF8String;
  100 + procedure Present(ForGroup: Boolean);
  101 + property ShouldPublishMessage : Boolean read GetShouldPublishMessage;
  102 + property LastPresentedMessage : UTF8string read FLastPresentedMessage;
97 103 property PlayerNicname : UTF8String read FNicname write FNicname;
98 104 property AppendiceSingular : UTF8String read FAppendiceSingular;
99 105 property AppendicePlural : UTF8String read FAppendicePlural;
  106 + property ConsequenseByPlayerID : TStringList read FConsequenceByPlayerID;
100 107 end;
101 108  
102 109 { TContingency }
... ... @@ -130,13 +137,20 @@ type
130 137  
131 138 TPrompt = class(TConsequence)
132 139 private
  140 + FResponses : array of UTF8String;
  141 + FResult : UTF8String;
133 142 FPromptTargets : TContingencies; // need to test this
  143 + FPromptStyle : TPromptStyle;
  144 + FPromptMessage : UTF8String;
  145 + procedure ClearResponses;
134 146 public
135   - PromptStyle : TPromptStyle;
136   - PromptMessage : string;
137   - public
138   - procedure Present(Sender:TObject;ForGroup:Boolean);override;
139   - property APromptTargets: TContingencies read FPromptTargets;
  147 + constructor Create(AOwner:TComponent; APStyle:TPromptStyle; APTarget : TContingencies; AMessage:UTF8string);reintroduce;
  148 + function ResponsesCount : integer;
  149 + procedure AppendResponse(AID,R:UTF8String);
  150 + function AsString: TStringList; overload;
  151 + property Question: UTF8String read FPromptMessage;
  152 + property PromptResult:UTF8String read FResult;
  153 +
140 154 end;
141 155  
142 156 TEndConditionCriterium = record
... ... @@ -153,6 +167,10 @@ type
153 167 TCondition = record
154 168 ConditionName : string;
155 169 Contingencies : TContingencies; // for producing points during the condition
  170 + Interlocks : record
  171 + Count : integer; // culturant,
  172 + History: array of Boolean; // to calculate interlock porcentage in the last cycles. sync with OnCycles
  173 + end;
156 174  
157 175 Points : record
158 176 Count : TPoints; // sum of points produced during the condition
... ... @@ -165,7 +183,7 @@ type
165 183 Random: Boolean; // if we should change Players[i].Turn OnCycle
166 184 end;
167 185  
168   - Cycles : record // for changing generations
  186 + Cycles : record // for changing generations //absolute value is (Value * Generation)+Count
169 187 Count, // current cycle
170 188 Value, // CyclesPerLineage, CyclesPerGeneration
171 189 Generation : integer;
... ... @@ -176,7 +194,7 @@ type
176 194  
177 195 implementation
178 196  
179   -uses ButtonPanel,Controls,ExtCtrls,strutils, string_methods,
  197 +uses Graphics, strutils, string_methods,
180 198 form_matrixgame{,StdCtrls};
181 199  
182 200 { TContingency }
... ... @@ -198,8 +216,8 @@ end;
198 216  
199 217 procedure TContingency.CriteriaEvent;
200 218 begin
201   - // FConsequence.Present(FMeta);
202   - // do admin internals
  219 + FFired:=True;
  220 + if Assigned(FOnCriteria) then FOnCriteria(Self);
203 221 end;
204 222  
205 223 constructor TContingency.Create(AOwner:TComponent;AConsequence:TConsequence;ACriteria:TCriteria;IsMeta:Boolean);
... ... @@ -220,13 +238,7 @@ begin
220 238 Result += GetRowString(R) + ',';
221 239 Result += '|';
222 240  
223   - case FCriteria.Style of
224   - gtNone : Result += 'INDIFERENTE';
225   - gtRowsAndColors : Result += 'E';
226   - gtRowsOrColors : Result += 'OU';
227   - gtRowsOnly: Result += 'LINHAS';
228   - gtColorsOnly:Result += 'CORES';
229   - end;
  241 + Result += GetCriteriaStyleString(FCriteria.Style);
230 242 Result += ',';
231 243 Result += '|';
232 244  
... ... @@ -255,7 +267,7 @@ begin
255 267 gtRowsOrColors: Result := LRow or LColor;
256 268 end;
257 269 if Result then
258   - if Assigned(FOnCriteria) then FOnCriteria(Self);
  270 + CriteriaEvent;
259 271 end;
260 272  
261 273 function TContingency.ResponseMeetsCriteriaG(Players: TPlayers): Boolean;
... ... @@ -269,48 +281,50 @@ var i : integer;
269 281 function AllColorsEqual:Boolean;
270 282 var i : integer;
271 283 begin
272   - Result := True;
  284 + Result := not (gcNot in Criteria.Colors);
273 285 for i := 0 to Len-2 do
274 286 if Cs[i] <> Cs[i+1] then
275 287 begin
276   - Result := False;
277   - Break;
  288 + Result := not Result;
  289 + Break;
278 290 end;
279 291 end;
280 292  
281 293 function AllColorsDiff:Boolean;
282 294 var i : integer;
283 295 begin
284   - Result := True;
  296 + Result := not (gcNot in Criteria.Colors);
285 297 for i := 0 to Len-2 do
286 298 if Cs[i] = Cs[i+1] then
287 299 begin
288   - Result := False;
289   - Break;
  300 + Result := not Result;
  301 + Break;
290 302 end;
291 303 end;
292 304  
293 305 function AllRowsOdd: Boolean;
294 306 begin
  307 + Result := not (grNot in Criteria.Rows);
295 308 for R in Rs do
296 309 if RowMod(R) = grEven then
297 310 begin
298   - Result := False;
299   - Exit;
  311 + Result := not Result;
  312 + Break;
300 313 end;
301 314 end;
302 315  
303 316 function AllRowsEven: Boolean;
304 317 begin
  318 + Result := not (grNot in Criteria.Rows);
305 319 for R in Rs do
306 320 if RowMod(R) = grOdd then
307 321 begin
308   - Result := False;
309   - Exit;
  322 + Result := not Result;
  323 + Break;
310 324 end;
311 325 end;
312 326  
313   -begin // grDiff,grEqual,grAll
  327 +begin // All -> (Diff,Equal,Even, Odd) or not all
314 328 Result := False;
315 329 Len := Length(Players);
316 330 SetLength(Cs,Len);
... ... @@ -348,13 +362,13 @@ begin // grDiff,grEqual,grAll
348 362 Result := AllColorsDiff and AllRowsOdd;
349 363  
350 364 if (gcDiff in Criteria.Colors) and (grEven in Criteria.Rows) then
351   - Result := AllColorsDiff and AllRowsEven;
  365 + Result := AllColorsDiff and AllRowsEven;
352 366  
353 367 if (gcEqual in Criteria.Colors) and (grOdd in Criteria.Rows) then
354   - Result := AllColorsEqual and AllRowsOdd;
  368 + Result := AllColorsEqual and AllRowsOdd;
355 369  
356 370 if (gcEqual in Criteria.Colors) and (grEven in Criteria.Rows) then
357   - Result := AllColorsEqual and AllRowsEven;
  371 + Result := AllColorsEqual and AllRowsEven;
358 372 end;
359 373 gtRowsOrColors:
360 374 begin
... ... @@ -362,61 +376,118 @@ begin // grDiff,grEqual,grAll
362 376 Result := AllColorsDiff or AllRowsOdd;
363 377  
364 378 if (gcDiff in Criteria.Colors) and (grEven in Criteria.Rows) then
365   - Result := AllColorsDiff or AllRowsEven;
  379 + Result := AllColorsDiff or AllRowsEven;
366 380  
367 381 if (gcEqual in Criteria.Colors) and (grOdd in Criteria.Rows) then
368   - Result := AllColorsEqual or AllRowsOdd;
  382 + Result := AllColorsEqual or AllRowsOdd;
369 383  
370 384 if (gcEqual in Criteria.Colors) and (grEven in Criteria.Rows) then
371   - Result := AllColorsEqual or AllRowsEven;
  385 + Result := AllColorsEqual or AllRowsEven;
372 386 end;
373 387 end;
374 388 if Result then
375   - if Assigned(FOnCriteria) then FOnCriteria(Self);
  389 + CriteriaEvent;
376 390 end;
377 391  
378 392  
379 393 { TPrompt }
380 394  
381   -procedure TPrompt.Present(Sender: TObject; ForGroup: Boolean);
  395 +procedure TPrompt.ClearResponses;
  396 +begin
  397 + FResponses := nil;
  398 +end;
  399 +
  400 +constructor TPrompt.Create(AOwner: TComponent; APStyle: TPromptStyle;
  401 + APTarget: TContingencies; AMessage: UTF8string);
  402 +begin
  403 + inherited Create(AOwner);
  404 + FPromptStyle := APStyle;
  405 + FPromptTargets := APTarget;
  406 + FPromptMessage := AMessage;
  407 +end;
  408 +
  409 +function TPrompt.ResponsesCount: integer;
  410 +begin
  411 + Result := Length(FResponses);
  412 +end;
382 413  
383   - function AskQuestion: boolean;
384   - var
385   - dlg: TForm;
386   - buttonPanel: TButtonPanel;
387   - mainPanel: TPanel;
388   - mr: TModalResult;
  414 +procedure TPrompt.AppendResponse(AID, R: UTF8String);
  415 +begin
  416 + SetLength(FResponses,Length(FResponses)+1);
  417 + FResponses[High(FResponses)] := AID+'|'+R+'|';
  418 +end;
  419 +
  420 +function TPrompt.AsString: TStringList;
  421 +var
  422 + j,i : integer;
  423 + LID,LConsequence : UTF8string;
  424 + LCsqStyle : TConsequenceStyle;
  425 + Pts : integer;
  426 +
  427 + function AllPlayersClickedYes: Boolean;
  428 + var i : integer;
389 429 begin
390   - dlg:=TForm.CreateNew(nil);
391   - try
392   - with dlg do begin
393   - BorderStyle:=bsNone;
394   - WindowState:=wsFullScreen;
395   - //Position:=poScreenCenter;
396   - Caption:='Task ' + IntToStr(0 {Succ(0)});
397   - buttonPanel:=TButtonPanel.Create(dlg);
398   - with buttonPanel do begin
399   - ShowButtons:=[pbCancel, pbOK];
400   - ShowBevel:=False;
401   - Parent:=dlg;
402   - end;
403   - mainPanel:=TPanel.Create(dlg);
404   - with mainPanel do begin
405   - Align:=alClient;
406   - Caption:=Format('Task %d - GUI buttons/edits etc. go here',[0]);
407   - Parent:=dlg;
  430 + Result := True;
  431 + for i := 0 to Length(FResponses)-1 do
  432 + if ExtractDelimited(2,FResponses[i],['|']) = 'N' then
  433 + begin
  434 + Result := False;
408 435 end;
  436 + end;
  437 +
  438 + procedure ApplyPointsConditions(IsMeta:Boolean);
  439 + var
  440 + S : UTF8string;
  441 + begin
  442 + Pts := StrToInt(ExtractDelimited(1,LConsequence, ['|']));
  443 + if gsRevertPoints in FPromptStyle then
  444 + Pts := Pts*-1;
409 445  
410   - mr:=ShowModal;
411   - Result:=(mr = mrOK);
  446 + if (gscB in LCsqStyle) and (gsBasA in FPromptStyle) then
  447 + begin
  448 + LCsqStyle += [gscB];
  449 + LCsqStyle -= [gscA];
412 450 end;
413   - finally
414   - dlg.Free;
415   - end;
  451 +
  452 + if IsMeta then
  453 + S := 'M'
  454 + else
  455 + S := LID;
  456 +
  457 + LConsequence := S + '+' +
  458 + IntToStr(Pts) +'|'+
  459 + GetConsequenceStylesString(LCsqStyle) +'|'+
  460 + ExtractDelimited(3,LConsequence, ['|']) +'|'+
  461 + ExtractDelimited(4,LConsequence, ['|']) +'|'+
  462 + ExtractDelimited(5,LConsequence, ['|']);
416 463 end;
417 464 begin
418   - inherited Present(Sender, ForGroup);
419   - //SendMessage(AskQuestion);
  465 + // to do, sanitize FPromptStyle first
  466 + Pts:= 0;
  467 + if (gsAll in FPromptStyle) and (gsYes in FPromptStyle) then
  468 + if AllPlayersClickedYes then
  469 + for i := 0 to Length(FPromptTargets)-1 do
  470 + for j := 0 to FPromptTargets[i].Consequence.ConsequenseByPlayerID.Count do
  471 + begin
  472 + LID := FPromptTargets[i].Consequence.ConsequenseByPlayerID.Names[j];
  473 + LConsequence := FPromptTargets[i].Consequence.ConsequenseByPlayerID.Values[LID];
  474 + LCsqStyle := GetConsequenceStylesFromString(ExtractDelimited(2,LConsequence, ['|']));
  475 +
  476 + if gsContingency in FPromptStyle then
  477 + if (FPromptTargets[i].Fired) and (not FPromptTargets[i].Meta) then
  478 + if (gscA in LCsqStyle) or (gscB in LCsqStyle) then
  479 + ApplyPointsConditions(False);
  480 +
  481 +
  482 + if gsMetacontingency in FPromptStyle then
  483 + if (FPromptTargets[i].Fired) and FPromptTargets[i].Meta then
  484 + if gscG in LCsqStyle then
  485 + ApplyPointsConditions(True);
  486 +
  487 + Result := TStringList.Create;
  488 + Result.Add(LConsequence);
  489 + end;
  490 +
420 491 end;
421 492  
422 493 { TConsequence }
... ... @@ -431,6 +502,7 @@ begin
431 502 FAppendicePlural:=AAppendicePlural;
432 503 FP := AP;
433 504 FMessage := TPopupNotifier.Create(AOwner);
  505 + FConsequenceByPlayerID := TStringList.Create;
434 506 end;
435 507  
436 508 constructor TConsequence.Create(AOwner: TComponent; AP: integer;
... ... @@ -443,83 +515,65 @@ begin
443 515 FAppendicePlural:=AMessage[2];
444 516 FP := TGamePoint.Create(AOwner,AP);
445 517 FMessage := TPopupNotifier.Create(AOwner);
  518 + FConsequenceByPlayerID := TStringList.Create;
446 519 end;
447 520  
448 521 constructor TConsequence.Create(AOwner: TComponent;
449 522 AConsequenceString: UTF8String);
450   -
451   - function GetConsequenceStyleFromString(S:UTF8String):TConsequenceStyle;
452   - var
453   - LCount,
454   - i : integer;
455   - begin
456   - Result := [];
457   - LCount := WordCount(S,[#0,',']);
458   - for i:= 1 to LCount do
459   - case ExtractDelimited(i,S,[',']) of
460   - '0':Result+=[gscNone];
461   - 'M':Result+=[gscMessage];
462   - 'C':Result+=[gscBroadcastMessage];
463   - 'P':Result+=[gscPoints];
464   - 'V':Result+=[gscVariablePoints];
465   - 'A':Result+=[gscA];
466   - 'B':Result+=[gscB];
467   - end;
468   - end;
469   -
470 523 begin
471 524 inherited Create(AOwner);
472 525 FP := TGamePoint.Create(AOwner,ExtractDelimited(1,AConsequenceString,['|']));
473   - FStyle:=GetConsequenceStyleFromString(ExtractDelimited(2,AConsequenceString,['|']));
  526 + FStyle:=GetConsequenceStylesFromString(ExtractDelimited(2,AConsequenceString,['|']));
474 527 FNicname:=ExtractDelimited(3,AConsequenceString,['|']);
475 528 FAppendiceSingular:=ExtractDelimited(4,AConsequenceString,['|']);
476 529 FAppendicePlural:=ExtractDelimited(5,AConsequenceString,['|']);
477 530 FMessage := TPopupNotifier.Create(AOwner);
  531 + FConsequenceByPlayerID := TStringList.Create;
478 532 end;
479 533  
480 534 destructor TConsequence.Destroy;
481 535 begin
  536 + FConsequenceByPlayerID.Free;
482 537 inherited Destroy;
483 538 end;
484 539  
485   -function TConsequence.AsString: utf8string;
486   - function GetConsequenceStyleString(CS:TConsequenceStyle): UTF8String;
487   - var ConsequenceStyle : TGameConsequenceStyle;
488   - begin
489   - Result := '';
490   - for ConsequenceStyle in CS do
491   - begin
492   - case ConsequenceStyle of
493   - gscNone: Result += '0';
494   - gscMessage:Result += 'M';
495   - gscBroadcastMessage:Result += 'C';
496   - gscPoints:Result += 'P';
497   - gscVariablePoints:Result += 'V';
498   - gscA:Result += 'A';
499   - gscB:Result += 'B';
500   - end;
501   - Result += ',';
502   - end;
503   - end;
504   -
  540 +function TConsequence.AsString(AID: UTF8String): UTF8String;
505 541 begin
506   - Result := IntToStr(FP.Value)+','+IntToStr(FP.Variation) + '|';
507   - Result += GetConsequenceStyleString(FStyle)+'|';
  542 + Result := IntToStr(FP.ValueWithVariation) + '|';
  543 + Result += GetConsequenceStylesString(FStyle)+'|';
508 544 Result += FNicname +'|';
509 545 Result += FAppendiceSingular + '|';
510 546 Result += FAppendicePlural + '|';
  547 + FConsequenceByPlayerID.Values[AID]:=Result;
511 548 end;
512 549  
  550 +function TConsequence.PointMessage(ForGroup: Boolean): UTF8String;
  551 +begin
  552 + Result := FP.PointMessage(FNicname,FAppendicePlural, FAppendiceSingular,ForGroup);
  553 +
  554 + if gscA in FStyle then
  555 + FormMatrixGame.LabelIndACount.Caption := IntToStr(StrToInt(FormMatrixGame.LabelIndACount.Caption) + FP.ResultAsInteger);
513 556  
514   -procedure TConsequence.Present(Sender: TObject; ForGroup: Boolean);
  557 + if gscB in FStyle then
  558 + FormMatrixGame.LabelIndBCount.Caption := IntToStr(StrToInt(FormMatrixGame.LabelIndBCount.Caption) + FP.ResultAsInteger);
  559 +
  560 + if gscG in FStyle then
  561 + FormMatrixGame.LabelGroupCount.Caption:= IntToStr(StrToInt(FormMatrixGame.LabelGroupCount.Caption) + FP.ResultAsInteger);
  562 +end;
  563 +
  564 +
  565 +procedure TConsequence.Present(ForGroup: Boolean);
515 566 var
516 567 PopUpPos : TPoint;
517 568 begin
518   - PopUpPos.X := FormMatrixGame.StringGridMatrix.Left+FormMatrixGame.StringGridMatrix.Width;
519   - PopUpPos.Y := FormMatrixGame.StringGridMatrix.Top;
520   - PopUpPos := FormMatrixGame.StringGridMatrix.ClientToScreen(PopUpPos);
  569 + PopUpPos.X := FormMatrixGame.GBIndividualAB.Left;
  570 + PopUpPos.Y := FormMatrixGame.GBIndividualAB.Top+FormMatrixGame.GBIndividual.Height-10;
  571 + PopUpPos := FormMatrixGame.ClientToScreen(PopUpPos);
521 572  
  573 + FMessage.Color:=clTeal;
  574 + FMessage.Title:='';
522 575 FMessage.Text := FP.PointMessage(FNicname,FAppendicePlural, FAppendiceSingular,ForGroup);
  576 + FLastPresentedMessage := FMessage.Text;
523 577 FMessage.OnClose:=@StopTimer;
524 578 FormMatrixGame.Timer.OnTimer := @TimerTimer;
525 579  
... ... @@ -532,15 +586,20 @@ begin
532 586 if gscG in FStyle then
533 587 FormMatrixGame.LabelGroupCount.Caption:= IntToStr(StrToInt(FormMatrixGame.LabelGroupCount.Caption) + FP.ResultAsInteger);
534 588  
  589 + if gscBroadcastMessage in FStyle then Exit;
535 590 FMessage.ShowAtPos(PopUpPos.X, PopUpPos.Y);
536 591 FormMatrixGame.Timer.Enabled:=True;
537 592 end;
538 593  
  594 +function TConsequence.GetShouldPublishMessage: Boolean;
  595 +begin
  596 + Result := gscBroadcastMessage in FStyle;
  597 +end;
  598 +
539 599 procedure TConsequence.StopTimer(Sender: TObject; var ACloseAction: TCloseAction
540 600 );
541 601 begin
542 602 FormMatrixGame.Timer.Enabled:=False;
543   - Free;
544 603 end;
545 604  
546 605 procedure TConsequence.TimerTimer(Sender: TOBject);
... ...
units/game_actors_point.pas
  Diff comments   View file @1722c6f
... ... @@ -19,15 +19,15 @@ type
19 19 function GetResult: integer;
20 20 function GetResultAsString: string;
21 21 function GetValue: integer;
22   - procedure SetValue(AValue: integer);
23 22 public
24 23 //Cycles : integer; // specify when present points regarding condition cycles
25 24 constructor Create(AOwner:TComponent;AValue : integer);overload;
26 25 constructor Create(AOwner:TComponent;AValue : array of integer); overload;
27   - constructor Create(AOwner:TComponent;AValue : utf8string); overload;
  26 + constructor Create(AOwner:TComponent;AResult : UTF8String); overload;
28 27 function PointMessage(APrepend, AAppendicePlural, AAppendiceSingular: string; IsGroupPoint: Boolean) : string;
29   - property Value : integer read GetValue write SetValue;
  28 + property ValueWithVariation : integer read GetValue write FValue;
30 29 property Variation : integer read FVariation write FVariation;
  30 +
31 31 property AsString : string read GetResultAsString;
32 32 property ResultAsInteger : integer read GetResult;
33 33 end;
... ... @@ -67,11 +67,6 @@ begin
67 67 Result := IntToStr(FResult);
68 68 end;
69 69  
70   -procedure TGamePoint.SetValue(AValue: integer);
71   -begin
72   - FValue := AValue;
73   -end;
74   -
75 70 constructor TGamePoint.Create(AOwner: TComponent; AValue: integer);
76 71 begin
77 72 inherited Create(AOwner);
... ... @@ -86,15 +81,15 @@ begin
86 81 FVariation := AValue[1];
87 82 end;
88 83  
89   -constructor TGamePoint.Create(AOwner: TComponent; AValue: utf8string);
  84 +constructor TGamePoint.Create(AOwner: TComponent; AResult: utf8string);
90 85 begin
91   - FValue := StrToInt(ExtractDelimited(1,AValue,[',']));
92   - FVariation := StrToInt(ExtractDelimited(2,AValue,[',']));
  86 + FValue := 0;//does not matter here, this creation method is called by a player, admin sent a result
  87 + FVariation := 0;
  88 + FResult := StrToInt(AResult);
93 89 end;
94 90  
95 91 function TGamePoint.PointMessage(APrepend, AAppendicePlural, AAppendiceSingular: string; IsGroupPoint: Boolean): string;
96 92 begin
97   - Self.Value;
98 93 if IsGroupPoint then
99 94 begin
100 95 if APrepend = '' then
... ... @@ -108,8 +103,8 @@ begin
108 103 -MaxInt..-2: Result += ' produziram a perda de '+Self.AsString+ ' pontos para o grupo';
109 104 -1 : Result += ' produziram a perda de 1 ponto para o grupo';
110 105 0 : Result += ' pontos do grupo não foram produzidos nem perdidos';
111   - 1 : Result += 'produziram 1 ponto para o grupo';
112   - 2..MaxInt: Result += 'produziu '+Self.AsString+' pontos para o grupo'
  106 + 1 : Result += ' produziram 1 ponto para o grupo';
  107 + 2..MaxInt: Result += ' produziram '+Self.AsString+' pontos para o grupo'
113 108 end;
114 109 end
115 110 else
... ... @@ -118,8 +113,8 @@ begin
118 113 -MaxInt..-2: Result += ' produziram a perda de '+Self.AsString+ ' ' + AAppendicePlural;
119 114 -1 : Result += ' produziram a perda de 1'+ ' ' + AAppendiceSingular;
120 115 0 : Result += ' não produziram ' + AAppendicePlural;
121   - 1 : Result += ' produziram 1 ponto ' + AAppendiceSingular;
122   - 2..MaxInt: Result += 'produziu '+Self.AsString+ ' ' + AAppendicePlural;
  116 + 1 : Result += ' produziram 1 ' + AAppendiceSingular;
  117 + 2..MaxInt: Result += ' produziram '+Self.AsString+ ' ' + AAppendicePlural;
123 118 end;
124 119 end;
125 120 end
... ... @@ -137,17 +132,17 @@ begin
137 132 -1 : Result += ' perdeu 1 ponto';
138 133 0 : Result += ' não perdeu nem ganhou pontos';
139 134 1 : Result += ' ganhou 1 ponto';
140   - 2..MaxInt: Result += 'ganhou '+Self.AsString+' pontos'
  135 + 2..MaxInt: Result += ' ganhou '+Self.AsString+' pontos'
141 136 end;
142 137 end
143 138 else
144 139 begin
145 140 case FValue of
146 141 -MaxInt..-2: Result += ' perdeu '+Self.AsString+ ' ' + AAppendicePlural;
147   - -1 : Result += ' ponto 1'+ ' ' + AAppendiceSingular;
  142 + -1 : Result += ' ponto 1 ' + AAppendiceSingular;
148 143 0 : Result += ' não perdeu nem ganhou ' + AAppendicePlural;
149   - 1 : Result += ' ganhou 1 ponto ' + AAppendiceSingular;
150   - 2..MaxInt: Result += 'ganhou '+Self.AsString+ ' ' + AAppendicePlural;
  144 + 1 : Result += ' ganhou 1 ' + AAppendiceSingular;
  145 + 2..MaxInt: Result += ' ganhou '+Self.AsString+ ' ' + AAppendicePlural;
151 146 end;
152 147 end;
153 148 end;
... ...
units/game_control.pas
  Diff comments   View file @1722c6f
... ... @@ -43,12 +43,21 @@ type
43 43 procedure SetMustDrawDotsClear(AValue: Boolean);
44 44 procedure SetRowBase(AValue: integer);
45 45 private
46   - function ShouldStartExperiment : Boolean;
  46 + function AskQuestion(AQuestion:UTF8string):UTF8String;
  47 + procedure ShowPopUp(AText:UTF8String);
  48 + procedure DisableConfirmationButton;
  49 + procedure CleanMatrix(AEnabled : Boolean);
  50 + procedure EnablePlayerMatrix(AID:UTF8String; ATurn:integer; AEnabled:Boolean);
  51 + private
  52 + function ShouldStartCycle : Boolean;
  53 + function ShouldAskQuestion : Boolean;
47 54 procedure KickPlayer(AID:string);
48 55 procedure NextTurn(Sender: TObject);
49 56 procedure NextCycle(Sender: TObject);
50 57 procedure NextLineage(Sender: TObject);
51 58 procedure NextCondition(Sender: TObject);
  59 + procedure Interlocking(Sender: TObject);
  60 + procedure Consequence(Sender: TObject);
52 61 procedure EndExperiment(Sender: TObject);
53 62 procedure StartExperiment;
54 63 public
... ... @@ -77,6 +86,7 @@ const
77 86 K_REFUSED = '.Refused';
78 87 K_CHAT_M = '.ChatM';
79 88 K_CHOICE = '.Choice';
  89 + K_MESSAGE = '.Message';
80 90 K_START = '.Start';
81 91 K_LEFT = '.Left';
82 92 K_RESUME = '.Resume';
... ... @@ -84,6 +94,7 @@ const
84 94 K_LOGIN = '.Login';
85 95 K_KICK = '.Kick';
86 96 K_QUESTION = '.Question';
  97 + K_QMESSAGE = '.QMessage';
87 98 //
88 99 K_STATUS = '.Status';
89 100 K_CYCLES = '.OnEndCycle';
... ... @@ -92,7 +103,9 @@ const
92 103  
93 104 implementation
94 105  
95   -uses LazUTF8, form_matrixgame, form_chooseactor, game_resources, strutils, string_methods, zhelpers;
  106 +uses ButtonPanel,Controls,ExtCtrls,
  107 + LazUTF8, Forms, strutils, zhelpers,
  108 + form_matrixgame, form_chooseactor, game_resources, string_methods ;
96 109  
97 110 const
98 111 GA_ADMIN = 'Admin';
... ... @@ -117,11 +130,17 @@ end;
117 130  
118 131 { TGameControl }
119 132  
120   -function TGameControl.ShouldStartExperiment: Boolean;
  133 +function TGameControl.ShouldStartCycle: Boolean; // starts experiment too
121 134 begin
122 135 Result := FExperiment.PlayersCount = FExperiment.Condition[FExperiment.CurrentCondition].Turn.Value;
123 136 end;
124 137  
  138 +function TGameControl.ShouldAskQuestion: Boolean; // end cycle, restart alias
  139 +begin
  140 + // TODO: prompt only when an odd row was selected
  141 + Result := ShouldStartCycle and FExperiment.Condition[FExperiment.CurrentCondition].Contingencies[3].Fired;
  142 +end;
  143 +
125 144 procedure TGameControl.KickPlayer(AID: string);
126 145 begin
127 146 FZMQActor.SendMessage([K_KICK, AID]);
... ... @@ -134,9 +153,7 @@ begin
134 153  
135 154 // inform players
136 155  
137   -{$IFDEF DEBUG}
138   - WriteLn('TGameControl.NextTurn');
139   -{$ENDIF}
  156 +
140 157 end;
141 158  
142 159 procedure TGameControl.NextCycle(Sender: TObject);
... ... @@ -144,8 +161,9 @@ begin
144 161 // prompt question to all players
145 162 FormMatrixGame.LabelExpCountCycle.Caption:=IntToStr(FExperiment.Condition[FExperiment.CurrentCondition].Cycles.Count);
146 163 {$IFDEF DEBUG}
147   - WriteLn('TGameControl.NextTurn');
  164 + WriteLn('cycle:',FExperiment.ConsequenceStringFromChoices);
148 165 {$ENDIF}
  166 + //FZMQActor.SendMessage([K_CYCLES])
149 167 end;
150 168  
151 169 procedure TGameControl.NextLineage(Sender: TObject);
... ... @@ -166,6 +184,20 @@ begin
166 184 // append which player
167 185 end;
168 186  
  187 +procedure TGameControl.Interlocking(Sender: TObject);
  188 +begin
  189 + FormMatrixGame.LabelExpCountInterlocks.Caption:= IntToStr(FExperiment.Condition[FExperiment.CurrentCondition].Interlocks.Count);
  190 +
  191 +end;
  192 +
  193 +procedure TGameControl.Consequence(Sender: TObject);
  194 +begin
  195 +{$IFDEF DEBUG}
  196 + if Sender is TConsequence then
  197 + FormMatrixGame.ChatMemoRecv.Lines.Append(('['+TConsequence(Sender).PlayerNicname+']: ')+TConsequence(Sender).AsString(''));
  198 +{$ENDIF}
  199 +end;
  200 +
169 201 procedure TGameControl.EndExperiment(Sender: TObject);
170 202 begin
171 203  
... ... @@ -298,7 +330,7 @@ end;
298 330  
299 331 function TGameControl.GetSelectedColorF(AStringGrid: TStringGrid): UTF8string;
300 332 begin
301   - Result := GetRowColorString(GetRowColor(AStringGrid.Selection.Top,RowBase));
  333 + Result := GetColorString(GetRowColor(AStringGrid.Selection.Top,RowBase));
302 334 end;
303 335  
304 336 function TGameControl.GetSelectedRowF(AStringGrid: TStringGrid): UTF8string;
... ... @@ -332,6 +364,80 @@ begin
332 364 FRowBase:=AValue;
333 365 end;
334 366  
  367 +function TGameControl.AskQuestion(AQuestion: UTF8string): UTF8String;
  368 +var
  369 + Prompt: TForm;
  370 + ButtonPanel: TButtonPanel;
  371 + QuestionPanel: TPanel;
  372 + mr: TModalResult;
  373 +begin
  374 + Prompt:=TForm.CreateNew(nil);
  375 + try
  376 + with Prompt do begin
  377 + BorderStyle:=bsNone;
  378 + Position:=poScreenCenter;
  379 + ButtonPanel:=TButtonPanel.Create(Prompt);
  380 + with ButtonPanel do begin
  381 + ButtonOrder:=boCloseOKCancel;
  382 + OKButton.Caption:='Sim';
  383 + CancelButton.Caption:='Não';
  384 + ShowButtons:=[pbOK, pbCancel];
  385 + ShowBevel:=True;
  386 + ShowGlyphs:=[];
  387 + Parent:=Prompt;
  388 + end;
  389 + QuestionPanel:=TPanel.Create(Prompt);
  390 + with QuestionPanel do begin
  391 + Align:=alClient;
  392 + Caption:= AQuestion;
  393 + Parent:=Prompt;
  394 + end;
  395 +
  396 + mr:=ShowModal;
  397 + if mr = mrOK then
  398 + Result := 'S'
  399 + else Result := 'N';
  400 + end;
  401 + finally
  402 + Prompt.Free;
  403 + end;
  404 +end;
  405 +
  406 +procedure TGameControl.ShowPopUp(AText: UTF8String);
  407 +var PopUpPos : TPoint;
  408 +begin
  409 + PopUpPos.X := FormMatrixGame.GBIndividualAB.Left;
  410 + PopUpPos.Y := FormMatrixGame.GBIndividualAB.Top+FormMatrixGame.GBIndividual.Height-10;
  411 + PopUpPos := FormMatrixGame.ClientToScreen(PopUpPos);
  412 + FormMatrixGame.PopupNotifier.Title:='';
  413 + FormMatrixGame.PopupNotifier.Text:=AText;
  414 + FormMatrixGame.PopupNotifier.ShowAtPos(PopUpPos.X,PopUpPos.Y);
  415 + FormMatrixGame.Timer.OnTimer:=@FormMatrixGame.TimerTimer;
  416 + FormMatrixGame.Timer.Enabled:=True;
  417 +end;
  418 +
  419 +procedure TGameControl.DisableConfirmationButton;
  420 +begin
  421 + FormMatrixGame.StringGridMatrix.Enabled:= False;
  422 + FormMatrixGame.btnConfirmRow.Enabled:=False;
  423 + FormMatrixGame.btnConfirmRow.Caption:='OK';
  424 +end;
  425 +
  426 +procedure TGameControl.CleanMatrix(AEnabled : Boolean);
  427 +begin
  428 + FormMatrixGame.StringGridMatrix.Enabled:=AEnabled;
  429 + FormMatrixGame.StringGridMatrix.Options := FormMatrixGame.StringGridMatrix.Options-[goRowSelect];
  430 + FormMatrixGame.btnConfirmRow.Enabled:=True;
  431 + FormMatrixGame.btnConfirmRow.Caption:='Confirmar';
  432 + FormMatrixGame.btnConfirmRow.Visible := False;
  433 +end;
  434 +
  435 +procedure TGameControl.EnablePlayerMatrix(AID:UTF8String; ATurn:integer; AEnabled:Boolean);
  436 +begin
  437 + if FExperiment.PlayerFromID[AID].Turn = ATurn then
  438 + CleanMatrix(AEnabled);
  439 +end;
  440 +
335 441 constructor TGameControl.Create(AOwner: TComponent);
336 442 begin
337 443 FZMQActor := TZMQActor(AOwner);
... ... @@ -358,13 +464,18 @@ begin
358 464 FExperiment.OnEndTurn := @NextTurn;
359 465 FExperiment.OnEndCycle := @NextCycle;
360 466 FExperiment.OnEndGeneration:=@NextLineage;
  467 + FExperiment.OnInterlocking:=@Interlocking;
  468 + FExperiment.OnConsequence:=@Consequence;
361 469 FExperiment.OnEndCondition:= @NextCondition;
362 470 FExperiment.OnEndExperiment:= @EndExperiment;
  471 + FExperiment.OnInterlocking := @Interlocking;
363 472  
364 473 NextTurn(Self);
365 474 NextCycle(Self);
366 475 NextLineage(Self);
367 476 NextCondition(Self);
  477 + Interlocking(Self);
  478 + Consequence(Self);
368 479  
369 480 SendRequest(K_LOGIN);
370 481 end;
... ... @@ -480,11 +591,6 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
480 591 var P : TPlayer;
481 592 begin
482 593 case FActor of
483   - gaAdmin:
484   - begin
485   - // do nothing
486   - end;
487   -
488 594 gaPlayer:
489 595 begin
490 596 P := FExperiment.PlayerFromString[AMessage[1]];
... ... @@ -497,19 +603,6 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
497 603 CreatePlayerBox(P,False);
498 604 end;
499 605 end;
500   -
501   - end;
502   -
503   - procedure SetPMatrix(ATurn:integer; AEnabled:Boolean);
504   - begin
505   - if FExperiment.PlayerFromID[Self.ID].Turn = ATurn then
506   - begin
507   - FormMatrixGame.StringGridMatrix.Enabled:=AEnabled;
508   - FormMatrixGame.StringGridMatrix.Options := FormMatrixGame.StringGridMatrix.Options-[goRowSelect];
509   - FormMatrixGame.btnConfirmRow.Enabled:=True;
510   - FormMatrixGame.btnConfirmRow.Caption:='Confirmar';
511   - FormMatrixGame.btnConfirmRow.Visible := False;
512   - end;
513 606 end;
514 607  
515 608 procedure ReceiveChoice;
... ... @@ -521,52 +614,58 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
521 614 with GetPlayerBox(P.ID) do
522 615 begin
523 616 LabelLastRowCount.Caption := AMessage[2];
524   - PanelLastColor.Color := GetRowColorFromString(AMessage[3]);
  617 + PanelLastColor.Color := GetColorFromString(AMessage[3]);
525 618 PanelLastColor.Caption:='';
526 619 end;
527 620  
528 621 case FActor of
529 622 gaPlayer:begin
  623 + if FExperiment.PlayersCount = P.Turn+1 then
  624 + begin
  625 + // update next turn
  626 + if Self.ID = P.ID then
  627 + begin
  628 + P.Turn := StrToInt(AMessage[4]);
  629 + FExperiment.Player[Self.ID] := P;
  630 + end;
  631 +
  632 + // no wait turns
  633 + // EnablePlayerMatrix(Self.ID,0, True);
  634 +
  635 + //CleanMatrix;
  636 + CleanMatrix(False);
  637 +
  638 + // wait for server
  639 + Exit;
  640 + end;
  641 +
530 642 if Self.ID = P.ID then
531 643 begin
532   - FormMatrixGame.StringGridMatrix.Enabled:= False;
533   - FormMatrixGame.btnConfirmRow.Enabled:=False;
534   - FormMatrixGame.btnConfirmRow.Caption:='OK';
  644 + // update confirmation button
  645 + DisableConfirmationButton;
  646 +
  647 + // update next turn
  648 + P.Turn := StrToInt(AMessage[4]);
  649 + FExperiment.Player[Self.ID] := P;
535 650 end
536 651 else
537   - SetPMatrix(P.Turn+1, True);
538   - end;
539   -
540   - gaAdmin:begin
541   - FExperiment.NextTurn;
  652 + EnablePlayerMatrix(Self.ID,P.Turn+1, True);
542 653 end;
543 654 end;
544 655 end;
545 656  
546 657 procedure NotifyPlayers;
547   - var PopUpPos : TPoint;
548 658 begin
549 659 case FActor of
550 660 gaPlayer:
551   - begin
552   - PopUpPos.X := FormMatrixGame.StringGridMatrix.Left+FormMatrixGame.StringGridMatrix.Width;
553   - PopUpPos.Y := FormMatrixGame.StringGridMatrix.Top;
554   - PopUpPos := FormMatrixGame.StringGridMatrix.ClientToScreen(PopUpPos);
555 661 if FExperiment.PlayerFromID[Self.ID].Turn = 0 then
556 662 begin
557   - PopUpPos.X := FormMatrixGame.StringGridMatrix.Left+FormMatrixGame.StringGridMatrix.Width;
558   - PopUpPos.Y := FormMatrixGame.StringGridMatrix.Top;
559   - SetPMatrix(0, True);
560   - FormMatrixGame.PopupNotifier.Text:='É sua vez! Clique sobre uma linha da matrix e confirme sua escolha.';
561   - FormMatrixGame.PopupNotifier.ShowAtPos(PopUpPos.X,PopUpPos.Y);
  663 + EnablePlayerMatrix(Self.ID, 0, True);
  664 + ShowPopUp('É sua vez! Clique sobre uma linha da matrix e confirme sua escolha.');
562 665 end
563 666 else
564   - begin
565   - FormMatrixGame.PopupNotifier.Text:='Começou! Aguarde sua vez.';
566   - FormMatrixGame.PopupNotifier.ShowAtPos(PopUpPos.X,PopUpPos.Y);
567   - end;
568   - FormMatrixGame.Timer.Enabled:=True;
569   - end;
  667 + ShowPopUp('Começou! Aguarde sua vez.');
  668 +
570 669 end;
571 670 end;
572 671  
... ... @@ -578,19 +677,7 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
578 677 case FActor of
579 678 gaPlayer:
580 679 begin
581   - if FExperiment.PlayerFromID[Self.ID].Turn = 0 then
582   - begin
583   - SetPMatrix(0,True);
584   - end
585   - else
586   - begin
587   - //CleanMatrix;
588   - FormMatrixGame.StringGridMatrix.Enabled:=False;
589   - FormMatrixGame.StringGridMatrix.Options := FormMatrixGame.StringGridMatrix.Options-[goRowSelect];
590   - FormMatrixGame.btnConfirmRow.Enabled:=True;
591   - FormMatrixGame.btnConfirmRow.Caption:='Confirmar';
592   - FormMatrixGame.btnConfirmRow.Visible := False;
593   - end;
  680 +
594 681 end;
595 682 end;
596 683 end;
... ... @@ -619,49 +706,80 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
619 706 end;
620 707 end;
621 708  
622   - procedure ResumeActor;
  709 + procedure ShowQuestion;
623 710 begin
624 711 case FActor of
625   - gaPlayer:begin
626   -
627   - end;
628   - gaAdmin:begin
629   -
630   - end;
  712 + gaPlayer:FZMQActor.Request([
  713 + FZMQActor.ID
  714 + , ' '
  715 + , GA_PLAYER+K_QUESTION
  716 + , AskQuestion(AMessage[1])
  717 + ]);
631 718 end;
632 719 end;
633   -
634   - procedure ReceiveLogin;
  720 +//
  721 +// procedure ResumeActor;
  722 +// begin
  723 +// case FActor of
  724 +// gaPlayer:begin
  725 +//
  726 +// end;
  727 +// gaAdmin:begin
  728 +//
  729 +// end;
  730 +// end;
  731 +// end;
  732 +
  733 +
  734 + procedure QuestionMessages;
  735 + var
  736 + LConsequence : TConsequence;
  737 + i : integer;
  738 + MID : UTF8String;
635 739 begin
636 740 case FActor of
  741 + // AMessage[i] :=
  742 + // S + '+' +
  743 + // IntToStr(Pts) +'|'+
  744 + // GetConsequenceStylesString(LCsqStyle) +'|'+
  745 + // ExtractDelimited(3,LConsequence, ['|']) +'|'+
  746 + // ExtractDelimited(4,LConsequence, ['|']) +'|'+
  747 + // ExtractDelimited(5,LConsequence, ['|']);
637 748 gaPlayer:begin
638   -
639   - end;
640   - gaAdmin:begin
641   -
  749 + if AMessage.Count > 1 then
  750 + begin
  751 + for i := 1 to AMessage.Count -1 do
  752 + begin
  753 + MID := ExtractDelimited(1,AMessage[i],['+']);
  754 + if (MID = 'M') or (MID = Self.ID) then
  755 + begin
  756 + LConsequence := TConsequence.Create(FormMatrixGame,ExtractDelimited(2,AMessage[i],['+']));
  757 + //LConsequence.PlayerNicname := P.Nicname;
  758 + ShowPopUp(LConsequence.PointMessage(MID = 'M'));
  759 + while FormMatrixGame.PopupNotifier.Visible do
  760 + Application.ProcessMessages;
  761 +
  762 + {$IFDEF DEBUG}
  763 + WriteLn('A consequence should have shown.');
  764 + {$ENDIF}
  765 + end;
  766 + end;
  767 + end;
642 768 end;
643 769 end;
644 770 end;
645 771  
646   - procedure ReceiveLogout;
647   - begin
648   - case FActor of
649   - gaPlayer:begin
650   -
651   - end;
652   - gaAdmin:begin
653   -
654   - end;
655   - end;
656   - end;
657 772  
658 773 begin
659 774 if MHas(K_ARRIVED) then ReceiveActor;
660 775 if MHas(K_CHAT_M) then ReceiveChat;
661 776 if MHas(K_CHOICE) then ReceiveChoice;
  777 + if MHas(K_MESSAGE) then ShowPopUp(AMessage[1]);
662 778 if MHas(K_KICK) then SayGoodBye;
663 779 if MHas(K_START) then NotifyPlayers;
664 780 if MHas(K_CYCLES) then OnEndCycle;
  781 + if MHas(K_QUESTION) then ShowQuestion;
  782 + if MHas(K_QMESSAGE) then QuestionMessages;
665 783 end;
666 784  
667 785 // Here FActor is garanted to be a TZMQAdmin
... ... @@ -738,8 +856,8 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList);
738 856 // inform all players about the new player, including itself
739 857 FZMQActor.SendMessage([K_ARRIVED,PS]);
740 858  
741   - // start Experiment if allowed
742   - if ShouldStartExperiment then
  859 + // start Experiment
  860 + if ShouldStartCycle then
743 861 StartExperiment;
744 862  
745 863 end
... ... @@ -759,18 +877,66 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList);
759 877 begin
760 878 P := FExperiment.PlayerFromID[ARequest[0]];
761 879 P.Choice.Row:= GetRowFromString(ARequest[3]); // row
762   - P.Choice.Color:= GetColorFromString(ARequest[4]); // color
  880 + P.Choice.Color:= GetGameColorFromString(ARequest[4]); // color
763 881 ARequest[2] := K_CHOICE+K_ARRIVED;
764   - ARequest.Append(FExperiment.ConsequenceStringFromChoice[P]); //individual consequences
765   - FZMQActor.SendMessage([K_CHOICE,P.ID,ARequest[3],ARequest[4]]);
  882 +
  883 + //individual consequences
  884 + ARequest.Append(FExperiment.ConsequenceStringFromChoice[P]);
  885 +
  886 + // update turn
  887 + P.Turn := FExperiment.NextTurn;
  888 + FExperiment.Player[P.ID] := P;
  889 +
  890 + // broadcast choice
  891 + FZMQActor.SendMessage([K_CHOICE,P.ID,ARequest[3],ARequest[4],IntToStr(P.Turn)]);
  892 +
  893 + if ShouldAskQuestion then // TODO: prompt only when an odd row was selected
  894 + begin
  895 + P.Turn := 0;
  896 + FZMQActor.SendMessage([K_QUESTION,FExperiment.Condition[FExperiment.CurrentCondition].Prompt.Question]);
  897 + end;
766 898 end;
767 899  
  900 + procedure ValidateQuestionResponse;
  901 + var
  902 + P : TPlayer;
  903 + M : array of UTF8string;
  904 + i : integer;
  905 + LPromptConsequences : TStringList;
  906 + begin
  907 + P := FExperiment.PlayerFromID[ARequest[0]];
  908 + ARequest[2] := K_QUESTION+K_ARRIVED;
  909 +
  910 + // append response of each player
  911 + FExperiment.Condition[FExperiment.CurrentCondition].Prompt.AppendResponse(P.ID,ARequest[3]);
  912 +
  913 + // return to experiment and present the prompt consequence, if any
  914 + if FExperiment.Condition[FExperiment.CurrentCondition].Prompt.ResponsesCount = Experiment.PlayersCount then
  915 + begin
  916 + // M setup
  917 +
  918 +
  919 + // generate messages
  920 + LPromptConsequences := FExperiment.Condition[FExperiment.CurrentCondition].Prompt.AsString;
  921 + if LPromptConsequences.Count > 0 then
  922 + begin
  923 + SetLength(M, 1+LPromptConsequences.Count);
  924 + M[0] := GA_ADMIN+K_QUESTION+K_QMESSAGE;
  925 + for i := 0 to LPromptConsequences.Count -1 do
  926 + M[i+1] := LPromptConsequences[i]
  927 + end;
  928 +
  929 + // send identified messages; each player takes only its own message and ignore the rest
  930 + FZMQActor.SendMessage(M);
  931 + end;
  932 + end;
768 933 begin
769 934 if MHas(K_LOGIN) then ReplyLoginRequest;
770 935 if MHas(K_CHOICE) then ValidateChoice;
  936 + if MHas(K_QUESTION) then ValidateQuestionResponse;
771 937 end;
772 938  
773   -// Here FActor is garanted to be a TZMQPlayer, reply
  939 +// Here FActor is garanted to be a TZMQPlayer, reply by:
774 940 // - sending private data to player player
775 941 // - sending data from early history to income players
776 942 procedure TGameControl.ReceiveReply(AReply: TStringList);
... ... @@ -814,11 +980,11 @@ procedure TGameControl.ReceiveReply(AReply: TStringList);
814 980 LConsequence : TConsequence;
815 981 LCount,
816 982 i : integer;
817   - P : TPlayer;
  983 + //P : TPlayer;
818 984 begin
819 985 if Self.ID = AReply[0] then
820 986 begin
821   - P := FExperiment.PlayerFromID[Self.ID];
  987 + //P := FExperiment.PlayerFromID[Self.ID];
822 988 LCount := WordCount(AReply[5],['+']);
823 989 {$IFDEF DEBUG}
824 990 WriteLn('LCount:',LCount);
... ... @@ -828,7 +994,9 @@ procedure TGameControl.ReceiveReply(AReply: TStringList);
828 994 begin
829 995 LConsequence := TConsequence.Create(FormMatrixGame,ExtractDelimited(i,AReply[5],['+']));
830 996 //LConsequence.PlayerNicname := P.Nicname;
831   - LConsequence.Present(Self, False);
  997 + LConsequence.Present(False);
  998 + if LConsequence.ShouldPublishMessage then
  999 + FZMQActor.SendMessage([K_MESSAGE,LConsequence.LastPresentedMessage]);
832 1000 {$IFDEF DEBUG}
833 1001 WriteLn('A consequence should have shown.');
834 1002 {$ENDIF}
... ... @@ -836,6 +1004,10 @@ procedure TGameControl.ReceiveReply(AReply: TStringList);
836 1004  
837 1005 end;
838 1006 end;
  1007 + procedure QuestionValidated;
  1008 + begin
  1009 + // wait
  1010 + end;
839 1011  
840 1012 procedure ResumePlayer;
841 1013 begin
... ... @@ -846,6 +1018,7 @@ begin
846 1018 if MHas(K_RESUME+K_ARRIVED) then ResumePlayer;
847 1019 if MHas(K_LOGIN+K_ARRIVED) then LoginAccepted;
848 1020 if MHas(K_CHOICE+K_ARRIVED) then ChoiceValidated;
  1021 + if MHas(K_QUESTION+K_ARRIVED) then QuestionValidated;
849 1022 end;
850 1023  
851 1024  
... ...
units/game_experiment.pas
  Diff comments   View file @1722c6f
... ... @@ -25,6 +25,8 @@ type
25 25 FExperimentName,
26 26 FFilename,
27 27 FResearcher : UTF8string;
  28 + FOnConsequence: TNotifyEvent;
  29 + FOnInterlocking: TNotifyEvent;
28 30 FOnEndTurn: TNotifyEvent;
29 31 FOnEndCondition: TNotifyEvent;
30 32 FOnEndCycle: TNotifyEvent;
... ... @@ -52,27 +54,33 @@ type
52 54 function GetNextCondition:integer;
53 55 function GetPlayer(I : integer): TPlayer; overload;
54 56 function GetPlayer(AID : UTF8string): TPlayer; overload;
55   - function GetPlayerAsString(P: TPlayer): UTF8string;
56   - function GetPlayerFromString(s : UTF8string): TPlayer;
  57 + function AliasPlayerAsString(P: TPlayer): UTF8string;
  58 + function AliasPlayerFromString(s : UTF8string): TPlayer;
57 59 function GetPlayerIndexFromID(AID : UTF8string): integer;
58 60 function GetPlayerIsPlaying(AID : UTF8string): Boolean;
59 61 function GetPlayersCount: integer;
60 62 function GetInterlockingsIn(ALastCycles : integer):integer;
61 63 function GetConsequenceStringFromChoice(P:TPlayer): Utf8string;
  64 + function GetConsequenceStringFromChoices:UTF8String;
62 65 procedure SetCondition(I : Integer; AValue: TCondition);
63 66 procedure SetContingency(ACondition, I : integer; AValue: TContingency);
64 67 procedure SetMatrixType(AValue: TGameMatrixType);
  68 + procedure SetOnConsequence(AValue: TNotifyEvent);
65 69 procedure SetOnEndCondition(AValue: TNotifyEvent);
66 70 procedure SetOnEndCycle(AValue: TNotifyEvent);
67 71 procedure SetOnEndExperiment(AValue: TNotifyEvent);
68 72 procedure SetOnEndGeneration(AValue: TNotifyEvent);
69 73 procedure SetOnEndTurn(AValue: TNotifyEvent);
  74 + procedure SetOnInterlocking(AValue: TNotifyEvent);
70 75 procedure SetPlayer(I : integer; AValue: TPlayer); overload;
71 76 procedure SetPlayer(S : UTF8string ; AValue: TPlayer); overload;
72 77 procedure SetResearcherCanChat(AValue: Boolean);
73 78 procedure SetResearcherCanPlay(AValue: Boolean);
74 79 procedure SetSendChatHistoryForNewPlayers(AValue: Boolean);
75 80 procedure SetState(AValue: TExperimentState);
  81 + private
  82 + procedure Consequence(Sender : TObject);
  83 + procedure Interlocking(Sender : TObject);
76 84 public
77 85 constructor Create(AOwner:TComponent);override;
78 86 constructor Create(AFilename: string; AOwner:TComponent); overload;
... ... @@ -106,9 +114,10 @@ type
106 114 property PlayersCount : integer read GetPlayersCount;
107 115 property PlayerIsPlaying[s : UTF8string] : Boolean read GetPlayerIsPlaying;
108 116 property PlayerIndexFromID[s : UTF8string]: integer read GetPlayerIndexFromID;
109   - property PlayerAsString[P:TPlayer]: UTF8string read GetPlayerAsString;
110   - property PlayerFromString[s : UTF8string]: TPlayer read GetPlayerFromString;
  117 + property PlayerAsString[P:TPlayer]: UTF8string read AliasPlayerAsString;
  118 + property PlayerFromString[s : UTF8string]: TPlayer read AliasPlayerFromString;
111 119 property ConsequenceStringFromChoice[P:Tplayer]:UTF8String read GetConsequenceStringFromChoice;
  120 + property ConsequenceStringFromChoices: UTF8String read GetConsequenceStringFromChoices;
112 121 property ShowChat : Boolean read FShowChat write FShowChat;
113 122 property SendChatHistoryForNewPlayers : Boolean read FSendChatHistoryForNewPlayers write SetSendChatHistoryForNewPlayers;
114 123 property MatrixType : TGameMatrixType read FMatrixType write SetMatrixType;
... ... @@ -123,6 +132,9 @@ type
123 132 property OnEndGeneration : TNotifyEvent read FOnEndGeneration write SetOnEndGeneration;
124 133 property OnEndCondition : TNotifyEvent read FOnEndCondition write SetOnEndCondition;
125 134 property OnEndExperiment : TNotifyEvent read FOnEndExperiment write SetOnEndExperiment;
  135 + public
  136 + property OnConsequence : TNotifyEvent read FOnConsequence write SetOnConsequence;
  137 + property OnInterlocking : TNotifyEvent read FOnInterlocking write SetOnInterlocking;
126 138 end;
127 139  
128 140 resourcestring
... ... @@ -130,7 +142,7 @@ resourcestring
130 142  
131 143 implementation
132 144  
133   -uses game_file_methods, game_actors_point, game_resources, strutils;
  145 +uses game_file_methods, game_actors_point, game_resources, string_methods;
134 146  
135 147 { TExperiment }
136 148  
... ... @@ -161,13 +173,11 @@ begin
161 173 else
162 174 Result := FConditions[CurrentCondition].Turn.Count;
163 175 if Assigned(FOnEndTurn) then FOnEndTurn(Self);
164   -
165 176 if FConditions[CurrentCondition].Turn.Count < FConditions[CurrentCondition].Turn.Value then
166 177 Inc(FConditions[CurrentCondition].Turn.Count)
167 178 else
168 179 begin
169 180 FConditions[CurrentCondition].Turn.Count := 0;
170   - if Assigned(FOnEndCycle) then FOnEndCycle(Self);
171 181 NextCycle;
172 182 end;
173 183 {$IFDEF DEBUG}
... ... @@ -184,16 +194,15 @@ end;
184 194 function TExperiment.GetNextCycle: integer;
185 195 begin
186 196 Result := FConditions[CurrentCondition].Cycles.Count;
  197 + if Assigned(FOnEndCycle) then FOnEndCycle(Self);
187 198 if FConditions[CurrentCondition].Cycles.Count < FConditions[CurrentCondition].Cycles.Value then
188 199 Inc(FConditions[CurrentCondition].Cycles.Count)
189 200 else
190 201 begin
191 202 FConditions[CurrentCondition].Cycles.Count := 0;
192   - if State = xsRunning then
193   - begin
194   - if Assigned(FOnEndGeneration) then FOnEndGeneration(Self);
195   - NextCondition;
196   - end;
  203 + Inc(FConditions[CurrentCondition].Cycles.Generation);
  204 + if Assigned(FOnEndGeneration) then FOnEndGeneration(Self);
  205 + NextCondition;
197 206 end;
198 207 {$IFDEF DEBUG}
199 208 WriteLn('TExperiment.GetNextCycle:',Result);
... ... @@ -212,7 +221,6 @@ var
212 221 end;
213 222  
214 223 begin
215   - Inc(FConditions[CurrentCondition].Cycles.Generation);
216 224 Result := CurrentCondition;
217 225 LAbsCycles := (FConditions[CurrentCondition].Cycles.Value *
218 226 FConditions[CurrentCondition].Cycles.Generation) + FConditions[CurrentCondition].Cycles.Count;
... ... @@ -261,147 +269,14 @@ begin
261 269 end;
262 270  
263 271 // fewer as possible data
264   -function TExperiment.GetPlayerAsString(P: TPlayer): UTF8string;
265   -var
266   - i : integer;
267   - M : array of UTF8String;
268   -
269   - procedure SetM(A : array of UTF8String);
270   - var i : integer;
271   - begin
272   - SetLength(M,Length(A));
273   - for i := 0 to Length(A) -1 do
274   - M[i] := A[i];
275   - end;
276   -
277   - function GetPPointsString(APPoints : TPlayerPoints) : string;
278   - begin
279   - Result := IntToStr(APPoints.A)+VV_SEP+IntToStr(APPoints.B);
280   - end;
281   -
282   - function GetStatusString(AStatus : TGamePlayerStatus): string;
283   - begin
284   - case AStatus of
285   - gpsWaiting: Result := '0';
286   - gpsPlaying: Result := '1';
287   - gpsPlayed: Result := '2';
288   - end;
289   - end;
290   -
291   - function GetRowString(ARow: TGameRow): string;
292   - begin
293   - case ARow of
294   - grNone : Result := '.';
295   - grOne : Result := '1';
296   - grTwo : Result := '2';
297   - grThree : Result :='3';
298   - grFour : Result := '4';
299   - grFive : Result := '5';
300   - grSix : Result := '6';
301   - grSeven : Result := '7';
302   - grEight : Result := '8';
303   - grNine : Result := '9';
304   - grTen : Result := '0';
305   - end;
306   - end;
307   -
308   - function GetColorString(AColor: TGameColor): string;
309   - begin
310   - case AColor of
311   - gcNone :Result := '0';
312   - gcYellow :Result := '1';
313   - gcRed :Result := '2';
314   - gcMagenta :Result := '3';
315   - gcBlue :Result := '4';
316   - gcGreen :Result := '5';
317   - end;
318   - end;
319   -
320   - function GetChoiceString(AChoice : TPlayerChoice) : string;
321   - begin
322   - Result := GetRowString(AChoice.Row) + VV_SEP;
323   - Result := Result+ GetColorString(AChoice.Color);
324   - end;
325   -
  272 +function TExperiment.AliasPlayerAsString(P: TPlayer): UTF8string;
326 273 begin
327   - Result := '';
328   - SetM([P.ID
329   - , P.Nicname
330   - , GetPPointsString(P.Points)
331   - , GetStatusString(P.Status)
332   - , GetChoiceString(P.Choice)
333   - , IntToStr(P.Turn)
334   - ]);
335   - for i := 0 to Length(M)-1 do
336   - Result += M[i] + '|';
  274 + Result:= GetPlayerAsString(P);
337 275 end;
338 276  
339   -function TExperiment.GetPlayerFromString(s: UTF8string): TPlayer;
340   -
341   - function GetRowFromString(S: string): TGameRow;
342   - begin
343   - case S of
344   - '.' : Result := grNone;
345   - '1' : Result := grOne;
346   - '2' : Result := grTwo;
347   - '3' : Result := grThree;
348   - '4' : Result := grFour;
349   - '5' : Result := grFive;
350   - '6' : Result := grSix;
351   - '7' : Result := grSeven;
352   - '8' : Result := grEight;
353   - '9' : Result := grNine;
354   - '0' : Result := grTen;
355   - end;
356   - end;
357   -
358   - function GetColorFromString(S: string): TGameColor;
359   - begin
360   - case S of
361   - '0' : Result := gcNone;
362   - '1' : Result := gcYellow;
363   - '2' : Result := gcRed;
364   - '3' : Result := gcMagenta;
365   - '4' : Result := gcBlue;
366   - '5' : Result := gcGreen;
367   - end;
368   - end;
369   -
370   - function GetChoiceFromString(S:string) : TPlayerChoice;
371   - begin
372   - Result.Row := GetRowFromString(ExtractDelimited(1,S,[',']));
373   - Result.Color := GetColorFromString(ExtractDelimited(2,S,[',']));
374   - end;
375   -
376   - function GetPPointsFromString(S:string) : TPlayerPoints;
377   - begin
378   - Result.A := StrToInt(ExtractDelimited(1,S,[',']));
379   - Result.B := StrToInt(ExtractDelimited(2,S,[',']));
380   - end;
381   -
382   - function GetStatusFromString(S : string): TGamePlayerStatus;
383   - begin
384   - case S of
385   - '0': Result := gpsWaiting;
386   - '1': Result := gpsPlaying;
387   - '2': Result := gpsPlayed;
388   - end;
389   - end;
  277 +function TExperiment.AliasPlayerFromString(s: UTF8string): TPlayer;
390 278 begin
391   - {$IFDEF DEBUG}
392   - WriteLn(ExtractDelimited(1,s,['|']));
393   - WriteLn(ExtractDelimited(2,s,['|']));
394   - WriteLn(ExtractDelimited(3,s,['|']));
395   - WriteLn(ExtractDelimited(4,s,['|']));
396   - WriteLn(ExtractDelimited(5,s,['|']));
397   - WriteLn(ExtractDelimited(6,s,['|']));
398   - {$ENDIF}
399   - Result.ID := ExtractDelimited(1,s,['|']);
400   - Result.Nicname := ExtractDelimited(2,s,['|']);
401   - Result.Points := GetPPointsFromString(ExtractDelimited(3,s,['|']));
402   - Result.Status := GetStatusFromString(ExtractDelimited(4,s,['|']));
403   - Result.Choice := GetChoiceFromString(ExtractDelimited(5,s,['|']));
404   - Result.Turn:=StrToInt(ExtractDelimited(6,s,['|']));
  279 + Result := GetPlayerFromString(S);
405 280 end;
406 281  
407 282 function TExperiment.GetPlayerIndexFromID(AID: UTF8string): integer;
... ... @@ -449,7 +324,20 @@ begin
449 324 for i :=0 to ContingenciesCount[c] -1 do
450 325 if not Contingency[c,i].Meta then
451 326 if Contingency[c,i].ResponseMeetsCriteriaI(P.Choice.Row,P.Choice.Color) then
452   - Result += Contingency[c,i].Consequence.AsString + '+';
  327 + Result += Contingency[c,i].Consequence.AsString(P.ID) + '+';
  328 +end;
  329 +
  330 +function TExperiment.GetConsequenceStringFromChoices: UTF8String;
  331 +var
  332 + i : integer;
  333 + c : integer;
  334 +begin
  335 + c := CurrentCondition;
  336 + Result:= '';
  337 + for i :=0 to ContingenciesCount[c] -1 do
  338 + if Contingency[c,i].Meta then
  339 + if Contingency[c,i].ResponseMeetsCriteriaG(FPlayers) then
  340 + Result += Contingency[c,i].Consequence.AsString(IntToStr(i)) + '+';
453 341 end;
454 342  
455 343 procedure TExperiment.SetCondition(I : Integer; AValue: TCondition);
... ... @@ -460,6 +348,10 @@ end;
460 348 procedure TExperiment.SetContingency(ACondition, I : integer; AValue: TContingency);
461 349 begin
462 350 FConditions[ACondition].Contingencies[I] := AValue;
  351 + if FConditions[ACondition].Contingencies[I].Meta then
  352 + FConditions[ACondition].Contingencies[I].OnCriteria:=@Interlocking
  353 + else
  354 + FConditions[ACondition].Contingencies[I].OnCriteria:=@Consequence;
463 355 end;
464 356  
465 357 procedure TExperiment.SetMatrixType(AValue: TGameMatrixType);
... ... @@ -468,6 +360,12 @@ begin
468 360 FMatrixType:=AValue;
469 361 end;
470 362  
  363 +procedure TExperiment.SetOnConsequence(AValue: TNotifyEvent);
  364 +begin
  365 + if FOnConsequence=AValue then Exit;
  366 + FOnConsequence:=AValue;
  367 +end;
  368 +
471 369 procedure TExperiment.SetOnEndCondition(AValue: TNotifyEvent);
472 370 begin
473 371 if FOnEndCondition=AValue then Exit;
... ... @@ -498,6 +396,12 @@ begin
498 396 FOnEndTurn:=AValue;
499 397 end;
500 398  
  399 +procedure TExperiment.SetOnInterlocking(AValue: TNotifyEvent);
  400 +begin
  401 + if FOnInterlocking=AValue then Exit;
  402 + FOnInterlocking:=AValue;
  403 +end;
  404 +
501 405  
502 406 procedure TExperiment.SetPlayer(I : integer; AValue: TPlayer);
503 407 begin
... ... @@ -541,6 +445,16 @@ begin
541 445 FState:=AValue;
542 446 end;
543 447  
  448 +procedure TExperiment.Consequence(Sender: TObject);
  449 +begin
  450 + if Assigned(FOnConsequence) then FOnConsequence(Sender);
  451 +end;
  452 +
  453 +procedure TExperiment.Interlocking(Sender: TObject);
  454 +begin
  455 + if Assigned(FOnInterlocking) then FOnInterlocking(Sender);
  456 +end;
  457 +
544 458 constructor TExperiment.Create(AOwner: TComponent);
545 459 begin
546 460 inherited Create(AOwner);
... ...
units/game_file_methods.pas
  Diff comments   View file @1722c6f
... ... @@ -48,6 +48,17 @@ var
48 48 Colors:[];
49 49 );
50 50  
  51 + LCriteria3 : TCriteria = (
  52 + Style:(gtRowsAndColors);
  53 + Rows:[grEven];
  54 + Colors:[gcDiff];
  55 + );
  56 +
  57 + LCriteria4 : TCriteria = (
  58 + Style:(gtRowsOrColors);
  59 + Rows:[grNot,grEven];
  60 + Colors:[gcNot,gcDiff];
  61 + );
51 62 begin
52 63 Result := False;
53 64 with AExperiment do
... ... @@ -61,26 +72,40 @@ begin
61 72 GenPlayersAsNeeded:=True;
62 73 CurrentCondition := 0;
63 74 MatrixType:=[gmRows];
  75 +
64 76 //AppendPlayer(C_PLAYER_TEMPLATE);
65 77 //AppendPlayer(C_PLAYER_TEMPLATE);
  78 +
66 79 C := C_CONDITION_TEMPLATE;
67 80 with C do
68 81 begin
69   - SetLength(Contingencies, 2);
70   - LConcequence := TConsequence.Create(AExperiment,1,[gscPoints, gscB, gscMessage,gscBroadcastMessage],['NICNAME','queijo','queijos']);
71   - Contingencies[0] := TContingency.Create(AExperiment,LConcequence,LCriteria1,False);
72   - LConcequence := TConsequence.Create(AExperiment,3,[gscPoints, gscA, gscMessage,gscBroadcastMessage],['NICNAME','queijo','queijos']);
73   - Contingencies[1] := TContingency.Create(AExperiment,LConcequence,LCriteria2,False);
74   -
75   - ConditionName := SEC_CONDITION+IntToStr(1);
  82 + ConditionName := SEC_CONDITION+'1';
76 83 Turn.Count:=0;
77 84 Turn.Value:=2;
78 85 Turn.Random:=False;
79 86 Cycles.Count:=0;
80 87 Cycles.Value:=4;
81 88 Cycles.Generation:=0;
  89 + SetLength(Contingencies, 4);
  90 + LConcequence := TConsequence.Create(AExperiment,1,[gscPoints, gscB, gscMessage,gscBroadcastMessage],['$NICNAME','queijo','queijos']);
  91 + Contingencies[0] := TContingency.Create(AExperiment,LConcequence,LCriteria1,False);
  92 + LConcequence := TConsequence.Create(AExperiment,3,[gscPoints, gscA, gscMessage,gscBroadcastMessage],['$NICNAME','pão','pães']);
  93 + Contingencies[1] := TContingency.Create(AExperiment,LConcequence,LCriteria2,False);
  94 + LConcequence := TConsequence.Create(AExperiment,1,[gscPoints, gscG, gscMessage,gscBroadcastMessage],['','item escolar','itens escolares']);
  95 + Contingencies[2] := TContingency.Create(AExperiment,LConcequence,LCriteria3,True);
  96 + LConcequence := TConsequence.Create(AExperiment,-1,[gscPoints, gscG, gscMessage,gscBroadcastMessage],['','item escolar','itens escolares']);
  97 + Contingencies[3] := TContingency.Create(AExperiment,LConcequence,LCriteria4,True);
  98 +
  99 + Prompt := TPrompt.Create(
  100 + AExperiment
  101 + , [gsAll,gsYes,gsMetacontingency,gsContingency,gsRevertPoints,gsBasA]
  102 + , Contingencies
  103 + , 'Um item escolar foi perdido, desejam recuperá-lo gastando pontos do Tipo A?'
  104 + );
  105 + // (gsYes, gsNo, gsAll, gsMetacontingency, gsContingency, gsBasA, gsRevertPoints);
82 106 end;
83   - AppendCondition(C);
  107 +
  108 + Condition[AppendCondition] := C;
84 109 end;
85 110 end;
86 111  
... ... @@ -96,59 +121,40 @@ var
96 121 //end;
97 122  
98 123 function GetEndCriteria(S:string) : TEndConditionCriterium;
99   - var
100   - LS : string;
101 124 begin
102   - // 2,20,10,10,
103   - LS := S + VV_SEP;
104   - case StrToIntDef(GetAndDelFirstValue(LS),2) of
  125 + case StrToIntDef(ExtractDelimited(1,S,[',']),2) of
105 126 0: Result.Value := gecAbsoluteCycles;
106 127 1: Result.Value := gecInterlockingPorcentage;
107 128 2: Result.Value := gecWhichComeFirst;
108 129 end;
109   - Result.AbsoluteCycles := StrToIntDef(GetAndDelFirstValue(LS), 20);
110   - Result.InterlockingPorcentage := StrToIntDef(GetAndDelFirstValue(LS),10);
111   - Result.LastCycles := StrToIntDef(GetAndDelFirstValue(LS), 10);
  130 + Result.AbsoluteCycles := StrToIntDef(ExtractDelimited(2,S,[',']), 20);
  131 + Result.InterlockingPorcentage := StrToIntDef(ExtractDelimited(3,S,[',']),10);
  132 + Result.LastCycles := StrToIntDef(ExtractDelimited(4,S,[',']), 10);
112 133 end;
113 134  
114 135 function GetPoints(S: string) : TPoints;
115   - var
116   - LS : string;
117 136 begin
118   - // A,B,G,
119   - LS := S + VV_SEP;
120   - Result.A := StrToIntDef(GetAndDelFirstValue(LS),0);
121   - Result.B := StrToIntDef(GetAndDelFirstValue(LS),0);
122   - Result.G := StrToIntDef(GetAndDelFirstValue(LS),0);
  137 + Result.A := StrToIntDef(ExtractDelimited(1,S,[',']),0);
  138 + Result.B := StrToIntDef(ExtractDelimited(2,S,[',']),0);
  139 + Result.G := StrToIntDef(ExtractDelimited(3,S,[',']),0);
123 140 end;
124 141  
125 142  
126 143 function GetChoiceFromString(S:string) : TPlayerChoice;
127   - var
128   - LS : string;
129 144 begin
130   - // 0,NONE,
131   - LS := S + VV_SEP;
132   - Result.Row := GetRowFromString(GetAndDelFirstValue(LS));
133   - Result.Color := GetColorFromString(GetAndDelFirstValue(LS));
  145 + Result.Row := GetRowFromString(ExtractDelimited(1,S,[',']));
  146 + Result.Color := GetGameColorFromString(ExtractDelimited(2,S,[',']));
134 147 end;
135 148  
136 149 function GetPPointsFromString(S:string) : TPlayerPoints;
137   - var
138   - LS : string;
139 150 begin
140   - // 0,0,
141   - LS := S + VV_SEP;
142   - Result.A := StrToIntDef(GetAndDelFirstValue(LS),0);
143   - Result.B := StrToIntDef(GetAndDelFirstValue(LS),0);
  151 + Result.A := StrToIntDef(ExtractDelimited(1,S,[',']),0);
  152 + Result.B := StrToIntDef(ExtractDelimited(2,S,[',']),0);
144 153 end;
145 154  
146 155 function GetStatusFromString(S : string): TGamePlayerStatus;
147   - var
148   - LS : string;
149 156 begin
150   - LS := S + VV_SEP;
151   - case GetAndDelFirstValue(LS) of
  157 + case ExtractDelimited(1,S,[',']) of
152 158 'esperando': Result := gpsWaiting;
153 159 'jogou': Result := gpsPlayed;
154 160 'jogando': Result := gpsPlaying;
... ... @@ -157,14 +163,12 @@ var
157 163  
158 164 function GetPromptStyle(S:string):TPromptStyle;
159 165 var
160   - LS : string;
161 166 i : integer;
162 167 begin
163 168 // Yes,All,Metacontingency,RecoverLostPoints,
164 169 Result := [];
165   - LS := S + VV_SEP;
166   - for i := 0 to 3 do
167   - Result := Result + GetPromptStyleFromString(GetAndDelFirstValue(LS));
  170 + for i := 1 to 4 do
  171 + Result := Result + GetPromptStyleFromString(ExtractDelimited(i,S,[',']));
168 172 end;
169 173  
170 174 procedure ReadExperiment;
... ... @@ -242,7 +246,7 @@ var
242 246 LCount := WordCount(LS,[#0,',']);
243 247 Result.Colors := [];
244 248 for i := 1 to LCount do
245   - Result.Colors += [GetColorFromString(ExtractDelimited(i,LS,[',']))];
  249 + Result.Colors += [GetGameColorFromString(ExtractDelimited(i,LS,[',']))];
246 250 end;
247 251  
248 252 procedure SetLCK(i:integer);
... ... @@ -307,9 +311,12 @@ var
307 311  
308 312 // if no contingencies, return false...
309 313  
310   - Prompt := TPrompt.Create(AExperiment,ReadString(LS,KEY_PROMPT_STYLE,'todos,sim,metacontingência,recuperar pontos,'));
311   - Prompt.PromptStyle:= GetPromptStyle(ReadString(LS,KEY_PROMPT_STYLE,'todos,sim,metacontingência,recuperar pontos,'));
312   - Prompt.PromptMessage := ReadString(LS,KEY_PROMPT_MESSAGE,DEF_PROMPTMESSAGE);
  314 + Prompt := TPrompt.Create(
  315 + AExperiment
  316 + , GetPromptStyle(ReadString(LS,KEY_PROMPT_STYLE,'todos,sim,metacontingência,recuperar pontos,'))
  317 + , Contingencies
  318 + , ReadString(LS,KEY_PROMPT_MESSAGE,DEF_PROMPTMESSAGE)
  319 + );
313 320  
314 321 end;
315 322 AExperiment.Condition[i]:= C;
... ... @@ -350,47 +357,6 @@ var
350 357 LC,
351 358 LCK : string;
352 359  
353   - function GetEndCriteriaString(AEndCriterium:TEndConditionCriterium) : string;
354   - begin
355   - // 2,20,10,10,
356   - case AEndCriterium.Value of
357   - gecAbsoluteCycles: Result := '0';
358   - gecInterlockingPorcentage: Result := '1';
359   - gecWhichComeFirst: Result := '2';
360   - end;
361   - Result := Result + VV_SEP;
362   - Result := Result + IntToStr(AEndCriterium.AbsoluteCycles) + VV_SEP;
363   - Result := Result + IntToStr(AEndCriterium.InterlockingPorcentage) + VV_SEP;
364   - Result := Result + IntToStr(AEndCriterium.LastCycles) + VV_SEP;
365   - end;
366   -
367   - function GetPointsString(APoints : TPoints) : string;
368   - begin
369   - Result := IntToStr(APoints.A) + VV_SEP;
370   - Result := Result + IntToStr(APoints.B) + VV_SEP;
371   - Result := Result + IntToStr(APoints.G) + VV_SEP;
372   - end;
373   -
374   - function GetChoiceString(AChoice : TPlayerChoice) : string;
375   - begin
376   - Result := GetRowString(AChoice.Row) + VV_SEP;
377   - Result := Result+ GetColorString(AChoice.Color) + VV_SEP;
378   - end;
379   -
380   - function GetPPointsString(APPoints : TPlayerPoints) : string;
381   - begin
382   - Result := IntToStr(APPoints.A)+VV_SEP+IntToStr(APPoints.B);
383   - end;
384   -
385   - function GetStatusString(AStatus : TGamePlayerStatus): string;
386   - begin
387   - case AStatus of
388   - gpsWaiting: Result := 'esperando';
389   - gpsPlayed: Result := 'jogou';
390   - gpsPlaying: Result := 'jogando';
391   - end;
392   - end;
393   -
394 360 begin
395 361 LWriter := TRegData.Create(nil,AFilename);
396 362 LIniFile:= TCIniFile.Create(LWriter.FileName);
... ... @@ -414,8 +380,8 @@ begin
414 380 WriteInteger(LC, KEY_CYCLES_VALUE,Cycles.Value);
415 381 WriteInteger(LC, KEY_CYCLES_GEN,Cycles.Generation);
416 382 //WriteBool(LC, KEY_PROMPT_VALUE,Prompt.Value);
417   - WriteString(LC, KEY_PROMPT_MESSAGE, Prompt.PromptMessage);
418   - WriteString(LC, KEY_PROMPT_STYLE, GetPromptStyleString(Prompt.PromptStyle));
  383 + //WriteString(LC, KEY_PROMPT_MESSAGE, Prompt.PromptMessage); TODO: write prompt as string
  384 + //WriteString(LC, KEY_PROMPT_STYLE, GetPromptStyleString(Prompt.PromptStyle));
419 385  
420 386 for j := 0 to High(Contingencies) do
421 387 begin
... ... @@ -426,7 +392,7 @@ begin
426 392  
427 393 with Contingencies[j] do
428 394 begin
429   - WriteString(LC,LCK+KEY_CONSEQUE,Consequence.AsString);
  395 + WriteString(LC,LCK+KEY_CONSEQUE,Consequence.AsString('')); // TODO review this
430 396 WriteString(LC,LCK+KEY_CRITERIA,CriteriaString);
431 397 end;
432 398 end;
... ...
units/game_resources.pas
  Diff comments   View file @1722c6f
... ... @@ -174,66 +174,19 @@ const
174 174 // Meta : True;
175 175 // );
176 176  
177   - //C_METACONTINGENCY_A2 : TContingency =
178   - // (
179   - // Consequence : (
180   - // Style : [gscShowMessage,gscPoints,gscBroadcastMessage];
181   - // Points :( A : 0; B : 0; G : -1;);
182   - // Message : 'Vocês perderam 1 item escolar.'; // show first in case of last participant
183   - // Cycles : 0; // absolute,
184   - // VariationMin: 0; // porcentage,
185   - // VariationMax : 0; // porcentage
186   - // Prompt : (
187   - // Message : '';
188   - // Style : [];
189   - // );
190   - // );
191   - //
192   - // Response : (
193   - // Operator_ : goNONE;
194   - // Rows : [grOdd,grSome];
195   - // Colors : [gcNone];
196   - // );
197   - //
198   - // Meta : True;
199   - // );
200   -
201   - //C_METACONTINGENCY_B1: TContingency =
202   - // (
203   - // Consequence : (
204   - // Style : [gscShowMessage,gscPoints,gscBroadcastMessage];
205   - // Points :(A :-1; B : 0; G : -1;);
206   - // Message : 'Vocês perderam 1 item escolar e uma quantidade de pontos do Tipo A.';
207   - // Cycles : 0; // absolute,
208   - // VariationMin: 0; // porcentage,
209   - // VariationMax : 0; // porcentage
210   - // Prompt : (
211   - // Message : '';
212   - // Style : [];
213   - // );
214   - // );
215   - //
216   - // Response : (
217   - // Operator_ : goNONE;
218   - // Rows : [grOdd, grSome];
219   - // Colors : [gcNone];
220   - // );
221   - //
222   - // Meta : True;
223   - // );
224 177  
225 178 //C_METACONTINGENCY_B2: TContingency =
226 179 // (
227 180 // Consequence : (
228 181 // Style : [gscShowMessage,gscPoints,gscBroadcastMessage,gscPromptQuestion];
229   - // Points :(A :-3; B : 0; G : -1;);
230   - // Message : 'Vocês perderam 1 item escolar.';
  182 + // Points :(A :0; B : 0; G : -1;);
  183 + // Message : 'Vocês produziram a perda de 1 item escolar.';
231 184 // Cycles : 0; // absolute,
232 185 // VariationMin: 0; // porcentage,
233 186 // VariationMax : 0; // porcentage
234 187 // Prompt : (
235   - // Message : 'Vocês perderam 1 item escolar, desejam recuperá-lo gastando pontos do Tipo A?';
236   - // Style : [gsAll,gsYes,gsMetacontingency,gsRecoverLostPoints];
  188 + // Message : 'Um item escolar foi perdido, desejam recuperá-lo gastando pontos do Tipo A?';
  189 + // Style : [gsAll,gsYes,gsMetacontingency,gsRecoverLostPoints, gsContingency, gsBasA];
237 190 // );
238 191 // );
239 192 //
... ... @@ -250,30 +203,34 @@ const
250 203 (
251 204 ConditionName : '';
252 205 Contingencies : nil;
  206 + Interlocks : (
  207 + Count : 0;
  208 + History : nil;
  209 + );
253 210  
254 211 Points : (
255   - Count : ( A:1; B:2; G:3; );
256   - OnStart : ( A:3; B:1; G:0; );
  212 + Count : ( A:0; B:0; G:0; );
  213 + OnStart : ( A:0; B:0; G:0; );
257 214 );
258 215  
259 216 Turn : (
260 217 Count: 0;
261   - Value : 3;
  218 + Value : 0;
262 219 Random: False;
263 220 );
264 221  
265 222 Cycles : (
266 223 Count : 0;
267   - Value : 3;
  224 + Value : 0;
268 225 Generation : 0;
269 226 );
270 227  
271 228 Prompt : nil;
272 229 EndCriterium : (
273 230 Value : gecWhichComeFirst;
274   - InterlockingPorcentage : 10;
275   - LastCycles : 6;
276   - AbsoluteCycles: 8;
  231 + InterlockingPorcentage : 50;
  232 + LastCycles : 4;
  233 + AbsoluteCycles: 6;
277 234 );
278 235 );
279 236  
... ...
units/string_methods.pas
  Diff comments   View file @1722c6f
... ... @@ -10,19 +10,36 @@ uses
10 10 , game_resources
11 11 ;
12 12  
13   -function GetAndDelFirstValue(var S: string;Sep:Char=','):string;
14   -function GetRowString(ARow : TGameRow) : string;
15   -function GetRowFromString(S : string):TGameRow;
16   -function GetRowColorFromString(S:string): TColor;
17   -function GetColorString(AColor : TGameColor) : string;
18   -function GetColorFromString(S : string) : TGameColor;
19   -function GetPromptStyleFromString(S : string) : TPromptStyle;
20   -function GetPromptStyleString(AStyle : TPromptStyle) : string;
21   -function GetConsequenceStyleFromString(s:string):TGameConsequenceStyle;
22   -function GetConsequenceStyleString(AStyle: TGameConsequenceStyle): string;
23   -function GetResponseString(ACriteria : TCriteria) : string;
24   -function GetResponseFromString(S: string) : TCriteria;
25   -function GetRowColorString(C: TColor):string;
  13 +function GetAndDelFirstValue(var S: string;Sep:Char=','):string; deprecated 'Use ExtracteDelimited from strutils instead';
  14 +
  15 +function GetRowString(ARow : TGameRow) : UTF8String;
  16 +function GetRowFromString(S : UTF8String):TGameRow;
  17 +
  18 +function GetColorString(C : TColor):UTF8String; overload;
  19 +function GetColorFromString(S : UTF8String): TColor;
  20 +function GetColorString(AColor : TGameColor) : UTF8String; overload;
  21 +function GetGameColorFromString(S : UTF8String) : TGameColor;
  22 +
  23 +function GetPromptStyleFromString(S : UTF8String) : TPromptStyle;
  24 +function GetPromptStyleString(AStyle : TPromptStyle) : UTF8String;
  25 +
  26 +function GetConsequenceStyleFromString(s : UTF8String):TGameConsequenceStyle;
  27 +function GetConsequenceStyleString(AStyle : TGameConsequenceStyle): UTF8String;
  28 +function GetConsequenceStylesFromString(S : UTF8String):TConsequenceStyle;
  29 +function GetConsequenceStylesString(CS : TConsequenceStyle): UTF8String;
  30 +
  31 +function GetCriteriaString(ACriteria : TCriteria) : UTF8String;
  32 +function GetCriteriaFromString(S : UTF8String) : TCriteria;
  33 +function GetCriteriaStyleString(AStyle: TGameStyle) : UTF8String;
  34 +
  35 +function GetStatusString(AStatus : TGamePlayerStatus): UTF8String;
  36 +function GetPPointsString(APPoints : TPlayerPoints) : UTF8String;
  37 +function GetChoiceString(AChoice : TPlayerChoice) : UTF8String;
  38 +function GetPointsString(APoints : TPoints) : UTF8String;
  39 +function GetEndCriteriaString(AEndCriterium:TEndConditionCriterium) : UTF8String;
  40 +
  41 +function GetPlayerFromString(s: UTF8string): TPlayer;
  42 +function GetPlayerAsString(P: TPlayer): UTF8string;
26 43  
27 44 implementation
28 45  
... ... @@ -35,7 +52,7 @@ begin
35 52 if Length(S) > 0 then while S[1] = Sep do Delete(S, 1, 1);
36 53 end;
37 54  
38   -function GetRowString(ARow: TGameRow): string;
  55 +function GetRowString(ARow: TGameRow): UTF8String;
39 56 begin
40 57 case ARow of
41 58 grNone : Result := '0';
... ... @@ -54,7 +71,7 @@ begin
54 71 end;
55 72 end;
56 73  
57   -function GetRowFromString(S: string): TGameRow;
  74 +function GetRowFromString(S: UTF8String): TGameRow;
58 75 begin
59 76 case UpperCase(S) of
60 77 'NA', '.' , '0', 'NONE' : Result := grNone;
... ... @@ -73,7 +90,7 @@ begin
73 90 end;
74 91 end;
75 92  
76   -function GetColorString(AColor: TGameColor): string;
  93 +function GetColorString(AColor: TGameColor): UTF8String;
77 94 begin
78 95 case AColor of
79 96 gcNone :Result := 'INDIFERENTE';
... ... @@ -87,7 +104,7 @@ begin
87 104 end;
88 105 end;
89 106  
90   -function GetColorFromString(S: string): TGameColor;
  107 +function GetGameColorFromString(S: UTF8String): TGameColor;
91 108 begin
92 109 case UpperCase(S) of
93 110 '.', 'INDIFERENTE', 'NONE' : Result := gcNone;
... ... @@ -96,13 +113,13 @@ begin
96 113 'G', 'VERDE', 'GREEN' : Result := gcGreen;
97 114 'R', 'VERMELHO', 'RED' : Result := gcRed;
98 115 'M', 'ROXO','MAGENTA', 'VIOLETA' : Result := gcMagenta;
99   - '!=','<>','DIFERENTES', 'DIFFERENT' : Result := gcDiff;
  116 + '!','<>','DIFERENTES', 'DIFFERENT' : Result := gcDiff;
100 117 '=','IGUAIS', 'EQUAL' : Result := gcEqual;
101 118 end;
102 119 end;
103 120  
104 121  
105   -function GetPromptStyleFromString(S: string): TPromptStyle;
  122 +function GetPromptStyleFromString(S: UTF8String): TPromptStyle;
106 123 begin
107 124 // todos,sim,metacontingência,recuperar pontos,
108 125 case UpperCase(S) of
... ... @@ -117,7 +134,7 @@ begin
117 134 end;
118 135 end;
119 136  
120   -function GetPromptStyleString(AStyle: TPromptStyle): string;
  137 +function GetPromptStyleString(AStyle: TPromptStyle): UTF8String;
121 138 var Style : TGamePromptStyle;
122 139 begin
123 140 Result:='';
... ... @@ -134,7 +151,7 @@ begin
134 151 end;
135 152 end;
136 153  
137   -function GetConsequenceStyleFromString(s: string): TGameConsequenceStyle;
  154 +function GetConsequenceStyleFromString(s: UTF8String): TGameConsequenceStyle;
138 155 begin
139 156 case UpperCase(S) of
140 157 'NADA': Result:= gscNone;
... ... @@ -145,7 +162,7 @@ begin
145 162 end;
146 163 end;
147 164  
148   -function GetConsequenceStyleString(AStyle: TGameConsequenceStyle): string;
  165 +function GetConsequenceStyleString(AStyle: TGameConsequenceStyle): UTF8String;
149 166 begin
150 167 case AStyle of
151 168 gscNone : Result:= 'NADA';
... ... @@ -156,61 +173,62 @@ begin
156 173 end;
157 174 end;
158 175  
159   -function GetResponseString(ACriteria : TCriteria) : string;
  176 +function GetCriteriaString(ACriteria: TCriteria): UTF8String;
160 177 var R : TGameRow;
161 178 C : TGameColor;
162 179 begin
163   - Result := '[';
164 180 for R in ACriteria.Rows do
165 181 Result += GetRowString(R) + VV_SEP;
166   - Result += ']';
  182 + Result += '|';
167 183  
168   - Result += '[';
169   - case ACriteria.Style of
170   - gtNone : Result += 'INDIFERENTE'+ VV_SEP;
171   - gtRowsAndColors : Result += 'E'+ VV_SEP;
172   - gtRowsOrColors : Result += 'OU'+ VV_SEP;
173   - end;
174   - Result += ']';
  184 + Result += GetCriteriaStyleString(ACriteria.Style)+'|';
175 185  
176   - Result += '[';
177 186 for C in ACriteria.Colors do
178 187 Result += GetColorString(C) + VV_SEP;
179   - Result += ']';
  188 + Result += '|';
180 189 end;
181 190  
182   -function GetResponseFromString(S: string) : TCriteria;
  191 +function GetCriteriaFromString(S: UTF8String): TCriteria;
183 192 var
184   - R : TGameRow;
185   - C : TGameColor;
186   - LS : string;
187 193 s1 : string;
188 194 i : integer;
189 195 begin
190   - LS := S + VV_SEP;
191   - s1 := ExtractDelimited(2,LS,['[',']']);
  196 + s1 := ExtractDelimited(1,S,['|']);
192 197 Result.Rows := [];
193   - for i := 0 to 10 do
194   - if s1 <> '' then
195   - Result.Rows += [GetRowFromString(UpperCase(GetAndDelFirstValue(s1)))]
  198 +
  199 + for i := 1 to WordCount(s1,[#0,',']) do
  200 + if ExtractDelimited(i,s1,[',']) <> '' then
  201 + Result.Rows += [GetRowFromString(ExtractDelimited(i,s1,[',']))]
196 202 else Break;
197 203  
198   - s1 := ExtractDelimited(4,LS,['[',']']);
199   - case UpperCase(GetAndDelFirstValue(s1)) of
  204 + s1 := ExtractDelimited(2,S,['|']);
  205 + case UpperCase(s1) of
200 206 '','INDIFERENTE', 'NONE' : Result.Style := gtNone;
201 207 'E', 'AND' : Result.Style := gtRowsAndColors;
202 208 'OU', 'OR' : Result.Style := gtRowsOrColors;
  209 +
203 210 end;
204 211  
205   - s1 := ExtractDelimited(6,LS,['[',']']);
  212 + s1 := ExtractDelimited(3,S,['|']);
206 213 Result.Colors := [];
207   - for i := 0 to 10 do
208   - if s1 <> '' then
209   - Result.Colors += [GetColorFromString(UpperCase(GetAndDelFirstValue(s1)))]
  214 + for i := 1 to WordCount(s1,[#0,',']) do
  215 + if ExtractDelimited(i,s1,[',']) <> '' then
  216 + Result.Colors += [GetGameColorFromString(ExtractDelimited(i,s1,[',']))]
210 217 else Break;
211 218 end;
212 219  
213   -function GetRowColorString(C: TColor): string;
  220 +function GetCriteriaStyleString(AStyle: TGameStyle): UTF8String;
  221 +begin
  222 + case AStyle of
  223 + gtNone : Result := 'INDIFERENTE';
  224 + gtRowsAndColors : Result := 'E';
  225 + gtRowsOrColors : Result := 'OU';
  226 + gtRowsOnly: Result := 'LINHAS';
  227 + gtColorsOnly:Result := 'CORES';
  228 + end;
  229 +end;
  230 +
  231 +function GetColorString(C: TColor): UTF8String;
214 232 begin
215 233 case C of
216 234 ccYellow: Result := 'Y';
... ... @@ -221,7 +239,7 @@ begin
221 239 end;
222 240 end;
223 241  
224   -function GetRowColorFromString(S:string): TColor;
  242 +function GetColorFromString(S: UTF8String): TColor;
225 243 begin
226 244 case S of
227 245 'Y' : Result := ccYellow;
... ... @@ -232,18 +250,230 @@ begin
232 250 end;
233 251 end;
234 252  
235   -//function ValidateString(S: String): string;
236   -////var
237   -//// i:integer;
238   -//begin
239   -// //for i:= Low(S) to High(S) do
240   -// // case S[i] of
241   -// // #32 : S[i] := #
242   -// // #128 : S[i] := #128;
243   -// //
244   -// // end;
245   -// //Result := AnsiToUtf8(S);
246   -//end;
  253 +function GetConsequenceStylesFromString(S:UTF8String):TConsequenceStyle;
  254 +var
  255 + LCount,
  256 + i : integer;
  257 +begin
  258 + Result := [];
  259 + LCount := WordCount(S,[#0,',']);
  260 + for i:= 1 to LCount do
  261 + case ExtractDelimited(i,S,[',']) of
  262 + '0':Result+=[gscNone];
  263 + 'M':Result+=[gscMessage];
  264 + 'C':Result+=[gscBroadcastMessage];
  265 + 'P':Result+=[gscPoints];
  266 + 'V':Result+=[gscVariablePoints];
  267 + 'A':Result+=[gscA];
  268 + 'B':Result+=[gscB];
  269 + 'G':Result+=[gscG]
  270 + end;
  271 +end;
  272 +
  273 +function GetConsequenceStylesString(CS: TConsequenceStyle): UTF8String;
  274 +var ConsequenceStyle : TGameConsequenceStyle;
  275 +begin
  276 + Result := '';
  277 + for ConsequenceStyle in CS do
  278 + begin
  279 + case ConsequenceStyle of
  280 + gscNone: Result += '0';
  281 + gscMessage:Result += 'M';
  282 + gscBroadcastMessage:Result += 'C';
  283 + gscPoints:Result += 'P';
  284 + gscVariablePoints:Result += 'V';
  285 + gscA:Result += 'A';
  286 + gscB:Result += 'B';
  287 + gscG:Result += 'G';
  288 + end;
  289 + Result += ',';
  290 + end;
  291 +end;
  292 +
  293 +function GetEndCriteriaString(AEndCriterium: TEndConditionCriterium
  294 + ): UTF8String;
  295 +begin
  296 + // 2,20,10,10,
  297 + case AEndCriterium.Value of
  298 + gecAbsoluteCycles: Result := '0';
  299 + gecInterlockingPorcentage: Result := '1';
  300 + gecWhichComeFirst: Result := '2';
  301 + end;
  302 + Result := Result + VV_SEP;
  303 + Result := Result + IntToStr(AEndCriterium.AbsoluteCycles) + VV_SEP;
  304 + Result := Result + IntToStr(AEndCriterium.InterlockingPorcentage) + VV_SEP;
  305 + Result := Result + IntToStr(AEndCriterium.LastCycles) + VV_SEP;
  306 +end;
  307 +
  308 +function GetPointsString(APoints: TPoints): UTF8String;
  309 +begin
  310 + Result := IntToStr(APoints.A) + VV_SEP;
  311 + Result := Result + IntToStr(APoints.B) + VV_SEP;
  312 + Result := Result + IntToStr(APoints.G) + VV_SEP;
  313 +end;
  314 +
  315 +function GetChoiceString(AChoice: TPlayerChoice): UTF8String;
  316 +begin
  317 + Result := GetRowString(AChoice.Row) + VV_SEP;
  318 + Result := Result+ GetColorString(AChoice.Color) + VV_SEP;
  319 +end;
  320 +
  321 +function GetPPointsString(APPoints: TPlayerPoints): UTF8String;
  322 +begin
  323 + Result := IntToStr(APPoints.A)+VV_SEP+IntToStr(APPoints.B);
  324 +end;
  325 +
  326 +function GetStatusString(AStatus: TGamePlayerStatus): UTF8String;
  327 +begin
  328 + case AStatus of
  329 + gpsWaiting: Result := 'esperando';
  330 + gpsPlayed: Result := 'jogou';
  331 + gpsPlaying: Result := 'jogando';
  332 + end;
  333 +end;
  334 +
  335 +function GetPlayerAsString(P: TPlayer): UTF8string;
  336 +var
  337 + i : integer;
  338 + M : array of UTF8String;
  339 +
  340 + procedure SetM(A : array of UTF8String);
  341 + var i : integer;
  342 + begin
  343 + SetLength(M,Length(A));
  344 + for i := 0 to Length(A) -1 do
  345 + M[i] := A[i];
  346 + end;
  347 +
  348 + function PointsString(APPoints : TPlayerPoints) : string;
  349 + begin
  350 + Result := IntToStr(APPoints.A)+VV_SEP+IntToStr(APPoints.B);
  351 + end;
  352 +
  353 + function StatusString(AStatus : TGamePlayerStatus): string;
  354 + begin
  355 + case AStatus of
  356 + gpsWaiting: Result := '0';
  357 + gpsPlaying: Result := '1';
  358 + gpsPlayed: Result := '2';
  359 + end;
  360 + end;
  361 +
  362 + function RowString(ARow: TGameRow): string;
  363 + begin
  364 + case ARow of
  365 + grNone : Result := '.';
  366 + grOne : Result := '1';
  367 + grTwo : Result := '2';
  368 + grThree : Result :='3';
  369 + grFour : Result := '4';
  370 + grFive : Result := '5';
  371 + grSix : Result := '6';
  372 + grSeven : Result := '7';
  373 + grEight : Result := '8';
  374 + grNine : Result := '9';
  375 + grTen : Result := '0';
  376 + end;
  377 + end;
  378 +
  379 + function ColorString(AColor: TGameColor): string;
  380 + begin
  381 + case AColor of
  382 + gcNone :Result := '0';
  383 + gcYellow :Result := '1';
  384 + gcRed :Result := '2';
  385 + gcMagenta :Result := '3';
  386 + gcBlue :Result := '4';
  387 + gcGreen :Result := '5';
  388 + end;
  389 + end;
  390 +
  391 + function ChoiceString(AChoice : TPlayerChoice) : string;
  392 + begin
  393 + Result := RowString(AChoice.Row) + VV_SEP;
  394 + Result := Result+ ColorString(AChoice.Color);
  395 + end;
  396 +
  397 +begin
  398 + Result := '';
  399 + SetM([P.ID
  400 + , P.Nicname
  401 + , PointsString(P.Points)
  402 + , StatusString(P.Status)
  403 + , ChoiceString(P.Choice)
  404 + , IntToStr(P.Turn)
  405 + ]);
  406 + for i := 0 to Length(M)-1 do
  407 + Result += M[i] + '|';
  408 +end;
  409 +
  410 +function GetPlayerFromString(s: UTF8string): TPlayer;
  411 +
  412 + function RowFromString(S: string): TGameRow;
  413 + begin
  414 + case S of
  415 + '.' : Result := grNone;
  416 + '1' : Result := grOne;
  417 + '2' : Result := grTwo;
  418 + '3' : Result := grThree;
  419 + '4' : Result := grFour;
  420 + '5' : Result := grFive;
  421 + '6' : Result := grSix;
  422 + '7' : Result := grSeven;
  423 + '8' : Result := grEight;
  424 + '9' : Result := grNine;
  425 + '0' : Result := grTen;
  426 + end;
  427 + end;
  428 +
  429 + function ColorFromString(S: string): TGameColor;
  430 + begin
  431 + case S of
  432 + '0' : Result := gcNone;
  433 + '1' : Result := gcYellow;
  434 + '2' : Result := gcRed;
  435 + '3' : Result := gcMagenta;
  436 + '4' : Result := gcBlue;
  437 + '5' : Result := gcGreen;
  438 + end;
  439 + end;
  440 +
  441 + function ChoiceFromString(S:string) : TPlayerChoice;
  442 + begin
  443 + Result.Row := RowFromString(ExtractDelimited(1,S,[',']));
  444 + Result.Color := ColorFromString(ExtractDelimited(2,S,[',']));
  445 + end;
  446 +
  447 + function PointsFromString(S:string) : TPlayerPoints;
  448 + begin
  449 + Result.A := StrToInt(ExtractDelimited(1,S,[',']));
  450 + Result.B := StrToInt(ExtractDelimited(2,S,[',']));
  451 + end;
  452 +
  453 + function StatusFromString(S : string): TGamePlayerStatus;
  454 + begin
  455 + case S of
  456 + '0': Result := gpsWaiting;
  457 + '1': Result := gpsPlaying;
  458 + '2': Result := gpsPlayed;
  459 + end;
  460 + end;
  461 +begin
  462 + {$IFDEF DEBUG}
  463 + WriteLn(ExtractDelimited(1,s,['|']));
  464 + WriteLn(ExtractDelimited(2,s,['|']));
  465 + WriteLn(ExtractDelimited(3,s,['|']));
  466 + WriteLn(ExtractDelimited(4,s,['|']));
  467 + WriteLn(ExtractDelimited(5,s,['|']));
  468 + WriteLn(ExtractDelimited(6,s,['|']));
  469 + {$ENDIF}
  470 + Result.ID := ExtractDelimited(1,s,['|']);
  471 + Result.Nicname := ExtractDelimited(2,s,['|']);
  472 + Result.Points := PointsFromString(ExtractDelimited(3,s,['|']));
  473 + Result.Status := StatusFromString(ExtractDelimited(4,s,['|']));
  474 + Result.Choice := ChoiceFromString(ExtractDelimited(5,s,['|']));
  475 + Result.Turn:=StrToInt(ExtractDelimited(6,s,['|']));
  476 +end;
247 477  
248 478 end.
249 479  
... ...