Download as
Browse Code »

Commit 1a5f54795341f61e1ab96a4a6fe377f6c73a5b0d

Authored by Carlos Picanco
1 parent 653a4067
Exists in master

implement operant and metacontingency schedules

Showing 9 changed files with 808 additions and 277 deletions   Show diff stats
form_matrixgame.lfm
  Diff comments   View file @1a5f547
1 object FormMatrixGame: TFormMatrixGame 1 object FormMatrixGame: TFormMatrixGame
2 - Left = -621 2 + Left = 0
3 Height = 565 3 Height = 565
4 Top = 124 4 Top = 124
5 - Width = 1393  
6 - HorzScrollBar.Page = 1393 5 + Width = 1278
  6 + HorzScrollBar.Page = 1278
7 VertScrollBar.Page = 542 7 VertScrollBar.Page = 542
8 AutoScroll = True 8 AutoScroll = True
9 Caption = 'FormMatrixGame' 9 Caption = 'FormMatrixGame'
10 ClientHeight = 555 10 ClientHeight = 555
11 - ClientWidth = 1393 11 + ClientWidth = 1278
12 Font.Name = 'Monospace' 12 Font.Name = 'Monospace'
13 OnActivate = FormActivate 13 OnActivate = FormActivate
14 LCLVersion = '1.6.2.0' 14 LCLVersion = '1.6.2.0'
@@ -457,6 +457,7 @@ object FormMatrixGame: TFormMatrixGame @@ -457,6 +457,7 @@ object FormMatrixGame: TFormMatrixGame
457 07544269746D617000000000 457 07544269746D617000000000
458 } 458 }
459 Text = 'Text' 459 Text = 'Text'
  460 + Title = 'Caption'
460 Visible = False 461 Visible = False
461 OnClose = PopupNotifierClose 462 OnClose = PopupNotifierClose
462 left = 112 463 left = 112
form_matrixgame.pas
  Diff comments   View file @1a5f547
@@ -220,7 +220,6 @@ end; @@ -220,7 +220,6 @@ end;
220 procedure TFormMatrixGame.TimerTimer(Sender: TObject); 220 procedure TFormMatrixGame.TimerTimer(Sender: TObject);
221 begin 221 begin
222 PopupNotifier.Visible:=False; 222 PopupNotifier.Visible:=False;
223 - Timer.Enabled := False;  
224 end; 223 end;
225 224
226 procedure TFormMatrixGame.SetGameActor(AValue: TGameActor); 225 procedure TFormMatrixGame.SetGameActor(AValue: TGameActor);
@@ -281,7 +280,7 @@ end; @@ -281,7 +280,7 @@ end;
281 procedure TFormMatrixGame.PopupNotifierClose(Sender: TObject; 280 procedure TFormMatrixGame.PopupNotifierClose(Sender: TObject;
282 var CloseAction: TCloseAction); 281 var CloseAction: TCloseAction);
283 begin 282 begin
284 - // do nothing for now 283 + Timer.Enabled := False;
285 end; 284 end;
286 285
287 procedure TFormMatrixGame.StringGridMatrixClick(Sender: TObject); 286 procedure TFormMatrixGame.StringGridMatrixClick(Sender: TObject);
@@ -309,7 +308,7 @@ end; @@ -309,7 +308,7 @@ end;
309 308
310 procedure TFormMatrixGame.btnConfirmRowClick(Sender: TObject); 309 procedure TFormMatrixGame.btnConfirmRowClick(Sender: TObject);
311 begin 310 begin
312 - FGameControl.SendMessage(K_CHOICE); 311 + FGameControl.SendRequest(K_CHOICE);
313 end; 312 end;
314 313
315 procedure TFormMatrixGame.Button3Click(Sender: TObject); 314 procedure TFormMatrixGame.Button3Click(Sender: TObject);
units/game_actors.pas
  Diff comments   View file @1a5f547
