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 1 object FormMatrixGame: TFormMatrixGame
2   - Left = -621
  2 + Left = 0
3 3 Height = 565
4 4 Top = 124
5   - Width = 1393
6   - HorzScrollBar.Page = 1393
  5 + Width = 1278
  6 + HorzScrollBar.Page = 1278
7 7 VertScrollBar.Page = 542
8 8 AutoScroll = True
9 9 Caption = 'FormMatrixGame'
10 10 ClientHeight = 555
11   - ClientWidth = 1393
  11 + ClientWidth = 1278
12 12 Font.Name = 'Monospace'
13 13 OnActivate = FormActivate
14 14 LCLVersion = '1.6.2.0'
... ... @@ -457,6 +457,7 @@ object FormMatrixGame: TFormMatrixGame
457 457 07544269746D617000000000
458 458 }
459 459 Text = 'Text'
  460 + Title = 'Caption'
460 461 Visible = False
461 462 OnClose = PopupNotifierClose
462 463 left = 112
... ...
form_matrixgame.pas
  Diff comments   View file @1a5f547
... ... @@ -220,7 +220,6 @@ end;
220 220 procedure TFormMatrixGame.TimerTimer(Sender: TObject);
221 221 begin
222 222 PopupNotifier.Visible:=False;
223   - Timer.Enabled := False;
224 223 end;
225 224  
226 225 procedure TFormMatrixGame.SetGameActor(AValue: TGameActor);
... ... @@ -281,7 +280,7 @@ end;
281 280 procedure TFormMatrixGame.PopupNotifierClose(Sender: TObject;
282 281 var CloseAction: TCloseAction);
283 282 begin
284   - // do nothing for now
  283 + Timer.Enabled := False;
285 284 end;
286 285  
287 286 procedure TFormMatrixGame.StringGridMatrixClick(Sender: TObject);
... ... @@ -309,7 +308,7 @@ end;
309 308  
310 309 procedure TFormMatrixGame.btnConfirmRowClick(Sender: TObject);
311 310 begin
312   - FGameControl.SendMessage(K_CHOICE);
  311 + FGameControl.SendRequest(K_CHOICE);
313 312 end;
314 313  
315 314 procedure TFormMatrixGame.Button3Click(Sender: TObject);
... ...
units/game_actors.pas
  Diff comments   View file @1a5f547
... ... @@ -5,7 +5,7 @@ unit game_actors;
5 5 interface
6 6  
7 7 uses
8   - Classes, SysUtils, PopupNotifier
  8 + Classes, SysUtils, Forms,PopupNotifier
9 9 , game_actors_point
10 10 ;
11 11 type
... ... @@ -19,7 +19,7 @@ type
19 19 TGameRow = (grNone,
20 20 grOne,grTwo,grThree,grFour,grFive,grSix,grSeven,grEight,grNine,grTen, // 10 rows
21 21 grEven,grOdd,
22   - grDiff,grAll,grNot,grSome); //meta only
  22 + grDiff,grEqual,grAll,grNot,grSome); //meta only
23 23  
24 24 TGameRows = set of TGameRow;
25 25  
... ... @@ -30,10 +30,10 @@ type
30 30 TGameColors = set of TGameColor;
31 31  
32 32 TGameEndCondition = (gecInterlockingPorcentage,gecAbsoluteCycles,gecWhichComeFirst);
33   - TGameOperator = (goNONE, goAND, goOR);
  33 + //TGameOperator = (goNONE, goAND, goOR);
34 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 37 TConsequenceStyle = set of TGameConsequenceStyle;
38 38  
39 39 TGamePromptStyle = (gsYes, gsNo, gsAll, gsMetacontingency, gsContingency, gsBasA, gsRevertPoints);
... ... @@ -43,6 +43,29 @@ type
43 43  
44 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 69 { TCriteria }
47 70  
48 71 TCriteria = record
... ... @@ -54,28 +77,49 @@ type
54 77 { TConsequence }
55 78  
56 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 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 100 end;
65 101  
66 102 { TContingency }
67 103  
68 104 TContingency = class(TComponent)
69 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 110 FOnCriteria: TNotifyEvent;
  111 + function RowMod(R:TGameRow):TGameRow;
