Download as
Browse Code »

Commit eeff651b8083cc60a24eeec256a8092617549773

Authored by Carlos Picanco
1 parent e3d84bd8
Exists in master

add prototype workflow

Showing 2 changed files with 118 additions and 50 deletions   Show diff stats
units/game_control.pas
  Diff comments   View file @eeff651
... ... @@ -45,16 +45,21 @@ type
45 45 private
46 46 function CanStartExperiment : Boolean;
47 47 procedure KickPlayer(AID:string);
48   - procedure StartCycle;
49   - procedure StartCondition;
50   - procedure StartExperiment;
51   - procedure StartTurn;
  48 + procedure NextTurn(Sender: TObject);
  49 + procedure NextCycle(Sender: TObject);
  50 + procedure NextLineage(Sender: TObject);
  51 + procedure NextCondition(Sender: TObject);
  52 + procedure EndExperiment(Sender: TObject);
52 53 public
53 54 constructor Create(AOwner : TComponent);override;
54 55 destructor Destroy; override;
55 56 procedure SetMatrix;
56 57 procedure SendRequest(ARequest : UTF8string);
57 58 procedure SendMessage(AMessage : UTF8string);
  59 + procedure Cancel;
  60 + procedure Start;
  61 + procedure Pause;
  62 + procedure Resume;
58 63 property Experiment : TExperiment read FExperiment write FExperiment;
59 64 property ID : string read FID;
60 65 property RowBase : integer read FRowBase write SetRowBase;
... ... @@ -76,6 +81,7 @@ const
76 81 K_DATA_A = '.Data';
77 82 K_LOGIN = '.Login';
78 83 K_KICK = '.Kick';
  84 + K_QUESTION = '.Question';
79 85 //
80 86 K_STATUS = '.Status';
81 87 K_CYCLES = '.OnCycleStart';
... ... @@ -119,6 +125,52 @@ begin
119 125 FZMQActor.SendMessage([K_KICK, AID]);
120 126 end;
121 127  
  128 +procedure TGameControl.NextTurn(Sender: TObject);
  129 +begin
  130 + // inform players
  131 +end;
  132 +
  133 +procedure TGameControl.NextCycle(Sender: TObject);
  134 +begin
  135 + // prompt question to all players
  136 +end;
  137 +
  138 +procedure TGameControl.NextLineage(Sender: TObject);
  139 +begin
  140 +
  141 +end;
  142 +
  143 +procedure TGameControl.NextCondition(Sender: TObject);
  144 +begin
  145 + // append OnStart data
  146 + //FExperiment.Condition[FExperiment.CurrentCondition].Points.OnStart.A;
  147 + //FExperiment.Condition[FExperiment.CurrentCondition].Points.OnStart.B;
  148 + //FExperiment.Condition[FExperiment.CurrentCondition].Points.OnStart.G;
  149 +
  150 + // append which player
  151 +end;
  152 +
  153 +procedure TGameControl.EndExperiment(Sender: TObject);
  154 +begin
  155 +
  156 +end;
  157 +
  158 +procedure TGameControl.Start;
  159 +begin
  160 + // basic data/csv setup
  161 + // wait for players
  162 +end;
  163 +
  164 +procedure TGameControl.Pause;
  165 +begin
  166 +
  167 +end;
  168 +
  169 +procedure TGameControl.Resume;
  170 +begin
  171 +
  172 +end;
  173 +
122 174 function TGameControl.GetPlayerBox(AID: string): TPlayerBox;
123 175 var i : integer;
124 176 begin
... ... @@ -251,26 +303,6 @@ begin
251 303 FRowBase:=AValue;
252 304 end;
253 305  
254   -procedure TGameControl.StartCycle;
255   -begin
256   -
257   -end;
258   -
259   -procedure TGameControl.StartCondition;
260   -begin
261   - // append OnStart data
262   - //FExperiment.Condition[FExperiment.CurrentCondition].Points.OnStart.A;
263   - //FExperiment.Condition[FExperiment.CurrentCondition].Points.OnStart.B;
264   - //FExperiment.Condition[FExperiment.CurrentCondition].Points.OnStart.G;
265   -
266   - // append which player
267   -end;
268   -
269   -procedure TGameControl.StartExperiment;
270   -begin
271   -
272   -end;
273   -
274 306 procedure TGameControl.StartTurn;
275 307 begin
276 308 FormMatrixGame.btnConfirmRow.Enabled:=True;
... ... @@ -301,6 +333,12 @@ begin
301 333 MustDrawDotsClear:=False;
302 334  
303 335 FExperiment := TExperiment.Create(FZMQActor.Owner);
  336 + FExperiment.OnEndTurn := @NextTurn;
  337 + FExperiment.OnEndCycle := @NextCycle;
  338 + FExperiment.OnEndGeneration:=@NextLineage;
  339 + FExperiment.OnEndCondition:= @NextCondition;
  340 + FExperiment.OnEndExperiment:= @EndExperiment;
  341 +