@@ -5,7 +5,7 @@ unit game_actors; @@ -5,7 +5,7 @@ unit game_actors;
5 interface 5 interface
6 6
7 uses 7 uses
8 - Classes, SysUtils, PopupNotifier 8 + Classes, SysUtils, Forms,PopupNotifier
9 , game_actors_point 9 , game_actors_point
10 ; 10 ;
11 type 11 type
@@ -19,7 +19,7 @@ type @@ -19,7 +19,7 @@ type
19 TGameRow = (grNone, 19 TGameRow = (grNone,
20 grOne,grTwo,grThree,grFour,grFive,grSix,grSeven,grEight,grNine,grTen, // 10 rows 20 grOne,grTwo,grThree,grFour,grFive,grSix,grSeven,grEight,grNine,grTen, // 10 rows
21 grEven,grOdd, 21 grEven,grOdd,
22 - grDiff,grAll,grNot,grSome); //meta only 22 + grDiff,grEqual,grAll,grNot,grSome); //meta only
23 23
24 TGameRows = set of TGameRow; 24 TGameRows = set of TGameRow;
25 25
@@ -30,10 +30,10 @@ type @@ -30,10 +30,10 @@ type
30 TGameColors = set of TGameColor; 30 TGameColors = set of TGameColor;
31 31
32 TGameEndCondition = (gecInterlockingPorcentage,gecAbsoluteCycles,gecWhichComeFirst); 32 TGameEndCondition = (gecInterlockingPorcentage,gecAbsoluteCycles,gecWhichComeFirst);
33 - TGameOperator = (goNONE, goAND, goOR); 33 + //TGameOperator = (goNONE, goAND, goOR);
34 TGameStyle = (gtNone, gtRowsOnly, gtColorsOnly, gtRowsAndColors, gtRowsOrColors); 34 TGameStyle = (gtNone, gtRowsOnly, gtColorsOnly, gtRowsAndColors, gtRowsOrColors);
35 35
36 - TGameConsequenceStyle = (gscNone, gscMessage, gscBroadcastMessage, gscPoints, gscVariablePoints); 36 + TGameConsequenceStyle = (gscNone, gscMessage, gscBroadcastMessage, gscPoints, gscVariablePoints, gscA, gscB,gscG);
37 TConsequenceStyle = set of TGameConsequenceStyle; 37 TConsequenceStyle = set of TGameConsequenceStyle;
38 38
39 TGamePromptStyle = (gsYes, gsNo, gsAll, gsMetacontingency, gsContingency, gsBasA, gsRevertPoints); 39 TGamePromptStyle = (gsYes, gsNo, gsAll, gsMetacontingency, gsContingency, gsBasA, gsRevertPoints);
@@ -43,6 +43,29 @@ type @@ -43,6 +43,29 @@ type
43 43
44 type 44 type
45 45
  46 + TPLayerPoints = record
  47 + A, B : integer
  48 + end;
  49 +
  50 + TPlayerChoice = record
  51 + Row : TGameRow;
  52 + Color : TGameColor;
  53 + end;
  54 +
  55 + TPlayer = record
  56 + ID,
  57 + Nicname,
  58 + Login,
  59 + Password : UTF8string;
  60 + Status : TGamePlayerStatus;
  61 + Data : TStringList;
  62 + Choice : TPlayerChoice;
  63 + Points : TPLayerPoints;
  64 + Turn : ShortInt;
  65 + end;
  66 +
  67 + TPlayers = array of TPlayer;
  68 +
46 { TCriteria } 69 { TCriteria }
47 70
48 TCriteria = record 71 TCriteria = record
@@ -54,28 +77,49 @@ type @@ -54,28 +77,49 @@ type
54 { TConsequence } 77 { TConsequence }
55 78
56 TConsequence = class(TComponent) 79 TConsequence = class(TComponent)
  80 + private
  81 + FAppendicePlural: UTF8String;
  82 + FAppendiceSingular: UTF8String;
  83 + FNicname: UTF8String;
  84 + protected
  85 + FStyle : TConsequenceStyle;
  86 + FP : TGamePoint;
  87 + FMessage : TPopupNotifier;
  88 + procedure StopTimer(Sender:TObject;var ACloseAction:TCloseAction);
  89 + procedure TimerTimer(Sender:TOBject);virtual;
57 public 90 public
58 - Style : TConsequenceStyle;  
59 - Message : TPopupNotifier;  
60 - Points : record  
61 - A, B, G : TGamePoint;  
62 - end;  
63 - procedure Present; virtual; 91 + 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;
  93 + constructor Create(AOwner:TComponent; AConsequenceString: UTF8String);overload;
  94 + destructor Destroy;override;
  95 + function AsString: utf8string;
  96 + procedure Present(Sender:TObject;ForGroup:Boolean);virtual;
  97 + property PlayerNicname : UTF8String read FNicname write FNicname;
  98 + property AppendiceSingular : UTF8String read FAppendiceSingular;
  99 + property AppendicePlural : UTF8String read FAppendicePlural;
64 end; 100 end;
65 101
66 { TContingency } 102 { TContingency }
67 103
68 TContingency = class(TComponent) 104 TContingency = class(TComponent)
69 private 105 private
70 - FFired: Boolean; 106 + FFired,
  107 + FMeta : Boolean; //True: Consequence occurs OnEndTurn, False: Consequence occurs OnEndCycle
  108 + FConsequence : TConsequence;
  109 + FCriteria : TCriteria;
71 FOnCriteria: TNotifyEvent; 110 FOnCriteria: TNotifyEvent;
  111 + function RowMod(R:TGameRow):TGameRow;
72 procedure CriteriaEvent; 112 procedure CriteriaEvent;
73 public 113 public
74 - Meta : Boolean; //True: Consequence occurs OnEndTurn, False: Consequence occurs OnEndCycle  
75 - Consequence : TConsequence;  
76 - Criteria : TCriteria; 114 + constructor Create(AOwner:TComponent;AConsequence:TConsequence;ACriteria:TCriteria;IsMeta:Boolean);overload;
  115 + function CriteriaString : UTF8String;
  116 + function ResponseMeetsCriteriaI(R : TGameRow; C : TGameColor):Boolean; // Does response meets operant criteria?
  117 + function ResponseMeetsCriteriaG(Players : TPlayers):Boolean;
77 property OnCriteria : TNotifyEvent read FOnCriteria write FOncriteria; 118 property OnCriteria : TNotifyEvent read FOnCriteria write FOncriteria;
78 property Fired : Boolean read FFired; 119 property Fired : Boolean read FFired;
  120 + property Consequence : TConsequence read FConsequence;
  121 + property Criteria : TCriteria read FCriteria;
  122 + property Meta : Boolean read FMeta;
79 end; 123 end;
80 124
81 { TContingencies } 125 { TContingencies }
@@ -85,11 +129,14 @@ type @@ -85,11 +129,14 @@ type
85 { TPrompt } 129 { TPrompt }
86 130
87 TPrompt = class(TConsequence) 131 TPrompt = class(TConsequence)
  132 + private
  133 + FPromptTargets : TContingencies; // need to test this
88 public 134 public
89 PromptStyle : TPromptStyle; 135 PromptStyle : TPromptStyle;
90 - PromptTargets : ^TContingencies;  
91 PromptMessage : string; 136 PromptMessage : string;
92 - procedure Present; override; 137 + public
  138 + procedure Present(Sender:TObject;ForGroup:Boolean);override;
  139 + property APromptTargets: TContingencies read FPromptTargets;
93 end; 140 end;
94 141
95 TEndConditionCriterium = record 142 TEndConditionCriterium = record
@@ -127,45 +174,211 @@ type @@ -127,45 +174,211 @@ type
127 EndCriterium : TEndConditionCriterium; // to change from one condition to another 174 EndCriterium : TEndConditionCriterium; // to change from one condition to another
128 end; 175 end;
129 176
130 - TPLayerPoints = record  
131 - A, B : integer 177 +implementation
  178 +
  179 +uses ButtonPanel,Controls,ExtCtrls,strutils, string_methods,
  180 + form_matrixgame{,StdCtrls};
  181 +
  182 +{ TContingency }
  183 +
  184 +function TContingency.RowMod(R: TGameRow): TGameRow;
  185 +var
  186 + LEvenSet : TGameRows;
  187 + LOddSet : TGameRows;
  188 +begin
  189 + Result := grNone;
  190 + LEvenSet := [grTwo, grFour, grSix, grEight, grTen];
  191 + LOddSet := [grOne, grThree, grFive, grSeven, grNine];
  192 + if R in LEvenSet then
  193 + Result := grEven;
  194 +
  195 + if R in LOddSet then
  196 + Result := grOdd;
  197 +end;
  198 +
  199 +procedure TContingency.CriteriaEvent;
  200 +begin
  201 + // FConsequence.Present(FMeta);
  202 + // do admin internals
  203 +end;
  204 +
  205 +constructor TContingency.Create(AOwner:TComponent;AConsequence:TConsequence;ACriteria:TCriteria;IsMeta:Boolean);
  206 +begin
  207 + inherited Create(AOwner);
  208 + FConsequence := AConsequence;
  209 + FCriteria := ACriteria;
  210 + FMeta := IsMeta;
  211 + FFired := False;
  212 +end;
  213 +
  214 +function TContingency.CriteriaString: UTF8String;
  215 +var R : TGameRow;
  216 + C : TGameColor;
  217 +begin
  218 + Result := '';
  219 + for R in FCriteria.Rows do
  220 + Result += GetRowString(R) + ',';
  221 + Result += '|';
  222 +
  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';
132 end; 229 end;
  230 + Result += ',';
  231 + Result += '|';
133 232
134 - TPlayerChoice = record  
135 - Row : TGameRow;  
136 - Color : TGameColor; 233 + for C in FCriteria.Colors do
  234 + Result += GetColorString(C) + ',';
  235 +
  236 + Result += '|';
  237 +end;
  238 +
  239 +function TContingency.ResponseMeetsCriteriaI(R : TGameRow; C : TGameColor): Boolean;
  240 +var
  241 + LMod : TGameRow;
  242 + LRow, LColor:Boolean;
  243 +begin
  244 + Result := False;
  245 +
  246 + LMod := RowMod(R);
  247 + LColor := C in Criteria.Colors;
  248 + LRow := (R in Criteria.Rows) or (LMod in Criteria.Rows);
  249 +
  250 + case Criteria.Style of
  251 + gtNone: Exit;
  252 + gtColorsOnly: Result := LColor;
  253 + gtRowsOnly: Result := LRow;
  254 + gtRowsAndColors: Result := LColor and LRow;
  255 + gtRowsOrColors: Result := LRow or LColor;
137 end; 256 end;
  257 + if Result then
  258 + if Assigned(FOnCriteria) then FOnCriteria(Self);
  259 +end;
138 260
139 - PPlayer = ^TPlayer; 261 +function TContingency.ResponseMeetsCriteriaG(Players: TPlayers): Boolean;
  262 +var i : integer;
  263 + Cs : array of TGameColor;
  264 + Rs : array of TGameRow;
  265 + //C : TGameColor;
  266 + R : TGameRow;
  267 + Len : Byte;
  268 +
  269 + function AllColorsEqual:Boolean;
  270 + var i : integer;
  271 + begin
  272 + Result := True;
  273 + for i := 0 to Len-2 do
  274 + if Cs[i] <> Cs[i+1] then
  275 + begin
  276 + Result := False;
  277 + Break;
  278 + end;
  279 + end;
140 280
141 - TPlayer = record  
142 - ID,  
143 - Nicname,  
144 - Login,  
145 - Password : UTF8string;  
146 - Status : TGamePlayerStatus;  
147 - Data : TStringList;  
148 - Choice : record  
149 - Current, Last : TPlayerChoice; 281 + function AllColorsDiff:Boolean;
  282 + var i : integer;
  283 + begin
  284 + Result := True;
  285 + for i := 0 to Len-2 do
  286 + if Cs[i] = Cs[i+1] then
  287 + begin
  288 + Result := False;
  289 + Break;
  290 + end;
150 end; 291 end;
151 - Points : TPLayerPoints;  
152 - Turn : ShortInt;  
153 - end;  
154 292
155 -implementation 293 + function AllRowsOdd: Boolean;
  294 + begin
  295 + for R in Rs do
  296 + if RowMod(R) = grEven then
  297 + begin
  298 + Result := False;
  299 + Exit;
  300 + end;
  301 + end;
156 302
157 -uses Forms,ButtonPanel,Controls,StdCtrls,ExtCtrls; 303 + function AllRowsEven: Boolean;
  304 + begin
  305 + for R in Rs do
  306 + if RowMod(R) = grOdd then
  307 + begin
  308 + Result := False;
  309 + Exit;
  310 + end;
  311 + end;
158 312
159 -{ TContingency } 313 +begin // grDiff,grEqual,grAll
  314 + Result := False;
  315 + Len := Length(Players);
  316 + SetLength(Cs,Len);
  317 + SetLength(Rs,Len);
160 318
161 -procedure TContingency.CriteriaEvent;  
162 -begin 319 + for i :=0 to Length(Players)-1 do
  320 + Cs[i] := Players[i].Choice.Color;
  321 +
  322 + for i :=0 to Length(Players)-1 do
  323 + Rs[i] := Players[i].Choice.Row;
  324 +
  325 + case Criteria.Style of
  326 + gtNone: Exit;
  327 + gtColorsOnly:
  328 + begin
  329 + if gcDiff in Criteria.Colors then
  330 + Result := AllColorsDiff;
  331 +
  332 + if gcEqual in Criteria.Colors then
  333 + Result := AllColorsEqual;
  334 + end;
  335 +
  336 + gtRowsOnly:
  337 + begin
  338 + if grOdd in Criteria.Rows then
  339 + Result := AllRowsOdd;
  340 +
  341 + if grEven in Criteria.Rows then
  342 + Result := AllRowsEven;
  343 + end;
163 344
  345 + gtRowsAndColors:
  346 + begin
  347 + if (gcDiff in Criteria.Colors) and (grOdd in Criteria.Rows) then
  348 + Result := AllColorsDiff and AllRowsOdd;
  349 +
  350 + if (gcDiff in Criteria.Colors) and (grEven in Criteria.Rows) then
  351 + Result := AllColorsDiff and AllRowsEven;
  352 +
  353 + if (gcEqual in Criteria.Colors) and (grOdd in Criteria.Rows) then
  354 + Result := AllColorsEqual and AllRowsOdd;
  355 +
  356 + if (gcEqual in Criteria.Colors) and (grEven in Criteria.Rows) then
  357 + Result := AllColorsEqual and AllRowsEven;
  358 + end;
  359 + gtRowsOrColors:
  360 + begin
  361 + if (gcDiff in Criteria.Colors) and (grOdd in Criteria.Rows) then
  362 + Result := AllColorsDiff or AllRowsOdd;
  363 +
  364 + if (gcDiff in Criteria.Colors) and (grEven in Criteria.Rows) then
  365 + Result := AllColorsDiff or AllRowsEven;
  366 +
  367 + if (gcEqual in Criteria.Colors) and (grOdd in Criteria.Rows) then
  368 + Result := AllColorsEqual or AllRowsOdd;
  369 +
  370 + if (gcEqual in Criteria.Colors) and (grEven in Criteria.Rows) then
  371 + Result := AllColorsEqual or AllRowsEven;
  372 + end;
  373 + end;
  374 + if Result then
  375 + if Assigned(FOnCriteria) then FOnCriteria(Self);
164 end; 376 end;
165 377
  378 +
166 { TPrompt } 379 { TPrompt }
167 380
168 -procedure TPrompt.Present; 381 +procedure TPrompt.Present(Sender: TObject; ForGroup: Boolean);
169 382
170 function AskQuestion: boolean; 383 function AskQuestion: boolean;
171 var 384 var
@@ -202,16 +415,139 @@ procedure TPrompt.Present; @@ -202,16 +415,139 @@ procedure TPrompt.Present;
202 end; 415 end;
203 end; 416 end;
204 begin 417 begin
205 - inherited Present; 418 + inherited Present(Sender, ForGroup);
206 //SendMessage(AskQuestion); 419 //SendMessage(AskQuestion);
207 end; 420 end;
208 421
209 { TConsequence } 422 { TConsequence }
210 423
211 -procedure TConsequence.Present; 424 +constructor TConsequence.Create(AOwner: TComponent; AP: TGamePoint;
  425 + AStyle: TConsequenceStyle; AAppendiceSingular, AAppendicePlural: UTF8String);
212 begin 426 begin
213 - AbstractError; 427 + inherited Create(AOwner);
  428 + FStyle:=AStyle;
  429 + FNicname:='';
  430 + FAppendiceSingular:=AAppendiceSingular;
  431 + FAppendicePlural:=AAppendicePlural;
  432 + FP := AP;
  433 + FMessage := TPopupNotifier.Create(AOwner);
214 end; 434 end;
215 435
  436 +constructor TConsequence.Create(AOwner: TComponent; AP: integer;
  437 + AStyle:TConsequenceStyle; AMessage: array of UTF8string);
  438 +begin
  439 + inherited Create(AOwner);
  440 + FStyle:=AStyle;
  441 + FNicname:=AMessage[0];
  442 + FAppendiceSingular:=AMessage[1];
  443 + FAppendicePlural:=AMessage[2];
  444 + FP := TGamePoint.Create(AOwner,AP);
  445 + FMessage := TPopupNotifier.Create(AOwner);
  446 +end;
  447 +
  448 +constructor TConsequence.Create(AOwner: TComponent;
  449 + 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
  471 + inherited Create(AOwner);
  472 + FP := TGamePoint.Create(AOwner,ExtractDelimited(1,AConsequenceString,['|']));
  473 + FStyle:=GetConsequenceStyleFromString(ExtractDelimited(2,AConsequenceString,['|']));
  474 + FNicname:=ExtractDelimited(3,AConsequenceString,['|']);
  475 + FAppendiceSingular:=ExtractDelimited(4,AConsequenceString,['|']);
  476 + FAppendicePlural:=ExtractDelimited(5,AConsequenceString,['|']);
  477 + FMessage := TPopupNotifier.Create(AOwner);
  478 +end;
  479 +
  480 +destructor TConsequence.Destroy;
  481 +begin
  482 + inherited Destroy;
  483 +end;
  484 +
  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 +
  505 +begin
  506 + Result := IntToStr(FP.Value)+','+IntToStr(FP.Variation) + '|';
  507 + Result += GetConsequenceStyleString(FStyle)+'|';
  508 + Result += FNicname +'|';
  509 + Result += FAppendiceSingular + '|';
  510 + Result += FAppendicePlural + '|';
  511 +end;
  512 +
  513 +
  514 +procedure TConsequence.Present(Sender: TObject; ForGroup: Boolean);
  515 +var
  516 + PopUpPos : TPoint;
  517 +begin
  518 + PopUpPos.X := FormMatrixGame.StringGridMatrix.Left+FormMatrixGame.StringGridMatrix.Width;
  519 + PopUpPos.Y := FormMatrixGame.StringGridMatrix.Top;
  520 + PopUpPos := FormMatrixGame.StringGridMatrix.ClientToScreen(PopUpPos);
  521 +
  522 + FMessage.Text := FP.PointMessage(FNicname,FAppendicePlural, FAppendiceSingular,ForGroup);
  523 + FMessage.OnClose:=@StopTimer;
  524 + FormMatrixGame.Timer.OnTimer := @TimerTimer;
  525 +
  526 + if gscA in FStyle then
  527 + FormMatrixGame.LabelIndACount.Caption := IntToStr(StrToInt(FormMatrixGame.LabelIndACount.Caption) + FP.ResultAsInteger);
  528 +
  529 + if gscB in FStyle then
  530 + FormMatrixGame.LabelIndBCount.Caption := IntToStr(StrToInt(FormMatrixGame.LabelIndBCount.Caption) + FP.ResultAsInteger);
  531 +
  532 + if gscG in FStyle then
  533 + FormMatrixGame.LabelGroupCount.Caption:= IntToStr(StrToInt(FormMatrixGame.LabelGroupCount.Caption) + FP.ResultAsInteger);
  534 +
  535 + FMessage.ShowAtPos(PopUpPos.X, PopUpPos.Y);
  536 + FormMatrixGame.Timer.Enabled:=True;
  537 +end;
  538 +
  539 +procedure TConsequence.StopTimer(Sender: TObject; var ACloseAction: TCloseAction
  540 + );
  541 +begin
  542 + FormMatrixGame.Timer.Enabled:=False;
  543 + Free;
  544 +end;
  545 +
  546 +procedure TConsequence.TimerTimer(Sender: TOBject);
  547 +begin
  548 + FMessage.Visible:=False;
  549 +end;
  550 +
  551 +
216 end. 552 end.
217 553
units/game_actors_point.pas
  Diff comments   View file @1a5f547
@@ -13,16 +13,23 @@ type @@ -13,16 +13,23 @@ type
13 13
14 TGamePoint = class(TComponent) 14 TGamePoint = class(TComponent)
15 private 15 private
  16 + FResult: integer;
16 FValue, 17 FValue,
17 FVariation : integer; 18 FVariation : integer;
  19 + function GetResult: integer;
  20 + function GetResultAsString: string;
18 function GetValue: integer; 21 function GetValue: integer;
19 procedure SetValue(AValue: integer); 22 procedure SetValue(AValue: integer);
20 public 23 public
21 - //Cycles : integer;  
22 - constructor Create(AValue : integer);overload;  
23 - constructor Create(AValue : array of integer); overload; 24 + //Cycles : integer; // specify when present points regarding condition cycles
  25 + constructor Create(AOwner:TComponent;AValue : integer);overload;
  26 + constructor Create(AOwner:TComponent;AValue : array of integer); overload;
  27 + constructor Create(AOwner:TComponent;AValue : utf8string); overload;
  28 + function PointMessage(APrepend, AAppendicePlural, AAppendiceSingular: string; IsGroupPoint: Boolean) : string;
24 property Value : integer read GetValue write SetValue; 29 property Value : integer read GetValue write SetValue;
25 property Variation : integer read FVariation write FVariation; 30 property Variation : integer read FVariation write FVariation;
  31 + property AsString : string read GetResultAsString;
  32 + property ResultAsInteger : integer read GetResult;
26 end; 33 end;
27 34
28 //operator :=(I :integer) : TGamePoint; 35 //operator :=(I :integer) : TGamePoint;
@@ -30,9 +37,11 @@ type @@ -30,9 +37,11 @@ type
30 // 37 //
31 implementation 38 implementation
32 39
  40 +uses strutils;
33 //operator:=(I: integer):TGamePoint; 41 //operator:=(I: integer):TGamePoint;
34 //begin 42 //begin
35 -// Result := TGamePoint.Create(I); 43 +// Result := ;
  44 +// Result.Value := I;
36 //end; 45 //end;
37 // 46 //
38 //operator:=(A: array of integer): TGamePoint; 47 //operator:=(A: array of integer): TGamePoint;
@@ -45,6 +54,17 @@ implementation @@ -45,6 +54,17 @@ implementation
45 function TGamePoint.GetValue: integer; 54 function TGamePoint.GetValue: integer;
46 begin 55 begin
47 Result := FValue - FVariation + Random((2 * FVariation) + 1); 56 Result := FValue - FVariation + Random((2 * FVariation) + 1);
  57 + FResult := Result;
  58 +end;
  59 +
  60 +function TGamePoint.GetResult: integer;
  61 +begin
  62 + Result := FResult;
  63 +end;
  64 +
  65 +function TGamePoint.GetResultAsString: string;
  66 +begin
  67 + Result := IntToStr(FResult);
48 end; 68 end;
49 69
50 procedure TGamePoint.SetValue(AValue: integer); 70 procedure TGamePoint.SetValue(AValue: integer);
@@ -52,17 +72,88 @@ begin @@ -52,17 +72,88 @@ begin
52 FValue := AValue; 72 FValue := AValue;
53 end; 73 end;
54 74
55 -constructor TGamePoint.Create(AValue: integer); 75 +constructor TGamePoint.Create(AOwner: TComponent; AValue: integer);
56 begin 76 begin
  77 + inherited Create(AOwner);
57 FValue := AValue; 78 FValue := AValue;
  79 + FVariation:=0;
58 end; 80 end;
59 81
60 -constructor TGamePoint.Create(AValue : array of integer); 82 +constructor TGamePoint.Create(AOwner: TComponent; AValue: array of integer);
61 begin 83 begin
  84 + inherited Create(AOwner);
62 FValue := AValue[0]; 85 FValue := AValue[0];
63 FVariation := AValue[1]; 86 FVariation := AValue[1];
64 - //Cycles := AValue[2];  
65 end; 87 end;
66 88
  89 +constructor TGamePoint.Create(AOwner: TComponent; AValue: utf8string);
  90 +begin
  91 + FValue := StrToInt(ExtractDelimited(1,AValue,[',']));
  92 + FVariation := StrToInt(ExtractDelimited(2,AValue,[',']));
  93 +end;
  94 +
  95 +function TGamePoint.PointMessage(APrepend, AAppendicePlural, AAppendiceSingular: string; IsGroupPoint: Boolean): string;
  96 +begin
  97 + Self.Value;
  98 + if IsGroupPoint then
  99 + begin
  100 + if APrepend = '' then
  101 + Result := 'Vocês'
  102 + else
  103 + Result := APrepend;
  104 +
  105 + if (AAppendiceSingular = '') or (AAppendicePlural = '') then
  106 + begin
  107 + case FValue of
  108 + -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';
  110 + 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'
  113 + end;
  114 + end
  115 + else
  116 + begin
  117 + case FValue of
  118 + -MaxInt..-2: Result += ' produziram a perda de '+Self.AsString+ ' ' + AAppendicePlural;
  119 + -1 : Result += ' produziram a perda de 1'+ ' ' + AAppendiceSingular;
  120 + 0 : Result += ' não produziram ' + AAppendicePlural;
  121 + 1 : Result += ' produziram 1 ponto ' + AAppendiceSingular;
  122 + 2..MaxInt: Result += 'produziu '+Self.AsString+ ' ' + AAppendicePlural;
  123 + end;
  124 + end;
  125 + end
  126 + else
  127 + begin
  128 + if APrepend = '' then
  129 + Result := 'Alguém'
  130 + else
  131 + Result := APrepend;
  132 +
  133 + if (AAppendiceSingular = '') or (AAppendicePlural = '') then
  134 + begin
  135 + case FValue of
  136 + -MaxInt..-2: Result += ' perdeu '+Self.AsString+ ' pontos';
  137 + -1 : Result += ' perdeu 1 ponto';
  138 + 0 : Result += ' não perdeu nem ganhou pontos';
  139 + 1 : Result += ' ganhou 1 ponto';
  140 + 2..MaxInt: Result += 'ganhou '+Self.AsString+' pontos'
  141 + end;
  142 + end
  143 + else
  144 + begin
  145 + case FValue of
  146 + -MaxInt..-2: Result += ' perdeu '+Self.AsString+ ' ' + AAppendicePlural;
  147 + -1 : Result += ' ponto 1'+ ' ' + AAppendiceSingular;
  148 + 0 : Result += ' não perdeu nem ganhou ' + AAppendicePlural;
  149 + 1 : Result += ' ganhou 1 ponto ' + AAppendiceSingular;
  150 + 2..MaxInt: Result += 'ganhou '+Self.AsString+ ' ' + AAppendicePlural;
  151 + end;
  152 + end;
  153 + end;
  154 + Result += '.';
  155 +end;
  156 +
  157 +
67 end. 158 end.
68 159
units/game_control.pas
  Diff comments   View file @1a5f547
@@ -86,13 +86,13 @@ const @@ -86,13 +86,13 @@ const
86 K_QUESTION = '.Question'; 86 K_QUESTION = '.Question';
87 // 87 //
88 K_STATUS = '.Status'; 88 K_STATUS = '.Status';
89 - K_CYCLES = '.OnCycleStart'; 89 + K_CYCLES = '.OnEndCycle';
90 90
91 //K_RESPONSE = 91 //K_RESPONSE =
92 92
93 implementation 93 implementation
94 94
95 -uses LazUTF8, form_matrixgame, form_chooseactor, game_resources, string_methods, zhelpers; 95 +uses LazUTF8, form_matrixgame, form_chooseactor, game_resources, strutils, string_methods, zhelpers;
96 96
97 const 97 const
98 GA_ADMIN = 'Admin'; 98 GA_ADMIN = 'Admin';
@@ -134,12 +134,18 @@ begin @@ -134,12 +134,18 @@ begin
134 134
135 // inform players 135 // inform players
136 136
  137 +{$IFDEF DEBUG}
  138 + WriteLn('TGameControl.NextTurn');
  139 +{$ENDIF}
137 end; 140 end;
138 141
139 procedure TGameControl.NextCycle(Sender: TObject); 142 procedure TGameControl.NextCycle(Sender: TObject);
140 begin 143 begin
141 // prompt question to all players 144 // prompt question to all players
142 FormMatrixGame.LabelExpCountCycle.Caption:=IntToStr(FExperiment.Condition[FExperiment.CurrentCondition].Cycles.Count); 145 FormMatrixGame.LabelExpCountCycle.Caption:=IntToStr(FExperiment.Condition[FExperiment.CurrentCondition].Cycles.Count);
  146 + {$IFDEF DEBUG}
  147 + WriteLn('TGameControl.NextTurn');
  148 + {$ENDIF}
143 end; 149 end;
144 150
145 procedure TGameControl.NextLineage(Sender: TObject); 151 procedure TGameControl.NextLineage(Sender: TObject);
@@ -235,12 +241,12 @@ begin @@ -235,12 +241,12 @@ begin
235 Caption := P.Nicname+SysToUtf8(' (Você)' ) 241 Caption := P.Nicname+SysToUtf8(' (Você)' )
236 else 242 else
237 Caption := P.Nicname; 243 Caption := P.Nicname;
238 - i1 := Integer(P.Choice.Last.Row); 244 + i1 := Integer(P.Choice.Row);
239 if i1 > 0 then 245 if i1 > 0 then
240 LabelLastRowCount.Caption := Format('%-*.*d', [1,2,i1]) 246 LabelLastRowCount.Caption := Format('%-*.*d', [1,2,i1])
241 else 247 else
242 LabelLastRowCount.Caption := 'NA'; 248 LabelLastRowCount.Caption := 'NA';
243 - PanelLastColor.Color := GetColorFromCode(P.Choice.Last.Color); 249 + PanelLastColor.Color := GetColorFromCode(P.Choice.Color);
244 Enabled := True; 250 Enabled := True;
245 Parent := FormMatrixGame.GBLastChoice; 251 Parent := FormMatrixGame.GBLastChoice;
246 end; 252 end;
@@ -385,12 +391,22 @@ var @@ -385,12 +391,22 @@ var
385 M[i] := A[i]; 391 M[i] := A[i];
386 end; 392 end;
387 begin 393 begin
388 - SetM([  
389 - FZMQActor.ID  
390 - , ' '  
391 - , ARequest  
392 - ]); 394 + case ARequest of
  395 + K_LOGIN :SetM([
  396 + FZMQActor.ID
  397 + , ' '
  398 + , ARequest
  399 + ]);
  400 +
  401 + K_CHOICE : SetM([
  402 + FZMQActor.ID
  403 + , ' '
  404 + , ARequest
  405 + , GetSelectedRowF(FormMatrixGame.StringGridMatrix)
  406 + , GetSelectedColorF(FormMatrixGame.StringGridMatrix)
  407 + ]);
393 408
  409 + end;
394 case FActor of 410 case FActor of
395 gaAdmin: begin 411 gaAdmin: begin
396 //M[2] := GA_ADMIN+M[2];// for now cannot Requests 412 //M[2] := GA_ADMIN+M[2];// for now cannot Requests
@@ -419,13 +435,6 @@ var @@ -419,13 +435,6 @@ var
419 begin 435 begin
420 case AMessage of 436 case AMessage of
421 437
422 - K_CHOICE : SetM([  
423 - AMessage  
424 - , FZMQActor.ID  
425 - , GetSelectedRowF(FormMatrixGame.StringGridMatrix)  
426 - , GetSelectedColorF(FormMatrixGame.StringGridMatrix)  
427 - ]);  
428 -  
429 K_CHAT_M : begin 438 K_CHAT_M : begin
430 //if (FActor = gaAdmin) and (not FExperiment.ResearcherCanChat) then Exit; 439 //if (FActor = gaAdmin) and (not FExperiment.ResearcherCanChat) then Exit;
431 SetM([ 440 SetM([
@@ -434,7 +443,12 @@ begin @@ -434,7 +443,12 @@ begin
434 , FormMatrixGame.ChatMemoSend.Lines.Text 443 , FormMatrixGame.ChatMemoSend.Lines.Text
435 ]); 444 ]);
436 end; 445 end;
437 - 446 + K_CHOICE : SetM([
  447 + AMessage
  448 + , FZMQActor.ID
  449 + , GetSelectedRowF(FormMatrixGame.StringGridMatrix)
  450 + , GetSelectedColorF(FormMatrixGame.StringGridMatrix)
  451 + ]);
438 end; 452 end;
439 453
440 case FActor of 454 case FActor of
@@ -486,11 +500,11 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList); @@ -486,11 +500,11 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
486 500
487 end; 501 end;
488 502
489 - procedure EnableMatrix(ATurn:integer); 503 + procedure SetPMatrix(ATurn:integer; AEnabled:Boolean);
490 begin 504 begin
491 if FExperiment.PlayerFromID[Self.ID].Turn = ATurn then 505 if FExperiment.PlayerFromID[Self.ID].Turn = ATurn then
492 begin 506 begin
493 - FormMatrixGame.StringGridMatrix.Enabled:=True; 507 + FormMatrixGame.StringGridMatrix.Enabled:=AEnabled;
494 FormMatrixGame.StringGridMatrix.Options := FormMatrixGame.StringGridMatrix.Options-[goRowSelect]; 508 FormMatrixGame.StringGridMatrix.Options := FormMatrixGame.StringGridMatrix.Options-[goRowSelect];
495 FormMatrixGame.btnConfirmRow.Enabled:=True; 509 FormMatrixGame.btnConfirmRow.Enabled:=True;
496 FormMatrixGame.btnConfirmRow.Caption:='Confirmar'; 510 FormMatrixGame.btnConfirmRow.Caption:='Confirmar';
@@ -520,7 +534,7 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList); @@ -520,7 +534,7 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
520 FormMatrixGame.btnConfirmRow.Caption:='OK'; 534 FormMatrixGame.btnConfirmRow.Caption:='OK';
521 end 535 end
522 else 536 else
523 - EnableMatrix(P.Turn+1); 537 + SetPMatrix(P.Turn+1, True);
524 end; 538 end;
525 539
526 gaAdmin:begin 540 gaAdmin:begin
@@ -542,7 +556,7 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList); @@ -542,7 +556,7 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
542 begin 556 begin
543 PopUpPos.X := FormMatrixGame.StringGridMatrix.Left+FormMatrixGame.StringGridMatrix.Width; 557 PopUpPos.X := FormMatrixGame.StringGridMatrix.Left+FormMatrixGame.StringGridMatrix.Width;
544 PopUpPos.Y := FormMatrixGame.StringGridMatrix.Top; 558 PopUpPos.Y := FormMatrixGame.StringGridMatrix.Top;
545 - EnableMatrix(0); 559 + SetPMatrix(0, True);
546 FormMatrixGame.PopupNotifier.Text:='É sua vez! Clique sobre uma linha da matrix e confirme sua escolha.'; 560 FormMatrixGame.PopupNotifier.Text:='É sua vez! Clique sobre uma linha da matrix e confirme sua escolha.';
547 FormMatrixGame.PopupNotifier.ShowAtPos(PopUpPos.X,PopUpPos.Y); 561 FormMatrixGame.PopupNotifier.ShowAtPos(PopUpPos.X,PopUpPos.Y);
548 end 562 end
@@ -556,6 +570,31 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList); @@ -556,6 +570,31 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
556 end; 570 end;
557 end; 571 end;
558 572
  573 + procedure OnEndCycle;
  574 + begin
  575 + // Updata turn
  576 +
  577 + //
  578 + case FActor of
  579 + gaPlayer:
  580 + 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;
  594 + end;
  595 + end;
  596 + end;
  597 +