72 112 procedure CriteriaEvent;
73 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 118 property OnCriteria : TNotifyEvent read FOnCriteria write FOncriteria;
78 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 123 end;
80 124  
81 125 { TContingencies }
... ... @@ -85,11 +129,14 @@ type
85 129 { TPrompt }
86 130  
87 131 TPrompt = class(TConsequence)
  132 + private
  133 + FPromptTargets : TContingencies; // need to test this
88 134 public
89 135 PromptStyle : TPromptStyle;
90   - PromptTargets : ^TContingencies;
91 136 PromptMessage : string;
92   - procedure Present; override;
  137 + public
  138 + procedure Present(Sender:TObject;ForGroup:Boolean);override;
  139 + property APromptTargets: TContingencies read FPromptTargets;
93 140 end;
94 141  
95 142 TEndConditionCriterium = record
... ... @@ -127,45 +174,211 @@ type
127 174 EndCriterium : TEndConditionCriterium; // to change from one condition to another
128 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 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 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 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 376 end;
165 377  
  378 +
166 379 { TPrompt }
167 380  
168   -procedure TPrompt.Present;
  381 +procedure TPrompt.Present(Sender: TObject; ForGroup: Boolean);
169 382  
170 383 function AskQuestion: boolean;
171 384 var
... ... @@ -202,16 +415,139 @@ procedure TPrompt.Present;
202 415 end;
203 416 end;
204 417 begin
205   - inherited Present;
  418 + inherited Present(Sender, ForGroup);
206 419 //SendMessage(AskQuestion);
207 420 end;
208 421  
209 422 { TConsequence }
210 423  
211   -procedure TConsequence.Present;
  424 +constructor TConsequence.Create(AOwner: TComponent; AP: TGamePoint;
  425 + AStyle: TConsequenceStyle; AAppendiceSingular, AAppendicePlural: UTF8String);
212 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 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 552 end.
217 553  
... ...
units/game_actors_point.pas
  Diff comments   View file @1a5f547
... ... @@ -13,16 +13,23 @@ type
13 13  
14 14 TGamePoint = class(TComponent)
15 15 private
  16 + FResult: integer;
16 17 FValue,
17 18 FVariation : integer;
  19 + function GetResult: integer;
  20 + function GetResultAsString: string;
18 21 function GetValue: integer;
19 22 procedure SetValue(AValue: integer);
20 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 29 property Value : integer read GetValue write SetValue;
25 30 property Variation : integer read FVariation write FVariation;
  31 + property AsString : string read GetResultAsString;
  32 + property ResultAsInteger : integer read GetResult;
26 33 end;
27 34  
28 35 //operator :=(I :integer) : TGamePoint;
... ... @@ -30,9 +37,11 @@ type
30 37 //
31 38 implementation
32 39  
  40 +uses strutils;
33 41 //operator:=(I: integer):TGamePoint;
34 42 //begin
35   -// Result := TGamePoint.Create(I);
  43 +// Result := ;
  44 +// Result.Value := I;
36 45 //end;
37 46 //
38 47 //operator:=(A: array of integer): TGamePoint;
... ... @@ -45,6 +54,17 @@ implementation
45 54 function TGamePoint.GetValue: integer;
46 55 begin
47 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 68 end;
49 69  
50 70 procedure TGamePoint.SetValue(AValue: integer);
... ... @@ -52,17 +72,88 @@ begin
52 72 FValue := AValue;
53 73 end;
54 74  
55   -constructor TGamePoint.Create(AValue: integer);
  75 +constructor TGamePoint.Create(AOwner: TComponent; AValue: integer);
56 76 begin
  77 + inherited Create(AOwner);
57 78 FValue := AValue;
  79 + FVariation:=0;
58 80 end;
59 81  
60   -constructor TGamePoint.Create(AValue : array of integer);
  82 +constructor TGamePoint.Create(AOwner: TComponent; AValue: array of integer);
61 83 begin
  84 + inherited Create(AOwner);
62 85 FValue := AValue[0];
63 86 FVariation := AValue[1];
64   - //Cycles := AValue[2];
65 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 158 end.
68 159  
... ...
units/game_control.pas
  Diff comments   View file @1a5f547
... ... @@ -86,13 +86,13 @@ const
86 86 K_QUESTION = '.Question';
87 87 //
88 88 K_STATUS = '.Status';
89   - K_CYCLES = '.OnCycleStart';
  89 + K_CYCLES = '.OnEndCycle';
