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,23 +80,30 @@ type
80 private 80 private
81 FAppendicePlural: UTF8String; 81 FAppendicePlural: UTF8String;
82 FAppendiceSingular: UTF8String; 82 FAppendiceSingular: UTF8String;
  83 + FLastPresentedMessage: UTF8string;
83 FNicname: UTF8String; 84 FNicname: UTF8String;
84 - protected  
85 FStyle : TConsequenceStyle; 85 FStyle : TConsequenceStyle;
86 FP : TGamePoint; 86 FP : TGamePoint;
87 FMessage : TPopupNotifier; 87 FMessage : TPopupNotifier;
  88 + function GetShouldPublishMessage: Boolean;
  89 + protected
  90 + FConsequenceByPlayerID : TStringList;
88 procedure StopTimer(Sender:TObject;var ACloseAction:TCloseAction); 91 procedure StopTimer(Sender:TObject;var ACloseAction:TCloseAction);
89 procedure TimerTimer(Sender:TOBject);virtual; 92 procedure TimerTimer(Sender:TOBject);virtual;
90 public 93 public
91 constructor Create(AOwner:TComponent; AP:TGamePoint; AStyle:TConsequenceStyle; AAppendiceSingular,AAppendicePlural:UTF8String);overload; 94 constructor Create(AOwner:TComponent; AP:TGamePoint; AStyle:TConsequenceStyle; AAppendiceSingular,AAppendicePlural:UTF8String);overload;
92 constructor Create(AOwner:TComponent; AP:integer; AStyle: TConsequenceStyle; AMessage:array of UTF8string);overload; 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 destructor Destroy;override; 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 property PlayerNicname : UTF8String read FNicname write FNicname; 103 property PlayerNicname : UTF8String read FNicname write FNicname;
98 property AppendiceSingular : UTF8String read FAppendiceSingular; 104 property AppendiceSingular : UTF8String read FAppendiceSingular;
99 property AppendicePlural : UTF8String read FAppendicePlural; 105 property AppendicePlural : UTF8String read FAppendicePlural;
  106 + property ConsequenseByPlayerID : TStringList read FConsequenceByPlayerID;
100 end; 107 end;
101 108
102 { TContingency } 109 { TContingency }
@@ -130,13 +137,20 @@ type @@ -130,13 +137,20 @@ type
130 137
131 TPrompt = class(TConsequence) 138 TPrompt = class(TConsequence)
132 private 139 private
  140 + FResponses : array of UTF8String;
  141 + FResult : UTF8String;
133 FPromptTargets : TContingencies; // need to test this 142 FPromptTargets : TContingencies; // need to test this
  143 + FPromptStyle : TPromptStyle;
  144 + FPromptMessage : UTF8String;
  145 + procedure ClearResponses;
134 public 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 end; 154 end;
141 155
142 TEndConditionCriterium = record 156 TEndConditionCriterium = record
@@ -153,6 +167,10 @@ type @@ -153,6 +167,10 @@ type
153 TCondition = record 167 TCondition = record
154 ConditionName : string; 168 ConditionName : string;
155 Contingencies : TContingencies; // for producing points during the condition 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 Points : record 175 Points : record
158 Count : TPoints; // sum of points produced during the condition 176 Count : TPoints; // sum of points produced during the condition
@@ -165,7 +183,7 @@ type @@ -165,7 +183,7 @@ type
165 Random: Boolean; // if we should change Players[i].Turn OnCycle 183 Random: Boolean; // if we should change Players[i].Turn OnCycle
166 end; 184 end;
167 185
168 - Cycles : record // for changing generations 186 + Cycles : record // for changing generations //absolute value is (Value * Generation)+Count
169 Count, // current cycle 187 Count, // current cycle
170 Value, // CyclesPerLineage, CyclesPerGeneration 188 Value, // CyclesPerLineage, CyclesPerGeneration
171 Generation : integer; 189 Generation : integer;
@@ -176,7 +194,7 @@ type @@ -176,7 +194,7 @@ type
176 194
177 implementation 195 implementation
178 196
179 -uses ButtonPanel,Controls,ExtCtrls,strutils, string_methods, 197 +uses Graphics, strutils, string_methods,
180 form_matrixgame{,StdCtrls}; 198 form_matrixgame{,StdCtrls};
181 199
182 { TContingency } 200 { TContingency }
@@ -198,8 +216,8 @@ end; @@ -198,8 +216,8 @@ end;
198 216
199 procedure TContingency.CriteriaEvent; 217 procedure TContingency.CriteriaEvent;
200 begin 218 begin
201 - // FConsequence.Present(FMeta);  
202 - // do admin internals 219 + FFired:=True;
  220 + if Assigned(FOnCriteria) then FOnCriteria(Self);
203 end; 221 end;
204 222
205 constructor TContingency.Create(AOwner:TComponent;AConsequence:TConsequence;ACriteria:TCriteria;IsMeta:Boolean); 223 constructor TContingency.Create(AOwner:TComponent;AConsequence:TConsequence;ACriteria:TCriteria;IsMeta:Boolean);
@@ -220,13 +238,7 @@ begin @@ -220,13 +238,7 @@ begin
220 Result += GetRowString(R) + ','; 238 Result += GetRowString(R) + ',';
221 Result += '|'; 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 Result += ','; 242 Result += ',';
231 Result += '|'; 243 Result += '|';
232 244
@@ -255,7 +267,7 @@ begin @@ -255,7 +267,7 @@ begin
255 gtRowsOrColors: Result := LRow or LColor; 267 gtRowsOrColors: Result := LRow or LColor;
256 end; 268 end;
257 if Result then 269 if Result then
258 - if Assigned(FOnCriteria) then FOnCriteria(Self); 270 + CriteriaEvent;
259 end; 271 end;
260 272
261 function TContingency.ResponseMeetsCriteriaG(Players: TPlayers): Boolean; 273 function TContingency.ResponseMeetsCriteriaG(Players: TPlayers): Boolean;
@@ -269,48 +281,50 @@ var i : integer; @@ -269,48 +281,50 @@ var i : integer;
269 function AllColorsEqual:Boolean; 281 function AllColorsEqual:Boolean;
270 var i : integer; 282 var i : integer;
271 begin 283 begin
272 - Result := True; 284 + Result := not (gcNot in Criteria.Colors);
273 for i := 0 to Len-2 do 285 for i := 0 to Len-2 do
274 if Cs[i] <> Cs[i+1] then 286 if Cs[i] <> Cs[i+1] then
275 begin 287 begin
276 - Result := False;  
277 - Break; 288 + Result := not Result;
  289 + Break;
278 end; 290 end;
279 end; 291 end;
280 292
281 function AllColorsDiff:Boolean; 293 function AllColorsDiff:Boolean;
282 var i : integer; 294 var i : integer;
283 begin 295 begin
284 - Result := True; 296 + Result := not (gcNot in Criteria.Colors);
285 for i := 0 to Len-2 do 297 for i := 0 to Len-2 do
286 if Cs[i] = Cs[i+1] then 298 if Cs[i] = Cs[i+1] then
287 begin 299 begin
288 - Result := False;  
289 - Break; 300 + Result := not Result;
  301 + Break;
290 end; 302 end;
291 end; 303 end;
292 304
293 function AllRowsOdd: Boolean; 305 function AllRowsOdd: Boolean;
294 begin 306 begin
  307 + Result := not (grNot in Criteria.Rows);
295 for R in Rs do 308 for R in Rs do
296 if RowMod(R) = grEven then 309 if RowMod(R) = grEven then
297 begin 310 begin
298 - Result := False;  
299 - Exit; 311 + Result := not Result;
  312 + Break;
300 end; 313 end;
301 end; 314 end;
302 315
303 function AllRowsEven: Boolean; 316 function AllRowsEven: Boolean;
304 begin 317 begin
  318 + Result := not (grNot in Criteria.Rows);
305 for R in Rs do 319 for R in Rs do
306 if RowMod(R) = grOdd then 320 if RowMod(R) = grOdd then
307 begin 321 begin
308 - Result := False;  
309 - Exit; 322 + Result := not Result;
  323 + Break;
