Download as
Browse Code »

Commit fa790dab883feabf0c8eb40cc45b9141bd19a3cf

Authored by Carlos Picanco
1 parent 81caf878
Exists in master

delete wrongly commited files

Showing 7 changed files with 1 additions and 1191 deletions   Show diff stats
.gitignore
  Diff comments   View file @fa790da
  1 +*/backup/*
1 2 id
2 3 /P*/*
3 4 *.zip
4 5 \ No newline at end of file
... ...
backup/form_chooseactor.lfm
View file @81caf87
... ... @@ -1,42 +0,0 @@
1   -object FormChooseActor: TFormChooseActor
2   - Left = 416
3   - Height = 240
4   - Top = 194
5   - Width = 320
6   - BorderStyle = bsNone
7   - Caption = 'FormChooseActor'
8   - ClientHeight = 240
9   - ClientWidth = 320
10   - OnCloseQuery = FormCloseQuery
11   - Position = poScreenCenter
12   - LCLVersion = '1.6.2.0'
13   - object btnAdmin: TButton
14   - Left = 64
15   - Height = 25
16   - Top = 70
17   - Width = 184
18   - Caption = 'Administrador'
19   - OnClick = btnAdminClick
20   - TabOrder = 0
21   - end
22   - object btnPlayer: TButton
23   - Left = 64
24   - Height = 25
25   - Top = 125
26   - Width = 179
27   - Caption = 'Jogador'
28   - OnClick = btnPlayerClick
29   - TabOrder = 1
30   - end
31   - object btnPlayerResume: TButton
32   - Left = 50
33   - Height = 140
34   - Top = 50
35   - Width = 220
36   - Align = alClient
37   - BorderSpacing.Around = 50
38   - Caption = 'ENTRAR'
39   - OnClick = btnPlayerResumeClick
40   - TabOrder = 2
41   - end
42   -end
backup/form_chooseactor.pas
View file @81caf87
... ... @@ -1,90 +0,0 @@
1   -unit form_chooseactor;
2   -
3   -{$mode objfpc}{$H+}
4   -
5   -interface
6   -
7   -uses
8   - Classes, SysUtils, FileUtil, Forms, Controls,
9   - Graphics, Dialogs, StdCtrls,ExtCtrls, LCLType
10   - , game_actors
11   - ;
12   -
13   -type
14   -
15   - { TFormChooseActor }
16   -
17   - TFormChooseActor = class(TForm)
18   - btnAdmin: TButton;
19   - btnPlayer: TButton;
20   - btnPlayerResume: TButton;
21   - procedure btnAdminClick(Sender: TObject);
22   - procedure btnPlayerClick(Sender: TObject);
23   - procedure btnPlayerResumeClick(Sender: TObject);
24   - procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
25   - //procedure FormCreate(Sender: TObject);
26   - private
27   - FGameActor: TGameActor;
28   - FCanClose : Boolean;
29   - FStyle: string;
30   - procedure SetStyle(AValue: string);
31   - { private declarations }
32   - public
33   - property GameActor : TGameActor read FGameActor;
34   - property Style : string read FStyle write SetStyle;
35   - end;
36   -
37   -var
38   - FormChooseActor: TFormChooseActor;
39   -
40   -implementation
41   -
42   -{$R *.lfm}
43   -
44   -{ TFormChooseActor }
45   -
46   -procedure TFormChooseActor.btnAdminClick(Sender: TObject);
47   -begin
48   - FGameActor:=gaAdmin;
49   - FCanClose := True;
50   - ModalResult:=1;
51   -end;
52   -
53   -procedure TFormChooseActor.btnPlayerClick(Sender: TObject);
54   -begin
55   - FGameActor:=gaPlayer;
56   - FCanClose := True;
57   - ModalResult:=1;
58   -end;
59   -
60   -procedure TFormChooseActor.btnPlayerResumeClick(Sender: TObject);
61   -begin
62   - FCanClose := True;
63   - ModalResult:=1;
64   -end;
65   -
66   -procedure TFormChooseActor.FormCloseQuery(Sender: TObject; var CanClose: boolean
67   - );
68   -begin
69   - CanClose := FCanClose;
70   -end;
71   -
72   -//procedure TFormChooseActor.FormCreate(Sender: TObject);
73   -//begin
74   -// FCanClose := True;
75   -//end;
76   -
77   -procedure TFormChooseActor.SetStyle(AValue: string);
78   -begin
79   - if FStyle=AValue then Exit;
80   - case AValue of
81   - '.Arrived': btnPlayerResume.Visible:=False;
82   - '.Left': btnPlayerResume.Visible:=True;
83   - end;
84   - FStyle:=AValue;
85   -end;
86   -
87   -
88   -
89   -end.
90   -
units/backup/game_dialogs.lfm
View file @81caf87
... ... @@ -1,18 +0,0 @@
1   -object DataModule2: TDataModule2
2   - OldCreateOrder = False
3   - Height = 210
4   - HorizontalOffset = 375
5   - VerticalOffset = 243
6   - Width = 412
7   - object OpenDialog: TOpenDialog
8   - Width = 862
9   - Height = 434
10   - Title = 'Abrir Experimento'
11   - DefaultExt = '.txt'
12   - FileName = '/home/rafael/free-pascal/published'
13   - Filter = 'txt|*.TXT|ini|*.INI'
14   - InitialDir = '/home/rafael/free-pascal/'
15   - left = 32
16   - top = 8
17   - end
18   -end
units/backup/game_experiment.pas
View file @81caf87
... ... @@ -1,782 +0,0 @@
1   -{
2   - Stimulus Control
3   - Copyright (C) 2014-2016 Carlos Rafael Fernandes Picanço, Universidade Federal do Pará.
4   -
5   - The present file is distributed under the terms of the GNU General Public License (GPL v3.0).
6   -
7   - You should have received a copy of the GNU General Public License
8   - along with this program. If not, see <http://www.gnu.org/licenses/>.
9   -}
10   -unit game_experiment;
11   -
12   -{$mode objfpc}{$H+}
13   -
14   -interface
15   -
16   -uses
17   - Classes, SysUtils
18   - , game_actors
19   - , regdata
20   - ;
21   -
22   -type
23   -
24   - { TExperiment }
25   -
26   - TExperimentState = (xsWaiting,xsRunning,xsPaused,xsCanceled);
27   - TConditions = array of TCondition;
28   -
29   - TExperiment = class(TComponent)
30   - private
31   - FExperimentAim,
32   - FExperimentName,
33   - FFilename,
34   - FResearcher : string;
35   - FGenPlayersAsNeeded : Boolean;
36   - FResearcherCanChat: Boolean;
37   - FResearcherCanPlay: Boolean;
38   - FSendChatHistoryForNewPlayers: Boolean;
39   - FShowChat: Boolean;
40   - FMatrixType: TGameMatrixType;
41   - private
42   - FLastReportColNames : string;
43   - FRegData : TRegData;
44   - FPlayers : TPlayers;
45   - FCurrentCondition : integer;
46   - FConditions : TConditions;
47   - FState: TExperimentState;
48   - FTurnsRandom : TStringList;
49   - function GetCondition(I : Integer): TCondition;
50   - function GetConditionsCount: integer;
51   - function GetContingenciesCount(C: integer): integer;
52   - function GetContingency(ACondition, I : integer): TContingency;
53   - function GetNextTurn: integer;
54   - function GetNextTurnPlayerID: UTF8string;
55   - function GetNextCycle:integer;
56   - function GetNextCondition:integer;
57   - function GetCurrentAbsoluteCycle : integer;
58   - function GetPlayer(I : integer): TPlayer; overload;
59   - function GetPlayer(AID : UTF8string): TPlayer; overload;
60   - function AliasPlayerAsString(P: TPlayer): UTF8string;
61   - function AliasPlayerFromString(s : UTF8string): TPlayer;
62   - function GetPlayerIndexFromID(AID : UTF8string): integer;
63   - function GetPlayerIsPlaying(AID : UTF8string): Boolean;
64   - function GetPlayersCount: integer;
65   - function GetInterlockingsIn(ALastCycles : integer):integer;
66   - function GetConsequenceStringFromChoice(P:TPlayer): Utf8string;
67   - function GetConsequenceStringFromChoices:UTF8String;
68   - procedure CheckNeedForRandomTurns;
69   - procedure SetCondition(I : Integer; AValue: TCondition);
70   - procedure SetContingency(ACondition, I : integer; AValue: TContingency);
71   - procedure SetMatrixType(AValue: TGameMatrixType);
72   - procedure SetOnConsequence(AValue: TNotifyEvent);
73   - procedure SetOnEndCondition(AValue: TNotifyEvent);
74   - procedure SetOnEndCycle(AValue: TNotifyEvent);
75   - procedure SetOnEndExperiment(AValue: TNotifyEvent);
76   - procedure SetOnEndGeneration(AValue: TNotifyEvent);
77   - procedure SetOnEndTurn(AValue: TNotifyEvent);
78   - procedure SetOnInterlocking(AValue: TNotifyEvent);
79   - procedure SetPlayer(I : integer; AValue: TPlayer); overload;
80   - procedure SetPlayer(S : UTF8string ; AValue: TPlayer); overload;
81   - procedure SetResearcherCanChat(AValue: Boolean);
82   - procedure SetResearcherCanPlay(AValue: Boolean);
83   - procedure SetSendChatHistoryForNewPlayers(AValue: Boolean);
84   - procedure SetState(AValue: TExperimentState);
85   - private
86   - FChangeGeneration: string;
87   - FOnConsequence: TNotifyEvent;
88   - FOnInterlocking: TNotifyEvent;
89   - FOnEndTurn: TNotifyEvent;
90   - FOnEndCondition: TNotifyEvent;
91   - FOnEndCycle: TNotifyEvent;
92   - FOnEndExperiment: TNotifyEvent;
93   - FOnEndGeneration: TNotifyEvent;
94   - procedure Consequence(Sender : TObject);
95   - function GetPlayerToKick: string;
96   - procedure Interlocking(Sender : TObject);
97   - procedure SetPlayersQueue(AValue: string);
98   - procedure WriteReportHeader;
99   - procedure WriteReportRowNames;
100   - procedure WriteReportRow;
101   - public
102   - constructor Create(AOwner:TComponent);override;
103   - constructor Create(AOwner:TComponent; AppPath:string);overload;
104   - constructor Create(AOwner:TComponent; AFilename, AppPath:string); overload;
105   - destructor Destroy; override;
106   - function LoadFromFile(AFilename: string):Boolean;
107   - function LoadFromGenerator:Boolean;
108   - procedure SaveToFile(AFilename: string); overload;
109   - procedure SaveToFile; overload;
110   - procedure Clean;
111   - procedure Play;
112   - procedure WriteReportRowPrompt;
113   - property ExperimentAim : string read FExperimentAim write FExperimentAim;
114   - property ExperimentName : string read FExperimentName write FExperimentName;
115   - property GenPlayersAsNeeded : Boolean read FGenPlayersAsNeeded write FGenPlayersAsNeeded;
116   - property ResearcherCanPlay : Boolean read FResearcherCanPlay write SetResearcherCanPlay;
117   - property ResearcherCanChat : Boolean read FResearcherCanChat write SetResearcherCanChat;
118   - property Researcher : string read FResearcher write FResearcher;
119   - property ShowChat : Boolean read FShowChat write FShowChat;
120   - property SendChatHistoryForNewPlayers : Boolean read FSendChatHistoryForNewPlayers write SetSendChatHistoryForNewPlayers;
121   - property MatrixType : TGameMatrixType read FMatrixType write SetMatrixType;
122   - public
123   - function AppendCondition : integer; overload;
124   - function AppendCondition(ACondition : TCondition) : integer;overload;
125   - function AppendContingency(ACondition : integer) : integer;overload;
126   - function AppendContingency(ACondition : integer;AContingency : TContingency) : integer;overload;
127   - function AppendPlayer : integer;overload;
128   - function AppendPlayer(APlayer : TPlayer) : integer; overload;
129   - property Condition[I : Integer]: TCondition read GetCondition write SetCondition;
130   - property ConditionsCount : integer read GetConditionsCount;
131   - property CurrentCondition : integer read FCurrentCondition write FCurrentCondition;
132   - property Contingency[C, I : integer] : TContingency read GetContingency write SetContingency;
133   - property ContingenciesCount[C:integer]:integer read GetContingenciesCount;
134   - property Player[I : integer] : TPlayer read GetPlayer write SetPlayer;
135   - property PlayerFromID[S : UTF8string ] : TPlayer read GetPlayer write SetPlayer;
136   - property PlayersCount : integer read GetPlayersCount;
137   - property PlayerIsPlaying[s : UTF8string] : Boolean read GetPlayerIsPlaying;
138   - property PlayerIndexFromID[s : UTF8string]: integer read GetPlayerIndexFromID;
139   - property PlayerAsString[P:TPlayer]: UTF8string read AliasPlayerAsString;
140   - property PlayerFromString[s : UTF8string]: TPlayer read AliasPlayerFromString;
141   - public
142   - property InterlockingsIn[i:integer]:integer read GetInterlockingsIn;
143   - property ConsequenceStringFromChoice[P:Tplayer]:UTF8String read GetConsequenceStringFromChoice;
144   - property ConsequenceStringFromChoices: UTF8String read GetConsequenceStringFromChoices;
145   - property NextTurnPlayerID : UTF8string read GetNextTurnPlayerID;
146   - property NextTurn : integer read GetNextTurn;
147   - property NextCycle : integer read GetNextCycle;
148   - property NextCondition : integer read GetNextCondition;
149   - property NextGeneration: string read GetPlayerToKick write SetPlayersQueue;
150   - property State : TExperimentState read FState write SetState;
151   - public
152   - property OnEndTurn : TNotifyEvent read FOnEndTurn write SetOnEndTurn;
153   - property OnEndCycle : TNotifyEvent read FOnEndCycle write SetOnEndCycle;
154   - property OnEndGeneration : TNotifyEvent read FOnEndGeneration write SetOnEndGeneration;
155   - property OnEndCondition : TNotifyEvent read FOnEndCondition write SetOnEndCondition;
156   - property OnEndExperiment : TNotifyEvent read FOnEndExperiment write SetOnEndExperiment;
157   - property OnConsequence : TNotifyEvent read FOnConsequence write SetOnConsequence;
158   - property OnInterlocking : TNotifyEvent read FOnInterlocking write SetOnInterlocking;
159   - end;
160   -
161   -resourcestring
162   - WARN_CANNOT_SAVE = 'O experimento não pode ser salvo.';
163   -
164   -implementation
165   -
166   -uses game_file_methods, game_resources, string_methods;
167   -
168   -{ TExperiment }
169   -
170   -function TExperiment.GetCondition(I : Integer): TCondition;
171   -begin
172   - Result := FConditions[I];
173   -end;
174   -
175   -function TExperiment.GetConditionsCount: integer;
176   -begin
177   - Result := Length(FConditions);
178   -end;
179   -
180   -function TExperiment.GetContingenciesCount(C: integer): integer;
181   -begin
182   - Result := Length(FConditions[C].Contingencies);
183   -end;
184   -
185   -function TExperiment.GetContingency(ACondition, I : integer): TContingency;
186   -begin
187   - Result := FConditions[ACondition].Contingencies[I];
188   -end;
189   -
190   -function TExperiment.GetNextTurn: integer; // used during player arriving
191   -begin
192   - if FConditions[CurrentCondition].Turn.Random then
193   - Result := StrToInt(FTurnsRandom.Names[FConditions[CurrentCondition].Turn.Count])
194   - else
195   - Result := FConditions[CurrentCondition].Turn.Count;
196   -
197   - if Assigned(FOnEndTurn) then FOnEndTurn(Self);
198   -
199   - if FConditions[CurrentCondition].Turn.Count < FConditions[CurrentCondition].Turn.Value-1 then
200   - Inc(FConditions[CurrentCondition].Turn.Count)
201   - else
202   - begin
203   - FConditions[CurrentCondition].Turn.Count := 0;
204   - NextCycle;
205   - end;
206   -{$IFDEF DEBUG}
207   - WriteLn('TExperiment.GetNextTurn:',Result);
208   -{$ENDIF}
209   -end;
210   -
211   -function TExperiment.GetNextTurnPlayerID: UTF8string; // used during cycles
212   -begin
213   - Result := Player[FConditions[CurrentCondition].Turn.Count].ID;
214   -end;
215   -
216   -function TExperiment.GetNextCycle: integer;
217   -begin
218   - Result := FConditions[CurrentCondition].Cycles.Count;
219   - WriteReportRow;
220   - if Assigned(FOnEndCycle) then FOnEndCycle(Self);
221   -
222   - if FConditions[CurrentCondition].Cycles.Count < FConditions[CurrentCondition].Cycles.Value-1 then
223   - Inc(FConditions[CurrentCondition].Cycles.Count)
224   - else
225   - begin
226   - FConditions[CurrentCondition].Cycles.Count := 0;
227   - if Assigned(FOnEndGeneration) then FOnEndGeneration(Self);
228   - Inc(FConditions[CurrentCondition].Cycles.Generation);
229   - NextCondition;
230   - end;
231   - {$IFDEF DEBUG}
232   - WriteLn('TExperiment.GetNextCycle:',Result);
233   - {$ENDIF}
234   -end;
235   -
236   -function TExperiment.GetNextCondition: integer;
237   -var
238   - LInterlocks : integer;
239   -
240   - procedure EndCondition;
241   - begin
242   - if Assigned(FOnEndCondition) then FOnEndCondition(Self);
243   - Inc(FCurrentCondition);
244   - WriteReportRowNames;
245   - end;
246   -
247   -begin
248   - Result := CurrentCondition;
249   -
250   - // interlockings in the last x cycles
251   - LInterlocks := InterlockingsIn[FConditions[CurrentCondition].EndCriterium.LastCycles];
252   - case FConditions[CurrentCondition].EndCriterium.Value of
253   - gecWhichComeFirst:
254   - begin
255   - if (GetCurrentAbsoluteCycle = FConditions[CurrentCondition].EndCriterium.AbsoluteCycles) or
256   - (LInterlocks = FConditions[CurrentCondition].EndCriterium.InterlockingPorcentage) then
257   - EndCondition;
258   -
259   - end;
260   - gecAbsoluteCycles:
261   - if GetCurrentAbsoluteCycle = FConditions[CurrentCondition].EndCriterium.AbsoluteCycles then
262   - EndCondition;
263   -
264   - gecInterlockingPorcentage:
265   - if LInterlocks = FConditions[CurrentCondition].EndCriterium.InterlockingPorcentage then
266   - EndCondition;
267   -
268   - end;
269   - {$IFDEF DEBUG}
270   - WriteLn('TExperiment.GetNextCondition:',Result);
271   - {$ENDIF}
272   -end;
273   -
274   -function TExperiment.GetCurrentAbsoluteCycle: integer;
275   -var c:integer;
276   -begin
277   - c := CurrentCondition;
278   - Result := (Condition[c].Cycles.Value*Condition[c].Cycles.Generation)+Condition[c].Cycles.Count;
279   -end;
280   -
281   -function TExperiment.GetPlayer(I : integer): TPlayer;
282   -begin
283   - Result := FPlayers[i];
284   -end;
285   -
286   -function TExperiment.GetPlayer(AID: UTF8string): TPlayer;
287   -var
288   - i : integer;
289   -begin
290   - //Result.ID := '';
291   - if PlayersCount > 0 then
292   - for i:= 0 to PlayersCount -1 do
293   - if FPlayers[i].ID = AID then
294   - begin
295   - Result := FPlayers[i];
296   - Break;
297   - end;
298   -end;
299   -
300   -// fewer as possible data
301   -function TExperiment.AliasPlayerAsString(P: TPlayer): UTF8string;
302   -begin
303   - Result:= GetPlayerAsString(P);
304   -end;
305   -
306   -function TExperiment.AliasPlayerFromString(s: UTF8string): TPlayer;
307   -begin
308   - Result := GetPlayerFromString(S);
309   -end;
310   -
311   -function TExperiment.GetPlayerIndexFromID(AID: UTF8string): integer;
312   -var i : integer;
313   -begin
314   - Result := -1;
315   - for i:= 0 to PlayersCount -1 do
316   - if FPlayers[i].ID = AID then
317   - begin
318   - Result := i;
319   - Break;
320   - end;
321   -end;
322   -
323   -function TExperiment.GetPlayerIsPlaying(AID: UTF8string): Boolean;
324   -var i : integer;
325   -begin
326   - Result := PlayersCount > 0;
327   - if Result then
328   - for i := 0 to PlayersCount -1 do
329   - if Player[i].ID = AID then
330   - Exit;
331   - Result:= False;
332   -end;
333   -
334   -
335   -function TExperiment.GetPlayersCount: integer;
336   -begin
337   - Result := Length(FPlayers);
338   -end;
339   -
340   -function TExperiment.GetInterlockingsIn(ALastCycles: integer): integer;
341   -var
342   - S : TStringList;
343   - LTargetMetaContingency : integer;
344   -begin
345   - S.LoadFromFile(FRegData.FileName);
346   -
347   -end;
348   -
349   -function TExperiment.GetConsequenceStringFromChoice(P: TPlayer): Utf8string;
350   -var
351   - i : integer;
352   - c : integer;
353   -begin
354   - c := CurrentCondition;
355   - PlayerFromID[P.ID] := P;
356   - Result:= '';
357   - for i :=0 to ContingenciesCount[c] -1 do
358   - if not Contingency[c,i].Meta then
359   - if Contingency[c,i].ResponseMeetsCriteriaI(P.Choice.Row,P.Choice.Color) then
360   - Result += Contingency[c,i].Consequence.AsString(P.ID);
361   -end;
362   -
363   -function TExperiment.GetConsequenceStringFromChoices: UTF8String;
364   -var
365   - i : integer;
366   - c : integer;
367   -begin
368   - c := CurrentCondition;
369   - Result:= '';
370   - for i :=0 to ContingenciesCount[c] -1 do
371   - if Contingency[c,i].Meta then
372   - if Contingency[c,i].ResponseMeetsCriteriaG(FPlayers) then
373   - Result += Contingency[c,i].Consequence.AsString(IntToStr(i));
374   -end;
375   -
376   -procedure TExperiment.CheckNeedForRandomTurns;
377   -var c ,
378   - i,
379   - r : integer;
380   -begin
381   - if Condition[CurrentCondition].Turn.Random then
382   - begin
383   - FTurnsRandom.Clear;
384   - for i:= 0 to Condition[CurrentCondition].Turn.Value-1 do
385   - FTurnsRandom.Add(IntToStr(i));
386   -
387   - c := FTurnsRandom.Count - 1;
388   - for i := 0 to c do
389   - begin
390   - r := Random(c);
391   - while r = i do r := Random(c);
392   - FTurnsRandom.Exchange(r,i);
393   - end;
394   - end;
395   -end;
396   -
397   -procedure TExperiment.SetCondition(I : Integer; AValue: TCondition);
398   -begin
399   - FConditions[I] := AValue;
400   -end;
401   -
402   -procedure TExperiment.SetContingency(ACondition, I : integer; AValue: TContingency);
403   -begin
404   - FConditions[ACondition].Contingencies[I] := AValue;
405   - if FConditions[ACondition].Contingencies[I].Meta then
406   - FConditions[ACondition].Contingencies[I].OnCriteria:=@Interlocking
407   - else
408   - FConditions[ACondition].Contingencies[I].OnCriteria:=@Consequence;
409   -end;
410   -
411   -procedure TExperiment.SetMatrixType(AValue: TGameMatrixType);
412   -begin
413   - if FMatrixType=AValue then Exit;
414   - FMatrixType:=AValue;
415   -end;
416   -
417   -procedure TExperiment.SetOnConsequence(AValue: TNotifyEvent);
418   -begin
419   - if FOnConsequence=AValue then Exit;
420   - FOnConsequence:=AValue;
421   -end;
422   -
423   -procedure TExperiment.SetOnEndCondition(AValue: TNotifyEvent);
424   -begin
425   - if FOnEndCondition=AValue then Exit;
426   - FOnEndCondition:=AValue;
427   -end;
428   -
429   -procedure TExperiment.SetOnEndCycle(AValue: TNotifyEvent);
430   -begin
431   - if FOnEndCycle=AValue then Exit;
432   - FOnEndCycle:=AValue;
433   -end;
434   -
435   -procedure TExperiment.SetOnEndExperiment(AValue: TNotifyEvent);
436   -begin
437   - if FOnEndExperiment=AValue then Exit;
438   - FOnEndExperiment:=AValue;
439   -end;
440   -
441   -procedure TExperiment.SetOnEndGeneration(AValue: TNotifyEvent);
442   -begin
443   - if FOnEndGeneration=AValue then Exit;
444   - FOnEndGeneration:=AValue;
445   -end;
446   -
447   -procedure TExperiment.SetOnEndTurn(AValue: TNotifyEvent);
448   -begin
449   - if FOnEndTurn=AValue then Exit;
450   - FOnEndTurn:=AValue;
451   -end;
452   -
453   -procedure TExperiment.SetOnInterlocking(AValue: TNotifyEvent);
454   -begin
455   - if FOnInterlocking=AValue then Exit;
456   - FOnInterlocking:=AValue;
457   -end;
458   -
459   -
460   -procedure TExperiment.SetPlayer(I : integer; AValue: TPlayer);
461   -begin
462   - FPlayers[I] := AValue;
463   -end;
464   -
465   -procedure TExperiment.SetPlayer(S: UTF8string; AValue: TPlayer);
466   -var i : integer;
467   -begin
468   - if PlayersCount > 0 then
469   - for i:= 0 to PlayersCount -1 do
470   - if FPlayers[i].ID = S then
471   - begin
472   - FPlayers[i] := AValue;
473   - Exit;
474   - end;
475   - raise Exception.Create('TExperiment.SetPlayer: Could not set player.');
476   -end;
477   -
478   -procedure TExperiment.SetResearcherCanChat(AValue: Boolean);
479   -begin
480   - if FResearcherCanChat=AValue then Exit;
481   - FResearcherCanChat:=AValue;
482   -end;
483   -
484   -procedure TExperiment.SetResearcherCanPlay(AValue: Boolean);
485   -begin
486   - if FResearcherCanPlay=AValue then Exit;
487   - FResearcherCanPlay:=AValue;
488   -end;
489   -
490   -procedure TExperiment.SetSendChatHistoryForNewPlayers(AValue: Boolean);
491   -begin
492   - if FSendChatHistoryForNewPlayers=AValue then Exit;
493   - FSendChatHistoryForNewPlayers:=AValue;
494   -end;
495   -
496   -procedure TExperiment.SetState(AValue: TExperimentState);
497   -begin
498   - if FState=AValue then Exit;
499   - FState:=AValue;
500   -end;
501   -
502   -procedure TExperiment.Consequence(Sender: TObject);
503   -begin
504   - if Assigned(FOnConsequence) then FOnConsequence(Sender);
505   -end;
506   -
507   -procedure TExperiment.Interlocking(Sender: TObject);
508   -begin
509   - if Assigned(FOnInterlocking) then FOnInterlocking(Sender);
510   -end;
511   -
512   -procedure TExperiment.SetPlayersQueue(AValue: string);
513   -var
514   - i : integer;
515   -begin
516   - for i := 0 to PlayersCount-2 do
517   - begin
518   - FPlayers[i] := FPlayers[i+1];
519   - end;
520   - FPlayers[High(FPlayers)] := PlayerFromString[AValue];
521   -end;
522   -
523   -function TExperiment.GetPlayerToKick: string;
524   -var c : integer;
525   -begin
526   - c := CurrentCondition;
527   - if Condition[c].Cycles.Count < Condition[c].Cycles.Value -1 then
528   - Result := #32
529   - else
530   - Result := FPlayers[0].ID;
531   -end;
532   -
533   -
534   -procedure TExperiment.WriteReportHeader;
535   -var
536   - LHeader : string;
537   -begin
538   - // header
539   - LHeader := VAL_RESEARCHER+':' + #9 + FResearcher + #9 + LineEnding +
540   - VAL_EXPERIMENT+':' + #9 + FExperimentName + #9 + LineEnding +
541   - VAL_BEGIN_TIME+':' + #9 + DateTimeToStr(Date) + #9 + TimeToStr(Time) +#9+ LineEnding + #9 + LineEnding;
542   - FRegData.SaveData(LHeader);
543   - WriteReportRowNames;
544   -end;
545   -
546   -procedure TExperiment.WriteReportRowNames;
547   -var
548   - c,j,i: integer;
549   - LNames : string;
550   -begin
551   - c:= CurrentCondition;
552   -
553   - // column names, line 1
554   - LNames := 'Experimento'+#9+#9+#9;
555   - for i:=0 to Condition[c].Turn.Value-1 do // player's response
556   - begin
557   - LNames += 'P'+IntToStr(i+1)+#9+#9;
558   - for j:=0 to ContingenciesCount[c]-1 do
559   - if not Contingency[c,j].Meta then
560   - LNames += #9;
561   - end;
562   -
563   - LNames += VAL_INTERLOCKING+'s';
564   - for i:=0 to ContingenciesCount[c]-1 do
565   - if Contingency[c,i].Meta then
566   - LNames += #9;
567   -
568   - if Assigned(Condition[c].Prompt) then
569   - begin
570   - LNames += 'Respostas à Pergunta';
571   - for i:=0 to Condition[c].Turn.Value-1 do
572   - LNames += #9;
573   - end;
574   - LNames += LineEnding;
575   -
576   - // column names, line 2
577   - LNames += 'Condição'+#9+'Geração'+#9+'Ciclos'+#9;
578   - for i:=0 to Condition[c].Turn.Value-1 do
579   - begin
580   - LNames += 'Linha'+#9+'Cor'+#9;
581   - for j:=0 to ContingenciesCount[c]-1 do
582   - if not Contingency[c,j].Meta then
583   - LNames += Contingency[c,j].ContingencyName+#9;
584   - end;
585   -
586   - for i:=0 to ContingenciesCount[c]-1 do
587   - if Contingency[c,i].Meta then
588   - LNames += Contingency[c,i].ContingencyName+#9;
589   -
590   - if Assigned(Condition[c].Prompt) then
591   - for i:=0 to Condition[c].Turn.Value-1 do
592   - LNames += 'R'+IntToStr(i+1)+#9;
593   -
594   - LNames += '|'+#9;
595   - if FLastReportColNames <> LNames then
596   - begin
597   - FLastReportColNames := LNames;
598   - FRegData.SaveData(LNames);
599   - end;
600   -end;
601   -
602   -procedure TExperiment.WriteReportRow;
603   -var
604   - c,j,i: integer;
605   - LRow : string;
606   -begin
607   - c:= CurrentCondition;
608   -
609   - LRow := LineEnding + IntToStr(c+1)+#9+IntToStr(Condition[c].Cycles.Generation+1)+#9+IntToStr(GetCurrentAbsoluteCycle+1)+#9;
610   - for i:=0 to Condition[c].Turn.Value-1 do
611   - begin
612   - LRow += GetRowString(FPlayers[i].Choice.Row)+#9+GetColorString(FPlayers[i].Choice.Color)+#9;
613   - for j:=0 to ContingenciesCount[c]-1 do
614   - if not Contingency[c,j].Meta then
615   - if Contingency[c,j].ConsequenceFromPlayerID(FPlayers[i].ID) <> '' then
616   - LRow += '1'+#9
617   - else
618   - LRow += '0'+#9;
619   - end;
620   -
621   - for i:=0 to ContingenciesCount[c]-1 do
622   - if Contingency[c,i].Meta then
623   - if Contingency[c,i].Fired then
624   - LRow += '1'+#9
625   - else
626   - LRow += '0'+#9;
627   -
628   - FRegData.SaveData(LRow);
629   -end;
630   -
631   -procedure TExperiment.WriteReportRowPrompt;
632   -var
633   - c,i: integer;
634   - LRow : string;
635   -begin
636   - c := CurrentCondition;
637   - LRow := '';
638   - if Condition[c].Prompt.ResponsesCount = Condition[c].Turn.Value then
639   - for i:=0 to Condition[c].Prompt.ResponsesCount-1 do
640   - LRow += 'P'+IntToStr(PlayerIndexFromID[Delimited(1,Condition[c].Prompt.Response(i))]+1)+
641   - '|'+
642   - Delimited(2,Condition[c].Prompt.Response(i))+#9
643   - else
644   - for i:=0 to Condition[c].Turn.Value-1 do
645   - LRow += 'NA'+#9;
646   -
647   - FRegData.SaveData(LRow);
648   -end;
649   -
650   -constructor TExperiment.Create(AOwner: TComponent);
651   -begin
652   - inherited Create(AOwner);
653   - FTurnsRandom := TStringList.Create;
654   - LoadExperimentFromResource(Self);
655   - CheckNeedForRandomTurns;
656   -end;
657   -
658   -constructor TExperiment.Create(AOwner: TComponent;AppPath:string);
659   -begin
660   - inherited Create(AOwner);
661   - FTurnsRandom := TStringList.Create;
662   - LoadExperimentFromResource(Self);
663   - CheckNeedForRandomTurns;
664   - FRegData := TRegData.Create(Self, AppPath+VAL_RESEARCHER+'es'+PathDelim+Researcher+PathDelim+ExperimentName+PathDelim+'000.dat');
665   - WriteReportHeader;
666   -end;
667   -
668   -constructor TExperiment.Create(AOwner:TComponent;AFilename,AppPath:string);
669   -begin
670   - inherited Create(AOwner);
671   - FTurnsRandom := TStringList.Create;
672   - LoadExperimentFromFile(Self,AFilename);
673   - CheckNeedForRandomTurns;
674   -end;
675   -
676   -destructor TExperiment.Destroy;
677   -begin
678   - FTurnsRandom.Free;
679   - inherited Destroy;
680   -end;
681   -
682   -function TExperiment.LoadFromFile(AFilename: string): Boolean;
683   -begin
684   - Result := LoadExperimentFromFile(Self, AFilename);
685   - if Result then
686   - FFilename := AFilename;
687   - CheckNeedForRandomTurns;
688   -end;
689   -
690   -function TExperiment.LoadFromGenerator: Boolean;
691   -begin
692   - Result := LoadExperimentFromResource(Self);
693   - if Result then
694   - FFilename := GetCurrentDir + PathDelim + FResearcher + PathDelim;
695   - CheckNeedForRandomTurns;
696   -end;
697   -
698   -function TExperiment.AppendCondition: integer;
699   -begin
700   - SetLength(FConditions, Length(FConditions)+1);
701   - Result := High(FConditions);
702   -end;
703   -
704   -function TExperiment.AppendCondition(ACondition: TCondition): integer;
705   -begin
706   - SetLength(FConditions, Length(FConditions)+1);
707   - Result := High(FConditions);
708   - FConditions[Result] := ACondition;
709   -end;
710   -
711   -function TExperiment.AppendContingency(ACondition: integer): integer;
712   -begin
713   - SetLength(FConditions[ACondition].Contingencies, Length(FConditions[ACondition].Contingencies)+1);
714   - Result := High(FConditions[ACondition].Contingencies);
715   -end;
716   -
717   -function TExperiment.AppendContingency(ACondition: integer;
718   - AContingency: TContingency): integer;
719   -begin
720   - SetLength(FConditions[ACondition].Contingencies, Length(FConditions[ACondition].Contingencies)+1);
721   - Result := High(FConditions[ACondition].Contingencies);
722   - FConditions[ACondition].Contingencies[Result] := AContingency;
723   -end;
724   -
725   -function TExperiment.AppendPlayer: integer;
726   -begin
727   - SetLength(FPlayers, Length(FPlayers)+1);
728   - Result := High(FPlayers);
729   -end;
730   -
731   -function TExperiment.AppendPlayer(APlayer: TPlayer): integer;
732   -begin
733   - SetLength(FPlayers, Length(FPlayers)+1);
734   - Result := High(FPlayers);
735   - FPlayers[Result] := APlayer;
736   -end;
737   -
738   -procedure TExperiment.SaveToFile(AFilename: string);
739   -begin
740   - SaveExperimentToFile(Self,AFilename);
741   -end;
742   -
743   -procedure TExperiment.SaveToFile;
744   -begin
745   - if FFilename <> '' then
746   - SaveExperimentToFile(Self,FFilename)
747   - else
748   -{$IFDEF DEBUG}
749   - WriteLn(WARN_CANNOT_SAVE)
750   -{$ENDIF};
751   -end;
752   -
753   -procedure TExperiment.Clean;
754   -var c,i : integer;
755   -begin
756   - for i := 0 to PlayersCount -1 do
757   - begin
758   - FPlayers[i].Choice.Row:=grNone;
759   - FPlayers[i].Choice.Color:=gcNone;
760   - end;
761   - c := CurrentCondition;
762   - for i := 0 to ContingenciesCount[c]-1 do
763   - Contingency[c,i].Clean;
764   -
765   - Condition[c].Prompt.Clean;
766   -
767   - FRegData.CloseAndOpen;
768   -end;
769   -
770   -procedure TExperiment.Play;
771   -var i : integer;
772   -begin
773   - //for i := 0 to Condition[CurrentCondition].Turn.Value-1 do
774   - // begin
775   - // //TRegData.Save Header;
776   - // end;
777   - FState:=xsRunning;
778   -end;
779   -
780   -
781   -end.
782   -
units/backup/presentation_classes.pas
View file @81caf87
... ... @@ -1,135 +0,0 @@
1   -unit presentation_classes;
2   -
3   -{$mode objfpc}{$H+}
4   -
5   -interface
6   -
7   -uses
8   - Classes, SysUtils, ExtCtrls;
9   -
10   -type
11   -
12   - { TAnnouncerStartEvent }
13   -
14   - TAnnouncerStartEvent = procedure (AMessage : array of UTF8String) of object;
15   -
16   - { TAnnoucerMessages }
17   -
18   - TAnnoucerMessages = array of array of UTF8String;
19   -
20   - { TIntervalarAnnouncer }
21   -
22   - TIntervalarAnnouncer = class(TComponent)
23   - private
24   - FMessages: TAnnoucerMessages;
25   - FTimer : TTimer;
26   - FOnStart: TAnnouncerStartEvent;
27   - function GetEnabled: Boolean;
28   - function GetInterval: integer;
29   - procedure NextMessage;
30   - procedure SetEnabled(AValue: Boolean);
31   - procedure SelfDestroy(Sender: TObject);
32   - procedure SetInterval(AValue: integer);
33   - procedure StartTimer(Sender:TObject);
34   - public
35   - constructor Create(AOwner : TComponent); override;
36   - procedure Append(M : array of UTF8String);
37   - procedure Reversed;
38   - property Messages : TAnnoucerMessages read FMessages write FMessages;
39   - property OnStart : TAnnouncerStartEvent read FOnStart write FOnStart;
40   - property Interval : integer read GetInterval write SetInterval;
41   - property Enabled : Boolean read GetEnabled write SetEnabled;
42   - end;
43   -
44   -implementation
45   -
46   -{ TIntervalarAnnouncer }
47   -
48   -procedure TIntervalarAnnouncer.SetEnabled(AValue: Boolean);
49   -begin
50   - if FTimer.Enabled=AValue then Exit;
51   - FTimer.Enabled:= AValue;
52   -end;
53   -
54   -function TIntervalarAnnouncer.GetEnabled: Boolean;
55   -begin
56   - Result := FTimer.Enabled;
57   -end;
58   -
59   -function TIntervalarAnnouncer.GetInterval: integer;
60   -begin
61   - Result := FTimer.Interval;
62   -end;
63   -
64   -procedure TIntervalarAnnouncer.NextMessage;
65   -begin
66   - SetLength(FMessages,Length(FMessages)-1);
67   -end;
68   -
69   -procedure TIntervalarAnnouncer.SelfDestroy(Sender : TObject);
70   -var LAnnouncer : TIntervalarAnnouncer;
71   -begin
72   - if Length(FMessages) > 0 then
73   - begin
74   - LAnnouncer := TIntervalarAnnouncer.Create(nil);
75   - LAnnouncer.Messages := FMessages;
76   - LAnnouncer.OnStart:= FOnStart;
77   - LAnnouncer.Enabled:=True;
78   - end;
79   - Free;
80   -end;
81   -
82   -procedure TIntervalarAnnouncer.SetInterval(AValue: integer);
83   -begin
84   - if FTimer.Interval=AValue then Exit;
85   - FTimer.Interval:= AValue;
86   -end;
87   -
88   -procedure TIntervalarAnnouncer.StartTimer(Sender: TObject);
89   -var M : array of UTF8String;
90   -begin
91   - M := FMessages[High(FMessages)];
92   - NextMessage;
93   - if Assigned(FOnStart) then FOnStart(M);
94   -end;
95   -
96   -constructor TIntervalarAnnouncer.Create(AOwner: TComponent);
97   -begin
98   - inherited Create(AOwner);
99   - FTimer := TTimer.Create(Self);
100   - FTimer.Enabled := False;
101   - FTimer.Interval := 5000;
102   - FTimer.OnTimer:=@SelfDestroy;
103   - //FTimer.OnStopTimer:=@SelfDestroy;
104   - FTimer.OnStartTimer:=@StartTimer;
105   -end;
106   -
107   -procedure TIntervalarAnnouncer.Append(M: array of UTF8String);
108   -var
109   - H : TAnnoucerMessages;
110   - i: Integer;
111   -begin
112   - SetLength(H,1,Length(M));
113   -
114   - for i := Low(M) to High(M) do
115   - H[0,i] := M[i];
116   -
117   - SetLength(FMessages,Length(FMessages)+1);
118   - FMessages[High(FMessages)] := H[0];
119   -end;
120   -
121   -procedure TIntervalarAnnouncer.Reversed;
122   -var
123   - i : integer;
124   - M : TAnnoucerMessages;
125   -begin
126   - for i := High(FMessages) downto Low(FMessages) do
127   - begin
128   - SetLength(M,Length(M)+1);
129   - M[High(M)] := FMessages[i]
130   - end;
131   - FMessages := M;
132   -end;
133   -
134   -end.
135   -
units/backup/report_reader.pas
View file @81caf87
... ... @@ -1,124 +0,0 @@
1   -unit report_reader;
2   -
3   -{$mode objfpc}{$H+}
4   -
5   -interface
6   -
7   -uses
8   - Classes, SysUtils;
9   -
10   -type
11   -
12   - TRowRange = record
13   - Low,
14   - High : integer;
15   - end;
16   -
17   - { TReportReader }
18   -
19   - TReportReader = class
20   - private
21   - FLastRowsX : integer;
22   - FRows : TStringList;
23   - FCols : TStringList;
24   - FRowRange: TRowRange;
25   - FUseRange: Boolean;
26   - function GetColumnOf(AName: string): TStringList;
27   - procedure RangeAsLastXRows;
28   - public
29   - VRow : string; //helper
30   - constructor Create;
31   - destructor Destroy; override;
32   - procedure Append(ARow : string);
33   - procedure Extend(ARowExtention : string);
34   - procedure Clean;
35   - procedure SetXLastRows(X:integer);
36   - property Range : TRowRange read FRowRange;
37   - property UseRange : Boolean read FUseRange write FUseRange;
38   - property ColumnOf[AName:string]:TStringList read GetColumnOf;
39   - end;
40   -
41   -implementation
42   -
43   -uses strutils;
44   -
45   -{ TReportReader }
46   -
47   -function TReportReader.GetColumnOf(AName: string): TStringList;
48   -var
49   - c,
50   - i : integer;
51   - Row : string;
52   -begin
53   - Result := TStringList.Create;
54   - c := FCols.IndexOf(AName);
55   - if c > -1 then
56   - if FUseRange and (FRowRange.Low <= FRowRange.High) and (FRowRange.Low > 0) then
57   - for i := FRowRange.Low to FRowRange.High do
58   - Result.Append(ExtractDelimited(c+1, FRows[i],[#9,#10]))
59   - else
60   - for Row in FRows do
61   - Result.Append(ExtractDelimited(c+1, Row,[#9,#10]));
62   -end;
63   -
64   -constructor TReportReader.Create;
65   -begin
66   - inherited Create;
67   - FUseRange := False;
68   - FRows := TStringList.Create;
69   - FCols := TStringList.Create;
70   - FCols.Delimiter := #9;
71   - FCols.StrictDelimiter := True;
72   -end;
73   -
74   -destructor TReportReader.Destroy;
75   -begin
76   - FRows.Free;
77   - FCols.Free;
78   - inherited Destroy;
79   -end;
80   -
81   -procedure TReportReader.Append(ARow: string);
82   -begin
83   - if FCols.Count = 0 then
84   - FCols.DelimitedText := ARow
85   - else
86   - begin
87   - FRows.Append(ARow);
88   - RangeAsLastXRows;
89   - end;
90   -end;
91   -
92   -procedure TReportReader.Extend(ARowExtention: string);
93   -begin
94   - FRows[FRows.Count-1] := FRows[FRows.Count-1] + ARowExtention;
95   -end;
96   -
97   -procedure TReportReader.Clean;
98   -begin
99   - FCols.Clear;
100   - FRows.Clear;
101   -end;
102   -
103   -procedure TReportReader.SetXLastRows(X: integer);
104   -begin
105   - FLastRowsX:=X;
106   - RangeAsLastXRows;
107   -end;
108   -
109   -procedure TReportReader.RangeAsLastXRows;
110   -begin
111   - FRowRange.High := FRows.Count-1;
112   - FRowRange.Low := FRows.Count-FLastRowsX;
113   - {$IFDEF DEBUG}
114   - if FRowRange.Low > FRowRange.High then
115   - WriteLn('Warning: FRowRange.Low > FRowRange.High, range will not be used');
116   -
117   - if FRowRange.Low < 0 then
118   - WriteLn('Warning: FRowRange.Low < 0, range will not be used');
119   - {$ENDIF}
120   -end;
121   -
122   -
123   -end.
124   -