90 90  
91 91 //K_RESPONSE =
92 92  
93 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 97 const
98 98 GA_ADMIN = 'Admin';
... ... @@ -134,12 +134,18 @@ begin
134 134  
135 135 // inform players
136 136  
  137 +{$IFDEF DEBUG}
  138 + WriteLn('TGameControl.NextTurn');
  139 +{$ENDIF}
137 140 end;
138 141  
139 142 procedure TGameControl.NextCycle(Sender: TObject);
140 143 begin
141 144 // prompt question to all players
142 145 FormMatrixGame.LabelExpCountCycle.Caption:=IntToStr(FExperiment.Condition[FExperiment.CurrentCondition].Cycles.Count);
  146 + {$IFDEF DEBUG}
  147 + WriteLn('TGameControl.NextTurn');
  148 + {$ENDIF}
143 149 end;
144 150  
145 151 procedure TGameControl.NextLineage(Sender: TObject);
... ... @@ -235,12 +241,12 @@ begin
235 241 Caption := P.Nicname+SysToUtf8(' (Você)' )
236 242 else
237 243 Caption := P.Nicname;
238   - i1 := Integer(P.Choice.Last.Row);
  244 + i1 := Integer(P.Choice.Row);
239 245 if i1 > 0 then
240 246 LabelLastRowCount.Caption := Format('%-*.*d', [1,2,i1])
241 247 else
242 248 LabelLastRowCount.Caption := 'NA';
243   - PanelLastColor.Color := GetColorFromCode(P.Choice.Last.Color);
  249 + PanelLastColor.Color := GetColorFromCode(P.Choice.Color);
244 250 Enabled := True;
245 251 Parent := FormMatrixGame.GBLastChoice;
246 252 end;
... ... @@ -385,12 +391,22 @@ var
385 391 M[i] := A[i];
386 392 end;
387 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 410 case FActor of
395 411 gaAdmin: begin
396 412 //M[2] := GA_ADMIN+M[2];// for now cannot Requests
... ... @@ -419,13 +435,6 @@ var
419 435 begin
420 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 438 K_CHAT_M : begin
430 439 //if (FActor = gaAdmin) and (not FExperiment.ResearcherCanChat) then Exit;
431 440 SetM([
... ... @@ -434,7 +443,12 @@ begin
434 443 , FormMatrixGame.ChatMemoSend.Lines.Text
435 444 ]);
436 445 end;
437   -
  446 + K_CHOICE : SetM([
  447 + AMessage
  448 + , FZMQActor.ID
  449 + , GetSelectedRowF(FormMatrixGame.StringGridMatrix)
  450 + , GetSelectedColorF(FormMatrixGame.StringGridMatrix)
  451 + ]);
438 452 end;
439 453  
440 454 case FActor of
... ... @@ -486,11 +500,11 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
486 500  
487 501 end;
488 502  
489   - procedure EnableMatrix(ATurn:integer);
  503 + procedure SetPMatrix(ATurn:integer; AEnabled:Boolean);
490 504 begin
491 505 if FExperiment.PlayerFromID[Self.ID].Turn = ATurn then
492 506 begin
493   - FormMatrixGame.StringGridMatrix.Enabled:=True;
  507 + FormMatrixGame.StringGridMatrix.Enabled:=AEnabled;
494 508 FormMatrixGame.StringGridMatrix.Options := FormMatrixGame.StringGridMatrix.Options-[goRowSelect];
495 509 FormMatrixGame.btnConfirmRow.Enabled:=True;
496 510 FormMatrixGame.btnConfirmRow.Caption:='Confirmar';
... ... @@ -520,7 +534,7 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
520 534 FormMatrixGame.btnConfirmRow.Caption:='OK';
521 535 end
522 536 else
523   - EnableMatrix(P.Turn+1);
  537 + SetPMatrix(P.Turn+1, True);
524 538 end;
525 539  
526 540 gaAdmin:begin
... ... @@ -542,7 +556,7 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
542 556 begin
543 557 PopUpPos.X := FormMatrixGame.StringGridMatrix.Left+FormMatrixGame.StringGridMatrix.Width;
544 558 PopUpPos.Y := FormMatrixGame.StringGridMatrix.Top;
545   - EnableMatrix(0);
  559 + SetPMatrix(0, True);