310 end; 324 end;
311 end; 325 end;
312 326
313 -begin // grDiff,grEqual,grAll 327 +begin // All -> (Diff,Equal,Even, Odd) or not all
314 Result := False; 328 Result := False;
315 Len := Length(Players); 329 Len := Length(Players);
316 SetLength(Cs,Len); 330 SetLength(Cs,Len);
@@ -348,13 +362,13 @@ begin // grDiff,grEqual,grAll @@ -348,13 +362,13 @@ begin // grDiff,grEqual,grAll
348 Result := AllColorsDiff and AllRowsOdd; 362 Result := AllColorsDiff and AllRowsOdd;
349 363
350 if (gcDiff in Criteria.Colors) and (grEven in Criteria.Rows) then 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 if (gcEqual in Criteria.Colors) and (grOdd in Criteria.Rows) then 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 if (gcEqual in Criteria.Colors) and (grEven in Criteria.Rows) then 370 if (gcEqual in Criteria.Colors) and (grEven in Criteria.Rows) then
357 - Result := AllColorsEqual and AllRowsEven; 371 + Result := AllColorsEqual and AllRowsEven;
358 end; 372 end;
359 gtRowsOrColors: 373 gtRowsOrColors:
360 begin 374 begin
@@ -362,61 +376,118 @@ begin // grDiff,grEqual,grAll @@ -362,61 +376,118 @@ begin // grDiff,grEqual,grAll
362 Result := AllColorsDiff or AllRowsOdd; 376 Result := AllColorsDiff or AllRowsOdd;
363 377
364 if (gcDiff in Criteria.Colors) and (grEven in Criteria.Rows) then 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 if (gcEqual in Criteria.Colors) and (grOdd in Criteria.Rows) then 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 if (gcEqual in Criteria.Colors) and (grEven in Criteria.Rows) then 384 if (gcEqual in Criteria.Colors) and (grEven in Criteria.Rows) then
371 - Result := AllColorsEqual or AllRowsEven; 385 + Result := AllColorsEqual or AllRowsEven;
372 end; 386 end;
373 end; 387 end;
374 if Result then 388 if Result then
375 - if Assigned(FOnCriteria) then FOnCriteria(Self); 389 + CriteriaEvent;
376 end; 390 end;
377 391
378 392
379 { TPrompt } 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 begin 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 end; 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 end; 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 end; 463 end;
417 begin 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 end; 491 end;
421 492
422 { TConsequence } 493 { TConsequence }
@@ -431,6 +502,7 @@ begin @@ -431,6 +502,7 @@ begin
431 FAppendicePlural:=AAppendicePlural; 502 FAppendicePlural:=AAppendicePlural;
432 FP := AP; 503 FP := AP;
433 FMessage := TPopupNotifier.Create(AOwner); 504 FMessage := TPopupNotifier.Create(AOwner);
  505 + FConsequenceByPlayerID := TStringList.Create;
