Download as
Browse Code »

Commit e3d84bd81d9e22822c3a490493e66bcae9d4e84c

Authored by Carlos Picanco
1 parent 5111a7e7
Exists in master

dump

Showing 10 changed files with 276 additions and 15 deletions   Show diff stats
backup/form_chooseactor.lfm 0 → 100644
  Diff comments   View file @e3d84bd
... ... @@ -0,0 +1,42 @@
  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 0 → 100644
  Diff comments   View file @e3d84bd
... ... @@ -0,0 +1,90 @@
  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 +
... ...
form_matrixgame.pas
  Diff comments   View file @e3d84bd
... ... @@ -17,7 +17,6 @@ uses
17 17 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Grids,
18 18 StdCtrls, DBGrids, ExtCtrls
19 19  
20   - //, zmq_pub_sub
21 20 , game_zmq_actors
22 21 , game_actors
23 22 , game_control
... ... @@ -295,6 +294,7 @@ procedure TFormMatrixGame.btnConfirmRowClick(Sender: TObject);
295 294 begin
296 295 StringGridMatrix.Enabled:= False;
297 296 btnConfirmRow.Enabled:=False;
  297 + btnConfirmRow.Caption:='OK';
298 298 FGameControl.SendMessage(K_CHOICE);
299 299 end;
300 300  
... ...
units/game_actors.pas
  Diff comments   View file @e3d84bd
... ... @@ -96,7 +96,7 @@ type
96 96 Value : TGameEndCondition;
97 97 InterlockingPorcentage,
98 98 LastCycles,
99   - AbsoluteCyles: integer;
  99 + AbsoluteCycles: integer;
100 100 end;
101 101  
102 102 TPoints = record
... ... @@ -114,13 +114,13 @@ type
114 114  
115 115 Turn : record // for changing cycles
116 116 Count, // current turn
117   - Value : integer; // PlayersPerTurn, CycleIncrement
  117 + Value : integer; // PlayersPerCycle, TurnsPerCycle
118 118 Random: Boolean; // if we should change Players[i].Turn OnCycle
119 119 end;
120 120  
121 121 Cycles : record // for changing generations
122 122 Count, // current cycle
123   - Value, // CyclesPerLineage, GenegarationIncrement
  123 + Value, // CyclesPerLineage, CyclesPerGeneration
124 124 Generation : integer;
125 125 end;
126 126 Prompt : TPrompt; // onEndCycle
... ...
units/game_control.pas
  Diff comments   View file @e3d84bd
... ... @@ -75,7 +75,7 @@ const
75 75 K_RESUME = '.Resume';
76 76 K_DATA_A = '.Data';
77 77 K_LOGIN = '.Login';
78   - K_KICK = '.Kick'
  78 + K_KICK = '.Kick';
79 79 //
80 80 K_STATUS = '.Status';
81 81 K_CYCLES = '.OnCycleStart';
... ... @@ -221,8 +221,12 @@ begin
221 221 end;
222 222  
223 223 function TGameControl.GetSelectedRowF(AStringGrid: TStringGrid): UTF8string;
  224 +var i : integer;
224 225 begin
225   - Result := IntToStr(AStringGrid.Selection.Top);
  226 + i := AStringGrid.Selection.Top;
  227 + if RowBase = 0 then
  228 + Inc(i);
  229 + Result := Format('%-*.*d', [1,2,i]);
226 230 end;
227 231  
228 232 procedure TGameControl.SetMustDrawDots(AValue: Boolean);
... ... @@ -269,8 +273,9 @@ end;
269 273  
270 274 procedure TGameControl.StartTurn;
271 275 begin
272   - FormMatrixGame.StringGridMatrix.Options := FormMatrixGame.StringGridMatrix.Options-[goRowSelect];
273 276 FormMatrixGame.btnConfirmRow.Enabled:=True;
  277 + FormMatrixGame.StringGridMatrix.Options := FormMatrixGame.StringGridMatrix.Options-[goRowSelect];
  278 + FormMatrixGame.btnConfirmRow.Caption:='Confirmar';