559 procedure ReceiveChat; 598 procedure ReceiveChat;
560 begin 599 begin
561 FormMatrixGame.ChatMemoRecv.Lines.Append(('['+AMessage[1]+']: ')+AMessage[2]); 600 FormMatrixGame.ChatMemoRecv.Lines.Append(('['+AMessage[1]+']: ')+AMessage[2]);
@@ -622,6 +661,7 @@ begin @@ -622,6 +661,7 @@ begin
622 if MHas(K_CHOICE) then ReceiveChoice; 661 if MHas(K_CHOICE) then ReceiveChoice;
623 if MHas(K_KICK) then SayGoodBye; 662 if MHas(K_KICK) then SayGoodBye;
624 if MHas(K_START) then NotifyPlayers; 663 if MHas(K_START) then NotifyPlayers;
  664 + if MHas(K_CYCLES) then OnEndCycle;
625 end; 665 end;
626 666
627 // Here FActor is garanted to be a TZMQAdmin 667 // Here FActor is garanted to be a TZMQAdmin
@@ -662,10 +702,8 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList); @@ -662,10 +702,8 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList);
662 P.Points.A:=0; 702 P.Points.A:=0;
663 P.Points.B:=0; 703 P.Points.B:=0;
664 P.Status:=gpsPlaying; 704 P.Status:=gpsPlaying;
665 - P.Choice.Current.Color:=gcNone;  
666 - P.Choice.Current.Row:=grNone;  
667 - P.Choice.Last.Color:=gcNone;  
668 - P.Choice.Last.Row:=grNone; 705 + P.Choice.Color:=gcNone;
  706 + P.Choice.Row:=grNone;