546 560 FormMatrixGame.PopupNotifier.Text:='É sua vez! Clique sobre uma linha da matrix e confirme sua escolha.';
547 561 FormMatrixGame.PopupNotifier.ShowAtPos(PopUpPos.X,PopUpPos.Y);
548 562 end
... ... @@ -556,6 +570,31 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
556 570 end;
557 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 598 procedure ReceiveChat;
560 599 begin
561 600 FormMatrixGame.ChatMemoRecv.Lines.Append(('['+AMessage[1]+']: ')+AMessage[2]);
... ... @@ -622,6 +661,7 @@ begin
622 661 if MHas(K_CHOICE) then ReceiveChoice;
623 662 if MHas(K_KICK) then SayGoodBye;
624 663 if MHas(K_START) then NotifyPlayers;
  664 + if MHas(K_CYCLES) then OnEndCycle;
625 665 end;
626 666  
627 667 // Here FActor is garanted to be a TZMQAdmin
... ... @@ -662,10 +702,8 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList);
662 702 P.Points.A:=0;
663 703 P.Points.B:=0;
664 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 707 // turns by entrance order or by random order
670 708 P.Turn := FExperiment.NextTurn;
671 709 FExperiment.Player[i] := P;
... ... @@ -716,11 +754,25 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList);
716 754 end;
717 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 768 begin
720 769 if MHas(K_LOGIN) then ReplyLoginRequest;
  770 + if MHas(K_CHOICE) then ValidateChoice;
721 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 776 procedure TGameControl.ReceiveReply(AReply: TStringList);
725 777 function MHas(const C : string) : Boolean;
726 778 begin
... ... @@ -752,11 +804,39 @@ procedure TGameControl.ReceiveReply(AReply: TStringList);
752 804 else
753 805 begin
754 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 808 {$ENDIF}
757 809 end;
758 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 840 procedure ResumePlayer;
761 841 begin
762 842  
... ... @@ -765,6 +845,7 @@ procedure TGameControl.ReceiveReply(AReply: TStringList);
765 845 begin
766 846 if MHas(K_RESUME+K_ARRIVED) then ResumePlayer;
767 847 if MHas(K_LOGIN+K_ARRIVED) then LoginAccepted;
  848 + if MHas(K_CHOICE+K_ARRIVED) then ChoiceValidated;
768 849 end;
769 850  
770 851  
... ...
units/game_experiment.pas
  Diff comments   View file @1a5f547
... ... @@ -2,6 +2,8 @@ unit game_experiment;
2 2  
3 3 {$mode objfpc}{$H+}
4 4  
  5 +{$DEFINE DEBUG}
  6 +
5 7 interface
6 8  
7 9 uses
... ... @@ -15,7 +17,6 @@ type
15 17 { TExperiment }
16 18  
17 19 TExperimentState = (xsWaiting,xsRunning,xsPaused,xsCanceled);
18   - TPlayers = array of TPlayer;
19 20 TConditions = array of TCondition;
20 21  
21 22 TExperiment = class(TComponent)
... ... @@ -43,6 +44,7 @@ type
43 44 FTurnsRandom : TStringList;
44 45 function GetCondition(I : Integer): TCondition;
45 46 function GetConditionsCount: integer;
  47 + function GetContingenciesCount(C: integer): integer;
46 48 function GetContingency(ACondition, I : integer): TContingency;
47 49 function GetNextTurn: integer;
48 50 function GetNextTurnPlayerID: UTF8string;
... ... @@ -56,6 +58,7 @@ type
56 58 function GetPlayerIsPlaying(AID : UTF8string): Boolean;
57 59 function GetPlayersCount: integer;
58 60 function GetInterlockingsIn(ALastCycles : integer):integer;
  61 + function GetConsequenceStringFromChoice(P:TPlayer): Utf8string;
59 62 procedure SetCondition(I : Integer; AValue: TCondition);
60 63 procedure SetContingency(ACondition, I : integer; AValue: TContingency);
61 64 procedure SetMatrixType(AValue: TGameMatrixType);
... ... @@ -93,6 +96,7 @@ type
93 96 property ConditionsCount : integer read GetConditionsCount;
94 97 property CurrentCondition : integer read FCurrentCondition write FCurrentCondition;
95 98 property Contingency[C, I : integer] : TContingency read GetContingency write SetContingency;
  99 + property ContingenciesCount[C:integer]:integer read GetContingenciesCount;