274 279 FormMatrixGame.btnConfirmRow.Visible := False;
275 280 end;
276 281  
... ... @@ -419,11 +424,22 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList);
419 424  
420 425 procedure ReceiveChoice;
421 426 begin
  427 + with GetPlayerBox(AMessage[1]) do
  428 + begin
  429 + LabelLastRowCount.Caption := Format('%-*.*d', [1,2,StrToInt(AMessage[2])]);
  430 + PanelLastColor.Color := GetRowColorFromString(AMessage[3]);
  431 + FormMatrixGame.Caption:='';
  432 + end;
  433 +
422 434 case FActor of
423 435 gaPlayer:begin
424 436  
425 437 end;
  438 +
426 439 gaAdmin:begin
  440 + // if last choice in cycle then end cycle
  441 + FExperiment.NextTurn;
  442 + Inc(FExperiment.Condition[FExperiment.CurrentCondition].Turn.Count);
427 443  
428 444 end;
429 445 end;
... ... @@ -494,7 +510,6 @@ begin
494 510 if MHas(K_CHAT_M) then ReceiveChat;
495 511 if MHas(K_CHOICE) then ReceiveChoice;
496 512 if MHas(K_KICK) then SayGoodBye;
497   - if MHas(K_STATUS) then ReceiveStatus;
498 513 end;
499 514  
500 515 // Here FActor is garanted to be a TZMQAdmin
... ... @@ -630,6 +645,11 @@ procedure TGameControl.ReceiveReply(AReply: TStringList);
630 645 end;
631 646 end;
632 647  
  648 + procedure ResumePlayer;
  649 + begin
  650 +
  651 + end;
  652 +
633 653 begin
634 654 if MHas(K_RESUME+K_ARRIVED) then ResumePlayer;
635 655 if MHas(K_LOGIN+K_ARRIVED) then LoginAccepted;
... ...
units/game_experiment.pas
  Diff comments   View file @e3d84bd
... ... @@ -24,6 +24,10 @@ type
24 24 FExperimentName,
25 25 FFilename,
26 26 FResearcher : UTF8string;
  27 + FOnEndCondition: TNotifyEvent;
  28 + FOnEndCycle: TNotifyEvent;
  29 + FOnEndExperiment: TNotifyEvent;
  30 + FOnEndGeneration: TNotifyEvent;
27 31 FMatrixType: TGameMatrixType;
28 32 FRegData : TRegData;
29 33 FGenPlayersAsNeeded : Boolean;
... ... @@ -40,6 +44,8 @@ type
40 44 function GetContingency(ACondition, I : integer): TContingency;
41 45 function GetNextTurn: integer;
42 46 function GetNextTurnPlayerID: UTF8string;
  47 + function GetNextCycle:integer;
  48 + function GetNextCondition:integer;
43 49 function GetPlayer(I : integer): TPlayer; overload;
44 50 function GetPlayer(AID : UTF8string): TPlayer; overload;
45 51 function GetPlayerAsString(P: TPlayer): UTF8string;
... ... @@ -50,6 +56,10 @@ type
50 56 procedure SetCondition(I : Integer; AValue: TCondition);
51 57 procedure SetContingency(ACondition, I : integer; AValue: TContingency);
52 58 procedure SetMatrixType(AValue: TGameMatrixType);
  59 + procedure SetOnEndCondition(AValue: TNotifyEvent);
  60 + procedure SetOnEndCycle(AValue: TNotifyEvent);
  61 + procedure SetOnEndExperiment(AValue: TNotifyEvent);
  62 + procedure SetOnEndGeneration(AValue: TNotifyEvent);
53 63 procedure SetPlayer(I : integer; AValue: TPlayer); overload;
54 64 procedure SetPlayer(S : UTF8string ; AValue: TPlayer); overload;
55 65 procedure SetResearcherCanChat(AValue: Boolean);
... ... @@ -71,6 +81,7 @@ type
71 81 procedure SaveToFile(AFilename: string); overload;
72 82 procedure SaveToFile; overload;
73 83 procedure Clean;
  84 + procedure Play;
74 85 property ResearcherCanPlay : Boolean read FResearcherCanPlay write SetResearcherCanPlay;
75 86 property ResearcherCanChat : Boolean read FResearcherCanChat write SetResearcherCanChat;
76 87 property Researcher : UTF8string read FResearcher write FResearcher;
... ... @@ -93,7 +104,14 @@ type
93 104 property MatrixType : TGameMatrixType read FMatrixType write SetMatrixType;
94 105 property NextTurnPlayerID : UTF8string read GetNextTurnPlayerID;
95 106 property NextTurn : integer read GetNextTurn;
  107 + property NextCycle : integer read GetNextCycle;
  108 + property NextCondition : integer read GetNextCondition;