669 // turns by entrance order or by random order 707 // turns by entrance order or by random order
670 P.Turn := FExperiment.NextTurn; 708 P.Turn := FExperiment.NextTurn;
671 FExperiment.Player[i] := P; 709 FExperiment.Player[i] := P;
@@ -716,11 +754,25 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList); @@ -716,11 +754,25 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList);
716 end; 754 end;
717 end; 755 end;
718 756
  757 + procedure ValidateChoice;
  758 + var P : TPlayer;
  759 + begin
  760 + P := FExperiment.PlayerFromID[ARequest[0]];
  761 + P.Choice.Row:= GetRowFromString(ARequest[3]); // row
  762 + P.Choice.Color:= GetColorFromString(ARequest[4]); // color
  763 + 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]]);
  766 + end;
  767 +
719 begin 768 begin
720 if MHas(K_LOGIN) then ReplyLoginRequest; 769 if MHas(K_LOGIN) then ReplyLoginRequest;
  770 + if MHas(K_CHOICE) then ValidateChoice;
721 end; 771 end;
722 772
723 -// Here FActor is garanted to be a TZMQPlayer, should be used to send all wanted history for new income players 773 +// Here FActor is garanted to be a TZMQPlayer, reply
  774 +// - sending private data to player player
  775 +// - sending data from early history to income players
724 procedure TGameControl.ReceiveReply(AReply: TStringList); 776 procedure TGameControl.ReceiveReply(AReply: TStringList);
725 function MHas(const C : string) : Boolean; 777 function MHas(const C : string) : Boolean;
726 begin 778 begin
@@ -752,11 +804,39 @@ procedure TGameControl.ReceiveReply(AReply: TStringList); @@ -752,11 +804,39 @@ procedure TGameControl.ReceiveReply(AReply: TStringList);
752 else 804 else
753 begin 805 begin
754 {$IFDEF DEBUG} 806 {$IFDEF DEBUG}
755 - WriteLn(Self.ID +' sent but' + AReply[0] +' received. This must not occur.'); 807 + WriteLn(Self.ID +' sent but' + AReply[0] +' received. <<<<<<<<<<<<<<<<<<<<<<< This must not occur >>>>>>>>>>>>>>>>>>>>>>>>>>');
756 {$ENDIF} 808 {$ENDIF}
757 end; 809 end;
758 end; 810 end;
759 811
  812 + procedure ChoiceValidated;
  813 + var
  814 + LConsequence : TConsequence;
  815 + LCount,
  816 + i : integer;
  817 + P : TPlayer;
  818 + begin
  819 + if Self.ID = AReply[0] then
  820 + begin
  821 + P := FExperiment.PlayerFromID[Self.ID];
  822 + LCount := WordCount(AReply[5],['+']);
  823 + {$IFDEF DEBUG}
  824 + WriteLn('LCount:',LCount);
  825 + {$ENDIF}
  826 + if LCount > 0 then
  827 + for i := 1 to LCount do
  828 + begin
  829 + LConsequence := TConsequence.Create(FormMatrixGame,ExtractDelimited(i,AReply[5],['+']));
  830 + //LConsequence.PlayerNicname := P.Nicname;
  831 + LConsequence.Present(Self, False);
  832 + {$IFDEF DEBUG}
  833 + WriteLn('A consequence should have shown.');
  834 + {$ENDIF}
  835 + end;
  836 +
  837 + end;
  838 + end;
  839 +
760 procedure ResumePlayer; 840 procedure ResumePlayer;
761 begin 841 begin
762 842
@@ -765,6 +845,7 @@ procedure TGameControl.ReceiveReply(AReply: TStringList); @@ -765,6 +845,7 @@ procedure TGameControl.ReceiveReply(AReply: TStringList);
765 begin 845 begin
766 if MHas(K_RESUME+K_ARRIVED) then ResumePlayer; 846 if MHas(K_RESUME+K_ARRIVED) then ResumePlayer;
767 if MHas(K_LOGIN+K_ARRIVED) then LoginAccepted; 847 if MHas(K_LOGIN+K_ARRIVED) then LoginAccepted;
  848 + if MHas(K_CHOICE+K_ARRIVED) then ChoiceValidated;
768 end; 849 end;
769 850
770 851
units/game_experiment.pas
  Diff comments   View file @1a5f547