304 342 SendRequest(K_LOGIN);
305 343 end;
306 344  
... ... @@ -391,6 +429,11 @@ begin
391 429 FZMQActor.SendMessage(M);
392 430 end;
393 431  
  432 +procedure TGameControl.Cancel;
  433 +begin
  434 +
  435 +end;
  436 +
394 437 // Here FActor is garanted to be a TZMQPlayer
395 438 procedure TGameControl.ReceiveMessage(AMessage: TStringList);
396 439 function MHas(const C : string) : Boolean;
... ... @@ -439,8 +482,6 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
439 482 gaAdmin:begin
440 483 // if last choice in cycle then end cycle
441 484 FExperiment.NextTurn;
442   - Inc(FExperiment.Condition[FExperiment.CurrentCondition].Turn.Count);
443   -
444 485 end;
445 486 end;
446 487 end;
... ...
units/game_experiment.pas
  Diff comments   View file @eeff651
... ... @@ -24,6 +24,7 @@ type
24 24 FExperimentName,
25 25 FFilename,
26 26 FResearcher : UTF8string;
  27 + FOnEndTurn: TNotifyEvent;
27 28 FOnEndCondition: TNotifyEvent;
28 29 FOnEndCycle: TNotifyEvent;
29 30 FOnEndExperiment: TNotifyEvent;
... ... @@ -53,6 +54,7 @@ type
53 54 function GetPlayerIndexFromID(AID : UTF8string): integer;
54 55 function GetPlayerIsPlaying(AID : UTF8string): Boolean;
55 56 function GetPlayersCount: integer;
  57 + function GetInterlockingsIn(ALastCycles : integer):integer;
56 58 procedure SetCondition(I : Integer; AValue: TCondition);
57 59 procedure SetContingency(ACondition, I : integer; AValue: TContingency);
58 60 procedure SetMatrixType(AValue: TGameMatrixType);
... ... @@ -60,6 +62,7 @@ type
60 62 procedure SetOnEndCycle(AValue: TNotifyEvent);
61 63 procedure SetOnEndExperiment(AValue: TNotifyEvent);
62 64 procedure SetOnEndGeneration(AValue: TNotifyEvent);
  65 + procedure SetOnEndTurn(AValue: TNotifyEvent);
63 66 procedure SetPlayer(I : integer; AValue: TPlayer); overload;
64 67 procedure SetPlayer(S : UTF8string ; AValue: TPlayer); overload;
65 68 procedure SetResearcherCanChat(AValue: Boolean);
... ... @@ -92,6 +95,7 @@ type
92 95 property ExperimentAim : UTF8string read FExperimentAim write FExperimentAim;
93 96 property ExperimentName : UTF8string read FExperimentName write FExperimentName;
94 97 property GenPlayersAsNeeded : Boolean read FGenPlayersAsNeeded write FGenPlayersAsNeeded;
  98 + property InterlockingsIn[i:integer]:integer read GetInterlockingsIn;
95 99 property Player[I : integer] : TPlayer read GetPlayer write SetPlayer;
96 100 property PlayerFromID[S : UTF8string ] : TPlayer read GetPlayer write SetPlayer;
97 101 property PlayersCount : integer read GetPlayersCount;
... ... @@ -106,8 +110,10 @@ type
106 110 property NextTurn : integer read GetNextTurn;
107 111 property NextCycle : integer read GetNextCycle;
108 112 property NextCondition : integer read GetNextCondition;
  113 +
109 114 property State : TExperimentState read FState write SetState;
110 115 public
  116 + property OnEndTurn : TNotifyEvent read FOnEndTurn write SetOnEndTurn;
111 117 property OnEndCycle : TNotifyEvent read FOnEndCycle write SetOnEndCycle;
112 118 property OnEndGeneration : TNotifyEvent read FOnEndGeneration write SetOnEndGeneration;
113 119 property OnEndCondition : TNotifyEvent read FOnEndCondition write SetOnEndCondition;
... ... @@ -142,7 +148,10 @@ function TExperiment.GetNextTurn: integer; // used during player arriving
142 148 begin
143 149 Result := FConditions[CurrentCondition].Turn.Count;
144 150 if FConditions[CurrentCondition].Turn.Count < FConditions[CurrentCondition].Turn.Value then
145   - Inc(FConditions[CurrentCondition].Turn.Count)
  151 + begin
  152 + Inc(FConditions[CurrentCondition].Turn.Count);
  153 + if Assigned(FOnEndTurn) then FOnEndTurn(Self);
  154 + end