96 109 property State : TExperimentState read FState write SetState;
  110 + public
  111 + property OnEndCycle : TNotifyEvent read FOnEndCycle write SetOnEndCycle;
  112 + property OnEndGeneration : TNotifyEvent read FOnEndGeneration write SetOnEndGeneration;
  113 + property OnEndCondition : TNotifyEvent read FOnEndCondition write SetOnEndCondition;
  114 + property OnEndExperiment : TNotifyEvent read FOnEndExperiment write SetOnEndExperiment;
97 115 end;
98 116  
99 117 resourcestring
... ... @@ -123,9 +141,14 @@ end;
123 141 function TExperiment.GetNextTurn: integer; // used during player arriving
124 142 begin
125 143 Result := FConditions[CurrentCondition].Turn.Count;
126   - if FConditions[CurrentCondition].Turn.Count = FConditions[CurrentCondition].Turn.Value then
127   - FConditions[CurrentCondition].Turn.Count := 0
128   - else Inc(FConditions[CurrentCondition].Turn.Count);
  144 + if FConditions[CurrentCondition].Turn.Count < FConditions[CurrentCondition].Turn.Value then
  145 + Inc(FConditions[CurrentCondition].Turn.Count)
  146 + else
  147 + begin
  148 + FConditions[CurrentCondition].Turn.Count := 0;
  149 + if Assigned(FOnEndCycle) then FOnEndCycle(Self);
  150 + NextCycle;
  151 + end;
129 152 end;
130 153  
131 154 function TExperiment.GetNextTurnPlayerID: UTF8string; // used during cycles
... ... @@ -134,6 +157,51 @@ begin
134 157 GetNextTurn;
135 158 end;
136 159  
  160 +function TExperiment.GetNextCycle: integer;
  161 +begin
  162 + Result := FConditions[CurrentCondition].Cycles.Count;
  163 + if FConditions[CurrentCondition].Cycles.Count < FConditions[CurrentCondition].Cycles.Value then
  164 + Inc(FConditions[CurrentCondition].Cycles.Count)
  165 + else
  166 + begin
  167 + FConditions[CurrentCondition].Cycles.Count := 0;
  168 + if Assigned(FOnEndGeneration) then FOnEndGeneration(Self);
  169 + NextCondition;
  170 + end;
  171 +end;
  172 +
  173 +function TExperiment.GetNextCondition: integer;
  174 +var LCycles : integer;
  175 +begin
  176 + Inc(FConditions[CurrentCondition].Cycles.Generation);
  177 + Result := CurrentCondition;
  178 + LCycles := (FConditions[CurrentCondition].Cycles.Value *
  179 + FConditions[CurrentCondition].Cycles.Generation) + FConditions[CurrentCondition].Cycles.Count;
  180 +
  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;
  193 +
  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 +end;
  204 +
137 205 function TExperiment.GetPlayer(I : integer): TPlayer;
138 206 begin
139 207 Result := FPlayers[i];
... ... @@ -342,6 +410,30 @@ begin
342 410 FMatrixType:=AValue;
343 411 end;
344 412  
  413 +procedure TExperiment.SetOnEndCondition(AValue: TNotifyEvent);
  414 +begin
  415 + if FOnEndCondition=AValue then Exit;
  416 + FOnEndCondition:=AValue;
  417 +end;
  418 +
  419 +procedure TExperiment.SetOnEndCycle(AValue: TNotifyEvent);
  420 +begin
  421 + if FOnEndCycle=AValue then Exit;
  422 + FOnEndCycle:=AValue;
  423 +end;
  424 +
  425 +procedure TExperiment.SetOnEndExperiment(AValue: TNotifyEvent);
  426 +begin
  427 + if FOnEndExperiment=AValue then Exit;
  428 + FOnEndExperiment:=AValue;
  429 +end;
  430 +
  431 +procedure TExperiment.SetOnEndGeneration(AValue: TNotifyEvent);
  432 +begin
  433 + if FOnEndGeneration=AValue then Exit;
  434 + FOnEndGeneration:=AValue;
  435 +end;
  436 +
