From 1722c6f81bf5f93dac6f8431a6cd70a3daa57e96 Mon Sep 17 00:00:00 2001 From: cpicanco Date: Sat, 26 Nov 2016 03:31:17 -0300 Subject: [PATCH] work on criteria, prompt, messages and refac dumps --- units/game_actors.pas | 297 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++----------------------------------------------------------------------------------------------------------------------- units/game_actors_point.pas | 35 +++++++++++++++-------------------- units/game_control.pas | 367 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++------------------------------------------------------------------------------------------------- units/game_experiment.pas | 216 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++------------------------------------------------------------------------------------------------------------------------------------------------------- units/game_file_methods.pas | 148 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++------------------------------------------------------------------------------------------- units/game_resources.pas | 73 +++++++++++++++---------------------------------------------------------- units/string_methods.pas | 356 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++--------------------------------------------------------------- 7 files changed, 893 insertions(+), 599 deletions(-) diff --git a/units/game_actors.pas b/units/game_actors.pas index f2f48b0..19e7e80 100644 --- a/units/game_actors.pas +++ b/units/game_actors.pas @@ -80,23 +80,30 @@ type private FAppendicePlural: UTF8String; FAppendiceSingular: UTF8String; + FLastPresentedMessage: UTF8string; FNicname: UTF8String; - protected FStyle : TConsequenceStyle; FP : TGamePoint; FMessage : TPopupNotifier; + function GetShouldPublishMessage: Boolean; + protected + FConsequenceByPlayerID : TStringList; procedure StopTimer(Sender:TObject;var ACloseAction:TCloseAction); procedure TimerTimer(Sender:TOBject);virtual; public constructor Create(AOwner:TComponent; AP:TGamePoint; AStyle:TConsequenceStyle; AAppendiceSingular,AAppendicePlural:UTF8String);overload; constructor Create(AOwner:TComponent; AP:integer; AStyle: TConsequenceStyle; AMessage:array of UTF8string);overload; - constructor Create(AOwner:TComponent; AConsequenceString: UTF8String);overload; + constructor Create(AOwner:TComponent; AConsequenceString: UTF8String);virtual;overload; destructor Destroy;override; - function AsString: utf8string; - procedure Present(Sender:TObject;ForGroup:Boolean);virtual; + function AsString(AID :UTF8String): UTF8String; + function PointMessage(ForGroup: Boolean):UTF8String; + procedure Present(ForGroup: Boolean); + property ShouldPublishMessage : Boolean read GetShouldPublishMessage; + property LastPresentedMessage : UTF8string read FLastPresentedMessage; property PlayerNicname : UTF8String read FNicname write FNicname; property AppendiceSingular : UTF8String read FAppendiceSingular; property AppendicePlural : UTF8String read FAppendicePlural; + property ConsequenseByPlayerID : TStringList read FConsequenceByPlayerID; end; { TContingency } @@ -130,13 +137,20 @@ type TPrompt = class(TConsequence) private + FResponses : array of UTF8String; + FResult : UTF8String; FPromptTargets : TContingencies; // need to test this + FPromptStyle : TPromptStyle; + FPromptMessage : UTF8String; + procedure ClearResponses; public - PromptStyle : TPromptStyle; - PromptMessage : string; - public - procedure Present(Sender:TObject;ForGroup:Boolean);override; - property APromptTargets: TContingencies read FPromptTargets; + constructor Create(AOwner:TComponent; APStyle:TPromptStyle; APTarget : TContingencies; AMessage:UTF8string);reintroduce; + function ResponsesCount : integer; + procedure AppendResponse(AID,R:UTF8String); + function AsString: TStringList; overload; + property Question: UTF8String read FPromptMessage; + property PromptResult:UTF8String read FResult; + end; TEndConditionCriterium = record @@ -153,6 +167,10 @@ type TCondition = record ConditionName : string; Contingencies : TContingencies; // for producing points during the condition + Interlocks : record + Count : integer; // culturant, + History: array of Boolean; // to calculate interlock porcentage in the last cycles. sync with OnCycles + end; Points : record Count : TPoints; // sum of points produced during the condition @@ -165,7 +183,7 @@ type Random: Boolean; // if we should change Players[i].Turn OnCycle end; - Cycles : record // for changing generations + Cycles : record // for changing generations //absolute value is (Value * Generation)+Count Count, // current cycle Value, // CyclesPerLineage, CyclesPerGeneration Generation : integer; @@ -176,7 +194,7 @@ type implementation -uses ButtonPanel,Controls,ExtCtrls,strutils, string_methods, +uses Graphics, strutils, string_methods, form_matrixgame{,StdCtrls}; { TContingency } @@ -198,8 +216,8 @@ end; procedure TContingency.CriteriaEvent; begin - // FConsequence.Present(FMeta); - // do admin internals + FFired:=True; + if Assigned(FOnCriteria) then FOnCriteria(Self); end; constructor TContingency.Create(AOwner:TComponent;AConsequence:TConsequence;ACriteria:TCriteria;IsMeta:Boolean); @@ -220,13 +238,7 @@ begin Result += GetRowString(R) + ','; Result += '|'; - case FCriteria.Style of - gtNone : Result += 'INDIFERENTE'; - gtRowsAndColors : Result += 'E'; - gtRowsOrColors : Result += 'OU'; - gtRowsOnly: Result += 'LINHAS'; - gtColorsOnly:Result += 'CORES'; - end; + Result += GetCriteriaStyleString(FCriteria.Style); Result += ','; Result += '|'; @@ -255,7 +267,7 @@ begin gtRowsOrColors: Result := LRow or LColor; end; if Result then - if Assigned(FOnCriteria) then FOnCriteria(Self); + CriteriaEvent; end; function TContingency.ResponseMeetsCriteriaG(Players: TPlayers): Boolean; @@ -269,48 +281,50 @@ var i : integer; function AllColorsEqual:Boolean; var i : integer; begin - Result := True; + Result := not (gcNot in Criteria.Colors); for i := 0 to Len-2 do if Cs[i] <> Cs[i+1] then begin - Result := False; - Break; + Result := not Result; + Break; end; end; function AllColorsDiff:Boolean; var i : integer; begin - Result := True; + Result := not (gcNot in Criteria.Colors); for i := 0 to Len-2 do if Cs[i] = Cs[i+1] then begin - Result := False; - Break; + Result := not Result; + Break; end; end; function AllRowsOdd: Boolean; begin + Result := not (grNot in Criteria.Rows); for R in Rs do if RowMod(R) = grEven then begin - Result := False; - Exit; + Result := not Result; + Break; end; end; function AllRowsEven: Boolean; begin + Result := not (grNot in Criteria.Rows); for R in Rs do if RowMod(R) = grOdd then begin - Result := False; - Exit; + Result := not Result; + Break; end; end; -begin // grDiff,grEqual,grAll +begin // All -> (Diff,Equal,Even, Odd) or not all Result := False; Len := Length(Players); SetLength(Cs,Len); @@ -348,13 +362,13 @@ begin // grDiff,grEqual,grAll Result := AllColorsDiff and AllRowsOdd; if (gcDiff in Criteria.Colors) and (grEven in Criteria.Rows) then - Result := AllColorsDiff and AllRowsEven; + Result := AllColorsDiff and AllRowsEven; if (gcEqual in Criteria.Colors) and (grOdd in Criteria.Rows) then - Result := AllColorsEqual and AllRowsOdd; + Result := AllColorsEqual and AllRowsOdd; if (gcEqual in Criteria.Colors) and (grEven in Criteria.Rows) then - Result := AllColorsEqual and AllRowsEven; + Result := AllColorsEqual and AllRowsEven; end; gtRowsOrColors: begin @@ -362,61 +376,118 @@ begin // grDiff,grEqual,grAll Result := AllColorsDiff or AllRowsOdd; if (gcDiff in Criteria.Colors) and (grEven in Criteria.Rows) then - Result := AllColorsDiff or AllRowsEven; + Result := AllColorsDiff or AllRowsEven; if (gcEqual in Criteria.Colors) and (grOdd in Criteria.Rows) then - Result := AllColorsEqual or AllRowsOdd; + Result := AllColorsEqual or AllRowsOdd; if (gcEqual in Criteria.Colors) and (grEven in Criteria.Rows) then - Result := AllColorsEqual or AllRowsEven; + Result := AllColorsEqual or AllRowsEven; end; end; if Result then - if Assigned(FOnCriteria) then FOnCriteria(Self); + CriteriaEvent; end; { TPrompt } -procedure TPrompt.Present(Sender: TObject; ForGroup: Boolean); +procedure TPrompt.ClearResponses; +begin + FResponses := nil; +end; + +constructor TPrompt.Create(AOwner: TComponent; APStyle: TPromptStyle; + APTarget: TContingencies; AMessage: UTF8string); +begin + inherited Create(AOwner); + FPromptStyle := APStyle; + FPromptTargets := APTarget; + FPromptMessage := AMessage; +end; + +function TPrompt.ResponsesCount: integer; +begin + Result := Length(FResponses); +end; - function AskQuestion: boolean; - var - dlg: TForm; - buttonPanel: TButtonPanel; - mainPanel: TPanel; - mr: TModalResult; +procedure TPrompt.AppendResponse(AID, R: UTF8String); +begin + SetLength(FResponses,Length(FResponses)+1); + FResponses[High(FResponses)] := AID+'|'+R+'|'; +end; + +function TPrompt.AsString: TStringList; +var + j,i : integer; + LID,LConsequence : UTF8string; + LCsqStyle : TConsequenceStyle; + Pts : integer; + + function AllPlayersClickedYes: Boolean; + var i : integer; begin - dlg:=TForm.CreateNew(nil); - try - with dlg do begin - BorderStyle:=bsNone; - WindowState:=wsFullScreen; - //Position:=poScreenCenter; - Caption:='Task ' + IntToStr(0 {Succ(0)}); - buttonPanel:=TButtonPanel.Create(dlg); - with buttonPanel do begin - ShowButtons:=[pbCancel, pbOK]; - ShowBevel:=False; - Parent:=dlg; - end; - mainPanel:=TPanel.Create(dlg); - with mainPanel do begin - Align:=alClient; - Caption:=Format('Task %d - GUI buttons/edits etc. go here',[0]); - Parent:=dlg; + Result := True; + for i := 0 to Length(FResponses)-1 do + if ExtractDelimited(2,FResponses[i],['|']) = 'N' then + begin + Result := False; end; + end; + + procedure ApplyPointsConditions(IsMeta:Boolean); + var + S : UTF8string; + begin + Pts := StrToInt(ExtractDelimited(1,LConsequence, ['|'])); + if gsRevertPoints in FPromptStyle then + Pts := Pts*-1; - mr:=ShowModal; - Result:=(mr = mrOK); + if (gscB in LCsqStyle) and (gsBasA in FPromptStyle) then + begin + LCsqStyle += [gscB]; + LCsqStyle -= [gscA]; end; - finally - dlg.Free; - end; + + if IsMeta then + S := 'M' + else + S := LID; + + LConsequence := S + '+' + + IntToStr(Pts) +'|'+ + GetConsequenceStylesString(LCsqStyle) +'|'+ + ExtractDelimited(3,LConsequence, ['|']) +'|'+ + ExtractDelimited(4,LConsequence, ['|']) +'|'+ + ExtractDelimited(5,LConsequence, ['|']); end; begin - inherited Present(Sender, ForGroup); - //SendMessage(AskQuestion); + // to do, sanitize FPromptStyle first + Pts:= 0; + if (gsAll in FPromptStyle) and (gsYes in FPromptStyle) then + if AllPlayersClickedYes then + for i := 0 to Length(FPromptTargets)-1 do + for j := 0 to FPromptTargets[i].Consequence.ConsequenseByPlayerID.Count do + begin + LID := FPromptTargets[i].Consequence.ConsequenseByPlayerID.Names[j]; + LConsequence := FPromptTargets[i].Consequence.ConsequenseByPlayerID.Values[LID]; + LCsqStyle := GetConsequenceStylesFromString(ExtractDelimited(2,LConsequence, ['|'])); + + if gsContingency in FPromptStyle then + if (FPromptTargets[i].Fired) and (not FPromptTargets[i].Meta) then + if (gscA in LCsqStyle) or (gscB in LCsqStyle) then + ApplyPointsConditions(False); + + + if gsMetacontingency in FPromptStyle then + if (FPromptTargets[i].Fired) and FPromptTargets[i].Meta then + if gscG in LCsqStyle then + ApplyPointsConditions(True); + + Result := TStringList.Create; + Result.Add(LConsequence); + end; + end; { TConsequence } @@ -431,6 +502,7 @@ begin FAppendicePlural:=AAppendicePlural; FP := AP; FMessage := TPopupNotifier.Create(AOwner); + FConsequenceByPlayerID := TStringList.Create; end; constructor TConsequence.Create(AOwner: TComponent; AP: integer; @@ -443,83 +515,65 @@ begin FAppendicePlural:=AMessage[2]; FP := TGamePoint.Create(AOwner,AP); FMessage := TPopupNotifier.Create(AOwner); + FConsequenceByPlayerID := TStringList.Create; end; constructor TConsequence.Create(AOwner: TComponent; AConsequenceString: UTF8String); - - function GetConsequenceStyleFromString(S:UTF8String):TConsequenceStyle; - var - LCount, - i : integer; - begin - Result := []; - LCount := WordCount(S,[#0,',']); - for i:= 1 to LCount do - case ExtractDelimited(i,S,[',']) of - '0':Result+=[gscNone]; - 'M':Result+=[gscMessage]; - 'C':Result+=[gscBroadcastMessage]; - 'P':Result+=[gscPoints]; - 'V':Result+=[gscVariablePoints]; - 'A':Result+=[gscA]; - 'B':Result+=[gscB]; - end; - end; - begin inherited Create(AOwner); FP := TGamePoint.Create(AOwner,ExtractDelimited(1,AConsequenceString,['|'])); - FStyle:=GetConsequenceStyleFromString(ExtractDelimited(2,AConsequenceString,['|'])); + FStyle:=GetConsequenceStylesFromString(ExtractDelimited(2,AConsequenceString,['|'])); FNicname:=ExtractDelimited(3,AConsequenceString,['|']); FAppendiceSingular:=ExtractDelimited(4,AConsequenceString,['|']); FAppendicePlural:=ExtractDelimited(5,AConsequenceString,['|']); FMessage := TPopupNotifier.Create(AOwner); + FConsequenceByPlayerID := TStringList.Create; end; destructor TConsequence.Destroy; begin + FConsequenceByPlayerID.Free; inherited Destroy; end; -function TConsequence.AsString: utf8string; - function GetConsequenceStyleString(CS:TConsequenceStyle): UTF8String; - var ConsequenceStyle : TGameConsequenceStyle; - begin - Result := ''; - for ConsequenceStyle in CS do - begin - case ConsequenceStyle of - gscNone: Result += '0'; - gscMessage:Result += 'M'; - gscBroadcastMessage:Result += 'C'; - gscPoints:Result += 'P'; - gscVariablePoints:Result += 'V'; - gscA:Result += 'A'; - gscB:Result += 'B'; - end; - Result += ','; - end; - end; - +function TConsequence.AsString(AID: UTF8String): UTF8String; begin - Result := IntToStr(FP.Value)+','+IntToStr(FP.Variation) + '|'; - Result += GetConsequenceStyleString(FStyle)+'|'; + Result := IntToStr(FP.ValueWithVariation) + '|'; + Result += GetConsequenceStylesString(FStyle)+'|'; Result += FNicname +'|'; Result += FAppendiceSingular + '|'; Result += FAppendicePlural + '|'; + FConsequenceByPlayerID.Values[AID]:=Result; end; +function TConsequence.PointMessage(ForGroup: Boolean): UTF8String; +begin + Result := FP.PointMessage(FNicname,FAppendicePlural, FAppendiceSingular,ForGroup); + + if gscA in FStyle then + FormMatrixGame.LabelIndACount.Caption := IntToStr(StrToInt(FormMatrixGame.LabelIndACount.Caption) + FP.ResultAsInteger); -procedure TConsequence.Present(Sender: TObject; ForGroup: Boolean); + if gscB in FStyle then + FormMatrixGame.LabelIndBCount.Caption := IntToStr(StrToInt(FormMatrixGame.LabelIndBCount.Caption) + FP.ResultAsInteger); + + if gscG in FStyle then + FormMatrixGame.LabelGroupCount.Caption:= IntToStr(StrToInt(FormMatrixGame.LabelGroupCount.Caption) + FP.ResultAsInteger); +end; + + +procedure TConsequence.Present(ForGroup: Boolean); var PopUpPos : TPoint; begin - PopUpPos.X := FormMatrixGame.StringGridMatrix.Left+FormMatrixGame.StringGridMatrix.Width; - PopUpPos.Y := FormMatrixGame.StringGridMatrix.Top; - PopUpPos := FormMatrixGame.StringGridMatrix.ClientToScreen(PopUpPos); + PopUpPos.X := FormMatrixGame.GBIndividualAB.Left; + PopUpPos.Y := FormMatrixGame.GBIndividualAB.Top+FormMatrixGame.GBIndividual.Height-10; + PopUpPos := FormMatrixGame.ClientToScreen(PopUpPos); + FMessage.Color:=clTeal; + FMessage.Title:=''; FMessage.Text := FP.PointMessage(FNicname,FAppendicePlural, FAppendiceSingular,ForGroup); + FLastPresentedMessage := FMessage.Text; FMessage.OnClose:=@StopTimer; FormMatrixGame.Timer.OnTimer := @TimerTimer; @@ -532,15 +586,20 @@ begin if gscG in FStyle then FormMatrixGame.LabelGroupCount.Caption:= IntToStr(StrToInt(FormMatrixGame.LabelGroupCount.Caption) + FP.ResultAsInteger); + if gscBroadcastMessage in FStyle then Exit; FMessage.ShowAtPos(PopUpPos.X, PopUpPos.Y); FormMatrixGame.Timer.Enabled:=True; end; +function TConsequence.GetShouldPublishMessage: Boolean; +begin + Result := gscBroadcastMessage in FStyle; +end; + procedure TConsequence.StopTimer(Sender: TObject; var ACloseAction: TCloseAction ); begin FormMatrixGame.Timer.Enabled:=False; - Free; end; procedure TConsequence.TimerTimer(Sender: TOBject); diff --git a/units/game_actors_point.pas b/units/game_actors_point.pas index 99982d2..64ef302 100644 --- a/units/game_actors_point.pas +++ b/units/game_actors_point.pas @@ -19,15 +19,15 @@ type function GetResult: integer; function GetResultAsString: string; function GetValue: integer; - procedure SetValue(AValue: integer); public //Cycles : integer; // specify when present points regarding condition cycles constructor Create(AOwner:TComponent;AValue : integer);overload; constructor Create(AOwner:TComponent;AValue : array of integer); overload; - constructor Create(AOwner:TComponent;AValue : utf8string); overload; + constructor Create(AOwner:TComponent;AResult : UTF8String); overload; function PointMessage(APrepend, AAppendicePlural, AAppendiceSingular: string; IsGroupPoint: Boolean) : string; - property Value : integer read GetValue write SetValue; + property ValueWithVariation : integer read GetValue write FValue; property Variation : integer read FVariation write FVariation; + property AsString : string read GetResultAsString; property ResultAsInteger : integer read GetResult; end; @@ -67,11 +67,6 @@ begin Result := IntToStr(FResult); end; -procedure TGamePoint.SetValue(AValue: integer); -begin - FValue := AValue; -end; - constructor TGamePoint.Create(AOwner: TComponent; AValue: integer); begin inherited Create(AOwner); @@ -86,15 +81,15 @@ begin FVariation := AValue[1]; end; -constructor TGamePoint.Create(AOwner: TComponent; AValue: utf8string); +constructor TGamePoint.Create(AOwner: TComponent; AResult: utf8string); begin - FValue := StrToInt(ExtractDelimited(1,AValue,[','])); - FVariation := StrToInt(ExtractDelimited(2,AValue,[','])); + FValue := 0;//does not matter here, this creation method is called by a player, admin sent a result + FVariation := 0; + FResult := StrToInt(AResult); end; function TGamePoint.PointMessage(APrepend, AAppendicePlural, AAppendiceSingular: string; IsGroupPoint: Boolean): string; begin - Self.Value; if IsGroupPoint then begin if APrepend = '' then @@ -108,8 +103,8 @@ begin -MaxInt..-2: Result += ' produziram a perda de '+Self.AsString+ ' pontos para o grupo'; -1 : Result += ' produziram a perda de 1 ponto para o grupo'; 0 : Result += ' pontos do grupo não foram produzidos nem perdidos'; - 1 : Result += 'produziram 1 ponto para o grupo'; - 2..MaxInt: Result += 'produziu '+Self.AsString+' pontos para o grupo' + 1 : Result += ' produziram 1 ponto para o grupo'; + 2..MaxInt: Result += ' produziram '+Self.AsString+' pontos para o grupo' end; end else @@ -118,8 +113,8 @@ begin -MaxInt..-2: Result += ' produziram a perda de '+Self.AsString+ ' ' + AAppendicePlural; -1 : Result += ' produziram a perda de 1'+ ' ' + AAppendiceSingular; 0 : Result += ' não produziram ' + AAppendicePlural; - 1 : Result += ' produziram 1 ponto ' + AAppendiceSingular; - 2..MaxInt: Result += 'produziu '+Self.AsString+ ' ' + AAppendicePlural; + 1 : Result += ' produziram 1 ' + AAppendiceSingular; + 2..MaxInt: Result += ' produziram '+Self.AsString+ ' ' + AAppendicePlural; end; end; end @@ -137,17 +132,17 @@ begin -1 : Result += ' perdeu 1 ponto'; 0 : Result += ' não perdeu nem ganhou pontos'; 1 : Result += ' ganhou 1 ponto'; - 2..MaxInt: Result += 'ganhou '+Self.AsString+' pontos' + 2..MaxInt: Result += ' ganhou '+Self.AsString+' pontos' end; end else begin case FValue of -MaxInt..-2: Result += ' perdeu '+Self.AsString+ ' ' + AAppendicePlural; - -1 : Result += ' ponto 1'+ ' ' + AAppendiceSingular; + -1 : Result += ' ponto 1 ' + AAppendiceSingular; 0 : Result += ' não perdeu nem ganhou ' + AAppendicePlural; - 1 : Result += ' ganhou 1 ponto ' + AAppendiceSingular; - 2..MaxInt: Result += 'ganhou '+Self.AsString+ ' ' + AAppendicePlural; + 1 : Result += ' ganhou 1 ' + AAppendiceSingular; + 2..MaxInt: Result += ' ganhou '+Self.AsString+ ' ' + AAppendicePlural; end; end; end; diff --git a/units/game_control.pas b/units/game_control.pas index bd720fc..1fc1568 100644 --- a/units/game_control.pas +++ b/units/game_control.pas @@ -43,12 +43,21 @@ type procedure SetMustDrawDotsClear(AValue: Boolean); procedure SetRowBase(AValue: integer); private - function ShouldStartExperiment : Boolean; + function AskQuestion(AQuestion:UTF8string):UTF8String; + procedure ShowPopUp(AText:UTF8String); + procedure DisableConfirmationButton; + procedure CleanMatrix(AEnabled : Boolean); + procedure EnablePlayerMatrix(AID:UTF8String; ATurn:integer; AEnabled:Boolean); + private + function ShouldStartCycle : Boolean; + function ShouldAskQuestion : Boolean; procedure KickPlayer(AID:string); procedure NextTurn(Sender: TObject); procedure NextCycle(Sender: TObject); procedure NextLineage(Sender: TObject); procedure NextCondition(Sender: TObject); + procedure Interlocking(Sender: TObject); + procedure Consequence(Sender: TObject); procedure EndExperiment(Sender: TObject); procedure StartExperiment; public @@ -77,6 +86,7 @@ const K_REFUSED = '.Refused'; K_CHAT_M = '.ChatM'; K_CHOICE = '.Choice'; + K_MESSAGE = '.Message'; K_START = '.Start'; K_LEFT = '.Left'; K_RESUME = '.Resume'; @@ -84,6 +94,7 @@ const K_LOGIN = '.Login'; K_KICK = '.Kick'; K_QUESTION = '.Question'; + K_QMESSAGE = '.QMessage'; // K_STATUS = '.Status'; K_CYCLES = '.OnEndCycle'; @@ -92,7 +103,9 @@ const implementation -uses LazUTF8, form_matrixgame, form_chooseactor, game_resources, strutils, string_methods, zhelpers; +uses ButtonPanel,Controls,ExtCtrls, + LazUTF8, Forms, strutils, zhelpers, + form_matrixgame, form_chooseactor, game_resources, string_methods ; const GA_ADMIN = 'Admin'; @@ -117,11 +130,17 @@ end; { TGameControl } -function TGameControl.ShouldStartExperiment: Boolean; +function TGameControl.ShouldStartCycle: Boolean; // starts experiment too begin Result := FExperiment.PlayersCount = FExperiment.Condition[FExperiment.CurrentCondition].Turn.Value; end; +function TGameControl.ShouldAskQuestion: Boolean; // end cycle, restart alias +begin + // TODO: prompt only when an odd row was selected + Result := ShouldStartCycle and FExperiment.Condition[FExperiment.CurrentCondition].Contingencies[3].Fired; +end; + procedure TGameControl.KickPlayer(AID: string); begin FZMQActor.SendMessage([K_KICK, AID]); @@ -134,9 +153,7 @@ begin // inform players -{$IFDEF DEBUG} - WriteLn('TGameControl.NextTurn'); -{$ENDIF} + end; procedure TGameControl.NextCycle(Sender: TObject); @@ -144,8 +161,9 @@ begin // prompt question to all players FormMatrixGame.LabelExpCountCycle.Caption:=IntToStr(FExperiment.Condition[FExperiment.CurrentCondition].Cycles.Count); {$IFDEF DEBUG} - WriteLn('TGameControl.NextTurn'); + WriteLn('cycle:',FExperiment.ConsequenceStringFromChoices); {$ENDIF} + //FZMQActor.SendMessage([K_CYCLES]) end; procedure TGameControl.NextLineage(Sender: TObject); @@ -166,6 +184,20 @@ begin // append which player end; +procedure TGameControl.Interlocking(Sender: TObject); +begin + FormMatrixGame.LabelExpCountInterlocks.Caption:= IntToStr(FExperiment.Condition[FExperiment.CurrentCondition].Interlocks.Count); + +end; + +procedure TGameControl.Consequence(Sender: TObject); +begin +{$IFDEF DEBUG} + if Sender is TConsequence then + FormMatrixGame.ChatMemoRecv.Lines.Append(('['+TConsequence(Sender).PlayerNicname+']: ')+TConsequence(Sender).AsString('')); +{$ENDIF} +end; + procedure TGameControl.EndExperiment(Sender: TObject); begin @@ -298,7 +330,7 @@ end; function TGameControl.GetSelectedColorF(AStringGrid: TStringGrid): UTF8string; begin - Result := GetRowColorString(GetRowColor(AStringGrid.Selection.Top,RowBase)); + Result := GetColorString(GetRowColor(AStringGrid.Selection.Top,RowBase)); end; function TGameControl.GetSelectedRowF(AStringGrid: TStringGrid): UTF8string; @@ -332,6 +364,80 @@ begin FRowBase:=AValue; end; +function TGameControl.AskQuestion(AQuestion: UTF8string): UTF8String; +var + Prompt: TForm; + ButtonPanel: TButtonPanel; + QuestionPanel: TPanel; + mr: TModalResult; +begin + Prompt:=TForm.CreateNew(nil); + try + with Prompt do begin + BorderStyle:=bsNone; + Position:=poScreenCenter; + ButtonPanel:=TButtonPanel.Create(Prompt); + with ButtonPanel do begin + ButtonOrder:=boCloseOKCancel; + OKButton.Caption:='Sim'; + CancelButton.Caption:='Não'; + ShowButtons:=[pbOK, pbCancel]; + ShowBevel:=True; + ShowGlyphs:=[]; + Parent:=Prompt; + end; + QuestionPanel:=TPanel.Create(Prompt); + with QuestionPanel do begin + Align:=alClient; + Caption:= AQuestion; + Parent:=Prompt; + end; + + mr:=ShowModal; + if mr = mrOK then + Result := 'S' + else Result := 'N'; + end; + finally + Prompt.Free; + end; +end; + +procedure TGameControl.ShowPopUp(AText: UTF8String); +var PopUpPos : TPoint; +begin + PopUpPos.X := FormMatrixGame.GBIndividualAB.Left; + PopUpPos.Y := FormMatrixGame.GBIndividualAB.Top+FormMatrixGame.GBIndividual.Height-10; + PopUpPos := FormMatrixGame.ClientToScreen(PopUpPos); + FormMatrixGame.PopupNotifier.Title:=''; + FormMatrixGame.PopupNotifier.Text:=AText; + FormMatrixGame.PopupNotifier.ShowAtPos(PopUpPos.X,PopUpPos.Y); + FormMatrixGame.Timer.OnTimer:=@FormMatrixGame.TimerTimer; + FormMatrixGame.Timer.Enabled:=True; +end; + +procedure TGameControl.DisableConfirmationButton; +begin + FormMatrixGame.StringGridMatrix.Enabled:= False; + FormMatrixGame.btnConfirmRow.Enabled:=False; + FormMatrixGame.btnConfirmRow.Caption:='OK'; +end; + +procedure TGameControl.CleanMatrix(AEnabled : Boolean); +begin + FormMatrixGame.StringGridMatrix.Enabled:=AEnabled; + FormMatrixGame.StringGridMatrix.Options := FormMatrixGame.StringGridMatrix.Options-[goRowSelect]; + FormMatrixGame.btnConfirmRow.Enabled:=True; + FormMatrixGame.btnConfirmRow.Caption:='Confirmar'; + FormMatrixGame.btnConfirmRow.Visible := False; +end; + +procedure TGameControl.EnablePlayerMatrix(AID:UTF8String; ATurn:integer; AEnabled:Boolean); +begin + if FExperiment.PlayerFromID[AID].Turn = ATurn then + CleanMatrix(AEnabled); +end; + constructor TGameControl.Create(AOwner: TComponent); begin FZMQActor := TZMQActor(AOwner); @@ -358,13 +464,18 @@ begin FExperiment.OnEndTurn := @NextTurn; FExperiment.OnEndCycle := @NextCycle; FExperiment.OnEndGeneration:=@NextLineage; + FExperiment.OnInterlocking:=@Interlocking; + FExperiment.OnConsequence:=@Consequence; FExperiment.OnEndCondition:= @NextCondition; FExperiment.OnEndExperiment:= @EndExperiment; + FExperiment.OnInterlocking := @Interlocking; NextTurn(Self); NextCycle(Self); NextLineage(Self); NextCondition(Self); + Interlocking(Self); + Consequence(Self); SendRequest(K_LOGIN); end; @@ -480,11 +591,6 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList); var P : TPlayer; begin case FActor of - gaAdmin: - begin - // do nothing - end; - gaPlayer: begin P := FExperiment.PlayerFromString[AMessage[1]]; @@ -497,19 +603,6 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList); CreatePlayerBox(P,False); end; end; - - end; - - procedure SetPMatrix(ATurn:integer; AEnabled:Boolean); - begin - if FExperiment.PlayerFromID[Self.ID].Turn = ATurn then - begin - FormMatrixGame.StringGridMatrix.Enabled:=AEnabled; - FormMatrixGame.StringGridMatrix.Options := FormMatrixGame.StringGridMatrix.Options-[goRowSelect]; - FormMatrixGame.btnConfirmRow.Enabled:=True; - FormMatrixGame.btnConfirmRow.Caption:='Confirmar'; - FormMatrixGame.btnConfirmRow.Visible := False; - end; end; procedure ReceiveChoice; @@ -521,52 +614,58 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList); with GetPlayerBox(P.ID) do begin LabelLastRowCount.Caption := AMessage[2]; - PanelLastColor.Color := GetRowColorFromString(AMessage[3]); + PanelLastColor.Color := GetColorFromString(AMessage[3]); PanelLastColor.Caption:=''; end; case FActor of gaPlayer:begin + if FExperiment.PlayersCount = P.Turn+1 then + begin + // update next turn + if Self.ID = P.ID then + begin + P.Turn := StrToInt(AMessage[4]); + FExperiment.Player[Self.ID] := P; + end; + + // no wait turns + // EnablePlayerMatrix(Self.ID,0, True); + + //CleanMatrix; + CleanMatrix(False); + + // wait for server + Exit; + end; + if Self.ID = P.ID then begin - FormMatrixGame.StringGridMatrix.Enabled:= False; - FormMatrixGame.btnConfirmRow.Enabled:=False; - FormMatrixGame.btnConfirmRow.Caption:='OK'; + // update confirmation button + DisableConfirmationButton; + + // update next turn + P.Turn := StrToInt(AMessage[4]); + FExperiment.Player[Self.ID] := P; end else - SetPMatrix(P.Turn+1, True); - end; - - gaAdmin:begin - FExperiment.NextTurn; + EnablePlayerMatrix(Self.ID,P.Turn+1, True); end; end; end; procedure NotifyPlayers; - var PopUpPos : TPoint; begin case FActor of gaPlayer: - begin - PopUpPos.X := FormMatrixGame.StringGridMatrix.Left+FormMatrixGame.StringGridMatrix.Width; - PopUpPos.Y := FormMatrixGame.StringGridMatrix.Top; - PopUpPos := FormMatrixGame.StringGridMatrix.ClientToScreen(PopUpPos); if FExperiment.PlayerFromID[Self.ID].Turn = 0 then begin - PopUpPos.X := FormMatrixGame.StringGridMatrix.Left+FormMatrixGame.StringGridMatrix.Width; - PopUpPos.Y := FormMatrixGame.StringGridMatrix.Top; - SetPMatrix(0, True); - FormMatrixGame.PopupNotifier.Text:='É sua vez! Clique sobre uma linha da matrix e confirme sua escolha.'; - FormMatrixGame.PopupNotifier.ShowAtPos(PopUpPos.X,PopUpPos.Y); + EnablePlayerMatrix(Self.ID, 0, True); + ShowPopUp('É sua vez! Clique sobre uma linha da matrix e confirme sua escolha.'); end else - begin - FormMatrixGame.PopupNotifier.Text:='Começou! Aguarde sua vez.'; - FormMatrixGame.PopupNotifier.ShowAtPos(PopUpPos.X,PopUpPos.Y); - end; - FormMatrixGame.Timer.Enabled:=True; - end; + ShowPopUp('Começou! Aguarde sua vez.'); + end; end; @@ -578,19 +677,7 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList); case FActor of gaPlayer: begin - if FExperiment.PlayerFromID[Self.ID].Turn = 0 then - begin - SetPMatrix(0,True); - end - else - begin - //CleanMatrix; - FormMatrixGame.StringGridMatrix.Enabled:=False; - FormMatrixGame.StringGridMatrix.Options := FormMatrixGame.StringGridMatrix.Options-[goRowSelect]; - FormMatrixGame.btnConfirmRow.Enabled:=True; - FormMatrixGame.btnConfirmRow.Caption:='Confirmar'; - FormMatrixGame.btnConfirmRow.Visible := False; - end; + end; end; end; @@ -619,49 +706,80 @@ procedure TGameControl.ReceiveMessage(AMessage: TStringList); end; end; - procedure ResumeActor; + procedure ShowQuestion; begin case FActor of - gaPlayer:begin - - end; - gaAdmin:begin - - end; + gaPlayer:FZMQActor.Request([ + FZMQActor.ID + , ' ' + , GA_PLAYER+K_QUESTION + , AskQuestion(AMessage[1]) + ]); end; end; - - procedure ReceiveLogin; +// +// procedure ResumeActor; +// begin +// case FActor of +// gaPlayer:begin +// +// end; +// gaAdmin:begin +// +// end; +// end; +// end; + + + procedure QuestionMessages; + var + LConsequence : TConsequence; + i : integer; + MID : UTF8String; begin case FActor of + // AMessage[i] := + // S + '+' + + // IntToStr(Pts) +'|'+ + // GetConsequenceStylesString(LCsqStyle) +'|'+ + // ExtractDelimited(3,LConsequence, ['|']) +'|'+ + // ExtractDelimited(4,LConsequence, ['|']) +'|'+ + // ExtractDelimited(5,LConsequence, ['|']); gaPlayer:begin - - end; - gaAdmin:begin - + if AMessage.Count > 1 then + begin + for i := 1 to AMessage.Count -1 do + begin + MID := ExtractDelimited(1,AMessage[i],['+']); + if (MID = 'M') or (MID = Self.ID) then + begin + LConsequence := TConsequence.Create(FormMatrixGame,ExtractDelimited(2,AMessage[i],['+'])); + //LConsequence.PlayerNicname := P.Nicname; + ShowPopUp(LConsequence.PointMessage(MID = 'M')); + while FormMatrixGame.PopupNotifier.Visible do + Application.ProcessMessages; + + {$IFDEF DEBUG} + WriteLn('A consequence should have shown.'); + {$ENDIF} + end; + end; + end; end; end; end; - procedure ReceiveLogout; - begin - case FActor of - gaPlayer:begin - - end; - gaAdmin:begin - - end; - end; - end; begin if MHas(K_ARRIVED) then ReceiveActor; if MHas(K_CHAT_M) then ReceiveChat; if MHas(K_CHOICE) then ReceiveChoice; + if MHas(K_MESSAGE) then ShowPopUp(AMessage[1]); if MHas(K_KICK) then SayGoodBye; if MHas(K_START) then NotifyPlayers; if MHas(K_CYCLES) then OnEndCycle; + if MHas(K_QUESTION) then ShowQuestion; + if MHas(K_QMESSAGE) then QuestionMessages; end; // Here FActor is garanted to be a TZMQAdmin @@ -738,8 +856,8 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList); // inform all players about the new player, including itself FZMQActor.SendMessage([K_ARRIVED,PS]); - // start Experiment if allowed - if ShouldStartExperiment then + // start Experiment + if ShouldStartCycle then StartExperiment; end @@ -759,18 +877,66 @@ procedure TGameControl.ReceiveRequest(var ARequest: TStringList); begin P := FExperiment.PlayerFromID[ARequest[0]]; P.Choice.Row:= GetRowFromString(ARequest[3]); // row - P.Choice.Color:= GetColorFromString(ARequest[4]); // color + P.Choice.Color:= GetGameColorFromString(ARequest[4]); // color ARequest[2] := K_CHOICE+K_ARRIVED; - ARequest.Append(FExperiment.ConsequenceStringFromChoice[P]); //individual consequences - FZMQActor.SendMessage([K_CHOICE,P.ID,ARequest[3],ARequest[4]]); + + //individual consequences + ARequest.Append(FExperiment.ConsequenceStringFromChoice[P]); + + // update turn + P.Turn := FExperiment.NextTurn; + FExperiment.Player[P.ID] := P; + + // broadcast choice + FZMQActor.SendMessage([K_CHOICE,P.ID,ARequest[3],ARequest[4],IntToStr(P.Turn)]); + + if ShouldAskQuestion then // TODO: prompt only when an odd row was selected + begin + P.Turn := 0; + FZMQActor.SendMessage([K_QUESTION,FExperiment.Condition[FExperiment.CurrentCondition].Prompt.Question]); + end; end; + procedure ValidateQuestionResponse; + var + P : TPlayer; + M : array of UTF8string; + i : integer; + LPromptConsequences : TStringList; + begin + P := FExperiment.PlayerFromID[ARequest[0]]; + ARequest[2] := K_QUESTION+K_ARRIVED; + + // append response of each player + FExperiment.Condition[FExperiment.CurrentCondition].Prompt.AppendResponse(P.ID,ARequest[3]); + + // return to experiment and present the prompt consequence, if any + if FExperiment.Condition[FExperiment.CurrentCondition].Prompt.ResponsesCount = Experiment.PlayersCount then + begin + // M setup + + + // generate messages + LPromptConsequences := FExperiment.Condition[FExperiment.CurrentCondition].Prompt.AsString; + if LPromptConsequences.Count > 0 then + begin + SetLength(M, 1+LPromptConsequences.Count); + M[0] := GA_ADMIN+K_QUESTION+K_QMESSAGE; + for i := 0 to LPromptConsequences.Count -1 do + M[i+1] := LPromptConsequences[i] + end; + + // send identified messages; each player takes only its own message and ignore the rest + FZMQActor.SendMessage(M); + end; + end; begin if MHas(K_LOGIN) then ReplyLoginRequest; if MHas(K_CHOICE) then ValidateChoice; + if MHas(K_QUESTION) then ValidateQuestionResponse; end; -// Here FActor is garanted to be a TZMQPlayer, reply +// Here FActor is garanted to be a TZMQPlayer, reply by: // - sending private data to player player // - sending data from early history to income players procedure TGameControl.ReceiveReply(AReply: TStringList); @@ -814,11 +980,11 @@ procedure TGameControl.ReceiveReply(AReply: TStringList); LConsequence : TConsequence; LCount, i : integer; - P : TPlayer; + //P : TPlayer; begin if Self.ID = AReply[0] then begin - P := FExperiment.PlayerFromID[Self.ID]; + //P := FExperiment.PlayerFromID[Self.ID]; LCount := WordCount(AReply[5],['+']); {$IFDEF DEBUG} WriteLn('LCount:',LCount); @@ -828,7 +994,9 @@ procedure TGameControl.ReceiveReply(AReply: TStringList); begin LConsequence := TConsequence.Create(FormMatrixGame,ExtractDelimited(i,AReply[5],['+'])); //LConsequence.PlayerNicname := P.Nicname; - LConsequence.Present(Self, False); + LConsequence.Present(False); + if LConsequence.ShouldPublishMessage then + FZMQActor.SendMessage([K_MESSAGE,LConsequence.LastPresentedMessage]); {$IFDEF DEBUG} WriteLn('A consequence should have shown.'); {$ENDIF} @@ -836,6 +1004,10 @@ procedure TGameControl.ReceiveReply(AReply: TStringList); end; end; + procedure QuestionValidated; + begin + // wait + end; procedure ResumePlayer; begin @@ -846,6 +1018,7 @@ begin if MHas(K_RESUME+K_ARRIVED) then ResumePlayer; if MHas(K_LOGIN+K_ARRIVED) then LoginAccepted; if MHas(K_CHOICE+K_ARRIVED) then ChoiceValidated; + if MHas(K_QUESTION+K_ARRIVED) then QuestionValidated; end; diff --git a/units/game_experiment.pas b/units/game_experiment.pas index d5676a1..3c426eb 100644 --- a/units/game_experiment.pas +++ b/units/game_experiment.pas @@ -25,6 +25,8 @@ type FExperimentName, FFilename, FResearcher : UTF8string; + FOnConsequence: TNotifyEvent; + FOnInterlocking: TNotifyEvent; FOnEndTurn: TNotifyEvent; FOnEndCondition: TNotifyEvent; FOnEndCycle: TNotifyEvent; @@ -52,27 +54,33 @@ type function GetNextCondition:integer; function GetPlayer(I : integer): TPlayer; overload; function GetPlayer(AID : UTF8string): TPlayer; overload; - function GetPlayerAsString(P: TPlayer): UTF8string; - function GetPlayerFromString(s : UTF8string): TPlayer; + function AliasPlayerAsString(P: TPlayer): UTF8string; + function AliasPlayerFromString(s : UTF8string): TPlayer; function GetPlayerIndexFromID(AID : UTF8string): integer; function GetPlayerIsPlaying(AID : UTF8string): Boolean; function GetPlayersCount: integer; function GetInterlockingsIn(ALastCycles : integer):integer; function GetConsequenceStringFromChoice(P:TPlayer): Utf8string; + function GetConsequenceStringFromChoices:UTF8String; procedure SetCondition(I : Integer; AValue: TCondition); procedure SetContingency(ACondition, I : integer; AValue: TContingency); procedure SetMatrixType(AValue: TGameMatrixType); + procedure SetOnConsequence(AValue: TNotifyEvent); procedure SetOnEndCondition(AValue: TNotifyEvent); procedure SetOnEndCycle(AValue: TNotifyEvent); procedure SetOnEndExperiment(AValue: TNotifyEvent); procedure SetOnEndGeneration(AValue: TNotifyEvent); procedure SetOnEndTurn(AValue: TNotifyEvent); + procedure SetOnInterlocking(AValue: TNotifyEvent); procedure SetPlayer(I : integer; AValue: TPlayer); overload; procedure SetPlayer(S : UTF8string ; AValue: TPlayer); overload; procedure SetResearcherCanChat(AValue: Boolean); procedure SetResearcherCanPlay(AValue: Boolean); procedure SetSendChatHistoryForNewPlayers(AValue: Boolean); procedure SetState(AValue: TExperimentState); + private + procedure Consequence(Sender : TObject); + procedure Interlocking(Sender : TObject); public constructor Create(AOwner:TComponent);override; constructor Create(AFilename: string; AOwner:TComponent); overload; @@ -106,9 +114,10 @@ type property PlayersCount : integer read GetPlayersCount; property PlayerIsPlaying[s : UTF8string] : Boolean read GetPlayerIsPlaying; property PlayerIndexFromID[s : UTF8string]: integer read GetPlayerIndexFromID; - property PlayerAsString[P:TPlayer]: UTF8string read GetPlayerAsString; - property PlayerFromString[s : UTF8string]: TPlayer read GetPlayerFromString; + property PlayerAsString[P:TPlayer]: UTF8string read AliasPlayerAsString; + property PlayerFromString[s : UTF8string]: TPlayer read AliasPlayerFromString; property ConsequenceStringFromChoice[P:Tplayer]:UTF8String read GetConsequenceStringFromChoice; + property ConsequenceStringFromChoices: UTF8String read GetConsequenceStringFromChoices; property ShowChat : Boolean read FShowChat write FShowChat; property SendChatHistoryForNewPlayers : Boolean read FSendChatHistoryForNewPlayers write SetSendChatHistoryForNewPlayers; property MatrixType : TGameMatrixType read FMatrixType write SetMatrixType; @@ -123,6 +132,9 @@ type property OnEndGeneration : TNotifyEvent read FOnEndGeneration write SetOnEndGeneration; property OnEndCondition : TNotifyEvent read FOnEndCondition write SetOnEndCondition; property OnEndExperiment : TNotifyEvent read FOnEndExperiment write SetOnEndExperiment; + public + property OnConsequence : TNotifyEvent read FOnConsequence write SetOnConsequence; + property OnInterlocking : TNotifyEvent read FOnInterlocking write SetOnInterlocking; end; resourcestring @@ -130,7 +142,7 @@ resourcestring implementation -uses game_file_methods, game_actors_point, game_resources, strutils; +uses game_file_methods, game_actors_point, game_resources, string_methods; { TExperiment } @@ -161,13 +173,11 @@ begin else Result := FConditions[CurrentCondition].Turn.Count; if Assigned(FOnEndTurn) then FOnEndTurn(Self); - 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; {$IFDEF DEBUG} @@ -184,16 +194,15 @@ end; function TExperiment.GetNextCycle: integer; begin Result := FConditions[CurrentCondition].Cycles.Count; + if Assigned(FOnEndCycle) then FOnEndCycle(Self); if FConditions[CurrentCondition].Cycles.Count < FConditions[CurrentCondition].Cycles.Value then Inc(FConditions[CurrentCondition].Cycles.Count) else begin FConditions[CurrentCondition].Cycles.Count := 0; - if State = xsRunning then - begin - if Assigned(FOnEndGeneration) then FOnEndGeneration(Self); - NextCondition; - end; + Inc(FConditions[CurrentCondition].Cycles.Generation); + if Assigned(FOnEndGeneration) then FOnEndGeneration(Self); + NextCondition; end; {$IFDEF DEBUG} WriteLn('TExperiment.GetNextCycle:',Result); @@ -212,7 +221,6 @@ var end; begin - Inc(FConditions[CurrentCondition].Cycles.Generation); Result := CurrentCondition; LAbsCycles := (FConditions[CurrentCondition].Cycles.Value * FConditions[CurrentCondition].Cycles.Generation) + FConditions[CurrentCondition].Cycles.Count; @@ -261,147 +269,14 @@ begin end; // fewer as possible data -function TExperiment.GetPlayerAsString(P: TPlayer): UTF8string; -var - i : integer; - M : array of UTF8String; - - procedure SetM(A : array of UTF8String); - var i : integer; - begin - SetLength(M,Length(A)); - for i := 0 to Length(A) -1 do - M[i] := A[i]; - end; - - function GetPPointsString(APPoints : TPlayerPoints) : string; - begin - Result := IntToStr(APPoints.A)+VV_SEP+IntToStr(APPoints.B); - end; - - function GetStatusString(AStatus : TGamePlayerStatus): string; - begin - case AStatus of - gpsWaiting: Result := '0'; - gpsPlaying: Result := '1'; - gpsPlayed: Result := '2'; - end; - end; - - function GetRowString(ARow: TGameRow): string; - begin - case ARow of - grNone : Result := '.'; - grOne : Result := '1'; - grTwo : Result := '2'; - grThree : Result :='3'; - grFour : Result := '4'; - grFive : Result := '5'; - grSix : Result := '6'; - grSeven : Result := '7'; - grEight : Result := '8'; - grNine : Result := '9'; - grTen : Result := '0'; - end; - end; - - function GetColorString(AColor: TGameColor): string; - begin - case AColor of - gcNone :Result := '0'; - gcYellow :Result := '1'; - gcRed :Result := '2'; - gcMagenta :Result := '3'; - gcBlue :Result := '4'; - gcGreen :Result := '5'; - end; - end; - - function GetChoiceString(AChoice : TPlayerChoice) : string; - begin - Result := GetRowString(AChoice.Row) + VV_SEP; - Result := Result+ GetColorString(AChoice.Color); - end; - +function TExperiment.AliasPlayerAsString(P: TPlayer): UTF8string; begin - Result := ''; - SetM([P.ID - , P.Nicname - , GetPPointsString(P.Points) - , GetStatusString(P.Status) - , GetChoiceString(P.Choice) - , IntToStr(P.Turn) - ]); - for i := 0 to Length(M)-1 do - Result += M[i] + '|'; + Result:= GetPlayerAsString(P); end; -function TExperiment.GetPlayerFromString(s: UTF8string): TPlayer; - - function GetRowFromString(S: string): TGameRow; - begin - case S of - '.' : Result := grNone; - '1' : Result := grOne; - '2' : Result := grTwo; - '3' : Result := grThree; - '4' : Result := grFour; - '5' : Result := grFive; - '6' : Result := grSix; - '7' : Result := grSeven; - '8' : Result := grEight; - '9' : Result := grNine; - '0' : Result := grTen; - end; - end; - - function GetColorFromString(S: string): TGameColor; - begin - case S of - '0' : Result := gcNone; - '1' : Result := gcYellow; - '2' : Result := gcRed; - '3' : Result := gcMagenta; - '4' : Result := gcBlue; - '5' : Result := gcGreen; - end; - end; - - function GetChoiceFromString(S:string) : TPlayerChoice; - begin - Result.Row := GetRowFromString(ExtractDelimited(1,S,[','])); - Result.Color := GetColorFromString(ExtractDelimited(2,S,[','])); - end; - - function GetPPointsFromString(S:string) : TPlayerPoints; - begin - Result.A := StrToInt(ExtractDelimited(1,S,[','])); - Result.B := StrToInt(ExtractDelimited(2,S,[','])); - end; - - function GetStatusFromString(S : string): TGamePlayerStatus; - begin - case S of - '0': Result := gpsWaiting; - '1': Result := gpsPlaying; - '2': Result := gpsPlayed; - end; - end; +function TExperiment.AliasPlayerFromString(s: UTF8string): TPlayer; begin - {$IFDEF DEBUG} - WriteLn(ExtractDelimited(1,s,['|'])); - WriteLn(ExtractDelimited(2,s,['|'])); - WriteLn(ExtractDelimited(3,s,['|'])); - WriteLn(ExtractDelimited(4,s,['|'])); - WriteLn(ExtractDelimited(5,s,['|'])); - WriteLn(ExtractDelimited(6,s,['|'])); - {$ENDIF} - Result.ID := ExtractDelimited(1,s,['|']); - Result.Nicname := ExtractDelimited(2,s,['|']); - Result.Points := GetPPointsFromString(ExtractDelimited(3,s,['|'])); - Result.Status := GetStatusFromString(ExtractDelimited(4,s,['|'])); - Result.Choice := GetChoiceFromString(ExtractDelimited(5,s,['|'])); - Result.Turn:=StrToInt(ExtractDelimited(6,s,['|'])); + Result := GetPlayerFromString(S); end; function TExperiment.GetPlayerIndexFromID(AID: UTF8string): integer; @@ -449,7 +324,20 @@ begin for i :=0 to ContingenciesCount[c] -1 do if not Contingency[c,i].Meta then if Contingency[c,i].ResponseMeetsCriteriaI(P.Choice.Row,P.Choice.Color) then - Result += Contingency[c,i].Consequence.AsString + '+'; + Result += Contingency[c,i].Consequence.AsString(P.ID) + '+'; +end; + +function TExperiment.GetConsequenceStringFromChoices: UTF8String; +var + i : integer; + c : integer; +begin + c := CurrentCondition; + Result:= ''; + for i :=0 to ContingenciesCount[c] -1 do + if Contingency[c,i].Meta then + if Contingency[c,i].ResponseMeetsCriteriaG(FPlayers) then + Result += Contingency[c,i].Consequence.AsString(IntToStr(i)) + '+'; end; procedure TExperiment.SetCondition(I : Integer; AValue: TCondition); @@ -460,6 +348,10 @@ end; procedure TExperiment.SetContingency(ACondition, I : integer; AValue: TContingency); begin FConditions[ACondition].Contingencies[I] := AValue; + if FConditions[ACondition].Contingencies[I].Meta then + FConditions[ACondition].Contingencies[I].OnCriteria:=@Interlocking + else + FConditions[ACondition].Contingencies[I].OnCriteria:=@Consequence; end; procedure TExperiment.SetMatrixType(AValue: TGameMatrixType); @@ -468,6 +360,12 @@ begin FMatrixType:=AValue; end; +procedure TExperiment.SetOnConsequence(AValue: TNotifyEvent); +begin + if FOnConsequence=AValue then Exit; + FOnConsequence:=AValue; +end; + procedure TExperiment.SetOnEndCondition(AValue: TNotifyEvent); begin if FOnEndCondition=AValue then Exit; @@ -498,6 +396,12 @@ begin FOnEndTurn:=AValue; end; +procedure TExperiment.SetOnInterlocking(AValue: TNotifyEvent); +begin + if FOnInterlocking=AValue then Exit; + FOnInterlocking:=AValue; +end; + procedure TExperiment.SetPlayer(I : integer; AValue: TPlayer); begin @@ -541,6 +445,16 @@ begin FState:=AValue; end; +procedure TExperiment.Consequence(Sender: TObject); +begin + if Assigned(FOnConsequence) then FOnConsequence(Sender); +end; + +procedure TExperiment.Interlocking(Sender: TObject); +begin + if Assigned(FOnInterlocking) then FOnInterlocking(Sender); +end; + constructor TExperiment.Create(AOwner: TComponent); begin inherited Create(AOwner); diff --git a/units/game_file_methods.pas b/units/game_file_methods.pas index bcb7c3c..4b64b9d 100644 --- a/units/game_file_methods.pas +++ b/units/game_file_methods.pas @@ -48,6 +48,17 @@ var Colors:[]; ); + LCriteria3 : TCriteria = ( + Style:(gtRowsAndColors); + Rows:[grEven]; + Colors:[gcDiff]; + ); + + LCriteria4 : TCriteria = ( + Style:(gtRowsOrColors); + Rows:[grNot,grEven]; + Colors:[gcNot,gcDiff]; + ); begin Result := False; with AExperiment do @@ -61,26 +72,40 @@ begin GenPlayersAsNeeded:=True; CurrentCondition := 0; MatrixType:=[gmRows]; + //AppendPlayer(C_PLAYER_TEMPLATE); //AppendPlayer(C_PLAYER_TEMPLATE); + C := C_CONDITION_TEMPLATE; with C do begin - SetLength(Contingencies, 2); - LConcequence := TConsequence.Create(AExperiment,1,[gscPoints, gscB, gscMessage,gscBroadcastMessage],['NICNAME','queijo','queijos']); - Contingencies[0] := TContingency.Create(AExperiment,LConcequence,LCriteria1,False); - LConcequence := TConsequence.Create(AExperiment,3,[gscPoints, gscA, gscMessage,gscBroadcastMessage],['NICNAME','queijo','queijos']); - Contingencies[1] := TContingency.Create(AExperiment,LConcequence,LCriteria2,False); - - ConditionName := SEC_CONDITION+IntToStr(1); + ConditionName := SEC_CONDITION+'1'; Turn.Count:=0; Turn.Value:=2; Turn.Random:=False; Cycles.Count:=0; Cycles.Value:=4; Cycles.Generation:=0; + SetLength(Contingencies, 4); + LConcequence := TConsequence.Create(AExperiment,1,[gscPoints, gscB, gscMessage,gscBroadcastMessage],['$NICNAME','queijo','queijos']); + Contingencies[0] := TContingency.Create(AExperiment,LConcequence,LCriteria1,False); + LConcequence := TConsequence.Create(AExperiment,3,[gscPoints, gscA, gscMessage,gscBroadcastMessage],['$NICNAME','pão','pães']); + Contingencies[1] := TContingency.Create(AExperiment,LConcequence,LCriteria2,False); + LConcequence := TConsequence.Create(AExperiment,1,[gscPoints, gscG, gscMessage,gscBroadcastMessage],['','item escolar','itens escolares']); + Contingencies[2] := TContingency.Create(AExperiment,LConcequence,LCriteria3,True); + LConcequence := TConsequence.Create(AExperiment,-1,[gscPoints, gscG, gscMessage,gscBroadcastMessage],['','item escolar','itens escolares']); + Contingencies[3] := TContingency.Create(AExperiment,LConcequence,LCriteria4,True); + + Prompt := TPrompt.Create( + AExperiment + , [gsAll,gsYes,gsMetacontingency,gsContingency,gsRevertPoints,gsBasA] + , Contingencies + , 'Um item escolar foi perdido, desejam recuperá-lo gastando pontos do Tipo A?' + ); + // (gsYes, gsNo, gsAll, gsMetacontingency, gsContingency, gsBasA, gsRevertPoints); end; - AppendCondition(C); + + Condition[AppendCondition] := C; end; end; @@ -96,59 +121,40 @@ var //end; function GetEndCriteria(S:string) : TEndConditionCriterium; - var - LS : string; begin - // 2,20,10,10, - LS := S + VV_SEP; - case StrToIntDef(GetAndDelFirstValue(LS),2) of + case StrToIntDef(ExtractDelimited(1,S,[',']),2) of 0: Result.Value := gecAbsoluteCycles; 1: Result.Value := gecInterlockingPorcentage; 2: Result.Value := gecWhichComeFirst; end; - Result.AbsoluteCycles := StrToIntDef(GetAndDelFirstValue(LS), 20); - Result.InterlockingPorcentage := StrToIntDef(GetAndDelFirstValue(LS),10); - Result.LastCycles := StrToIntDef(GetAndDelFirstValue(LS), 10); + Result.AbsoluteCycles := StrToIntDef(ExtractDelimited(2,S,[',']), 20); + Result.InterlockingPorcentage := StrToIntDef(ExtractDelimited(3,S,[',']),10); + Result.LastCycles := StrToIntDef(ExtractDelimited(4,S,[',']), 10); end; function GetPoints(S: string) : TPoints; - var - LS : string; begin - // A,B,G, - LS := S + VV_SEP; - Result.A := StrToIntDef(GetAndDelFirstValue(LS),0); - Result.B := StrToIntDef(GetAndDelFirstValue(LS),0); - Result.G := StrToIntDef(GetAndDelFirstValue(LS),0); + Result.A := StrToIntDef(ExtractDelimited(1,S,[',']),0); + Result.B := StrToIntDef(ExtractDelimited(2,S,[',']),0); + Result.G := StrToIntDef(ExtractDelimited(3,S,[',']),0); end; function GetChoiceFromString(S:string) : TPlayerChoice; - var - LS : string; begin - // 0,NONE, - LS := S + VV_SEP; - Result.Row := GetRowFromString(GetAndDelFirstValue(LS)); - Result.Color := GetColorFromString(GetAndDelFirstValue(LS)); + Result.Row := GetRowFromString(ExtractDelimited(1,S,[','])); + Result.Color := GetGameColorFromString(ExtractDelimited(2,S,[','])); end; function GetPPointsFromString(S:string) : TPlayerPoints; - var - LS : string; begin - // 0,0, - LS := S + VV_SEP; - Result.A := StrToIntDef(GetAndDelFirstValue(LS),0); - Result.B := StrToIntDef(GetAndDelFirstValue(LS),0); + Result.A := StrToIntDef(ExtractDelimited(1,S,[',']),0); + Result.B := StrToIntDef(ExtractDelimited(2,S,[',']),0); end; function GetStatusFromString(S : string): TGamePlayerStatus; - var - LS : string; begin - LS := S + VV_SEP; - case GetAndDelFirstValue(LS) of + case ExtractDelimited(1,S,[',']) of 'esperando': Result := gpsWaiting; 'jogou': Result := gpsPlayed; 'jogando': Result := gpsPlaying; @@ -157,14 +163,12 @@ var function GetPromptStyle(S:string):TPromptStyle; var - LS : string; i : integer; begin // Yes,All,Metacontingency,RecoverLostPoints, Result := []; - LS := S + VV_SEP; - for i := 0 to 3 do - Result := Result + GetPromptStyleFromString(GetAndDelFirstValue(LS)); + for i := 1 to 4 do + Result := Result + GetPromptStyleFromString(ExtractDelimited(i,S,[','])); end; procedure ReadExperiment; @@ -242,7 +246,7 @@ var LCount := WordCount(LS,[#0,',']); Result.Colors := []; for i := 1 to LCount do - Result.Colors += [GetColorFromString(ExtractDelimited(i,LS,[',']))]; + Result.Colors += [GetGameColorFromString(ExtractDelimited(i,LS,[',']))]; end; procedure SetLCK(i:integer); @@ -307,9 +311,12 @@ var // if no contingencies, return false... - Prompt := TPrompt.Create(AExperiment,ReadString(LS,KEY_PROMPT_STYLE,'todos,sim,metacontingência,recuperar pontos,')); - Prompt.PromptStyle:= GetPromptStyle(ReadString(LS,KEY_PROMPT_STYLE,'todos,sim,metacontingência,recuperar pontos,')); - Prompt.PromptMessage := ReadString(LS,KEY_PROMPT_MESSAGE,DEF_PROMPTMESSAGE); + Prompt := TPrompt.Create( + AExperiment + , GetPromptStyle(ReadString(LS,KEY_PROMPT_STYLE,'todos,sim,metacontingência,recuperar pontos,')) + , Contingencies + , ReadString(LS,KEY_PROMPT_MESSAGE,DEF_PROMPTMESSAGE) + ); end; AExperiment.Condition[i]:= C; @@ -350,47 +357,6 @@ var LC, LCK : string; - function GetEndCriteriaString(AEndCriterium:TEndConditionCriterium) : string; - begin - // 2,20,10,10, - case AEndCriterium.Value of - gecAbsoluteCycles: Result := '0'; - gecInterlockingPorcentage: Result := '1'; - gecWhichComeFirst: Result := '2'; - end; - Result := Result + VV_SEP; - Result := Result + IntToStr(AEndCriterium.AbsoluteCycles) + VV_SEP; - Result := Result + IntToStr(AEndCriterium.InterlockingPorcentage) + VV_SEP; - Result := Result + IntToStr(AEndCriterium.LastCycles) + VV_SEP; - end; - - function GetPointsString(APoints : TPoints) : string; - begin - Result := IntToStr(APoints.A) + VV_SEP; - Result := Result + IntToStr(APoints.B) + VV_SEP; - Result := Result + IntToStr(APoints.G) + VV_SEP; - end; - - function GetChoiceString(AChoice : TPlayerChoice) : string; - begin - Result := GetRowString(AChoice.Row) + VV_SEP; - Result := Result+ GetColorString(AChoice.Color) + VV_SEP; - end; - - function GetPPointsString(APPoints : TPlayerPoints) : string; - begin - Result := IntToStr(APPoints.A)+VV_SEP+IntToStr(APPoints.B); - end; - - function GetStatusString(AStatus : TGamePlayerStatus): string; - begin - case AStatus of - gpsWaiting: Result := 'esperando'; - gpsPlayed: Result := 'jogou'; - gpsPlaying: Result := 'jogando'; - end; - end; - begin LWriter := TRegData.Create(nil,AFilename); LIniFile:= TCIniFile.Create(LWriter.FileName); @@ -414,8 +380,8 @@ begin WriteInteger(LC, KEY_CYCLES_VALUE,Cycles.Value); WriteInteger(LC, KEY_CYCLES_GEN,Cycles.Generation); //WriteBool(LC, KEY_PROMPT_VALUE,Prompt.Value); - WriteString(LC, KEY_PROMPT_MESSAGE, Prompt.PromptMessage); - WriteString(LC, KEY_PROMPT_STYLE, GetPromptStyleString(Prompt.PromptStyle)); + //WriteString(LC, KEY_PROMPT_MESSAGE, Prompt.PromptMessage); TODO: write prompt as string + //WriteString(LC, KEY_PROMPT_STYLE, GetPromptStyleString(Prompt.PromptStyle)); for j := 0 to High(Contingencies) do begin @@ -426,7 +392,7 @@ begin with Contingencies[j] do begin - WriteString(LC,LCK+KEY_CONSEQUE,Consequence.AsString); + WriteString(LC,LCK+KEY_CONSEQUE,Consequence.AsString('')); // TODO review this WriteString(LC,LCK+KEY_CRITERIA,CriteriaString); end; end; diff --git a/units/game_resources.pas b/units/game_resources.pas index ac6b155..402c0eb 100644 --- a/units/game_resources.pas +++ b/units/game_resources.pas @@ -174,66 +174,19 @@ const // Meta : True; // ); - //C_METACONTINGENCY_A2 : TContingency = - // ( - // Consequence : ( - // Style : [gscShowMessage,gscPoints,gscBroadcastMessage]; - // Points :( A : 0; B : 0; G : -1;); - // Message : 'Vocês perderam 1 item escolar.'; // show first in case of last participant - // Cycles : 0; // absolute, - // VariationMin: 0; // porcentage, - // VariationMax : 0; // porcentage - // Prompt : ( - // Message : ''; - // Style : []; - // ); - // ); - // - // Response : ( - // Operator_ : goNONE; - // Rows : [grOdd,grSome]; - // Colors : [gcNone]; - // ); - // - // Meta : True; - // ); - - //C_METACONTINGENCY_B1: TContingency = - // ( - // Consequence : ( - // Style : [gscShowMessage,gscPoints,gscBroadcastMessage]; - // Points :(A :-1; B : 0; G : -1;); - // Message : 'Vocês perderam 1 item escolar e uma quantidade de pontos do Tipo A.'; - // Cycles : 0; // absolute, - // VariationMin: 0; // porcentage, - // VariationMax : 0; // porcentage - // Prompt : ( - // Message : ''; - // Style : []; - // ); - // ); - // - // Response : ( - // Operator_ : goNONE; - // Rows : [grOdd, grSome]; - // Colors : [gcNone]; - // ); - // - // Meta : True; - // ); //C_METACONTINGENCY_B2: TContingency = // ( // Consequence : ( // Style : [gscShowMessage,gscPoints,gscBroadcastMessage,gscPromptQuestion]; - // Points :(A :-3; B : 0; G : -1;); - // Message : 'Vocês perderam 1 item escolar.'; + // Points :(A :0; B : 0; G : -1;); + // Message : 'Vocês produziram a perda de 1 item escolar.'; // Cycles : 0; // absolute, // VariationMin: 0; // porcentage, // VariationMax : 0; // porcentage // Prompt : ( - // Message : 'Vocês perderam 1 item escolar, desejam recuperá-lo gastando pontos do Tipo A?'; - // Style : [gsAll,gsYes,gsMetacontingency,gsRecoverLostPoints]; + // Message : 'Um item escolar foi perdido, desejam recuperá-lo gastando pontos do Tipo A?'; + // Style : [gsAll,gsYes,gsMetacontingency,gsRecoverLostPoints, gsContingency, gsBasA]; // ); // ); // @@ -250,30 +203,34 @@ const ( ConditionName : ''; Contingencies : nil; + Interlocks : ( + Count : 0; + History : nil; + ); Points : ( - Count : ( A:1; B:2; G:3; ); - OnStart : ( A:3; B:1; G:0; ); + Count : ( A:0; B:0; G:0; ); + OnStart : ( A:0; B:0; G:0; ); ); Turn : ( Count: 0; - Value : 3; + Value : 0; Random: False; ); Cycles : ( Count : 0; - Value : 3; + Value : 0; Generation : 0; ); Prompt : nil; EndCriterium : ( Value : gecWhichComeFirst; - InterlockingPorcentage : 10; - LastCycles : 6; - AbsoluteCycles: 8; + InterlockingPorcentage : 50; + LastCycles : 4; + AbsoluteCycles: 6; ); ); diff --git a/units/string_methods.pas b/units/string_methods.pas index 8e609f9..4670434 100644 --- a/units/string_methods.pas +++ b/units/string_methods.pas @@ -10,19 +10,36 @@ uses , game_resources ; -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; -function GetPromptStyleString(AStyle : TPromptStyle) : string; -function GetConsequenceStyleFromString(s:string):TGameConsequenceStyle; -function GetConsequenceStyleString(AStyle: TGameConsequenceStyle): string; -function GetResponseString(ACriteria : TCriteria) : string; -function GetResponseFromString(S: string) : TCriteria; -function GetRowColorString(C: TColor):string; +function GetAndDelFirstValue(var S: string;Sep:Char=','):string; deprecated 'Use ExtracteDelimited from strutils instead'; + +function GetRowString(ARow : TGameRow) : UTF8String; +function GetRowFromString(S : UTF8String):TGameRow; + +function GetColorString(C : TColor):UTF8String; overload; +function GetColorFromString(S : UTF8String): TColor; +function GetColorString(AColor : TGameColor) : UTF8String; overload; +function GetGameColorFromString(S : UTF8String) : TGameColor; + +function GetPromptStyleFromString(S : UTF8String) : TPromptStyle; +function GetPromptStyleString(AStyle : TPromptStyle) : UTF8String; + +function GetConsequenceStyleFromString(s : UTF8String):TGameConsequenceStyle; +function GetConsequenceStyleString(AStyle : TGameConsequenceStyle): UTF8String; +function GetConsequenceStylesFromString(S : UTF8String):TConsequenceStyle; +function GetConsequenceStylesString(CS : TConsequenceStyle): UTF8String; + +function GetCriteriaString(ACriteria : TCriteria) : UTF8String; +function GetCriteriaFromString(S : UTF8String) : TCriteria; +function GetCriteriaStyleString(AStyle: TGameStyle) : UTF8String; + +function GetStatusString(AStatus : TGamePlayerStatus): UTF8String; +function GetPPointsString(APPoints : TPlayerPoints) : UTF8String; +function GetChoiceString(AChoice : TPlayerChoice) : UTF8String; +function GetPointsString(APoints : TPoints) : UTF8String; +function GetEndCriteriaString(AEndCriterium:TEndConditionCriterium) : UTF8String; + +function GetPlayerFromString(s: UTF8string): TPlayer; +function GetPlayerAsString(P: TPlayer): UTF8string; implementation @@ -35,7 +52,7 @@ begin if Length(S) > 0 then while S[1] = Sep do Delete(S, 1, 1); end; -function GetRowString(ARow: TGameRow): string; +function GetRowString(ARow: TGameRow): UTF8String; begin case ARow of grNone : Result := '0'; @@ -54,7 +71,7 @@ begin end; end; -function GetRowFromString(S: string): TGameRow; +function GetRowFromString(S: UTF8String): TGameRow; begin case UpperCase(S) of 'NA', '.' , '0', 'NONE' : Result := grNone; @@ -73,7 +90,7 @@ begin end; end; -function GetColorString(AColor: TGameColor): string; +function GetColorString(AColor: TGameColor): UTF8String; begin case AColor of gcNone :Result := 'INDIFERENTE'; @@ -87,7 +104,7 @@ begin end; end; -function GetColorFromString(S: string): TGameColor; +function GetGameColorFromString(S: UTF8String): TGameColor; begin case UpperCase(S) of '.', 'INDIFERENTE', 'NONE' : Result := gcNone; @@ -96,13 +113,13 @@ begin 'G', 'VERDE', 'GREEN' : Result := gcGreen; 'R', 'VERMELHO', 'RED' : Result := gcRed; 'M', 'ROXO','MAGENTA', 'VIOLETA' : Result := gcMagenta; - '!=','<>','DIFERENTES', 'DIFFERENT' : Result := gcDiff; + '!','<>','DIFERENTES', 'DIFFERENT' : Result := gcDiff; '=','IGUAIS', 'EQUAL' : Result := gcEqual; end; end; -function GetPromptStyleFromString(S: string): TPromptStyle; +function GetPromptStyleFromString(S: UTF8String): TPromptStyle; begin // todos,sim,metacontingência,recuperar pontos, case UpperCase(S) of @@ -117,7 +134,7 @@ begin end; end; -function GetPromptStyleString(AStyle: TPromptStyle): string; +function GetPromptStyleString(AStyle: TPromptStyle): UTF8String; var Style : TGamePromptStyle; begin Result:=''; @@ -134,7 +151,7 @@ begin end; end; -function GetConsequenceStyleFromString(s: string): TGameConsequenceStyle; +function GetConsequenceStyleFromString(s: UTF8String): TGameConsequenceStyle; begin case UpperCase(S) of 'NADA': Result:= gscNone; @@ -145,7 +162,7 @@ begin end; end; -function GetConsequenceStyleString(AStyle: TGameConsequenceStyle): string; +function GetConsequenceStyleString(AStyle: TGameConsequenceStyle): UTF8String; begin case AStyle of gscNone : Result:= 'NADA'; @@ -156,61 +173,62 @@ begin end; end; -function GetResponseString(ACriteria : TCriteria) : string; +function GetCriteriaString(ACriteria: TCriteria): UTF8String; var R : TGameRow; C : TGameColor; begin - Result := '['; for R in ACriteria.Rows do Result += GetRowString(R) + VV_SEP; - Result += ']'; + Result += '|'; - Result += '['; - case ACriteria.Style of - gtNone : Result += 'INDIFERENTE'+ VV_SEP; - gtRowsAndColors : Result += 'E'+ VV_SEP; - gtRowsOrColors : Result += 'OU'+ VV_SEP; - end; - Result += ']'; + Result += GetCriteriaStyleString(ACriteria.Style)+'|'; - Result += '['; for C in ACriteria.Colors do Result += GetColorString(C) + VV_SEP; - Result += ']'; + Result += '|'; end; -function GetResponseFromString(S: string) : TCriteria; +function GetCriteriaFromString(S: UTF8String): TCriteria; var - R : TGameRow; - C : TGameColor; - LS : string; s1 : string; i : integer; begin - LS := S + VV_SEP; - s1 := ExtractDelimited(2,LS,['[',']']); + s1 := ExtractDelimited(1,S,['|']); Result.Rows := []; - for i := 0 to 10 do - if s1 <> '' then - Result.Rows += [GetRowFromString(UpperCase(GetAndDelFirstValue(s1)))] + + for i := 1 to WordCount(s1,[#0,',']) do + if ExtractDelimited(i,s1,[',']) <> '' then + Result.Rows += [GetRowFromString(ExtractDelimited(i,s1,[',']))] else Break; - s1 := ExtractDelimited(4,LS,['[',']']); - case UpperCase(GetAndDelFirstValue(s1)) of + s1 := ExtractDelimited(2,S,['|']); + case UpperCase(s1) of '','INDIFERENTE', 'NONE' : Result.Style := gtNone; 'E', 'AND' : Result.Style := gtRowsAndColors; 'OU', 'OR' : Result.Style := gtRowsOrColors; + end; - s1 := ExtractDelimited(6,LS,['[',']']); + s1 := ExtractDelimited(3,S,['|']); Result.Colors := []; - for i := 0 to 10 do - if s1 <> '' then - Result.Colors += [GetColorFromString(UpperCase(GetAndDelFirstValue(s1)))] + for i := 1 to WordCount(s1,[#0,',']) do + if ExtractDelimited(i,s1,[',']) <> '' then + Result.Colors += [GetGameColorFromString(ExtractDelimited(i,s1,[',']))] else Break; end; -function GetRowColorString(C: TColor): string; +function GetCriteriaStyleString(AStyle: TGameStyle): UTF8String; +begin + case AStyle of + gtNone : Result := 'INDIFERENTE'; + gtRowsAndColors : Result := 'E'; + gtRowsOrColors : Result := 'OU'; + gtRowsOnly: Result := 'LINHAS'; + gtColorsOnly:Result := 'CORES'; + end; +end; + +function GetColorString(C: TColor): UTF8String; begin case C of ccYellow: Result := 'Y'; @@ -221,7 +239,7 @@ begin end; end; -function GetRowColorFromString(S:string): TColor; +function GetColorFromString(S: UTF8String): TColor; begin case S of 'Y' : Result := ccYellow; @@ -232,18 +250,230 @@ begin end; end; -//function ValidateString(S: String): string; -////var -//// i:integer; -//begin -// //for i:= Low(S) to High(S) do -// // case S[i] of -// // #32 : S[i] := # -// // #128 : S[i] := #128; -// // -// // end; -// //Result := AnsiToUtf8(S); -//end; +function GetConsequenceStylesFromString(S:UTF8String):TConsequenceStyle; +var + LCount, + i : integer; +begin + Result := []; + LCount := WordCount(S,[#0,',']); + for i:= 1 to LCount do + case ExtractDelimited(i,S,[',']) of + '0':Result+=[gscNone]; + 'M':Result+=[gscMessage]; + 'C':Result+=[gscBroadcastMessage]; + 'P':Result+=[gscPoints]; + 'V':Result+=[gscVariablePoints]; + 'A':Result+=[gscA]; + 'B':Result+=[gscB]; + 'G':Result+=[gscG] + end; +end; + +function GetConsequenceStylesString(CS: TConsequenceStyle): UTF8String; +var ConsequenceStyle : TGameConsequenceStyle; +begin + Result := ''; + for ConsequenceStyle in CS do + begin + case ConsequenceStyle of + gscNone: Result += '0'; + gscMessage:Result += 'M'; + gscBroadcastMessage:Result += 'C'; + gscPoints:Result += 'P'; + gscVariablePoints:Result += 'V'; + gscA:Result += 'A'; + gscB:Result += 'B'; + gscG:Result += 'G'; + end; + Result += ','; + end; +end; + +function GetEndCriteriaString(AEndCriterium: TEndConditionCriterium + ): UTF8String; +begin + // 2,20,10,10, + case AEndCriterium.Value of + gecAbsoluteCycles: Result := '0'; + gecInterlockingPorcentage: Result := '1'; + gecWhichComeFirst: Result := '2'; + end; + Result := Result + VV_SEP; + Result := Result + IntToStr(AEndCriterium.AbsoluteCycles) + VV_SEP; + Result := Result + IntToStr(AEndCriterium.InterlockingPorcentage) + VV_SEP; + Result := Result + IntToStr(AEndCriterium.LastCycles) + VV_SEP; +end; + +function GetPointsString(APoints: TPoints): UTF8String; +begin + Result := IntToStr(APoints.A) + VV_SEP; + Result := Result + IntToStr(APoints.B) + VV_SEP; + Result := Result + IntToStr(APoints.G) + VV_SEP; +end; + +function GetChoiceString(AChoice: TPlayerChoice): UTF8String; +begin + Result := GetRowString(AChoice.Row) + VV_SEP; + Result := Result+ GetColorString(AChoice.Color) + VV_SEP; +end; + +function GetPPointsString(APPoints: TPlayerPoints): UTF8String; +begin + Result := IntToStr(APPoints.A)+VV_SEP+IntToStr(APPoints.B); +end; + +function GetStatusString(AStatus: TGamePlayerStatus): UTF8String; +begin + case AStatus of + gpsWaiting: Result := 'esperando'; + gpsPlayed: Result := 'jogou'; + gpsPlaying: Result := 'jogando'; + end; +end; + +function GetPlayerAsString(P: TPlayer): UTF8string; +var + i : integer; + M : array of UTF8String; + + procedure SetM(A : array of UTF8String); + var i : integer; + begin + SetLength(M,Length(A)); + for i := 0 to Length(A) -1 do + M[i] := A[i]; + end; + + function PointsString(APPoints : TPlayerPoints) : string; + begin + Result := IntToStr(APPoints.A)+VV_SEP+IntToStr(APPoints.B); + end; + + function StatusString(AStatus : TGamePlayerStatus): string; + begin + case AStatus of + gpsWaiting: Result := '0'; + gpsPlaying: Result := '1'; + gpsPlayed: Result := '2'; + end; + end; + + function RowString(ARow: TGameRow): string; + begin + case ARow of + grNone : Result := '.'; + grOne : Result := '1'; + grTwo : Result := '2'; + grThree : Result :='3'; + grFour : Result := '4'; + grFive : Result := '5'; + grSix : Result := '6'; + grSeven : Result := '7'; + grEight : Result := '8'; + grNine : Result := '9'; + grTen : Result := '0'; + end; + end; + + function ColorString(AColor: TGameColor): string; + begin + case AColor of + gcNone :Result := '0'; + gcYellow :Result := '1'; + gcRed :Result := '2'; + gcMagenta :Result := '3'; + gcBlue :Result := '4'; + gcGreen :Result := '5'; + end; + end; + + function ChoiceString(AChoice : TPlayerChoice) : string; + begin + Result := RowString(AChoice.Row) + VV_SEP; + Result := Result+ ColorString(AChoice.Color); + end; + +begin + Result := ''; + SetM([P.ID + , P.Nicname + , PointsString(P.Points) + , StatusString(P.Status) + , ChoiceString(P.Choice) + , IntToStr(P.Turn) + ]); + for i := 0 to Length(M)-1 do + Result += M[i] + '|'; +end; + +function GetPlayerFromString(s: UTF8string): TPlayer; + + function RowFromString(S: string): TGameRow; + begin + case S of + '.' : Result := grNone; + '1' : Result := grOne; + '2' : Result := grTwo; + '3' : Result := grThree; + '4' : Result := grFour; + '5' : Result := grFive; + '6' : Result := grSix; + '7' : Result := grSeven; + '8' : Result := grEight; + '9' : Result := grNine; + '0' : Result := grTen; + end; + end; + + function ColorFromString(S: string): TGameColor; + begin + case S of + '0' : Result := gcNone; + '1' : Result := gcYellow; + '2' : Result := gcRed; + '3' : Result := gcMagenta; + '4' : Result := gcBlue; + '5' : Result := gcGreen; + end; + end; + + function ChoiceFromString(S:string) : TPlayerChoice; + begin + Result.Row := RowFromString(ExtractDelimited(1,S,[','])); + Result.Color := ColorFromString(ExtractDelimited(2,S,[','])); + end; + + function PointsFromString(S:string) : TPlayerPoints; + begin + Result.A := StrToInt(ExtractDelimited(1,S,[','])); + Result.B := StrToInt(ExtractDelimited(2,S,[','])); + end; + + function StatusFromString(S : string): TGamePlayerStatus; + begin + case S of + '0': Result := gpsWaiting; + '1': Result := gpsPlaying; + '2': Result := gpsPlayed; + end; + end; +begin + {$IFDEF DEBUG} + WriteLn(ExtractDelimited(1,s,['|'])); + WriteLn(ExtractDelimited(2,s,['|'])); + WriteLn(ExtractDelimited(3,s,['|'])); + WriteLn(ExtractDelimited(4,s,['|'])); + WriteLn(ExtractDelimited(5,s,['|'])); + WriteLn(ExtractDelimited(6,s,['|'])); + {$ENDIF} + Result.ID := ExtractDelimited(1,s,['|']); + Result.Nicname := ExtractDelimited(2,s,['|']); + Result.Points := PointsFromString(ExtractDelimited(3,s,['|'])); + Result.Status := StatusFromString(ExtractDelimited(4,s,['|'])); + Result.Choice := ChoiceFromString(ExtractDelimited(5,s,['|'])); + Result.Turn:=StrToInt(ExtractDelimited(6,s,['|'])); +end; end. -- libgit2 0.21.2