96 100 property ExperimentAim : UTF8string read FExperimentAim write FExperimentAim;
97 101 property ExperimentName : UTF8string read FExperimentName write FExperimentName;
98 102 property GenPlayersAsNeeded : Boolean read FGenPlayersAsNeeded write FGenPlayersAsNeeded;
... ... @@ -104,6 +108,7 @@ type
104 108 property PlayerIndexFromID[s : UTF8string]: integer read GetPlayerIndexFromID;
105 109 property PlayerAsString[P:TPlayer]: UTF8string read GetPlayerAsString;
106 110 property PlayerFromString[s : UTF8string]: TPlayer read GetPlayerFromString;
  111 + property ConsequenceStringFromChoice[P:Tplayer]:UTF8String read GetConsequenceStringFromChoice;
107 112 property ShowChat : Boolean read FShowChat write FShowChat;
108 113 property SendChatHistoryForNewPlayers : Boolean read FSendChatHistoryForNewPlayers write SetSendChatHistoryForNewPlayers;
109 114 property MatrixType : TGameMatrixType read FMatrixType write SetMatrixType;
... ... @@ -111,7 +116,6 @@ type
111 116 property NextTurn : integer read GetNextTurn;
112 117 property NextCycle : integer read GetNextCycle;
113 118 property NextCondition : integer read GetNextCondition;
114   -
115 119 property State : TExperimentState read FState write SetState;
116 120 public
117 121 property OnEndTurn : TNotifyEvent read FOnEndTurn write SetOnEndTurn;
... ... @@ -140,6 +144,11 @@ begin
140 144 Result := Length(FConditions);
141 145 end;
142 146  
  147 +function TExperiment.GetContingenciesCount(C: integer): integer;
  148 +begin
  149 + Result := Length(FConditions[C].Contingencies);
  150 +end;
  151 +
143 152 function TExperiment.GetContingency(ACondition, I : integer): TContingency;
144 153 begin
145 154 Result := FConditions[ACondition].Contingencies[I];
... ... @@ -161,6 +170,9 @@ begin
161 170 if Assigned(FOnEndCycle) then FOnEndCycle(Self);
162 171 NextCycle;
163 172 end;
  173 +{$IFDEF DEBUG}
  174 + WriteLn('TExperiment.GetNextTurn:',Result);
  175 +{$ENDIF}
164 176 end;
165 177  
166 178 function TExperiment.GetNextTurnPlayerID: UTF8string; // used during cycles
... ... @@ -183,6 +195,9 @@ begin
183 195 NextCondition;
184 196 end;
185 197 end;
  198 + {$IFDEF DEBUG}
  199 + WriteLn('TExperiment.GetNextCycle:',Result);
  200 + {$ENDIF}
186 201 end;
187 202  
188 203 function TExperiment.GetNextCondition: integer;
... ... @@ -221,7 +236,9 @@ begin
221 236 EndCondition
222 237  
223 238 end;
224   -
  239 + {$IFDEF DEBUG}
  240 + WriteLn('TExperiment.GetNextCondition:',Result);
  241 + {$ENDIF}
225 242 end;
226 243  
227 244 function TExperiment.GetPlayer(I : integer): TPlayer;
... ... @@ -312,8 +329,7 @@ begin
312 329 , P.Nicname
313 330 , GetPPointsString(P.Points)
314 331 , GetStatusString(P.Status)
315   - , GetChoiceString(P.Choice.Current)
316   - , GetChoiceString(P.Choice.Last)
  332 + , GetChoiceString(P.Choice)
317 333 , IntToStr(P.Turn)
318 334 ]);
319 335 for i := 0 to Length(M)-1 do
... ... @@ -384,9 +400,8 @@ begin
384 400 Result.Nicname := ExtractDelimited(2,s,['|']);
385 401 Result.Points := GetPPointsFromString(ExtractDelimited(3,s,['|']));
386 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 405 end;
391 406  
392 407 function TExperiment.GetPlayerIndexFromID(AID: UTF8string): integer;
... ... @@ -423,6 +438,20 @@ begin
423 438  
424 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 455 procedure TExperiment.SetCondition(I : Integer; AValue: TCondition);
427 456 begin
428 457 FConditions[I] := AValue;
... ... @@ -611,9 +640,9 @@ begin
611 640 if FFilename <> '' then
612 641 SaveExperimentToFile(Self,FFilename)
613 642 else
614   - {$IFDEF DEBUG}
615   - WriteLn(WARN_CANNOT_SAVE)
616   - {$ENDIF};
  643 +{$IFDEF DEBUG}
  644 + WriteLn(WARN_CANNOT_SAVE)
  645 +{$ENDIF};