345 437  
346 438 procedure TExperiment.SetPlayer(I : integer; AValue: TPlayer);
347 439 begin
... ... @@ -476,5 +568,10 @@ begin
476 568  
477 569 end;
478 570  
  571 +procedure TExperiment.Play;
  572 +begin
  573 +
  574 +end;
  575 +
479 576 end.
480 577  
... ...
units/game_file_methods.pas
  Diff comments   View file @e3d84bd
... ... @@ -85,7 +85,7 @@ var
85 85 1: Result.Value := gecInterlockingPorcentage;
86 86 2: Result.Value := gecWhichComeFirst;
87 87 end;
88   - Result.AbsoluteCyles := StrToIntDef(GetAndDelFirstValue(LS), 20);
  88 + Result.AbsoluteCycles := StrToIntDef(GetAndDelFirstValue(LS), 20);
89 89 Result.InterlockingPorcentage := StrToIntDef(GetAndDelFirstValue(LS),10);
90 90 Result.LastCycles := StrToIntDef(GetAndDelFirstValue(LS), 10);
91 91 end;
... ... @@ -329,7 +329,7 @@ var
329 329 gecWhichComeFirst: Result := '2';
330 330 end;
331 331 Result := Result + VV_SEP;
332   - Result := Result + IntToStr(AEndCriterium.AbsoluteCyles) + VV_SEP;
  332 + Result := Result + IntToStr(AEndCriterium.AbsoluteCycles) + VV_SEP;
333 333 Result := Result + IntToStr(AEndCriterium.InterlockingPorcentage) + VV_SEP;
334 334 Result := Result + IntToStr(AEndCriterium.LastCycles) + VV_SEP;
335 335 end;
... ...
units/game_resources.pas
  Diff comments   View file @e3d84bd
... ... @@ -291,7 +291,7 @@ const
291 291 Value : gecWhichComeFirst;
292 292 InterlockingPorcentage : 10;
293 293 LastCycles : 6;
294   - AbsoluteCyles: 8;
  294 + AbsoluteCycles: 8;
295 295 );
296 296 );
297 297  
... ...
units/game_visual_elements.pas
  Diff comments   View file @e3d84bd
... ... @@ -57,7 +57,6 @@ begin
57 57 PanelLastColor.Caption:=CAP_NA;
58 58 //PanelLastColor.Color:= $0;
59 59 PanelLastColor.Parent:= Self;
60   -
61 60 LabelLastRow:= TLabel.Create(Self);
62 61 LabelLastRow.Caption:=CAP_ROW;
63 62 LabelLastRow.Parent := Self;
... ...
units/string_methods.pas
  Diff comments   View file @e3d84bd
... ... @@ -13,6 +13,7 @@ uses
13 13 function GetAndDelFirstValue(var S: string;Sep:Char=','):string;
14 14 function GetRowString(ARow : TGameRow) : string;
15 15 function GetRowFromString(S : string):TGameRow;
  16 +function GetRowColorFromString(S:string): TColor;
16 17 function GetColorString(AColor : TGameColor) : string;
17 18 function GetColorFromString(S : string) : TGameColor;
18 19 function GetPromptStyleFromString(S : string) : TPromptStyle;
... ... @@ -100,6 +101,7 @@ begin
100 101 end;
101 102 end;
102 103  
  104 +
103 105 function GetPromptStyleFromString(S: string): TPromptStyle;
104 106 begin
105 107 // todos,sim,metacontingência,recuperar pontos,
... ... @@ -219,6 +221,17 @@ begin
219 221 end;
220 222 end;
221 223  
  224 +function GetRowColorFromString(S:string): TColor;
  225 +begin
  226 + case S of
  227 + 'Y' : Result := ccYellow;
  228 + 'B' : Result := ccBlue;
  229 + 'G' : Result := ccGreen;
  230 + 'R' : Result := ccRed;
  231 + 'M' : Result := ccMagenta;
  232 + end;
  233 +end;
  234 +
222 235 //function ValidateString(S: String): string;
223 236 ////var
224 237 //// i:integer;
... ...