From e3d84bd81d9e22822c3a490493e66bcae9d4e84c Mon Sep 17 00:00:00 2001 From: cpicanco Date: Wed, 23 Nov 2016 14:12:08 -0300 Subject: [PATCH] dump --- backup/form_chooseactor.lfm | 42 ++++++++++++++++++++++++++++++++++++++++++ backup/form_chooseactor.pas | 90 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ form_matrixgame.pas | 2 +- units/game_actors.pas | 6 +++--- units/game_control.pas | 28 ++++++++++++++++++++++++---- units/game_experiment.pas | 103 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++--- units/game_file_methods.pas | 4 ++-- units/game_resources.pas | 2 +- units/game_visual_elements.pas | 1 - units/string_methods.pas | 13 +++++++++++++ 10 files changed, 276 insertions(+), 15 deletions(-) create mode 100644 backup/form_chooseactor.lfm create mode 100644 backup/form_chooseactor.pas diff --git a/backup/form_chooseactor.lfm b/backup/form_chooseactor.lfm new file mode 100644 index 0000000..5a671cb --- /dev/null +++ b/backup/form_chooseactor.lfm @@ -0,0 +1,42 @@ +object FormChooseActor: TFormChooseActor + Left = 416 + Height = 240 + Top = 194 + Width = 320 + BorderStyle = bsNone + Caption = 'FormChooseActor' + ClientHeight = 240 + ClientWidth = 320 + OnCloseQuery = FormCloseQuery + Position = poScreenCenter + LCLVersion = '1.6.2.0' + object btnAdmin: TButton + Left = 64 + Height = 25 + Top = 70 + Width = 184 + Caption = 'Administrador' + OnClick = btnAdminClick + TabOrder = 0 + end + object btnPlayer: TButton + Left = 64 + Height = 25 + Top = 125 + Width = 179 + Caption = 'Jogador' + OnClick = btnPlayerClick + TabOrder = 1 + end + object btnPlayerResume: TButton + Left = 50 + Height = 140 + Top = 50 + Width = 220 + Align = alClient + BorderSpacing.Around = 50 + Caption = 'ENTRAR' + OnClick = btnPlayerResumeClick + TabOrder = 2 + end +end diff --git a/backup/form_chooseactor.pas b/backup/form_chooseactor.pas new file mode 100644 index 0000000..e1e4aa6 --- /dev/null +++ b/backup/form_chooseactor.pas @@ -0,0 +1,90 @@ +unit form_chooseactor; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, Forms, Controls, + Graphics, Dialogs, StdCtrls,ExtCtrls, LCLType + , game_actors + ; + +type + + { TFormChooseActor } + + TFormChooseActor = class(TForm) + btnAdmin: TButton; + btnPlayer: TButton; + btnPlayerResume: TButton; + procedure btnAdminClick(Sender: TObject); + procedure btnPlayerClick(Sender: TObject); + procedure btnPlayerResumeClick(Sender: TObject); + procedure FormCloseQuery(Sender: TObject; var CanClose: boolean); + //procedure FormCreate(Sender: TObject); + private + FGameActor: TGameActor; + FCanClose : Boolean; + FStyle: string; + procedure SetStyle(AValue: string); + { private declarations } + public + property GameActor : TGameActor read FGameActor; + property Style : string read FStyle write SetStyle; + end; + +var + FormChooseActor: TFormChooseActor; + +implementation + +{$R *.lfm} + +{ TFormChooseActor } + +procedure TFormChooseActor.btnAdminClick(Sender: TObject); +begin + FGameActor:=gaAdmin; + FCanClose := True; + ModalResult:=1; +end; + +procedure TFormChooseActor.btnPlayerClick(Sender: TObject); +begin + FGameActor:=gaPlayer; + FCanClose := True; + ModalResult:=1; +end; + +procedure TFormChooseActor.btnPlayerResumeClick(Sender: TObject); +begin + FCanClose := True; + ModalResult:=1; +end; + +procedure TFormChooseActor.FormCloseQuery(Sender: TObject; var CanClose: boolean + ); +begin + CanClose := FCanClose; +end; + +//procedure TFormChooseActor.FormCreate(Sender: TObject); +//begin +// FCanClose := True; +//end; + +procedure TFormChooseActor.SetStyle(AValue: string); +begin + if FStyle=AValue then Exit; + case AValue of + '.Arrived': btnPlayerResume.Visible:=False; + '.Left': btnPlayerResume.Visible:=True; + end; + FStyle:=AValue; +end; + + + +end. + diff --git a/form_matrixgame.pas b/form_matrixgame.pas index 4e0a642..03daa5d 100644 --- a/form_matrixgame.pas +++ b/form_matrixgame.pas @@ -17,7 +17,6 @@ uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Grids, StdCtrls, DBGrids, ExtCtrls - //, zmq_pub_sub , game_zmq_actors , game_actors , game_control @@ -295,6 +294,7 @@ procedure TFormMatrixGame.btnConfirmRowClick(Sender: TObject); begin StringGridMatrix.Enabled:= False; btnConfirmRow.Enabled:=False; + btnConfirmRow.Caption:='OK'; FGameControl.SendMessage(K_CHOICE); end; diff --git a/units/game_actors.pas b/units/game_actors.pas index e59c888..3bf0fb6 100644 --- a/units/game_actors.pas +++ b/units/game_actors.pas @@ -96,7 +96,7 @@ type Value : TGameEndCondition; InterlockingPorcentage, LastCycles, - AbsoluteCyles: integer; + AbsoluteCycles: integer; end; TPoints = record @@ -114,13 +114,13 @@ type Turn : record // for changing cycles Count, // current turn - Value : integer; // PlayersPerTurn, CycleIncrement + Value : integer; // PlayersPerCycle, TurnsPerCycle Random: Boolean; // if we should change Players[i].Turn OnCycle end; Cycles : record // for changing generations Count, // current cycle - Value, // CyclesPerLineage, GenegarationIncrement + Value, // CyclesPerLineage, CyclesPerGeneration Generation : integer; end; Prompt : TPrompt; // onEndCycle diff --git a/units/game_control.pas b/units/game_control.pas index f177ddc..2ec4ad8 100644 --- a/units/game_control.pas +++ b/units/game_control.pas @@ -75,7 +75,7 @@ const K_RESUME = '.Resume'; K_DATA_A = '.Data'; K_LOGIN = '.Login'; - K_KICK = '.Kick' + K_KICK = '.Kick'; // K_STATUS = '.Status'; K_CYCLES = '.OnCycleStart'; @@ -221,8 +221,12 @@ begin end; function TGameControl.GetSelectedRowF(AStringGrid: TStringGrid): UTF8string; +var i : integer; begin - Result := IntToStr(AStringGrid.Selection.Top); + i := AStringGrid.Selection.Top; + if RowBase = 0 then + Inc(i); + Result := Format('%-*.*d', [1,2,i]); end; procedure TGameControl.SetMustDrawDots(AValue: Boolean); @@ -269,8 +273,9 @@ end; procedure TGameControl.StartTurn; begin - FormMatrixGame.StringGridMatrix.Options := FormMatrixGame.StringGridMatrix.Options-[goRowSelect]; FormMatrixGame.btnConfirmRow.Enabled:=True; + FormMatrixGame.StringGridMatrix.Options := FormMatrixGame.StringGridMatrix.Options-[goRowSelect]; + FormMatrixGame.btnConfirmRow.Caption:='Confirmar'; FormMatrixGame.btnConfirmRow.Visible := False; end; @@ -419,11 +424,22 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList); procedure ReceiveChoice; begin + with GetPlayerBox(AMessage[1]) do + begin + LabelLastRowCount.Caption := Format('%-*.*d', [1,2,StrToInt(AMessage[2])]); + PanelLastColor.Color := GetRowColorFromString(AMessage[3]); + FormMatrixGame.Caption:=''; + end; + case FActor of gaPlayer:begin end; + gaAdmin:begin + // if last choice in cycle then end cycle + FExperiment.NextTurn; + Inc(FExperiment.Condition[FExperiment.CurrentCondition].Turn.Count); end; end; @@ -494,7 +510,6 @@ begin if MHas(K_CHAT_M) then ReceiveChat; if MHas(K_CHOICE) then ReceiveChoice; if MHas(K_KICK) then SayGoodBye; - if MHas(K_STATUS) then ReceiveStatus; end; // Here FActor is garanted to be a TZMQAdmin @@ -630,6 +645,11 @@ procedure TGameControl.ReceiveReply(AReply: TStringList); end; end; + procedure ResumePlayer; + begin + + end; + begin if MHas(K_RESUME+K_ARRIVED) then ResumePlayer; if MHas(K_LOGIN+K_ARRIVED) then LoginAccepted; diff --git a/units/game_experiment.pas b/units/game_experiment.pas index dd7313d..b6c5bf6 100644 --- a/units/game_experiment.pas +++ b/units/game_experiment.pas @@ -24,6 +24,10 @@ type FExperimentName, FFilename, FResearcher : UTF8string; + FOnEndCondition: TNotifyEvent; + FOnEndCycle: TNotifyEvent; + FOnEndExperiment: TNotifyEvent; + FOnEndGeneration: TNotifyEvent; FMatrixType: TGameMatrixType; FRegData : TRegData; FGenPlayersAsNeeded : Boolean; @@ -40,6 +44,8 @@ type function GetContingency(ACondition, I : integer): TContingency; function GetNextTurn: integer; function GetNextTurnPlayerID: UTF8string; + function GetNextCycle:integer; + function GetNextCondition:integer; function GetPlayer(I : integer): TPlayer; overload; function GetPlayer(AID : UTF8string): TPlayer; overload; function GetPlayerAsString(P: TPlayer): UTF8string; @@ -50,6 +56,10 @@ type procedure SetCondition(I : Integer; AValue: TCondition); procedure SetContingency(ACondition, I : integer; AValue: TContingency); procedure SetMatrixType(AValue: TGameMatrixType); + procedure SetOnEndCondition(AValue: TNotifyEvent); + procedure SetOnEndCycle(AValue: TNotifyEvent); + procedure SetOnEndExperiment(AValue: TNotifyEvent); + procedure SetOnEndGeneration(AValue: TNotifyEvent); procedure SetPlayer(I : integer; AValue: TPlayer); overload; procedure SetPlayer(S : UTF8string ; AValue: TPlayer); overload; procedure SetResearcherCanChat(AValue: Boolean); @@ -71,6 +81,7 @@ type procedure SaveToFile(AFilename: string); overload; procedure SaveToFile; overload; procedure Clean; + procedure Play; property ResearcherCanPlay : Boolean read FResearcherCanPlay write SetResearcherCanPlay; property ResearcherCanChat : Boolean read FResearcherCanChat write SetResearcherCanChat; property Researcher : UTF8string read FResearcher write FResearcher; @@ -93,7 +104,14 @@ type property MatrixType : TGameMatrixType read FMatrixType write SetMatrixType; property NextTurnPlayerID : UTF8string read GetNextTurnPlayerID; property NextTurn : integer read GetNextTurn; + property NextCycle : integer read GetNextCycle; + property NextCondition : integer read GetNextCondition; property State : TExperimentState read FState write SetState; + public + property OnEndCycle : TNotifyEvent read FOnEndCycle write SetOnEndCycle; + property OnEndGeneration : TNotifyEvent read FOnEndGeneration write SetOnEndGeneration; + property OnEndCondition : TNotifyEvent read FOnEndCondition write SetOnEndCondition; + property OnEndExperiment : TNotifyEvent read FOnEndExperiment write SetOnEndExperiment; end; resourcestring @@ -123,9 +141,14 @@ end; function TExperiment.GetNextTurn: integer; // used during player arriving begin Result := FConditions[CurrentCondition].Turn.Count; - if FConditions[CurrentCondition].Turn.Count = FConditions[CurrentCondition].Turn.Value then - FConditions[CurrentCondition].Turn.Count := 0 - else Inc(FConditions[CurrentCondition].Turn.Count); + if FConditions[CurrentCondition].Turn.Count < FConditions[CurrentCondition].Turn.Value then + Inc(FConditions[CurrentCondition].Turn.Count) + else + begin + FConditions[CurrentCondition].Turn.Count := 0; + if Assigned(FOnEndCycle) then FOnEndCycle(Self); + NextCycle; + end; end; function TExperiment.GetNextTurnPlayerID: UTF8string; // used during cycles @@ -134,6 +157,51 @@ begin GetNextTurn; end; +function TExperiment.GetNextCycle: integer; +begin + Result := FConditions[CurrentCondition].Cycles.Count; + if FConditions[CurrentCondition].Cycles.Count < FConditions[CurrentCondition].Cycles.Value then + Inc(FConditions[CurrentCondition].Cycles.Count) + else + begin + FConditions[CurrentCondition].Cycles.Count := 0; + if Assigned(FOnEndGeneration) then FOnEndGeneration(Self); + NextCondition; + end; +end; + +function TExperiment.GetNextCondition: integer; +var LCycles : integer; +begin + Inc(FConditions[CurrentCondition].Cycles.Generation); + Result := CurrentCondition; + LCycles := (FConditions[CurrentCondition].Cycles.Value * + FConditions[CurrentCondition].Cycles.Generation) + FConditions[CurrentCondition].Cycles.Count; + + if FConditions[CurrentCondition].EndCriterium.Value = gecAbsoluteCycles then + begin + if LCycles < FConditions[CurrentCondition].EndCriterium.AbsoluteCycles then + // do nothing + else + begin + Inc(CurrentCondition); + FConditions[CurrentCondition].Turn.Count := 0; + Inc(FConditions[CurrentCondition].Cycles.Count); + if Assigned(FOnEndCondition) then FOnEndCondition(Self); + end; + end; + +// +// if FConditions[CurrentCondition].Turn.Count < FConditions[CurrentCondition].Turn.Value then +// Inc(FConditions[CurrentCondition].Turn.Count +// else +// begin +// FConditions[CurrentCondition].Turn.Count := 0; +// Inc(FConditions[CurrentCondition].Cycles.Count); +// if Assigned(FOnEndCycle) then FOnEndCycle(Self); +// end; +end; + function TExperiment.GetPlayer(I : integer): TPlayer; begin Result := FPlayers[i]; @@ -342,6 +410,30 @@ begin FMatrixType:=AValue; end; +procedure TExperiment.SetOnEndCondition(AValue: TNotifyEvent); +begin + if FOnEndCondition=AValue then Exit; + FOnEndCondition:=AValue; +end; + +procedure TExperiment.SetOnEndCycle(AValue: TNotifyEvent); +begin + if FOnEndCycle=AValue then Exit; + FOnEndCycle:=AValue; +end; + +procedure TExperiment.SetOnEndExperiment(AValue: TNotifyEvent); +begin + if FOnEndExperiment=AValue then Exit; + FOnEndExperiment:=AValue; +end; + +procedure TExperiment.SetOnEndGeneration(AValue: TNotifyEvent); +begin + if FOnEndGeneration=AValue then Exit; + FOnEndGeneration:=AValue; +end; + procedure TExperiment.SetPlayer(I : integer; AValue: TPlayer); begin @@ -476,5 +568,10 @@ begin end; +procedure TExperiment.Play; +begin + +end; + end. diff --git a/units/game_file_methods.pas b/units/game_file_methods.pas index c894770..c1651bd 100644 --- a/units/game_file_methods.pas +++ b/units/game_file_methods.pas @@ -85,7 +85,7 @@ var 1: Result.Value := gecInterlockingPorcentage; 2: Result.Value := gecWhichComeFirst; end; - Result.AbsoluteCyles := StrToIntDef(GetAndDelFirstValue(LS), 20); + Result.AbsoluteCycles := StrToIntDef(GetAndDelFirstValue(LS), 20); Result.InterlockingPorcentage := StrToIntDef(GetAndDelFirstValue(LS),10); Result.LastCycles := StrToIntDef(GetAndDelFirstValue(LS), 10); end; @@ -329,7 +329,7 @@ var gecWhichComeFirst: Result := '2'; end; Result := Result + VV_SEP; - Result := Result + IntToStr(AEndCriterium.AbsoluteCyles) + VV_SEP; + Result := Result + IntToStr(AEndCriterium.AbsoluteCycles) + VV_SEP; Result := Result + IntToStr(AEndCriterium.InterlockingPorcentage) + VV_SEP; Result := Result + IntToStr(AEndCriterium.LastCycles) + VV_SEP; end; diff --git a/units/game_resources.pas b/units/game_resources.pas index 4502545..b72ea2e 100644 --- a/units/game_resources.pas +++ b/units/game_resources.pas @@ -291,7 +291,7 @@ const Value : gecWhichComeFirst; InterlockingPorcentage : 10; LastCycles : 6; - AbsoluteCyles: 8; + AbsoluteCycles: 8; ); ); diff --git a/units/game_visual_elements.pas b/units/game_visual_elements.pas index 303ec15..86b4c33 100644 --- a/units/game_visual_elements.pas +++ b/units/game_visual_elements.pas @@ -57,7 +57,6 @@ begin PanelLastColor.Caption:=CAP_NA; //PanelLastColor.Color:= $0; PanelLastColor.Parent:= Self; - LabelLastRow:= TLabel.Create(Self); LabelLastRow.Caption:=CAP_ROW; LabelLastRow.Parent := Self; diff --git a/units/string_methods.pas b/units/string_methods.pas index 97f6abe..c1a0b57 100644 --- a/units/string_methods.pas +++ b/units/string_methods.pas @@ -13,6 +13,7 @@ uses function GetAndDelFirstValue(var S: string;Sep:Char=','):string; function GetRowString(ARow : TGameRow) : string; function GetRowFromString(S : string):TGameRow; +function GetRowColorFromString(S:string): TColor; function GetColorString(AColor : TGameColor) : string; function GetColorFromString(S : string) : TGameColor; function GetPromptStyleFromString(S : string) : TPromptStyle; @@ -100,6 +101,7 @@ begin end; end; + function GetPromptStyleFromString(S: string): TPromptStyle; begin // todos,sim,metacontingência,recuperar pontos, @@ -219,6 +221,17 @@ begin end; end; +function GetRowColorFromString(S:string): TColor; +begin + case S of + 'Y' : Result := ccYellow; + 'B' : Result := ccBlue; + 'G' : Result := ccGreen; + 'R' : Result := ccRed; + 'M' : Result := ccMagenta; + end; +end; + //function ValidateString(S: String): string; ////var //// i:integer; -- libgit2 0.21.2