434 end; 506 end;
435 507
436 constructor TConsequence.Create(AOwner: TComponent; AP: integer; 508 constructor TConsequence.Create(AOwner: TComponent; AP: integer;
@@ -443,83 +515,65 @@ begin @@ -443,83 +515,65 @@ begin
443 FAppendicePlural:=AMessage[2]; 515 FAppendicePlural:=AMessage[2];
444 FP := TGamePoint.Create(AOwner,AP); 516 FP := TGamePoint.Create(AOwner,AP);
445 FMessage := TPopupNotifier.Create(AOwner); 517 FMessage := TPopupNotifier.Create(AOwner);
  518 + FConsequenceByPlayerID := TStringList.Create;
446 end; 519 end;
447 520
448 constructor TConsequence.Create(AOwner: TComponent; 521 constructor TConsequence.Create(AOwner: TComponent;
449 AConsequenceString: UTF8String); 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 begin 523 begin
471 inherited Create(AOwner); 524 inherited Create(AOwner);
472 FP := TGamePoint.Create(AOwner,ExtractDelimited(1,AConsequenceString,['|'])); 525 FP := TGamePoint.Create(AOwner,ExtractDelimited(1,AConsequenceString,['|']));
473 - FStyle:=GetConsequenceStyleFromString(ExtractDelimited(2,AConsequenceString,['|'])); 526 + FStyle:=GetConsequenceStylesFromString(ExtractDelimited(2,AConsequenceString,['|']));
474 FNicname:=ExtractDelimited(3,AConsequenceString,['|']); 527 FNicname:=ExtractDelimited(3,AConsequenceString,['|']);
475 FAppendiceSingular:=ExtractDelimited(4,AConsequenceString,['|']); 528 FAppendiceSingular:=ExtractDelimited(4,AConsequenceString,['|']);
476 FAppendicePlural:=ExtractDelimited(5,AConsequenceString,['|']); 529 FAppendicePlural:=ExtractDelimited(5,AConsequenceString,['|']);
477 FMessage := TPopupNotifier.Create(AOwner); 530 FMessage := TPopupNotifier.Create(AOwner);
  531 + FConsequenceByPlayerID := TStringList.Create;
478 end; 532 end;
479 533
480 destructor TConsequence.Destroy; 534 destructor TConsequence.Destroy;
481 begin 535 begin
  536 + FConsequenceByPlayerID.Free;
482 inherited Destroy; 537 inherited Destroy;
483 end; 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 begin 541 begin
506 - Result := IntToStr(FP.Value)+','+IntToStr(FP.Variation) + '|';  
507 - Result += GetConsequenceStyleString(FStyle)+'|'; 542 + Result := IntToStr(FP.ValueWithVariation) + '|';
  543 + Result += GetConsequenceStylesString(FStyle)+'|';
508 Result += FNicname +'|'; 544 Result += FNicname +'|';
509 Result += FAppendiceSingular + '|'; 545 Result += FAppendiceSingular + '|';
510 Result += FAppendicePlural + '|'; 546 Result += FAppendicePlural + '|';
  547 + FConsequenceByPlayerID.Values[AID]:=Result;
511 end; 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 var 566 var
516 PopUpPos : TPoint; 567 PopUpPos : TPoint;
517 begin 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 FMessage.Text := FP.PointMessage(FNicname,FAppendicePlural, FAppendiceSingular,ForGroup); 575 FMessage.Text := FP.PointMessage(FNicname,FAppendicePlural, FAppendiceSingular,ForGroup);
  576 + FLastPresentedMessage := FMessage.Text;
523 FMessage.OnClose:=@StopTimer; 577 FMessage.OnClose:=@StopTimer;
524 FormMatrixGame.Timer.OnTimer := @TimerTimer; 578 FormMatrixGame.Timer.OnTimer := @TimerTimer;
525 579
@@ -532,15 +586,20 @@ begin @@ -532,15 +586,20 @@ begin
532 if gscG in FStyle then 586 if gscG in FStyle then
533 FormMatrixGame.LabelGroupCount.Caption:= IntToStr(StrToInt(FormMatrixGame.LabelGroupCount.Caption) + FP.ResultAsInteger); 587 FormMatrixGame.LabelGroupCount.Caption:= IntToStr(StrToInt(FormMatrixGame.LabelGroupCount.Caption) + FP.ResultAsInteger);
534 588
  589 + if gscBroadcastMessage in FStyle then Exit;
535 FMessage.ShowAtPos(PopUpPos.X, PopUpPos.Y); 590 FMessage.ShowAtPos(PopUpPos.X, PopUpPos.Y);
536 FormMatrixGame.Timer.Enabled:=True; 591 FormMatrixGame.Timer.Enabled:=True;
537 end; 592 end;
538 593
  594 +function TConsequence.GetShouldPublishMessage: Boolean;
  595 +begin
  596 + Result := gscBroadcastMessage in FStyle;
  597 +end;
  598 +
539 procedure TConsequence.StopTimer(Sender: TObject; var ACloseAction: TCloseAction 599 procedure TConsequence.StopTimer(Sender: TObject; var ACloseAction: TCloseAction
540 ); 600 );
541 begin 601 begin
542 FormMatrixGame.Timer.Enabled:=False; 602 FormMatrixGame.Timer.Enabled:=False;
543 - Free;  
544 end; 603 end;
545 604
546 procedure TConsequence.TimerTimer(Sender: TOBject); 605 procedure TConsequence.TimerTimer(Sender: TOBject);
units/game_actors_point.pas
  Diff comments   View file @1722c6f
@@ -19,15 +19,15 @@ type @@ -19,15 +19,15 @@ type
19 function GetResult: integer; 19 function GetResult: integer;
20 function GetResultAsString: string; 20 function GetResultAsString: string;
21 function GetValue: integer; 21 function GetValue: integer;
22 - procedure SetValue(AValue: integer);  
23 public 22 public
24 //Cycles : integer; // specify when present points regarding condition cycles 23 //Cycles : integer; // specify when present points regarding condition cycles
25 constructor Create(AOwner:TComponent;AValue : integer);overload; 24 constructor Create(AOwner:TComponent;AValue : integer);overload;
26 constructor Create(AOwner:TComponent;AValue : array of integer); overload; 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 function PointMessage(APrepend, AAppendicePlural, AAppendiceSingular: string; IsGroupPoint: Boolean) : string; 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 property Variation : integer read FVariation write FVariation; 29 property Variation : integer read FVariation write FVariation;
  30 +
31 property AsString : string read GetResultAsString; 31 property AsString : string read GetResultAsString;
32 property ResultAsInteger : integer read GetResult; 32 property ResultAsInteger : integer read GetResult;
33 end; 33 end;
@@ -67,11 +67,6 @@ begin @@ -67,11 +67,6 @@ begin
67 Result := IntToStr(FResult); 67 Result := IntToStr(FResult);
68 end; 68 end;
69 69
70 -procedure TGamePoint.SetValue(AValue: integer);  
71 -begin  
72 - FValue := AValue;  
73 -end;  
74 -  
75 constructor TGamePoint.Create(AOwner: TComponent; AValue: integer); 70 constructor TGamePoint.Create(AOwner: TComponent; AValue: integer);
76 begin 71 begin
77 inherited Create(AOwner); 72 inherited Create(AOwner);
@@ -86,15 +81,15 @@ begin @@ -86,15 +81,15 @@ begin
86 FVariation := AValue[1]; 81 FVariation := AValue[1];
87 end; 82 end;
88 83
89 -constructor TGamePoint.Create(AOwner: TComponent; AValue: utf8string); 84 +constructor TGamePoint.Create(AOwner: TComponent; AResult: utf8string);
90 begin 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 end; 89 end;
94 90
95 function TGamePoint.PointMessage(APrepend, AAppendicePlural, AAppendiceSingular: string; IsGroupPoint: Boolean): string; 91 function TGamePoint.PointMessage(APrepend, AAppendicePlural, AAppendiceSingular: string; IsGroupPoint: Boolean): string;
96 begin 92 begin
97 - Self.Value;  
98 if IsGroupPoint then 93 if IsGroupPoint then
99 begin 94 begin
100 if APrepend = '' then 95 if APrepend = '' then
@@ -108,8 +103,8 @@ begin @@ -108,8 +103,8 @@ begin
108 -MaxInt..-2: Result += ' produziram a perda de '+Self.AsString+ ' pontos para o grupo'; 103 -MaxInt..-2: Result += ' produziram a perda de '+Self.AsString+ ' pontos para o grupo';
109 -1 : Result += ' produziram a perda de 1 ponto para o grupo'; 104 -1 : Result += ' produziram a perda de 1 ponto para o grupo';
110 0 : Result += ' pontos do grupo não foram produzidos nem perdidos'; 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 end; 108 end;
114 end 109 end
115 else 110 else
@@ -118,8 +113,8 @@ begin @@ -118,8 +113,8 @@ begin
118 -MaxInt..-2: Result += ' produziram a perda de '+Self.AsString+ ' ' + AAppendicePlural; 113 -MaxInt..-2: Result += ' produziram a perda de '+Self.AsString+ ' ' + AAppendicePlural;
119 -1 : Result += ' produziram a perda de 1'+ ' ' + AAppendiceSingular; 114 -1 : Result += ' produziram a perda de 1'+ ' ' + AAppendiceSingular;
120 0 : Result += ' não produziram ' + AAppendicePlural; 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 end; 118 end;
124 end; 119 end;
125 end 120 end
@@ -137,17 +132,17 @@ begin @@ -137,17 +132,17 @@ begin
137 -1 : Result += ' perdeu 1 ponto'; 132 -1 : Result += ' perdeu 1 ponto';
138 0 : Result += ' não perdeu nem ganhou pontos'; 133 0 : Result += ' não perdeu nem ganhou pontos';
139 1 : Result += ' ganhou 1 ponto'; 134 1 : Result += ' ganhou 1 ponto';
140 - 2..MaxInt: Result += 'ganhou '+Self.AsString+' pontos' 135 + 2..MaxInt: Result += ' ganhou '+Self.AsString+' pontos'
141 end; 136 end;
142 end 137 end
143 else 138 else
144 begin 139 begin
145 case FValue of 140 case FValue of
146 -MaxInt..-2: Result += ' perdeu '+Self.AsString+ ' ' + AAppendicePlural; 141 -MaxInt..-2: Result += ' perdeu '+Self.AsString+ ' ' + AAppendicePlural;
147 - -1 : Result += ' ponto 1'+ ' ' + AAppendiceSingular; 142 + -1 : Result += ' ponto 1 ' + AAppendiceSingular;
148 0 : Result += ' não perdeu nem ganhou ' + AAppendicePlural; 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 end; 146 end;
152 end; 147 end;
153 end; 148 end;
units/game_control.pas
  Diff comments   View file @1722c6f
@@ -43,12 +43,21 @@ type @@ -43,12 +43,21 @@ type
43 procedure SetMustDrawDotsClear(AValue: Boolean); 43 procedure SetMustDrawDotsClear(AValue: Boolean);
44 procedure SetRowBase(AValue: integer); 44 procedure SetRowBase(AValue: integer);
45 private 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 procedure KickPlayer(AID:string); 54 procedure KickPlayer(AID:string);
48 procedure NextTurn(Sender: TObject); 55 procedure NextTurn(Sender: TObject);
49 procedure NextCycle(Sender: TObject); 56 procedure NextCycle(Sender: TObject);
50 procedure NextLineage(Sender: TObject); 57 procedure NextLineage(Sender: TObject);
51 procedure NextCondition(Sender: TObject); 58 procedure NextCondition(Sender: TObject);
  59 + procedure Interlocking(Sender: TObject);
  60 + procedure Consequence(Sender: TObject);
52 procedure EndExperiment(Sender: TObject); 61 procedure EndExperiment(Sender: TObject);
53 procedure StartExperiment; 62 procedure StartExperiment;
54 public 63 public
@@ -77,6 +86,7 @@ const @@ -77,6 +86,7 @@ const
77 K_REFUSED = '.Refused'; 86 K_REFUSED = '.Refused';
78 K_CHAT_M = '.ChatM'; 87 K_CHAT_M = '.ChatM';
79 K_CHOICE = '.Choice'; 88 K_CHOICE = '.Choice';
  89 + K_MESSAGE = '.Message';
80 K_START = '.Start'; 90 K_START = '.Start';
81 K_LEFT = '.Left'; 91 K_LEFT = '.Left';
82 K_RESUME = '.Resume'; 92 K_RESUME = '.Resume';
@@ -84,6 +94,7 @@ const @@ -84,6 +94,7 @@ const
84 K_LOGIN = '.Login'; 94 K_LOGIN = '.Login';
85 K_KICK = '.Kick'; 95 K_KICK = '.Kick';
86 K_QUESTION = '.Question'; 96 K_QUESTION = '.Question';
  97 + K_QMESSAGE = '.QMessage';
87 // 98 //
88 K_STATUS = '.Status'; 99 K_STATUS = '.Status';
89 K_CYCLES = '.OnEndCycle'; 100 K_CYCLES = '.OnEndCycle';
@@ -92,7 +103,9 @@ const @@ -92,7 +103,9 @@ const
92 103
93 implementation 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 const 110 const
98 GA_ADMIN = 'Admin'; 111 GA_ADMIN = 'Admin';
@@ -117,11 +130,17 @@ end; @@ -117,11 +130,17 @@ end;
117 130
118 { TGameControl } 131 { TGameControl }
119 132
120 -function TGameControl.ShouldStartExperiment: Boolean; 133 +function TGameControl.ShouldStartCycle: Boolean; // starts experiment too
121 begin 134 begin
122 Result := FExperiment.PlayersCount = FExperiment.Condition[FExperiment.CurrentCondition].Turn.Value; 135 Result := FExperiment.PlayersCount = FExperiment.Condition[FExperiment.CurrentCondition].Turn.Value;
123 end; 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 procedure TGameControl.KickPlayer(AID: string); 144 procedure TGameControl.KickPlayer(AID: string);
126 begin 145 begin
127 FZMQActor.SendMessage([K_KICK, AID]); 146 FZMQActor.SendMessage([K_KICK, AID]);
@@ -134,9 +153,7 @@ begin @@ -134,9 +153,7 @@ begin
134 153
135 // inform players 154 // inform players
136 155
137 -{$IFDEF DEBUG}  
138 - WriteLn('TGameControl.NextTurn');  
139 -{$ENDIF} 156 +
140 end; 157 end;
141 158
142 procedure TGameControl.NextCycle(Sender: TObject); 159 procedure TGameControl.NextCycle(Sender: TObject);
@@ -144,8 +161,9 @@ begin @@ -144,8 +161,9 @@ begin
144 // prompt question to all players 161 // prompt question to all players
145 FormMatrixGame.LabelExpCountCycle.Caption:=IntToStr(FExperiment.Condition[FExperiment.CurrentCondition].Cycles.Count); 162 FormMatrixGame.LabelExpCountCycle.Caption:=IntToStr(FExperiment.Condition[FExperiment.CurrentCondition].Cycles.Count);
146 {$IFDEF DEBUG} 163 {$IFDEF DEBUG}
147 - WriteLn('TGameControl.NextTurn'); 164 + WriteLn('cycle:',FExperiment.ConsequenceStringFromChoices);
148 {$ENDIF} 165 {$ENDIF}
  166 + //FZMQActor.SendMessage([K_CYCLES])
149 end; 167 end;
150 168
151 procedure TGameControl.NextLineage(Sender: TObject); 169 procedure TGameControl.NextLineage(Sender: TObject);
@@ -166,6 +184,20 @@ begin @@ -166,6 +184,20 @@ begin
166 // append which player 184 // append which player
167 end; 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 procedure TGameControl.EndExperiment(Sender: TObject); 201 procedure TGameControl.EndExperiment(Sender: TObject);
170 begin 202 begin
171 203
@@ -298,7 +330,7 @@ end; @@ -298,7 +330,7 @@ end;
298 330
299 function TGameControl.GetSelectedColorF(AStringGrid: TStringGrid): UTF8string; 331 function TGameControl.GetSelectedColorF(AStringGrid: TStringGrid): UTF8string;
300 begin 332 begin
301 - Result := GetRowColorString(GetRowColor(AStringGrid.Selection.Top,RowBase)); 333 + Result := GetColorString(GetRowColor(AStringGrid.Selection.Top,RowBase));
302 end; 334 end;
303 335
304 function TGameControl.GetSelectedRowF(AStringGrid: TStringGrid): UTF8string; 336 function TGameControl.GetSelectedRowF(AStringGrid: TStringGrid): UTF8string;
@@ -332,6 +364,80 @@ begin @@ -332,6 +364,80 @@ begin
332 FRowBase:=AValue; 364 FRowBase:=AValue;
333 end; 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 constructor TGameControl.Create(AOwner: TComponent); 441 constructor TGameControl.Create(AOwner: TComponent);
336 begin 442 begin
337 FZMQActor := TZMQActor(AOwner); 443 FZMQActor := TZMQActor(AOwner);
@@ -358,13 +464,18 @@ begin @@ -358,13 +464,18 @@ begin
358 FExperiment.OnEndTurn := @NextTurn; 464 FExperiment.OnEndTurn := @NextTurn;
359 FExperiment.OnEndCycle := @NextCycle; 465 FExperiment.OnEndCycle := @NextCycle;
360 FExperiment.OnEndGeneration:=@NextLineage; 466 FExperiment.OnEndGeneration:=@NextLineage;
  467 + FExperiment.OnInterlocking:=@Interlocking;
  468 + FExperiment.OnConsequence:=@Consequence;
361 FExperiment.OnEndCondition:= @NextCondition; 469 FExperiment.OnEndCondition:= @NextCondition;
362 FExperiment.OnEndExperiment:= @EndExperiment; 470 FExperiment.OnEndExperiment:= @EndExperiment;
  471 + FExperiment.OnInterlocking := @Interlocking;
363 472
364 NextTurn(Self); 473 NextTurn(Self);
365 NextCycle(Self); 474 NextCycle(Self);
366 NextLineage(Self); 475 NextLineage(Self);
367 NextCondition(Self); 476 NextCondition(Self);
  477 + Interlocking(Self);
  478 + Consequence(Self);
368 479
369 SendRequest(K_LOGIN); 480 SendRequest(K_LOGIN);
370 end; 481 end;
@@ -480,11 +591,6 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList); @@ -480,11 +591,6 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
480 var P : TPlayer; 591 var P : TPlayer;
481 begin 592 begin
482 case FActor of 593 case FActor of
483 - gaAdmin:  
484 - begin  
485 - // do nothing  
486 - end;  
487 -  
488 gaPlayer: 594 gaPlayer:
489 begin 595 begin
490 P := FExperiment.PlayerFromString[AMessage[1]]; 596 P := FExperiment.PlayerFromString[AMessage[1]];
@@ -497,19 +603,6 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList); @@ -497,19 +603,6 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
497 CreatePlayerBox(P,False); 603 CreatePlayerBox(P,False);
498 end; 604 end;
499 end; 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 end; 606 end;
514 607
515 procedure ReceiveChoice; 608 procedure ReceiveChoice;
@@ -521,52 +614,58 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList); @@ -521,52 +614,58 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
521 with GetPlayerBox(P.ID) do 614 with GetPlayerBox(P.ID) do
522 begin 615 begin
523 LabelLastRowCount.Caption := AMessage[2]; 616 LabelLastRowCount.Caption := AMessage[2];
524 - PanelLastColor.Color := GetRowColorFromString(AMessage[3]); 617 + PanelLastColor.Color := GetColorFromString(AMessage[3]);
525 PanelLastColor.Caption:=''; 618 PanelLastColor.Caption:='';
526 end; 619 end;
527 620
528 case FActor of 621 case FActor of
529 gaPlayer:begin 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 if Self.ID = P.ID then 642 if Self.ID = P.ID then
531 begin 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 end 650 end
536 else 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 end; 653 end;
543 end; 654 end;
544 end; 655 end;
545 656
546 procedure NotifyPlayers; 657 procedure NotifyPlayers;
547 - var PopUpPos : TPoint;  
548 begin 658 begin
549 case FActor of 659 case FActor of
550 gaPlayer: 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 if FExperiment.PlayerFromID[Self.ID].Turn = 0 then 661 if FExperiment.PlayerFromID[Self.ID].Turn = 0 then
556 begin 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 end 665 end
563 else 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 end; 669 end;
571 end; 670 end;
572 671
@@ -578,19 +677,7 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList); @@ -578,19 +677,7 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
578 case FActor of 677 case FActor of
579 gaPlayer: 678 gaPlayer:
580 begin 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 end; 681 end;
595 end; 682 end;
596 end; 683 end;
@@ -619,49 +706,80 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList); @@ -619,49 +706,80 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
619 end; 706 end;
620 end; 707 end;
621 708
622 - procedure ResumeActor; 709 + procedure ShowQuestion;
623 begin 710 begin
624 case FActor of 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 end; 718 end;
632 end; 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 begin 739 begin
636 case FActor of 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 gaPlayer:begin 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 end; 768 end;
643 end; 769 end;
644 end; 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 begin 773 begin
659 if MHas(K_ARRIVED) then ReceiveActor; 774 if MHas(K_ARRIVED) then ReceiveActor;
660 if MHas(K_CHAT_M) then ReceiveChat; 775 if MHas(K_CHAT_M) then ReceiveChat;
661 if MHas(K_CHOICE) then ReceiveChoice; 776 if MHas(K_CHOICE) then ReceiveChoice;
  777 + if MHas(K_MESSAGE) then ShowPopUp(AMessage[1]);