@@ -2,6 +2,8 @@ unit game_experiment; @@ -2,6 +2,8 @@ unit game_experiment;
2 2
3 {$mode objfpc}{$H+} 3 {$mode objfpc}{$H+}
4 4
  5 +{$DEFINE DEBUG}
  6 +
5 interface 7 interface
6 8
7 uses 9 uses
@@ -15,7 +17,6 @@ type @@ -15,7 +17,6 @@ type
15 { TExperiment } 17 { TExperiment }
16 18
17 TExperimentState = (xsWaiting,xsRunning,xsPaused,xsCanceled); 19 TExperimentState = (xsWaiting,xsRunning,xsPaused,xsCanceled);
18 - TPlayers = array of TPlayer;  
19 TConditions = array of TCondition; 20 TConditions = array of TCondition;
20 21
21 TExperiment = class(TComponent) 22 TExperiment = class(TComponent)
@@ -43,6 +44,7 @@ type @@ -43,6 +44,7 @@ type
43 FTurnsRandom : TStringList; 44 FTurnsRandom : TStringList;
44 function GetCondition(I : Integer): TCondition; 45 function GetCondition(I : Integer): TCondition;
45 function GetConditionsCount: integer; 46 function GetConditionsCount: integer;
  47 + function GetContingenciesCount(C: integer): integer;
46 function GetContingency(ACondition, I : integer): TContingency; 48 function GetContingency(ACondition, I : integer): TContingency;
47 function GetNextTurn: integer; 49 function GetNextTurn: integer;
48 function GetNextTurnPlayerID: UTF8string; 50 function GetNextTurnPlayerID: UTF8string;
@@ -56,6 +58,7 @@ type @@ -56,6 +58,7 @@ type
56 function GetPlayerIsPlaying(AID : UTF8string): Boolean; 58 function GetPlayerIsPlaying(AID : UTF8string): Boolean;
57 function GetPlayersCount: integer; 59 function GetPlayersCount: integer;
58 function GetInterlockingsIn(ALastCycles : integer):integer; 60 function GetInterlockingsIn(ALastCycles : integer):integer;
  61 + function GetConsequenceStringFromChoice(P:TPlayer): Utf8string;
59 procedure SetCondition(I : Integer; AValue: TCondition); 62 procedure SetCondition(I : Integer; AValue: TCondition);
60 procedure SetContingency(ACondition, I : integer; AValue: TContingency); 63 procedure SetContingency(ACondition, I : integer; AValue: TContingency);
61 procedure SetMatrixType(AValue: TGameMatrixType); 64 procedure SetMatrixType(AValue: TGameMatrixType);
@@ -93,6 +96,7 @@ type @@ -93,6 +96,7 @@ type
93 property ConditionsCount : integer read GetConditionsCount; 96 property ConditionsCount : integer read GetConditionsCount;
94 property CurrentCondition : integer read FCurrentCondition write FCurrentCondition; 97 property CurrentCondition : integer read FCurrentCondition write FCurrentCondition;
95 property Contingency[C, I : integer] : TContingency read GetContingency write SetContingency; 98 property Contingency[C, I : integer] : TContingency read GetContingency write SetContingency;
  99 + property ContingenciesCount[C:integer]:integer read GetContingenciesCount;
96 property ExperimentAim : UTF8string read FExperimentAim write FExperimentAim; 100 property ExperimentAim : UTF8string read FExperimentAim write FExperimentAim;
97 property ExperimentName : UTF8string read FExperimentName write FExperimentName; 101 property ExperimentName : UTF8string read FExperimentName write FExperimentName;
98 property GenPlayersAsNeeded : Boolean read FGenPlayersAsNeeded write FGenPlayersAsNeeded; 102 property GenPlayersAsNeeded : Boolean read FGenPlayersAsNeeded write FGenPlayersAsNeeded;
@@ -104,6 +108,7 @@ type @@ -104,6 +108,7 @@ type
104 property PlayerIndexFromID[s : UTF8string]: integer read GetPlayerIndexFromID; 108 property PlayerIndexFromID[s : UTF8string]: integer read GetPlayerIndexFromID;
105 property PlayerAsString[P:TPlayer]: UTF8string read GetPlayerAsString; 109 property PlayerAsString[P:TPlayer]: UTF8string read GetPlayerAsString;
106 property PlayerFromString[s : UTF8string]: TPlayer read GetPlayerFromString; 110 property PlayerFromString[s : UTF8string]: TPlayer read GetPlayerFromString;
  111 + property ConsequenceStringFromChoice[P:Tplayer]:UTF8String read GetConsequenceStringFromChoice;
107 property ShowChat : Boolean read FShowChat write FShowChat; 112 property ShowChat : Boolean read FShowChat write FShowChat;
108 property SendChatHistoryForNewPlayers : Boolean read FSendChatHistoryForNewPlayers write SetSendChatHistoryForNewPlayers; 113 property SendChatHistoryForNewPlayers : Boolean read FSendChatHistoryForNewPlayers write SetSendChatHistoryForNewPlayers;
109 property MatrixType : TGameMatrixType read FMatrixType write SetMatrixType; 114 property MatrixType : TGameMatrixType read FMatrixType write SetMatrixType;
@@ -111,7 +116,6 @@ type @@ -111,7 +116,6 @@ type
111 property NextTurn : integer read GetNextTurn; 116 property NextTurn : integer read GetNextTurn;
112 property NextCycle : integer read GetNextCycle; 117 property NextCycle : integer read GetNextCycle;
113 property NextCondition : integer read GetNextCondition; 118 property NextCondition : integer read GetNextCondition;
114 -  
115 property State : TExperimentState read FState write SetState; 119 property State : TExperimentState read FState write SetState;
116 public 120 public
117 property OnEndTurn : TNotifyEvent read FOnEndTurn write SetOnEndTurn; 121 property OnEndTurn : TNotifyEvent read FOnEndTurn write SetOnEndTurn;
@@ -140,6 +144,11 @@ begin @@ -140,6 +144,11 @@ begin
140 Result := Length(FConditions); 144 Result := Length(FConditions);
141 end; 145 end;
142 146
  147 +function TExperiment.GetContingenciesCount(C: integer): integer;
  148 +begin
  149 + Result := Length(FConditions[C].Contingencies);
  150 +end;
  151 +
143 function TExperiment.GetContingency(ACondition, I : integer): TContingency; 152 function TExperiment.GetContingency(ACondition, I : integer): TContingency;
144 begin 153 begin
145 Result := FConditions[ACondition].Contingencies[I]; 154 Result := FConditions[ACondition].Contingencies[I];
@@ -161,6 +170,9 @@ begin @@ -161,6 +170,9 @@ begin
161 if Assigned(FOnEndCycle) then FOnEndCycle(Self); 170 if Assigned(FOnEndCycle) then FOnEndCycle(Self);
162 NextCycle; 171 NextCycle;
163 end; 172 end;
  173 +{$IFDEF DEBUG}
  174 + WriteLn('TExperiment.GetNextTurn:',Result);
  175 +{$ENDIF}
164 end; 176 end;
165 177
166 function TExperiment.GetNextTurnPlayerID: UTF8string; // used during cycles 178 function TExperiment.GetNextTurnPlayerID: UTF8string; // used during cycles
@@ -183,6 +195,9 @@ begin @@ -183,6 +195,9 @@ begin
183 NextCondition; 195 NextCondition;
184 end; 196 end;
185 end; 197 end;
  198 + {$IFDEF DEBUG}
  199 + WriteLn('TExperiment.GetNextCycle:',Result);
  200 + {$ENDIF}
186 end; 201 end;
187 202
188 function TExperiment.GetNextCondition: integer; 203 function TExperiment.GetNextCondition: integer;
@@ -221,7 +236,9 @@ begin @@ -221,7 +236,9 @@ begin
221 EndCondition 236 EndCondition
222 237
223 end; 238 end;
224 - 239 + {$IFDEF DEBUG}
  240 + WriteLn('TExperiment.GetNextCondition:',Result);
  241 + {$ENDIF}
225 end; 242 end;
226 243
227 function TExperiment.GetPlayer(I : integer): TPlayer; 244 function TExperiment.GetPlayer(I : integer): TPlayer;
@@ -312,8 +329,7 @@ begin @@ -312,8 +329,7 @@ begin
312 , P.Nicname 329 , P.Nicname
313 , GetPPointsString(P.Points) 330 , GetPPointsString(P.Points)
314 , GetStatusString(P.Status) 331 , GetStatusString(P.Status)
315 - , GetChoiceString(P.Choice.Current)  
316 - , GetChoiceString(P.Choice.Last) 332 + , GetChoiceString(P.Choice)
317 , IntToStr(P.Turn) 333 , IntToStr(P.Turn)
318 ]); 334 ]);
319 for i := 0 to Length(M)-1 do 335 for i := 0 to Length(M)-1 do
@@ -384,9 +400,8 @@ begin @@ -384,9 +400,8 @@ begin
384 Result.Nicname := ExtractDelimited(2,s,['|']); 400 Result.Nicname := ExtractDelimited(2,s,['|']);
385 Result.Points := GetPPointsFromString(ExtractDelimited(3,s,['|'])); 401 Result.Points := GetPPointsFromString(ExtractDelimited(3,s,['|']));
386 Result.Status := GetStatusFromString(ExtractDelimited(4,s,['|'])); 402 Result.Status := GetStatusFromString(ExtractDelimited(4,s,['|']));
387 - Result.Choice.Current := GetChoiceFromString(ExtractDelimited(5,s,['|']));  
388 - Result.Choice.Last := GetChoiceFromString(ExtractDelimited(6,s,['|']));  
389 - Result.Turn:=StrToInt(ExtractDelimited(7,s,['|'])); 403 + Result.Choice := GetChoiceFromString(ExtractDelimited(5,s,['|']));
  404 + Result.Turn:=StrToInt(ExtractDelimited(6,s,['|']));
390 end; 405 end;
391 406
392 function TExperiment.GetPlayerIndexFromID(AID: UTF8string): integer; 407 function TExperiment.GetPlayerIndexFromID(AID: UTF8string): integer;
@@ -423,6 +438,20 @@ begin @@ -423,6 +438,20 @@ begin
423 438
424 end; 439 end;
425 440
  441 +function TExperiment.GetConsequenceStringFromChoice(P: TPlayer): Utf8string;
  442 +var
  443 + i : integer;
  444 + c : integer;
  445 +begin
  446 + c := CurrentCondition;
  447 + PlayerFromID[P.ID] := P;
  448 + Result:= '';
  449 + for i :=0 to ContingenciesCount[c] -1 do
  450 + if not Contingency[c,i].Meta then
  451 + if Contingency[c,i].ResponseMeetsCriteriaI(P.Choice.Row,P.Choice.Color) then
  452 + Result += Contingency[c,i].Consequence.AsString + '+';
  453 +end;
  454 +
426 procedure TExperiment.SetCondition(I : Integer; AValue: TCondition); 455 procedure TExperiment.SetCondition(I : Integer; AValue: TCondition);
427 begin 456 begin
428 FConditions[I] := AValue; 457 FConditions[I] := AValue;
@@ -611,9 +640,9 @@ begin @@ -611,9 +640,9 @@ begin
611 if FFilename <> '' then 640 if FFilename <> '' then
612 SaveExperimentToFile(Self,FFilename) 641 SaveExperimentToFile(Self,FFilename)
613 else 642 else
614 - {$IFDEF DEBUG}  
615 - WriteLn(WARN_CANNOT_SAVE)  
616 - {$ENDIF}; 643 +{$IFDEF DEBUG}
  644 + WriteLn(WARN_CANNOT_SAVE)
  645 +{$ENDIF};