617 646 end;
618 647  
619 648 procedure TExperiment.Clean;
... ...
units/game_file_methods.pas
  Diff comments   View file @1a5f547
... ... @@ -30,11 +30,24 @@ resourcestring
30 30  
31 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 35 function LoadExperimentFromResource(var AExperiment: TExperiment): Boolean;
36   -var i,j : integer;
  36 +var
37 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 51 begin
39 52 Result := False;
40 53 with AExperiment do
... ... @@ -53,19 +66,27 @@ begin
53 66 C := C_CONDITION_TEMPLATE;
54 67 with C do
55 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 75 ConditionName := SEC_CONDITION+IntToStr(1);
57 76 Turn.Count:=0;
58 77 Turn.Value:=2;
59 78 Turn.Random:=False;
  79 + Cycles.Count:=0;
  80 + Cycles.Value:=4;
  81 + Cycles.Generation:=0;
60 82 end;
61   - i := AppendCondition(C);
  83 + AppendCondition(C);
62 84 end;
63 85 end;
64 86  
65 87 function LoadExperimentFromFile(var AExperiment: TExperiment; AFilename: string):Boolean;
66 88 var
67 89 LIniFile : TCIniFile;
68   - LExperiment : TExperiment;
69 90  
70 91 //procedure HandleRootPath(var APath : string);
71 92 //begin
... ... @@ -101,27 +122,6 @@ var
101 122 Result.G := StrToIntDef(GetAndDelFirstValue(LS),0);
102 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 126 function GetChoiceFromString(S:string) : TPlayerChoice;
127 127 var
... ... @@ -172,11 +172,11 @@ var
172 172 // Experiment;
173 173 with LIniFile do
174 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 180 end;
181 181 end;
182 182  
... ... @@ -184,30 +184,68 @@ var
184 184 var
185 185 LS : string;
186 186 i : integer;
  187 + P : TPlayer;
187 188 begin
188 189 i := 0;
189 190 LS := SEC_PLAYER+IntToStr(i+1);
190 191 with LIniFile do
191 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 212 end;
206 213  
207 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 249 begin
212 250 if IsMeta then
213 251 LCK := KEY_METACONTINGENCY+IntToStr(i+1)
... ... @@ -216,72 +254,68 @@ var
216 254 end;
217 255 begin
218 256 LS := SEC_CONDITION+IntToStr(ACondition+1);
219   - i := 0;
220   - SetLCK;
  257 + i := AExperiment.AppendContingency(ACondition);
  258 + SetLCK(i);
221 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 268 end;
238 269  
239 270 procedure ReadConditions;
240 271 var
241 272 s1, LS : string;
242   - LCondition : integer;
  273 + i : integer;
  274 + C :TCondition;
243 275 begin
244   - LCondition := 0;
245   - LS := SEC_CONDITION+IntToStr(LCondition+1);
  276 + i := 0;
  277 + LS := SEC_CONDITION+IntToStr(i+1);
246 278 with LIniFile do
247 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 319 end;
286 320  
287 321 begin
... ... @@ -292,7 +326,7 @@ begin
292 326 with LIniFile do
293 327 if SectionExists(SEC_EXPERIMENT) then
294 328 begin
295   - LExperiment.Create(AExperiment.Owner);
  329 + AExperiment := TExperiment.Create(AExperiment.Owner);