662 if MHas(K_KICK) then SayGoodBye; 778 if MHas(K_KICK) then SayGoodBye;
663 if MHas(K_START) then NotifyPlayers; 779 if MHas(K_START) then NotifyPlayers;
664 if MHas(K_CYCLES) then OnEndCycle; 780 if MHas(K_CYCLES) then OnEndCycle;
  781 + if MHas(K_QUESTION) then ShowQuestion;
  782 + if MHas(K_QMESSAGE) then QuestionMessages;
665 end; 783 end;
666 784
667 // Here FActor is garanted to be a TZMQAdmin 785 // Here FActor is garanted to be a TZMQAdmin
@@ -738,8 +856,8 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList); @@ -738,8 +856,8 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList);
738 // inform all players about the new player, including itself 856 // inform all players about the new player, including itself
739 FZMQActor.SendMessage([K_ARRIVED,PS]); 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 StartExperiment; 861 StartExperiment;
744 862
745 end 863 end
@@ -759,18 +877,66 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList); @@ -759,18 +877,66 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList);
759 begin 877 begin
760 P := FExperiment.PlayerFromID[ARequest[0]]; 878 P := FExperiment.PlayerFromID[ARequest[0]];
761 P.Choice.Row:= GetRowFromString(ARequest[3]); // row 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 ARequest[2] := K_CHOICE+K_ARRIVED; 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 end; 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 begin 933 begin
769 if MHas(K_LOGIN) then ReplyLoginRequest; 934 if MHas(K_LOGIN) then ReplyLoginRequest;
770 if MHas(K_CHOICE) then ValidateChoice; 935 if MHas(K_CHOICE) then ValidateChoice;
  936 + if MHas(K_QUESTION) then ValidateQuestionResponse;