617 end; 646 end;
618 647
619 procedure TExperiment.Clean; 648 procedure TExperiment.Clean;
units/game_file_methods.pas
  Diff comments   View file @1a5f547
@@ -30,11 +30,24 @@ resourcestring @@ -30,11 +30,24 @@ resourcestring
30 30
31 implementation 31 implementation
32 32
33 -uses LCLIntf, game_actors_point, game_resources, string_methods, regdata, zhelpers; 33 +uses LCLIntf, game_actors_point, game_resources, string_methods, regdata, zhelpers, strutils;
34 34
35 function LoadExperimentFromResource(var AExperiment: TExperiment): Boolean; 35 function LoadExperimentFromResource(var AExperiment: TExperiment): Boolean;
36 -var i,j : integer; 36 +var
37 C : TCondition; 37 C : TCondition;
  38 + LConcequence : TConsequence;
  39 + LCriteria1 : TCriteria = (
  40 + Style:(gtRowsOnly);
  41 + Rows:[grEven];
  42 + Colors:[];
  43 + );
  44 +
  45 + LCriteria2 : TCriteria = (
  46 + Style:(gtRowsOnly);
  47 + Rows:[grOdd];
  48 + Colors:[];
  49 + );
  50 +
38 begin 51 begin
39 Result := False; 52 Result := False;
40 with AExperiment do 53 with AExperiment do
@@ -53,19 +66,27 @@ begin @@ -53,19 +66,27 @@ begin
53 C := C_CONDITION_TEMPLATE; 66 C := C_CONDITION_TEMPLATE;
54 with C do 67 with C do
55 begin 68 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 +
56 ConditionName := SEC_CONDITION+IntToStr(1); 75 ConditionName := SEC_CONDITION+IntToStr(1);
57 Turn.Count:=0; 76 Turn.Count:=0;
58 Turn.Value:=2; 77 Turn.Value:=2;
59 Turn.Random:=False; 78 Turn.Random:=False;
  79 + Cycles.Count:=0;
  80 + Cycles.Value:=4;
  81 + Cycles.Generation:=0;
60 end; 82 end;
61 - i := AppendCondition(C); 83 + AppendCondition(C);
62 end; 84 end;
63 end; 85 end;
64 86
65 function LoadExperimentFromFile(var AExperiment: TExperiment; AFilename: string):Boolean; 87 function LoadExperimentFromFile(var AExperiment: TExperiment; AFilename: string):Boolean;
66 var 88 var
67 LIniFile : TCIniFile; 89 LIniFile : TCIniFile;
68 - LExperiment : TExperiment;  
69 90
70 //procedure HandleRootPath(var APath : string); 91 //procedure HandleRootPath(var APath : string);
71 //begin 92 //begin
@@ -101,27 +122,6 @@ var @@ -101,27 +122,6 @@ var
101 Result.G := StrToIntDef(GetAndDelFirstValue(LS),0); 122 Result.G := StrToIntDef(GetAndDelFirstValue(LS),0);
102 end; 123 end;
103 124
104 - function GetConsequence(S: string) : TConsequence;  
105 - var  
106 - CS : TGameConsequenceStyle;  
107 - LS : string;  
108 - begin  
109 - // 0,0,0,0,0,0,NON  
110 - LS := UpperCase(S + VV_SEP);  
111 - Result.Points.A.Value := StrToIntDef(GetAndDelFirstValue(LS),0);  
112 - Result.Points.A.Variation:=StrToIntDef(GetAndDelFirstValue(LS),0);  
113 -  
114 - Result.Points.B.Value := StrToIntDef(GetAndDelFirstValue(LS),0);  
115 - Result.Points.B.Variation:=StrToIntDef(GetAndDelFirstValue(LS),0);  
116 -  
117 - Result.Points.G.Value := StrToIntDef(GetAndDelFirstValue(LS),0);  
118 - Result.Points.G.Variation:=StrToIntDef(GetAndDelFirstValue(LS),0);  
119 -  
120 - Result.Style := [];  
121 - for CS in TGameConsequenceStyle do  
122 - Result.Style += [GetConsequenceStyleFromString(GetAndDelFirstValue(LS))]  
123 -  
124 - end;  
125 125
126 function GetChoiceFromString(S:string) : TPlayerChoice; 126 function GetChoiceFromString(S:string) : TPlayerChoice;
127 var 127 var
@@ -172,11 +172,11 @@ var @@ -172,11 +172,11 @@ var
172 // Experiment; 172 // Experiment;
173 with LIniFile do 173 with LIniFile do
174 begin 174 begin
175 - LExperiment.Researcher := ReadString(SEC_EXPERIMENT, KEY_RESEARCHER,VAL_RESEARCHER);  
176 - LExperiment.ExperimentName:=ReadString(SEC_EXPERIMENT, KEY_NAME,'');  
177 - LExperiment.ExperimentAim:=ReadString(SEC_EXPERIMENT, KEY_AIM,'');  
178 - LExperiment.GenPlayersAsNeeded:=ReadBool(SEC_EXPERIMENT, KEY_GEN_PLAYER_AS_NEEDED,True);  
179 - LExperiment.CurrentCondition := ReadInteger(SEC_EXPERIMENT, KEY_CURRENT_CONDITION,0)-1; //zero based 175 + AExperiment.Researcher := ReadString(SEC_EXPERIMENT, KEY_RESEARCHER,VAL_RESEARCHER);
  176 + AExperiment.ExperimentName:=ReadString(SEC_EXPERIMENT, KEY_NAME,'');
  177 + AExperiment.ExperimentAim:=ReadString(SEC_EXPERIMENT, KEY_AIM,'');
  178 + AExperiment.GenPlayersAsNeeded:=ReadBool(SEC_EXPERIMENT, KEY_GEN_PLAYER_AS_NEEDED,True);
  179 + AExperiment.CurrentCondition := ReadInteger(SEC_EXPERIMENT, KEY_CURRENT_CONDITION,0)-1; //zero based
180 end; 180 end;
181 end; 181 end;
182 182
@@ -184,30 +184,68 @@ var @@ -184,30 +184,68 @@ var
184 var 184 var
185 LS : string; 185 LS : string;
186 i : integer; 186 i : integer;
  187 + P : TPlayer;
187 begin 188 begin
188 i := 0; 189 i := 0;
189 LS := SEC_PLAYER+IntToStr(i+1); 190 LS := SEC_PLAYER+IntToStr(i+1);
190 with LIniFile do 191 with LIniFile do
191 while SectionExists(LS) do 192 while SectionExists(LS) do
192 - with LExperiment.Player[LExperiment.AppendPlayer] do  
193 - begin  
194 - Turn := ReadInteger(LS,KEY_PLAYER_TURN,i);  
195 - Choice.Current := GetChoiceFromString(ReadString(LS,KEY_PLAYER_CHOICE_CURRENT,'0,NONE,'));  
196 - Choice.Last := GetChoiceFromString(ReadString(LS,KEY_PLAYER_CHOICE_LAST,'0,NONE,'));  
197 - ID := ReadString(LS,KEY_PLAYER_ID,s_random(20));  
198 - Nicname := ReadString(LS,KEY_PLAYER_NICNAME,GenResourceName(i));  
199 - Login := ReadString(LS,KEY_PLAYER_LOGIN,'jogador'+IntToStr(i+1));  
200 - Password := ReadString(LS,KEY_PLAYER_PASSWORD,'1234');  
201 - Points := GetPPointsFromString(ReadString(LS,KEY_PLAYER_POINTS,'0,0,'));  
202 - Status := GetStatusFromString(ReadString(LS,KEY_PLAYER_STATUS,'esperando'));  
203 - Data.Values[KEY_PLAYER_TEMP] := ReadString(LS,KEY_PLAYER_TEMP,'');  
204 - end; 193 + begin
  194 + if i = 0 then
  195 + i := AExperiment.AppendPlayer;
  196 + with P do
  197 + begin
  198 + Turn := ReadInteger(LS,KEY_PLAYER_TURN,i);
  199 + Choice := GetChoiceFromString(ReadString(LS,KEY_PLAYER_CHOICE_LAST,'0,NONE,'));
  200 + ID := ReadString(LS,KEY_PLAYER_ID,s_random(20));
  201 + Nicname := ReadString(LS,KEY_PLAYER_NICNAME,GenResourceName(i));
  202 + Login := ReadString(LS,KEY_PLAYER_LOGIN,'jogador'+IntToStr(i+1));
  203 + Password := ReadString(LS,KEY_PLAYER_PASSWORD,'1234');
  204 + Points := GetPPointsFromString(ReadString(LS,KEY_PLAYER_POINTS,'0,0,'));
  205 + Status := GetStatusFromString(ReadString(LS,KEY_PLAYER_STATUS,'esperando'));
  206 + Data.Values[KEY_PLAYER_TEMP] := ReadString(LS,KEY_PLAYER_TEMP,'');
  207 + end;
  208 + AExperiment.Player[i] := P;
  209 + i := AExperiment.AppendPlayer;
  210 + LS := SEC_PLAYER+IntToStr(i+1);
  211 + end;