146 155 else
147 156 begin
148 157 FConditions[CurrentCondition].Turn.Count := 0;
... ... @@ -171,35 +180,42 @@ begin
171 180 end;
172 181  
173 182 function TExperiment.GetNextCondition: integer;
174   -var LCycles : integer;
  183 +var
  184 + LAbsCycles : integer;
  185 + LInterlocks : integer;
  186 +
  187 + procedure EndCondition;
  188 + begin
  189 + Inc(CurrentCondition);
  190 + if Assigned(FOnEndCondition) then FOnEndCondition(Self);
  191 + end;
  192 +
175 193 begin
176 194 Inc(FConditions[CurrentCondition].Cycles.Generation);
177 195 Result := CurrentCondition;
178   - LCycles := (FConditions[CurrentCondition].Cycles.Value *
  196 + LAbsCycles := (FConditions[CurrentCondition].Cycles.Value *
179 197 FConditions[CurrentCondition].Cycles.Generation) + FConditions[CurrentCondition].Cycles.Count;
180 198  
181   - if FConditions[CurrentCondition].EndCriterium.Value = gecAbsoluteCycles then
182   - begin
183   - if LCycles < FConditions[CurrentCondition].EndCriterium.AbsoluteCycles then
184   - // do nothing
185   - else
186   - begin
187   - Inc(CurrentCondition);
188   - FConditions[CurrentCondition].Turn.Count := 0;
189   - Inc(FConditions[CurrentCondition].Cycles.Count);
190   - if Assigned(FOnEndCondition) then FOnEndCondition(Self);
191   - end;
192   - end;
  199 + // interlockings in last x cycles
  200 + LInterlocks := InterlockingsIn(FConditions[CurrentCondition].EndCriterium.LastCycles);
  201 + case FConditions[CurrentCondition].EndCriterium.Value of
  202 + gecWhichComeFirst:
  203 + begin
  204 + if (LAbsCycles = FConditions[CurrentCondition].EndCriterium.AbsoluteCycles) or
  205 + (LInterlocks = FConditions[CurrentCondition].EndCriterium.InterlockingPorcentage) then
  206 + EndCondition;
  207 +
  208 + end;
  209 + gecAbsoluteCycles:
  210 + if LAbsCycles = FConditions[CurrentCondition].EndCriterium.AbsoluteCycles then
  211 + EndCondition;
  212 +
  213 + gecInterlockingPorcentage:
  214 + if LInterlocks = FConditions[CurrentCondition].EndCriterium.InterlockingPorcentage then
  215 + EndCondition
  216 +
  217 + end;
193 218  
194   -//
195   -// if FConditions[CurrentCondition].Turn.Count < FConditions[CurrentCondition].Turn.Value then
196   -// Inc(FConditions[CurrentCondition].Turn.Count
197   -// else
198   -// begin
199   -// FConditions[CurrentCondition].Turn.Count := 0;
200   -// Inc(FConditions[CurrentCondition].Cycles.Count);
201   -// if Assigned(FOnEndCycle) then FOnEndCycle(Self);
202   -// end;
203 219 end;
204 220  
205 221 function TExperiment.GetPlayer(I : integer): TPlayer;
... ... @@ -394,6 +410,11 @@ begin
394 410 Result := Length(FPlayers);
395 411 end;
396 412  
  413 +function TExperiment.GetInterlockingsIn(ALastCycles: integer): integer;
  414 +begin
  415 +
  416 +end;
  417 +
397 418 procedure TExperiment.SetCondition(I : Integer; AValue: TCondition);
398 419 begin
399 420 FConditions[I] := AValue;
... ... @@ -434,6 +455,12 @@ begin
434 455 FOnEndGeneration:=AValue;
435 456 end;
436 457  
  458 +procedure TExperiment.SetOnEndTurn(AValue: TNotifyEvent);
  459 +begin
  460 + if FOnEndTurn=AValue then Exit;
  461 + FOnEndTurn:=AValue;
  462 +end;
  463 +
437 464  
438 465 procedure TExperiment.SetPlayer(I : integer; AValue: TPlayer);
439 466 begin
... ...