771 end; 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 // - sending private data to player player 940 // - sending private data to player player
775 // - sending data from early history to income players 941 // - sending data from early history to income players
776 procedure TGameControl.ReceiveReply(AReply: TStringList); 942 procedure TGameControl.ReceiveReply(AReply: TStringList);
@@ -814,11 +980,11 @@ procedure TGameControl.ReceiveReply(AReply: TStringList); @@ -814,11 +980,11 @@ procedure TGameControl.ReceiveReply(AReply: TStringList);
814 LConsequence : TConsequence; 980 LConsequence : TConsequence;
815 LCount, 981 LCount,
816 i : integer; 982 i : integer;
817 - P : TPlayer; 983 + //P : TPlayer;
818 begin 984 begin
819 if Self.ID = AReply[0] then 985 if Self.ID = AReply[0] then
820 begin 986 begin
821 - P := FExperiment.PlayerFromID[Self.ID]; 987 + //P := FExperiment.PlayerFromID[Self.ID];
822 LCount := WordCount(AReply[5],['+']); 988 LCount := WordCount(AReply[5],['+']);
823 {$IFDEF DEBUG} 989 {$IFDEF DEBUG}
824 WriteLn('LCount:',LCount); 990 WriteLn('LCount:',LCount);
@@ -828,7 +994,9 @@ procedure TGameControl.ReceiveReply(AReply: TStringList); @@ -828,7 +994,9 @@ procedure TGameControl.ReceiveReply(AReply: TStringList);
828 begin 994 begin
829 LConsequence := TConsequence.Create(FormMatrixGame,ExtractDelimited(i,AReply[5],['+'])); 995 LConsequence := TConsequence.Create(FormMatrixGame,ExtractDelimited(i,AReply[5],['+']));
830 //LConsequence.PlayerNicname := P.Nicname; 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 {$IFDEF DEBUG} 1000 {$IFDEF DEBUG}
833 WriteLn('A consequence should have shown.'); 1001 WriteLn('A consequence should have shown.');
834 {$ENDIF} 1002 {$ENDIF}
@@ -836,6 +1004,10 @@ procedure TGameControl.ReceiveReply(AReply: TStringList); @@ -836,6 +1004,10 @@ procedure TGameControl.ReceiveReply(AReply: TStringList);
836 1004
837 end; 1005 end;
838 end; 1006 end;
  1007 + procedure QuestionValidated;
  1008 + begin
  1009 + // wait
  1010 + end;
839 1011
840 procedure ResumePlayer; 1012 procedure ResumePlayer;
841 begin 1013 begin
@@ -846,6 +1018,7 @@ begin @@ -846,6 +1018,7 @@ begin
846 if MHas(K_RESUME+K_ARRIVED) then ResumePlayer; 1018 if MHas(K_RESUME+K_ARRIVED) then ResumePlayer;
847 if MHas(K_LOGIN+K_ARRIVED) then LoginAccepted; 1019 if MHas(K_LOGIN+K_ARRIVED) then LoginAccepted;
848 if MHas(K_CHOICE+K_ARRIVED) then ChoiceValidated; 1020 if MHas(K_CHOICE+K_ARRIVED) then ChoiceValidated;
  1021 + if MHas(K_QUESTION+K_ARRIVED) then QuestionValidated;
849 end; 1022 end;
850 1023
851 1024
units/game_experiment.pas
  Diff comments   View file @1722c6f
@@ -25,6 +25,8 @@ type @@ -25,6 +25,8 @@ type
25 FExperimentName, 25 FExperimentName,
26 FFilename, 26 FFilename,
27 FResearcher : UTF8string; 27 FResearcher : UTF8string;
  28 + FOnConsequence: TNotifyEvent;
  29 + FOnInterlocking: TNotifyEvent;
28 FOnEndTurn: TNotifyEvent; 30 FOnEndTurn: TNotifyEvent;
29 FOnEndCondition: TNotifyEvent; 31 FOnEndCondition: TNotifyEvent;
30 FOnEndCycle: TNotifyEvent; 32 FOnEndCycle: TNotifyEvent;
@@ -52,27 +54,33 @@ type @@ -52,27 +54,33 @@ type
52 function GetNextCondition:integer; 54 function GetNextCondition:integer;
53 function GetPlayer(I : integer): TPlayer; overload; 55 function GetPlayer(I : integer): TPlayer; overload;
54 function GetPlayer(AID : UTF8string): TPlayer; overload; 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 function GetPlayerIndexFromID(AID : UTF8string): integer; 59 function GetPlayerIndexFromID(AID : UTF8string): integer;
58 function GetPlayerIsPlaying(AID : UTF8string): Boolean; 60 function GetPlayerIsPlaying(AID : UTF8string): Boolean;
59 function GetPlayersCount: integer; 61 function GetPlayersCount: integer;
60 function GetInterlockingsIn(ALastCycles : integer):integer; 62 function GetInterlockingsIn(ALastCycles : integer):integer;
61 function GetConsequenceStringFromChoice(P:TPlayer): Utf8string; 63 function GetConsequenceStringFromChoice(P:TPlayer): Utf8string;
  64 + function GetConsequenceStringFromChoices:UTF8String;
62 procedure SetCondition(I : Integer; AValue: TCondition); 65 procedure SetCondition(I : Integer; AValue: TCondition);
63 procedure SetContingency(ACondition, I : integer; AValue: TContingency); 66 procedure SetContingency(ACondition, I : integer; AValue: TContingency);
64 procedure SetMatrixType(AValue: TGameMatrixType); 67 procedure SetMatrixType(AValue: TGameMatrixType);
  68 + procedure SetOnConsequence(AValue: TNotifyEvent);
65 procedure SetOnEndCondition(AValue: TNotifyEvent); 69 procedure SetOnEndCondition(AValue: TNotifyEvent);
66 procedure SetOnEndCycle(AValue: TNotifyEvent); 70 procedure SetOnEndCycle(AValue: TNotifyEvent);
67 procedure SetOnEndExperiment(AValue: TNotifyEvent); 71 procedure SetOnEndExperiment(AValue: TNotifyEvent);
68 procedure SetOnEndGeneration(AValue: TNotifyEvent); 72 procedure SetOnEndGeneration(AValue: TNotifyEvent);
69 procedure SetOnEndTurn(AValue: TNotifyEvent); 73 procedure SetOnEndTurn(AValue: TNotifyEvent);
  74 + procedure SetOnInterlocking(AValue: TNotifyEvent);
70 procedure SetPlayer(I : integer; AValue: TPlayer); overload; 75 procedure SetPlayer(I : integer; AValue: TPlayer); overload;
71 procedure SetPlayer(S : UTF8string ; AValue: TPlayer); overload; 76 procedure SetPlayer(S : UTF8string ; AValue: TPlayer); overload;
72 procedure SetResearcherCanChat(AValue: Boolean); 77 procedure SetResearcherCanChat(AValue: Boolean);
73 procedure SetResearcherCanPlay(AValue: Boolean); 78 procedure SetResearcherCanPlay(AValue: Boolean);
74 procedure SetSendChatHistoryForNewPlayers(AValue: Boolean); 79 procedure SetSendChatHistoryForNewPlayers(AValue: Boolean);
75 procedure SetState(AValue: TExperimentState); 80 procedure SetState(AValue: TExperimentState);
  81 + private
  82 + procedure Consequence(Sender : TObject);
  83 + procedure Interlocking(Sender : TObject);