296 330 ReadExperiment;
297 331 ReadPlayers;
298 332 ReadConditions;
... ... @@ -303,10 +337,6 @@ begin
303 337 LIniFile.Free;
304 338 Exit;
305 339 end;
306   - Result := True;
307   - LIniFile.Free;
308   - AExperiment := LExperiment;
309   - LExperiment.Free;
310 340 end
311 341 else
312 342 ShowMessage(ERROR_FILE_NOT_FOUND);
... ... @@ -341,23 +371,6 @@ var
341 371 Result := Result + IntToStr(APoints.G) + VV_SEP;
342 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 374 function GetChoiceString(AChoice : TPlayerChoice) : string;
362 375 begin
363 376 Result := GetRowString(AChoice.Row) + VV_SEP;
... ... @@ -413,8 +426,8 @@ begin
413 426  
414 427 with Contingencies[j] do
415 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 431 end;
419 432 end;
420 433 end;
... ... @@ -426,8 +439,7 @@ begin
426 439 begin
427 440 LC := SEC_PLAYER+IntToStr(i+1);
428 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 443 WriteString(LC,KEY_PLAYER_ID,AExperiment.Player[i].ID);
432 444 WriteString(LC,KEY_PLAYER_NICNAME,AExperiment.Player[i].Nicname);
433 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 26 SEC_PLAYER = 'Jogador.';
27 27 KEY_PLAYER_TEMP = 'Data.X';
28 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 30 KEY_PLAYER_ID = 'ID';
32 31 KEY_PLAYER_NICNAME = 'Apelido';
33 32 KEY_PLAYER_LOGIN = 'Usuário';
... ... @@ -52,25 +51,26 @@ resourcestring
52 51 //KEY_PROMPT_VALUE = 'Questão.Apresentar'; // BOOL,CSQPROMPTCODE
53 52 KEY_PROMPT_STYLE = 'Questão.Estilo'; // string
54 53 KEY_PROMPT_MESSAGE = 'Questão.Mensagem'; // string
55   -
56 54 KEY_ENDCRITERIA = 'Critério.DeFinalizaçãoDaCondição'; //2,50,10,30,
57 55  
58 56 KEY_CONTINGENCY = 'Contingência.';
59 57 KEY_METACONTINGENCY = 'Metacontingência.';
60 58  
61   - KEY_RESPONSE = '.RespostaEsperada'; // ROW,COLOR,OPCODE
  59 + // ROW,COLOR,OPCODE
  60 + KEY_CRITERIA = '.EsquemaDeReforço';
62 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 67 VAL_RESEARCHER = 'Pesquisador';
66 68  
67 69 DEF_END = '2,20,10,10,'; // which come first, 20 cycles | 10% entrelaçamentos in the last 10 cycles
68 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 72 DEF_METARESPONSE = 'IMPAR,E,DIFERENTES,';
73   - DEF_RESPONSE = 'PAR,E,INDIFERENTE,';
  73 + DEF_CRITERIA = 'PAR,E,INDIFERENTE,';
74 74 DEF_PROMPTMESSAGE = 'Vocês perderam <$G> item escolar. Desejam recuperá-lo gastando pontos do Tipo A?';
75 75  
76 76 const
... ... @@ -113,10 +113,7 @@ const
113 113 Password : '';
114 114 Status : gpsWaiting;
115 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 117 Points : (A:0; B:0);
121 118 Turn : -1;
122 119 );
... ... @@ -124,20 +121,13 @@ const
124 121 //C_OPERANT_1 : TContingency =
125 122 // (
126 123 // Consequence : (
127   - // Style : [gscShowMessage,gscPoints];
128   - // Points :(A : 0; B : 1; G : 0;);
  124 + // Style : [gscShowMessage,gscPoints, gscB];
129 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 131 // Rows : [grEven];
142 132 // Colors : [gcNone];
143 133 // );
... ... @@ -148,23 +138,15 @@ const
148 138 //C_OPERANT_2 : TContingency =
149 139 // (
150 140 // Consequence : (
151   - // Style : [gscShowMessage,gscPoints];
152   - // Points :(A : 3; B : 0; G : 0;);
  141 + // Style : [gscShowMessage,gscPoints, gscA];
153 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 145 // Operator_ : goNONE;
165   - // Rows : [grOdd];
  146 + // Rows : [grEven];
166 147 // Colors : [gcNone];
167 148 // );
  149 + //
168 150 // Meta : False;
169 151 // );
170 152  
... ...
units/string_methods.pas
  Diff comments   View file @1a5f547
... ... @@ -57,16 +57,16 @@ end;
57 57 function GetRowFromString(S: string): TGameRow;
58 58 begin
59 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 70 '10', 'DEZ', 'TEN' : Result := grTen;
71 71 'PAR', 'EVEN' : Result := grEven;
72 72 'IMPAR', 'ODD' : Result := grOdd;
... ... @@ -90,12 +90,12 @@ end;
90 90 function GetColorFromString(S: string): TGameColor;
91 91 begin
92 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 99 '!=','<>','DIFERENTES', 'DIFFERENT' : Result := gcDiff;
100 100 '=','IGUAIS', 'EQUAL' : Result := gcEqual;
101 101 end;
... ...