205 end; 212 end;
206 213
207 procedure ReadContingencies(ACondition:integer;IsMeta : Boolean); 214 procedure ReadContingencies(ACondition:integer;IsMeta : Boolean);
208 - var i : integer;  
209 - LS,LCK : string;  
210 - procedure SetLCK; 215 + var
  216 + i : integer;
  217 + LS,LCK : string;
  218 + LConsequence : TConsequence;
  219 + LCriteria:TCriteria;
  220 +
  221 + function GetCriteriaFromString(S:string):TCriteria;
  222 + var
  223 + LS : string;
  224 + i,
  225 + LCount: integer;
  226 + begin
  227 + LS := ExtractDelimited(1,S,['|']);
  228 + LCount := WordCount(LS,[#0,',']);
  229 + Result.Rows := [];
  230 + for i := 1 to LCount do
  231 + Result.Rows += [GetRowFromString(ExtractDelimited(i,LS,[',']))];
  232 +
  233 + case ExtractDelimited(2,S,['|'])of
  234 + 'NONE':Result.Style:=gtNone;
  235 + 'CORES':Result.Style:=gtColorsOnly;
  236 + 'E':Result.Style:=gtRowsAndColors;
  237 + 'LINHAS':Result.Style:=gtRowsOnly;
  238 + 'OU':Result.Style:=gtRowsOrColors;
  239 + end;
  240 +
  241 + LS := ExtractDelimited(3,S,['|']);
  242 + LCount := WordCount(LS,[#0,',']);
  243 + Result.Colors := [];
  244 + for i := 1 to LCount do
  245 + Result.Colors += [GetColorFromString(ExtractDelimited(i,LS,[',']))];
  246 + end;
  247 +
  248 + procedure SetLCK(i:integer);
211 begin 249 begin
212 if IsMeta then 250 if IsMeta then
213 LCK := KEY_METACONTINGENCY+IntToStr(i+1) 251 LCK := KEY_METACONTINGENCY+IntToStr(i+1)
@@ -216,72 +254,68 @@ var @@ -216,72 +254,68 @@ var
216 end; 254 end;
217 begin 255 begin
218 LS := SEC_CONDITION+IntToStr(ACondition+1); 256 LS := SEC_CONDITION+IntToStr(ACondition+1);
219 - i := 0;  
220 - SetLCK; 257 + i := AExperiment.AppendContingency(ACondition);
  258 + SetLCK(i);
221 with LIniFile do 259 with LIniFile do
222 - while ValueExists(LS, LCK+KEY_CONSEQUE) do  
223 - with LExperiment.Condition[ACondition].Contingencies[LExperiment.AppendContingency(ACondition)] do  
224 - begin  
225 - Meta:=IsMeta;  
226 - Consequence := GetConsequence(ReadString(LS,LCK+KEY_CONSEQUE,DEF_CONSEQUENCE));  
227 - if IsMeta then  
228 - Consequence.Message.Text := ReadString(LS,LCK+KEY_CONSEQUE_MESSAGE,DEF_CONSEQUENCE_MESSAGE)  
229 - else  
230 - Consequence.Message.Text := ReadString(LS,LCK+KEY_CONSEQUE_MESSAGE,DEF_CONSEQUENCE_MESSAGE);  
231 -  
232 - Criteria := GetResponseFromString(ReadString(LS,LCK+KEY_RESPONSE,DEF_RESPONSE));  
233 -  
234 - Inc(i);  
235 - SetLCK;  
236 - end; 260 + while ValueExists(LS, LCK+KEY_CONSEQUE) and ValueExists(LS, LCK+KEY_CRITERIA)do
  261 + begin
  262 + LConsequence := TConsequence.Create(AExperiment,ReadString(LS,LCK+KEY_CONSEQUE,DEF_CONSEQUENCE));
  263 + LCriteria := GetCriteriaFromString(ReadString(LS,LCK+KEY_CRITERIA,DEF_CRITERIA));
  264 + AExperiment.Condition[ACondition].Contingencies[i] := TContingency.Create(AExperiment,LConsequence,LCriteria,IsMeta);
  265 + i := AExperiment.AppendContingency(ACondition);
  266 + SetLCK(i);
  267 + end;
237 end; 268 end;
238 269
239 procedure ReadConditions; 270 procedure ReadConditions;
240 var 271 var
241 s1, LS : string; 272 s1, LS : string;
242 - LCondition : integer; 273 + i : integer;
  274 + C :TCondition;
243 begin 275 begin
244 - LCondition := 0;  
245 - LS := SEC_CONDITION+IntToStr(LCondition+1); 276 + i := 0;
  277 + LS := SEC_CONDITION+IntToStr(i+1);
246 with LIniFile do 278 with LIniFile do
247 while SectionExists(LS) do 279 while SectionExists(LS) do
248 - with LExperiment.Condition[LExperiment.AppendCondition] do  
249 - begin  
250 - s1 := ReadString(LS, KEY_ENDCRITERIA,'');  
251 - if s1 = '' then  
252 - begin  
253 - {$IFDEF DEBUG}  
254 - WriteLn(WARN_CONDITION_WITH_NO_END+LS+'. '+KEY_ENDCRITERIA+KV_SEP+DEF_END+WARN_END);  
255 - {$ENDIF}  
256 - s1 := DEF_END;  
257 - end;  
258 - EndCriterium := GetEndCriteria(s1);  
259 - ConditionName := ReadString(LS,KEY_COND_NAME,LS);  
260 - Points.Count := GetPoints(ReadString(LS, KEY_POINTS_COUNT,DEF_POINTS));  
261 - Points.OnStart := GetPoints(ReadString(LS, KEY_POINTS_ONSTART,DEF_POINTS));  
262 - Turn.Count:= ReadInteger(LS, KEY_TURN_COUNT,1);  
263 - Turn.Value:= ReadInteger(LS, KEY_TURN_VALUE,2);  
264 - Turn.Random:= ReadBool(LS, KEY_TURN_RANDOM,False);  
265 - Cycles.Count:= ReadInteger(LS, KEY_CYCLES_COUNT,1);  
266 - Cycles.Value:= ReadInteger(LS, KEY_CYCLES_VALUE,10);  
267 - Cycles.Generation:= ReadInteger(LS, KEY_CYCLES_GEN,1);  
268 -  
269 - // todo: create and initialize prompt based on its values  
270 - ///////////////////////////////////  
271 - // need to create classes first ///  
272 - ///////////////////////////////////  
273 -  
274 - Prompt.PromptStyle:= GetPromptStyle(ReadString(LS,KEY_PROMPT_STYLE,'todos,sim,metacontingência,recuperar pontos,'));  
275 - Prompt.PromptMessage := ReadString(LS,KEY_PROMPT_MESSAGE,DEF_PROMPTMESSAGE);  
276 -  
277 - ReadContingencies(LCondition,True);  
278 - ReadContingencies(LCondition,False);  
279 -  
280 - Prompt.PromptTargets:=@Contingencies;  
281 -  
282 - Inc(LCondition);  
283 - LS := SEC_CONDITION+IntToStr(LCondition+1);  
284 - end; 280 + begin
  281 + if i = 0 then
  282 + i := AExperiment.AppendCondition;
  283 +
  284 + with C do
  285 + begin
  286 + s1 := ReadString(LS, KEY_ENDCRITERIA,'');
  287 + if s1 = '' then
  288 + begin
  289 + {$IFDEF DEBUG}
  290 + WriteLn(WARN_CONDITION_WITH_NO_END+LS+'. '+KEY_ENDCRITERIA+KV_SEP+DEF_END+WARN_END);
  291 + {$ENDIF}
  292 + s1 := DEF_END;
  293 + end;
  294 + EndCriterium := GetEndCriteria(s1);
  295 + ConditionName := ReadString(LS,KEY_COND_NAME,LS);
  296 + Points.Count := GetPoints(ReadString(LS, KEY_POINTS_COUNT,DEF_POINTS));
  297 + Points.OnStart := GetPoints(ReadString(LS, KEY_POINTS_ONSTART,DEF_POINTS));
  298 + Turn.Count:= ReadInteger(LS, KEY_TURN_COUNT,1);
  299 + Turn.Value:= ReadInteger(LS, KEY_TURN_VALUE,2);
  300 + Turn.Random:= ReadBool(LS, KEY_TURN_RANDOM,False);
  301 + Cycles.Count:= ReadInteger(LS, KEY_CYCLES_COUNT,1);
  302 + Cycles.Value:= ReadInteger(LS, KEY_CYCLES_VALUE,10);
  303 + Cycles.Generation:= ReadInteger(LS, KEY_CYCLES_GEN,1);
  304 +
  305 + ReadContingencies(i,True);
  306 + ReadContingencies(i,False);
  307 +
  308 + // if no contingencies, return false...
  309 +
  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);
  313 +
  314 + end;
  315 + AExperiment.Condition[i]:= C;
  316 + i := AExperiment.AppendCondition;
  317 + LS := SEC_CONDITION+IntToStr(i+1);
  318 + end;
285 end; 319 end;
286 320
287 begin 321 begin
@@ -292,7 +326,7 @@ begin @@ -292,7 +326,7 @@ begin
292 with LIniFile do 326 with LIniFile do
293 if SectionExists(SEC_EXPERIMENT) then 327 if SectionExists(SEC_EXPERIMENT) then
294 begin 328 begin
295 - LExperiment.Create(AExperiment.Owner); 329 + AExperiment := TExperiment.Create(AExperiment.Owner);
296 ReadExperiment; 330 ReadExperiment;
297 ReadPlayers; 331 ReadPlayers;
298 ReadConditions; 332 ReadConditions;
@@ -303,10 +337,6 @@ begin @@ -303,10 +337,6 @@ begin
303 LIniFile.Free; 337 LIniFile.Free;
304 Exit; 338 Exit;
305 end; 339 end;
306 - Result := True;  
307 - LIniFile.Free;  
308 - AExperiment := LExperiment;  
309 - LExperiment.Free;  
310 end 340 end
311 else 341 else
312 ShowMessage(ERROR_FILE_NOT_FOUND); 342 ShowMessage(ERROR_FILE_NOT_FOUND);
@@ -341,23 +371,6 @@ var @@ -341,23 +371,6 @@ var
341 Result := Result + IntToStr(APoints.G) + VV_SEP; 371 Result := Result + IntToStr(APoints.G) + VV_SEP;
342 end; 372 end;
343 373
344 - function GetConsequenceString(AConsequence : TConsequence) : string;  
345 - var CS : TGameConsequenceStyle;  
346 - begin  
347 - Result := IntToStr(AConsequence.Points.A.Value);  
348 - Result := Result + IntToStr(AConsequence.Points.A.Variation) + VV_SEP;  
349 -  
350 - Result := Result + IntToStr(AConsequence.Points.B.Value) + VV_SEP;  
351 - Result := Result + IntToStr(AConsequence.Points.B.Variation) + VV_SEP;  
352 -  
353 - Result := Result + IntToStr(AConsequence.Points.G.Value) + VV_SEP;  
354 - Result := Result + IntToStr(AConsequence.Points.G.Variation) + VV_SEP;  
355 -  
356 - for CS in AConsequence.Style do  
357 - Result := Result + GetConsequenceStyleString(CS) + VV_SEP;  
358 - end;  
359 -  
360 -  
361 function GetChoiceString(AChoice : TPlayerChoice) : string; 374 function GetChoiceString(AChoice : TPlayerChoice) : string;
362 begin 375 begin
363 Result := GetRowString(AChoice.Row) + VV_SEP; 376 Result := GetRowString(AChoice.Row) + VV_SEP;
@@ -413,8 +426,8 @@ begin @@ -413,8 +426,8 @@ begin
413 426
414 with Contingencies[j] do 427 with Contingencies[j] do
415 begin 428 begin
416 - WriteString(LC,LCK+KEY_CONSEQUE,GetConsequenceString(Consequence));  
417 - WriteString(LC,LCK+KEY_RESPONSE,GetResponseString(Criteria)); 429 + WriteString(LC,LCK+KEY_CONSEQUE,Consequence.AsString);
  430 + WriteString(LC,LCK+KEY_CRITERIA,CriteriaString);
418 end; 431 end;
419 end; 432 end;
420 end; 433 end;
@@ -426,8 +439,7 @@ begin @@ -426,8 +439,7 @@ begin
426 begin 439 begin
427 LC := SEC_PLAYER+IntToStr(i+1); 440 LC := SEC_PLAYER+IntToStr(i+1);
428 WriteInteger(LC,KEY_PLAYER_TURN,AExperiment.Player[i].Turn); 441 WriteInteger(LC,KEY_PLAYER_TURN,AExperiment.Player[i].Turn);
429 - WriteString(LC,KEY_PLAYER_CHOICE_CURRENT,GetChoiceString(AExperiment.Player[i].Choice.Current));  
430 - WriteString(LC,KEY_PLAYER_CHOICE_LAST,GetChoiceString(AExperiment.Player[i].Choice.Last)); 442 + WriteString(LC,KEY_PLAYER_CHOICE_LAST,GetChoiceString(AExperiment.Player[i].Choice));
431 WriteString(LC,KEY_PLAYER_ID,AExperiment.Player[i].ID); 443 WriteString(LC,KEY_PLAYER_ID,AExperiment.Player[i].ID);
432 WriteString(LC,KEY_PLAYER_NICNAME,AExperiment.Player[i].Nicname); 444 WriteString(LC,KEY_PLAYER_NICNAME,AExperiment.Player[i].Nicname);
433 WriteString(LC,KEY_PLAYER_LOGIN,AExperiment.Player[i].Login); 445 WriteString(LC,KEY_PLAYER_LOGIN,AExperiment.Player[i].Login);
units/game_resources.pas
  Diff comments   View file @1a5f547
@@ -26,8 +26,7 @@ resourcestring @@ -26,8 +26,7 @@ resourcestring
26 SEC_PLAYER = 'Jogador.'; 26 SEC_PLAYER = 'Jogador.';
27 KEY_PLAYER_TEMP = 'Data.X'; 27 KEY_PLAYER_TEMP = 'Data.X';
28 KEY_PLAYER_TURN = 'Jogada'; 28 KEY_PLAYER_TURN = 'Jogada';
29 - KEY_PLAYER_CHOICE_CURRENT = 'Escolha.Atual';  
30 - KEY_PLAYER_CHOICE_LAST = 'Escolha.Passada'; 29 + KEY_PLAYER_CHOICE_LAST = 'Escolha';
31 KEY_PLAYER_ID = 'ID'; 30 KEY_PLAYER_ID = 'ID';
32 KEY_PLAYER_NICNAME = 'Apelido'; 31 KEY_PLAYER_NICNAME = 'Apelido';
33 KEY_PLAYER_LOGIN = 'Usuário'; 32 KEY_PLAYER_LOGIN = 'Usuário';
@@ -52,25 +51,26 @@ resourcestring @@ -52,25 +51,26 @@ resourcestring
52 //KEY_PROMPT_VALUE = 'Questão.Apresentar'; // BOOL,CSQPROMPTCODE 51 //KEY_PROMPT_VALUE = 'Questão.Apresentar'; // BOOL,CSQPROMPTCODE
53 KEY_PROMPT_STYLE = 'Questão.Estilo'; // string 52 KEY_PROMPT_STYLE = 'Questão.Estilo'; // string
54 KEY_PROMPT_MESSAGE = 'Questão.Mensagem'; // string 53 KEY_PROMPT_MESSAGE = 'Questão.Mensagem'; // string
55 -  
56 KEY_ENDCRITERIA = 'Critério.DeFinalizaçãoDaCondição'; //2,50,10,30, 54 KEY_ENDCRITERIA = 'Critério.DeFinalizaçãoDaCondição'; //2,50,10,30,
57 55
58 KEY_CONTINGENCY = 'Contingência.'; 56 KEY_CONTINGENCY = 'Contingência.';
59 KEY_METACONTINGENCY = 'Metacontingência.'; 57 KEY_METACONTINGENCY = 'Metacontingência.';
60 58
61 - KEY_RESPONSE = '.RespostaEsperada'; // ROW,COLOR,OPCODE 59 + // ROW,COLOR,OPCODE
  60 + KEY_CRITERIA = '.EsquemaDeReforço';
62 KEY_CONSEQUE = '.Consequência'; // A,B,G,CSQCODE 61 KEY_CONSEQUE = '.Consequência'; // A,B,G,CSQCODE
63 - KEY_CONSEQUE_MESSAGE = '.Consequência.Mensagem'; 62 + KEY_CONSEQUE_MESSAGE_PREPEND = '.Consequência.Mensagem.Prefixo';
  63 + KEY_CONSEQUE_MESSAGE_APPENDS = '.Consequência.Mensagem.Sufixo.Singular';
  64 + KEY_CONSEQUE_MESSAGE_APPENDP = '.Consequência.Mensagem.Sufixo.Plural';
  65 +
64 66
65 VAL_RESEARCHER = 'Pesquisador'; 67 VAL_RESEARCHER = 'Pesquisador';
66 68
67 DEF_END = '2,20,10,10,'; // which come first, 20 cycles | 10% entrelaçamentos in the last 10 cycles 69 DEF_END = '2,20,10,10,'; // which come first, 20 cycles | 10% entrelaçamentos in the last 10 cycles
68 DEF_POINTS = '0,0,0,'; 70 DEF_POINTS = '0,0,0,';
69 - DEF_CONSEQUENCE = '0,0,0,NON,50,50,';  
70 - DEF_METACONSEQUENCE_MESSAGE = 'Vocês produziram <$G> <$SG>.';  
71 - DEF_CONSEQUENCE_MESSAGE = '<$JOGADOR> ganhou <$A> <$SA> e <$B> <$SB>.'; 71 + DEF_CONSEQUENCE = '1,0|M,C,P,A,|$NICNAME|ponto|pontos|';
72 DEF_METARESPONSE = 'IMPAR,E,DIFERENTES,'; 72 DEF_METARESPONSE = 'IMPAR,E,DIFERENTES,';
73 - DEF_RESPONSE = 'PAR,E,INDIFERENTE,'; 73 + DEF_CRITERIA = 'PAR,E,INDIFERENTE,';
74 DEF_PROMPTMESSAGE = 'Vocês perderam <$G> item escolar. Desejam recuperá-lo gastando pontos do Tipo A?'; 74 DEF_PROMPTMESSAGE = 'Vocês perderam <$G> item escolar. Desejam recuperá-lo gastando pontos do Tipo A?';
75 75
76 const 76 const
@@ -113,10 +113,7 @@ const @@ -113,10 +113,7 @@ const
113 Password : ''; 113 Password : '';
114 Status : gpsWaiting; 114 Status : gpsWaiting;
115 Data : nil; 115 Data : nil;
116 - Choice : (  
117 - Current : (Row:grNone; Color:gcNone;);  
118 - Last : (Row:grNone; Color:gcNone;);  
119 - ); 116 + Choice : (Row:grNone; Color:gcNone;);
120 Points : (A:0; B:0); 117 Points : (A:0; B:0);
121 Turn : -1; 118 Turn : -1;
122 ); 119 );
@@ -124,20 +121,13 @@ const @@ -124,20 +121,13 @@ const
124 //C_OPERANT_1 : TContingency = 121 //C_OPERANT_1 : TContingency =
125 // ( 122 // (
126 // Consequence : ( 123 // Consequence : (
127 - // Style : [gscShowMessage,gscPoints];  
128 - // Points :(A : 0; B : 1; G : 0;); 124 + // Style : [gscShowMessage,gscPoints, gscB];
129 // Message : '<$JOGADOR> produziu 1 ponto do tipo B.'; 125 // Message : '<$JOGADOR> produziu 1 ponto do tipo B.';
130 - // Cycles : 0; // absolute,  
131 - // VariationMin: 0; // porcentage,  
132 - // VariationMax : 0; // porcentage  
133 - // Prompt : (  
134 - // Message : '';  
135 - // Style : [];  
136 - // );  
137 - // ); // prompt needs its own class 126 + // Value: 1;
  127 + // Variation:1;
138 // 128 //
139 - // Response : (  
140 - // Operator_ : goNONE; 129 + // Criteria : (
  130 + // Style : goNONE;
141 // Rows : [grEven]; 131 // Rows : [grEven];
142 // Colors : [gcNone]; 132 // Colors : [gcNone];
143 // ); 133 // );
@@ -148,23 +138,15 @@ const @@ -148,23 +138,15 @@ const
148 //C_OPERANT_2 : TContingency = 138 //C_OPERANT_2 : TContingency =
149 // ( 139 // (
150 // Consequence : ( 140 // Consequence : (
151 - // Style : [gscShowMessage,gscPoints];  
152 - // Points :(A : 3; B : 0; G : 0;); 141 + // Style : [gscShowMessage,gscPoints, gscA];
153 // Message : '<$JOGADOR> produziu 3 pontos do tipo A.'; 142 // Message : '<$JOGADOR> produziu 3 pontos do tipo A.';
154 - // Cycles : 0; // absolute,  
155 - // VariationMin: 0; // porcentage,  
156 - // VariationMax : 0; // porcentage  
157 - // Prompt : (  
158 - // Message : '';  
159 - // Style : [];  
160 - // );  
161 - // );  
162 // 143 //
163 - // Response : ( 144 + // Criteria : (
164 // Operator_ : goNONE; 145 // Operator_ : goNONE;
165 - // Rows : [grOdd]; 146 + // Rows : [grEven];
166 // Colors : [gcNone]; 147 // Colors : [gcNone];
167 // ); 148 // );
  149 + //
168 // Meta : False; 150 // Meta : False;
169 // ); 151 // );
170 152
units/string_methods.pas
  Diff comments   View file @1a5f547
@@ -57,16 +57,16 @@ end; @@ -57,16 +57,16 @@ end;
57 function GetRowFromString(S: string): TGameRow; 57 function GetRowFromString(S: string): TGameRow;
58 begin 58 begin
59 case UpperCase(S) of 59 case UpperCase(S) of
60 - '0', 'NONE' : Result := grNone;  
61 - '1', 'UM', 'ONE' : Result := grOne;  
62 - '2', 'DOIS', 'TWO' : Result := grTwo;  
63 - '3', 'TRÊS', 'THREE' : Result := grThree;  
64 - '4', 'QUATRO', 'FOUR' : Result := grFour;  
65 - '5', 'CINCO', 'FIVE' : Result := grFive;  
66 - '6', 'SEIS', 'SIX' : Result := grSix;  
67 - '7', 'SETE', 'SEVEN' : Result := grSeven;  
68 - '8', 'OITO', 'EIGHT' : Result := grEight;  
69 - '9', 'NOVE', 'NINE' : Result := grNine; 60 + 'NA', '.' , '0', 'NONE' : Result := grNone;
  61 + '01', '1', 'UM', 'ONE' : Result := grOne;
  62 + '02', '2', 'DOIS', 'TWO' : Result := grTwo;
  63 + '03', '3', 'TRÊS', 'THREE' : Result := grThree;
  64 + '04', '4', 'QUATRO', 'FOUR' : Result := grFour;
  65 + '05', '5', 'CINCO', 'FIVE' : Result := grFive;
  66 + '06', '6', 'SEIS', 'SIX' : Result := grSix;
  67 + '07', '7', 'SETE', 'SEVEN' : Result := grSeven;
  68 + '08', '8', 'OITO', 'EIGHT' : Result := grEight;
  69 + '09', '9', 'NOVE', 'NINE' : Result := grNine;
70 '10', 'DEZ', 'TEN' : Result := grTen; 70 '10', 'DEZ', 'TEN' : Result := grTen;
71 'PAR', 'EVEN' : Result := grEven; 71 'PAR', 'EVEN' : Result := grEven;
72 'IMPAR', 'ODD' : Result := grOdd; 72 'IMPAR', 'ODD' : Result := grOdd;
@@ -90,12 +90,12 @@ end; @@ -90,12 +90,12 @@ end;
90 function GetColorFromString(S: string): TGameColor; 90 function GetColorFromString(S: string): TGameColor;
91 begin 91 begin
92 case UpperCase(S) of 92 case UpperCase(S) of
93 - 'INDIFERENTE', 'NONE' : Result := gcNone;  
94 - 'AMARELO', 'YELLOW' : Result := gcYellow;  
95 - 'VERMELHO', 'RED' : Result := gcRed;  
96 - 'ROXO','MAGENTA', 'VIOLETA' : Result := gcMagenta;  
97 - 'AZUL', 'BLUE' : Result := gcBlue;  
98 - 'VERDE', 'GREEN' : Result := gcGreen; 93 + '.', 'INDIFERENTE', 'NONE' : Result := gcNone;
  94 + 'Y', 'AMARELO', 'YELLOW' : Result := gcYellow;
  95 + 'B', 'AZUL', 'BLUE' : Result := gcBlue;
  96 + 'G', 'VERDE', 'GREEN' : Result := gcGreen;
  97 + 'R', 'VERMELHO', 'RED' : Result := gcRed;
  98 + 'M', 'ROXO','MAGENTA', 'VIOLETA' : Result := gcMagenta;
99 '!=','<>','DIFERENTES', 'DIFFERENT' : Result := gcDiff; 99 '!=','<>','DIFERENTES', 'DIFFERENT' : Result := gcDiff;
100 '=','IGUAIS', 'EQUAL' : Result := gcEqual; 100 '=','IGUAIS', 'EQUAL' : Result := gcEqual;
101 end; 101 end;