76 public 84 public
77 constructor Create(AOwner:TComponent);override; 85 constructor Create(AOwner:TComponent);override;
78 constructor Create(AFilename: string; AOwner:TComponent); overload; 86 constructor Create(AFilename: string; AOwner:TComponent); overload;
@@ -106,9 +114,10 @@ type @@ -106,9 +114,10 @@ type
106 property PlayersCount : integer read GetPlayersCount; 114 property PlayersCount : integer read GetPlayersCount;
107 property PlayerIsPlaying[s : UTF8string] : Boolean read GetPlayerIsPlaying; 115 property PlayerIsPlaying[s : UTF8string] : Boolean read GetPlayerIsPlaying;
108 property PlayerIndexFromID[s : UTF8string]: integer read GetPlayerIndexFromID; 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 property ConsequenceStringFromChoice[P:Tplayer]:UTF8String read GetConsequenceStringFromChoice; 119 property ConsequenceStringFromChoice[P:Tplayer]:UTF8String read GetConsequenceStringFromChoice;
  120 + property ConsequenceStringFromChoices: UTF8String read GetConsequenceStringFromChoices;
112 property ShowChat : Boolean read FShowChat write FShowChat; 121 property ShowChat : Boolean read FShowChat write FShowChat;
113 property SendChatHistoryForNewPlayers : Boolean read FSendChatHistoryForNewPlayers write SetSendChatHistoryForNewPlayers; 122 property SendChatHistoryForNewPlayers : Boolean read FSendChatHistoryForNewPlayers write SetSendChatHistoryForNewPlayers;
114 property MatrixType : TGameMatrixType read FMatrixType write SetMatrixType; 123 property MatrixType : TGameMatrixType read FMatrixType write SetMatrixType;
@@ -123,6 +132,9 @@ type @@ -123,6 +132,9 @@ type
123 property OnEndGeneration : TNotifyEvent read FOnEndGeneration write SetOnEndGeneration; 132 property OnEndGeneration : TNotifyEvent read FOnEndGeneration write SetOnEndGeneration;
124 property OnEndCondition : TNotifyEvent read FOnEndCondition write SetOnEndCondition; 133 property OnEndCondition : TNotifyEvent read FOnEndCondition write SetOnEndCondition;
125 property OnEndExperiment : TNotifyEvent read FOnEndExperiment write SetOnEndExperiment; 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 end; 138 end;
127 139
128 resourcestring 140 resourcestring
@@ -130,7 +142,7 @@ resourcestring @@ -130,7 +142,7 @@ resourcestring
130 142
131 implementation 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 { TExperiment } 147 { TExperiment }
136 148
@@ -161,13 +173,11 @@ begin @@ -161,13 +173,11 @@ begin
161 else 173 else
162 Result := FConditions[CurrentCondition].Turn.Count; 174 Result := FConditions[CurrentCondition].Turn.Count;
163 if Assigned(FOnEndTurn) then FOnEndTurn(Self); 175 if Assigned(FOnEndTurn) then FOnEndTurn(Self);
164 -  
165 if FConditions[CurrentCondition].Turn.Count < FConditions[CurrentCondition].Turn.Value then 176 if FConditions[CurrentCondition].Turn.Count < FConditions[CurrentCondition].Turn.Value then
166 Inc(FConditions[CurrentCondition].Turn.Count) 177 Inc(FConditions[CurrentCondition].Turn.Count)
167 else 178 else
168 begin 179 begin
169 FConditions[CurrentCondition].Turn.Count := 0; 180 FConditions[CurrentCondition].Turn.Count := 0;
170 - if Assigned(FOnEndCycle) then FOnEndCycle(Self);  
171 NextCycle; 181 NextCycle;
172 end; 182 end;
173 {$IFDEF DEBUG} 183 {$IFDEF DEBUG}
@@ -184,16 +194,15 @@ end; @@ -184,16 +194,15 @@ end;
184 function TExperiment.GetNextCycle: integer; 194 function TExperiment.GetNextCycle: integer;
185 begin 195 begin
186 Result := FConditions[CurrentCondition].Cycles.Count; 196 Result := FConditions[CurrentCondition].Cycles.Count;
  197 + if Assigned(FOnEndCycle) then FOnEndCycle(Self);
187 if FConditions[CurrentCondition].Cycles.Count < FConditions[CurrentCondition].Cycles.Value then 198 if FConditions[CurrentCondition].Cycles.Count < FConditions[CurrentCondition].Cycles.Value then
188 Inc(FConditions[CurrentCondition].Cycles.Count) 199 Inc(FConditions[CurrentCondition].Cycles.Count)
189 else 200 else
190 begin 201 begin
191 FConditions[CurrentCondition].Cycles.Count := 0; 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 end; 206 end;
198 {$IFDEF DEBUG} 207 {$IFDEF DEBUG}
199 WriteLn('TExperiment.GetNextCycle:',Result); 208 WriteLn('TExperiment.GetNextCycle:',Result);
@@ -212,7 +221,6 @@ var @@ -212,7 +221,6 @@ var
212 end; 221 end;
213 222
214 begin 223 begin
215 - Inc(FConditions[CurrentCondition].Cycles.Generation);  
216 Result := CurrentCondition; 224 Result := CurrentCondition;
217 LAbsCycles := (FConditions[CurrentCondition].Cycles.Value * 225 LAbsCycles := (FConditions[CurrentCondition].Cycles.Value *
218 FConditions[CurrentCondition].Cycles.Generation) + FConditions[CurrentCondition].Cycles.Count; 226 FConditions[CurrentCondition].Cycles.Generation) + FConditions[CurrentCondition].Cycles.Count;
@@ -261,147 +269,14 @@ begin @@ -261,147 +269,14 @@ begin
261 end; 269 end;
262 270
263 // fewer as possible data 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 begin 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 end; 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 begin 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 end; 280 end;
406 281
407 function TExperiment.GetPlayerIndexFromID(AID: UTF8string): integer; 282 function TExperiment.GetPlayerIndexFromID(AID: UTF8string): integer;
@@ -449,7 +324,20 @@ begin @@ -449,7 +324,20 @@ begin
449 for i :=0 to ContingenciesCount[c] -1 do 324 for i :=0 to ContingenciesCount[c] -1 do
450 if not Contingency[c,i].Meta then 325 if not Contingency[c,i].Meta then
451 if Contingency[c,i].ResponseMeetsCriteriaI(P.Choice.Row,P.Choice.Color) then 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 end; 341 end;
454 342
455 procedure TExperiment.SetCondition(I : Integer; AValue: TCondition); 343 procedure TExperiment.SetCondition(I : Integer; AValue: TCondition);
@@ -460,6 +348,10 @@ end; @@ -460,6 +348,10 @@ end;
460 procedure TExperiment.SetContingency(ACondition, I : integer; AValue: TContingency); 348 procedure TExperiment.SetContingency(ACondition, I : integer; AValue: TContingency);
461 begin 349 begin
462 FConditions[ACondition].Contingencies[I] := AValue; 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 end; 355 end;
464 356
465 procedure TExperiment.SetMatrixType(AValue: TGameMatrixType); 357 procedure TExperiment.SetMatrixType(AValue: TGameMatrixType);
@@ -468,6 +360,12 @@ begin @@ -468,6 +360,12 @@ begin
468 FMatrixType:=AValue; 360 FMatrixType:=AValue;
469 end; 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 procedure TExperiment.SetOnEndCondition(AValue: TNotifyEvent); 369 procedure TExperiment.SetOnEndCondition(AValue: TNotifyEvent);
472 begin 370 begin
473 if FOnEndCondition=AValue then Exit; 371 if FOnEndCondition=AValue then Exit;
@@ -498,6 +396,12 @@ begin @@ -498,6 +396,12 @@ begin
498 FOnEndTurn:=AValue; 396 FOnEndTurn:=AValue;
499 end; 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 procedure TExperiment.SetPlayer(I : integer; AValue: TPlayer); 406 procedure TExperiment.SetPlayer(I : integer; AValue: TPlayer);
503 begin 407 begin
@@ -541,6 +445,16 @@ begin @@ -541,6 +445,16 @@ begin
541 FState:=AValue; 445 FState:=AValue;
542 end; 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 constructor TExperiment.Create(AOwner: TComponent); 458 constructor TExperiment.Create(AOwner: TComponent);
545 begin 459 begin
546 inherited Create(AOwner); 460 inherited Create(AOwner);
units/game_file_methods.pas
  Diff comments   View file @1722c6f
@@ -48,6 +48,17 @@ var @@ -48,6 +48,17 @@ var
48 Colors:[]; 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 begin 62 begin
52 Result := False; 63 Result := False;
53 with AExperiment do 64 with AExperiment do
@@ -61,26 +72,40 @@ begin @@ -61,26 +72,40 @@ begin
61 GenPlayersAsNeeded:=True; 72 GenPlayersAsNeeded:=True;
62 CurrentCondition := 0; 73 CurrentCondition := 0;
63 MatrixType:=[gmRows]; 74 MatrixType:=[gmRows];
  75 +
64 //AppendPlayer(C_PLAYER_TEMPLATE); 76 //AppendPlayer(C_PLAYER_TEMPLATE);
65 //AppendPlayer(C_PLAYER_TEMPLATE); 77 //AppendPlayer(C_PLAYER_TEMPLATE);
  78 +
66 C := C_CONDITION_TEMPLATE; 79 C := C_CONDITION_TEMPLATE;
67 with C do 80 with C do
68 begin 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 Turn.Count:=0; 83 Turn.Count:=0;
77 Turn.Value:=2; 84 Turn.Value:=2;
78 Turn.Random:=False; 85 Turn.Random:=False;
79 Cycles.Count:=0; 86 Cycles.Count:=0;
80 Cycles.Value:=4; 87 Cycles.Value:=4;
81 Cycles.Generation:=0; 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 end; 106 end;
83 - AppendCondition(C); 107 +
  108 + Condition[AppendCondition] := C;
84 end; 109 end;
85 end; 110 end;
86 111
@@ -96,59 +121,40 @@ var @@ -96,59 +121,40 @@ var
96 //end; 121 //end;
97 122
98 function GetEndCriteria(S:string) : TEndConditionCriterium; 123 function GetEndCriteria(S:string) : TEndConditionCriterium;
99 - var  
100 - LS : string;  
101 begin 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 0: Result.Value := gecAbsoluteCycles; 126 0: Result.Value := gecAbsoluteCycles;
106 1: Result.Value := gecInterlockingPorcentage; 127 1: Result.Value := gecInterlockingPorcentage;
107 2: Result.Value := gecWhichComeFirst; 128 2: Result.Value := gecWhichComeFirst;
108 end; 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 end; 133 end;
113 134
114 function GetPoints(S: string) : TPoints; 135 function GetPoints(S: string) : TPoints;
115 - var  
116 - LS : string;  
117 begin 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 end; 140 end;
124 141
125 142
126 function GetChoiceFromString(S:string) : TPlayerChoice; 143 function GetChoiceFromString(S:string) : TPlayerChoice;
127 - var  
128 - LS : string;  
129 begin 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 end; 147 end;
135 148
136 function GetPPointsFromString(S:string) : TPlayerPoints; 149 function GetPPointsFromString(S:string) : TPlayerPoints;
137 - var  
138 - LS : string;  
139 begin 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 end; 153 end;
145 154
146 function GetStatusFromString(S : string): TGamePlayerStatus; 155 function GetStatusFromString(S : string): TGamePlayerStatus;
147 - var  
148 - LS : string;  
149 begin 156 begin
150 - LS := S + VV_SEP;  
151 - case GetAndDelFirstValue(LS) of 157 + case ExtractDelimited(1,S,[',']) of
152 'esperando': Result := gpsWaiting; 158 'esperando': Result := gpsWaiting;
153 'jogou': Result := gpsPlayed; 159 'jogou': Result := gpsPlayed;
154 'jogando': Result := gpsPlaying; 160 'jogando': Result := gpsPlaying;
@@ -157,14 +163,12 @@ var @@ -157,14 +163,12 @@ var
157 163
158 function GetPromptStyle(S:string):TPromptStyle; 164 function GetPromptStyle(S:string):TPromptStyle;
159 var 165 var
160 - LS : string;  
161 i : integer; 166 i : integer;
162 begin 167 begin
163 // Yes,All,Metacontingency,RecoverLostPoints, 168 // Yes,All,Metacontingency,RecoverLostPoints,
164 Result := []; 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 end; 172 end;
169 173
170 procedure ReadExperiment; 174 procedure ReadExperiment;
@@ -242,7 +246,7 @@ var @@ -242,7 +246,7 @@ var
242 LCount := WordCount(LS,[#0,',']); 246 LCount := WordCount(LS,[#0,',']);
243 Result.Colors := []; 247 Result.Colors := [];
244 for i := 1 to LCount do 248 for i := 1 to LCount do
245 - Result.Colors += [GetColorFromString(ExtractDelimited(i,LS,[',']))]; 249 + Result.Colors += [GetGameColorFromString(ExtractDelimited(i,LS,[',']))];
246 end; 250 end;
247 251
248 procedure SetLCK(i:integer); 252 procedure SetLCK(i:integer);
@@ -307,9 +311,12 @@ var @@ -307,9 +311,12 @@ var
307 311
308 // if no contingencies, return false... 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 end; 321 end;
315 AExperiment.Condition[i]:= C; 322 AExperiment.Condition[i]:= C;
@@ -350,47 +357,6 @@ var @@ -350,47 +357,6 @@ var
350 LC, 357 LC,
351 LCK : string; 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 begin 360 begin
395 LWriter := TRegData.Create(nil,AFilename); 361 LWriter := TRegData.Create(nil,AFilename);
396 LIniFile:= TCIniFile.Create(LWriter.FileName); 362 LIniFile:= TCIniFile.Create(LWriter.FileName);
@@ -414,8 +380,8 @@ begin @@ -414,8 +380,8 @@ begin
414 WriteInteger(LC, KEY_CYCLES_VALUE,Cycles.Value); 380 WriteInteger(LC, KEY_CYCLES_VALUE,Cycles.Value);
415 WriteInteger(LC, KEY_CYCLES_GEN,Cycles.Generation); 381 WriteInteger(LC, KEY_CYCLES_GEN,Cycles.Generation);
416 //WriteBool(LC, KEY_PROMPT_VALUE,Prompt.Value); 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 for j := 0 to High(Contingencies) do 386 for j := 0 to High(Contingencies) do
421 begin 387 begin
@@ -426,7 +392,7 @@ begin @@ -426,7 +392,7 @@ begin
426 392
427 with Contingencies[j] do 393 with Contingencies[j] do
428 begin 394 begin
429 - WriteString(LC,LCK+KEY_CONSEQUE,Consequence.AsString); 395 + WriteString(LC,LCK+KEY_CONSEQUE,Consequence.AsString('')); // TODO review this
430 WriteString(LC,LCK+KEY_CRITERIA,CriteriaString); 396 WriteString(LC,LCK+KEY_CRITERIA,CriteriaString);
431 end; 397 end;
432 end; 398 end;
units/game_resources.pas
  Diff comments   View file @1722c6f
@@ -174,66 +174,19 @@ const @@ -174,66 +174,19 @@ const
174 // Meta : True; 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 //C_METACONTINGENCY_B2: TContingency = 178 //C_METACONTINGENCY_B2: TContingency =
226 // ( 179 // (
227 // Consequence : ( 180 // Consequence : (
228 // Style : [gscShowMessage,gscPoints,gscBroadcastMessage,gscPromptQuestion]; 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 // Cycles : 0; // absolute, 184 // Cycles : 0; // absolute,
232 // VariationMin: 0; // porcentage, 185 // VariationMin: 0; // porcentage,
233 // VariationMax : 0; // porcentage 186 // VariationMax : 0; // porcentage
234 // Prompt : ( 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,30 +203,34 @@ const
250 ( 203 (
251 ConditionName : ''; 204 ConditionName : '';
252 Contingencies : nil; 205 Contingencies : nil;
  206 + Interlocks : (
  207 + Count : 0;
  208 + History : nil;
  209 + );
253 210
254 Points : ( 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 Turn : ( 216 Turn : (
260 Count: 0; 217 Count: 0;
261 - Value : 3; 218 + Value : 0;
262 Random: False; 219 Random: False;
263 ); 220 );
264 221
265 Cycles : ( 222 Cycles : (
266 Count : 0; 223 Count : 0;
267 - Value : 3; 224 + Value : 0;
268 Generation : 0; 225 Generation : 0;
269 ); 226 );
270 227
271 Prompt : nil; 228 Prompt : nil;
272 EndCriterium : ( 229 EndCriterium : (
273 Value : gecWhichComeFirst; 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,19 +10,36 @@ uses
10 , game_resources 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 implementation 44 implementation
28 45
@@ -35,7 +52,7 @@ begin @@ -35,7 +52,7 @@ begin
35 if Length(S) > 0 then while S[1] = Sep do Delete(S, 1, 1); 52 if Length(S) > 0 then while S[1] = Sep do Delete(S, 1, 1);
36 end; 53 end;
37 54
38 -function GetRowString(ARow: TGameRow): string; 55 +function GetRowString(ARow: TGameRow): UTF8String;
39 begin 56 begin
40 case ARow of 57 case ARow of
41 grNone : Result := '0'; 58 grNone : Result := '0';
@@ -54,7 +71,7 @@ begin @@ -54,7 +71,7 @@ begin
54 end; 71 end;
55 end; 72 end;
56 73
57 -function GetRowFromString(S: string): TGameRow; 74 +function GetRowFromString(S: UTF8String): TGameRow;
58 begin 75 begin
59 case UpperCase(S) of 76 case UpperCase(S) of
60 'NA', '.' , '0', 'NONE' : Result := grNone; 77 'NA', '.' , '0', 'NONE' : Result := grNone;
@@ -73,7 +90,7 @@ begin @@ -73,7 +90,7 @@ begin
73 end; 90 end;
74 end; 91 end;
75 92
76 -function GetColorString(AColor: TGameColor): string; 93 +function GetColorString(AColor: TGameColor): UTF8String;
77 begin 94 begin
78 case AColor of 95 case AColor of
79 gcNone :Result := 'INDIFERENTE'; 96 gcNone :Result := 'INDIFERENTE';
@@ -87,7 +104,7 @@ begin @@ -87,7 +104,7 @@ begin
87 end; 104 end;
88 end; 105 end;
89 106
90 -function GetColorFromString(S: string): TGameColor; 107 +function GetGameColorFromString(S: UTF8String): TGameColor;
91 begin 108 begin
92 case UpperCase(S) of 109 case UpperCase(S) of
93 '.', 'INDIFERENTE', 'NONE' : Result := gcNone; 110 '.', 'INDIFERENTE', 'NONE' : Result := gcNone;
@@ -96,13 +113,13 @@ begin @@ -96,13 +113,13 @@ begin
96 'G', 'VERDE', 'GREEN' : Result := gcGreen; 113 'G', 'VERDE', 'GREEN' : Result := gcGreen;
97 'R', 'VERMELHO', 'RED' : Result := gcRed; 114 'R', 'VERMELHO', 'RED' : Result := gcRed;
98 'M', 'ROXO','MAGENTA', 'VIOLETA' : Result := gcMagenta; 115 'M', 'ROXO','MAGENTA', 'VIOLETA' : Result := gcMagenta;
99 - '!=','<>','DIFERENTES', 'DIFFERENT' : Result := gcDiff; 116 + '!','<>','DIFERENTES', 'DIFFERENT' : Result := gcDiff;
100 '=','IGUAIS', 'EQUAL' : Result := gcEqual; 117 '=','IGUAIS', 'EQUAL' : Result := gcEqual;
101 end; 118 end;
102 end; 119 end;
103 120
104 121
105 -function GetPromptStyleFromString(S: string): TPromptStyle; 122 +function GetPromptStyleFromString(S: UTF8String): TPromptStyle;
106 begin 123 begin
107 // todos,sim,metacontingência,recuperar pontos, 124 // todos,sim,metacontingência,recuperar pontos,
108 case UpperCase(S) of 125 case UpperCase(S) of
@@ -117,7 +134,7 @@ begin @@ -117,7 +134,7 @@ begin
117 end; 134 end;
118 end; 135 end;
119 136
120 -function GetPromptStyleString(AStyle: TPromptStyle): string; 137 +function GetPromptStyleString(AStyle: TPromptStyle): UTF8String;
121 var Style : TGamePromptStyle; 138 var Style : TGamePromptStyle;
122 begin 139 begin
123 Result:=''; 140 Result:='';
@@ -134,7 +151,7 @@ begin @@ -134,7 +151,7 @@ begin
134 end; 151 end;
135 end; 152 end;
136 153
137 -function GetConsequenceStyleFromString(s: string): TGameConsequenceStyle; 154 +function GetConsequenceStyleFromString(s: UTF8String): TGameConsequenceStyle;
138 begin 155 begin
139 case UpperCase(S) of 156 case UpperCase(S) of
140 'NADA': Result:= gscNone; 157 'NADA': Result:= gscNone;
@@ -145,7 +162,7 @@ begin @@ -145,7 +162,7 @@ begin
145 end; 162 end;
146 end; 163 end;
147 164
148 -function GetConsequenceStyleString(AStyle: TGameConsequenceStyle): string; 165 +function GetConsequenceStyleString(AStyle: TGameConsequenceStyle): UTF8String;
149 begin 166 begin
150 case AStyle of 167 case AStyle of
151 gscNone : Result:= 'NADA'; 168 gscNone : Result:= 'NADA';
@@ -156,61 +173,62 @@ begin @@ -156,61 +173,62 @@ begin
156 end; 173 end;
157 end; 174 end;
158 175
159 -function GetResponseString(ACriteria : TCriteria) : string; 176 +function GetCriteriaString(ACriteria: TCriteria): UTF8String;
160 var R : TGameRow; 177 var R : TGameRow;
161 C : TGameColor; 178 C : TGameColor;
162 begin 179 begin
163 - Result := '[';  
164 for R in ACriteria.Rows do 180 for R in ACriteria.Rows do
165 Result += GetRowString(R) + VV_SEP; 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 for C in ACriteria.Colors do 186 for C in ACriteria.Colors do
178 Result += GetColorString(C) + VV_SEP; 187 Result += GetColorString(C) + VV_SEP;
179 - Result += ']'; 188 + Result += '|';
180 end; 189 end;
181 190
182 -function GetResponseFromString(S: string) : TCriteria; 191 +function GetCriteriaFromString(S: UTF8String): TCriteria;
183 var 192 var
184 - R : TGameRow;  
185 - C : TGameColor;  
186 - LS : string;  
187 s1 : string; 193 s1 : string;
188 i : integer; 194 i : integer;
189 begin 195 begin
190 - LS := S + VV_SEP;  
191 - s1 := ExtractDelimited(2,LS,['[',']']); 196 + s1 := ExtractDelimited(1,S,['|']);
192 Result.Rows := []; 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 else Break; 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 '','INDIFERENTE', 'NONE' : Result.Style := gtNone; 206 '','INDIFERENTE', 'NONE' : Result.Style := gtNone;
201 'E', 'AND' : Result.Style := gtRowsAndColors; 207 'E', 'AND' : Result.Style := gtRowsAndColors;
202 'OU', 'OR' : Result.Style := gtRowsOrColors; 208 'OU', 'OR' : Result.Style := gtRowsOrColors;
  209 +
203 end; 210 end;
204 211
205 - s1 := ExtractDelimited(6,LS,['[',']']); 212 + s1 := ExtractDelimited(3,S,['|']);
206 Result.Colors := []; 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 else Break; 217 else Break;
211 end; 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 begin 232 begin
215 case C of 233 case C of
216 ccYellow: Result := 'Y'; 234 ccYellow: Result := 'Y';
@@ -221,7 +239,7 @@ begin @@ -221,7 +239,7 @@ begin
221 end; 239 end;
222 end; 240 end;
223 241
224 -function GetRowColorFromString(S:string): TColor; 242 +function GetColorFromString(S: UTF8String): TColor;
225 begin 243 begin
226 case S of 244 case S of
227 'Y' : Result := ccYellow; 245 'Y' : Result := ccYellow;
@@ -232,18 +250,230 @@ begin @@ -232,18 +250,230 @@ begin
232 end; 250 end;
233 end; 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 end. 478 end.
249 479