diff options
Diffstat (limited to 'Game/Code/Classes/UParty.pas')
| -rw-r--r-- | Game/Code/Classes/UParty.pas | 616 |
1 files changed, 616 insertions, 0 deletions
diff --git a/Game/Code/Classes/UParty.pas b/Game/Code/Classes/UParty.pas new file mode 100644 index 00000000..b0b400db --- /dev/null +++ b/Game/Code/Classes/UParty.pas @@ -0,0 +1,616 @@ +unit UParty;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses UPartyDefs, UCoreModule, UPluginDefs;
+
+type
+ ARounds = Array [0..252] of Integer; //0..252 needed for
+ PARounds = ^ARounds;
+
+ TRoundInfo = record
+ Modi: Cardinal;
+ Winner: Byte;
+ end;
+
+ TeamOrderEntry = record
+ Teamnum: Byte;
+ Score: Byte;
+ end;
+
+ TeamOrderArray = Array[0..5] of Byte;
+
+ TUS_ModiInfoEx = record
+ Info: TUS_ModiInfo;
+ Owner: Integer;
+ TimesPlayed: Byte; //Helper for setting Round Plugins
+ end;
+
+ TPartySession = class (TCoreModule)
+ private
+ bPartyMode: Boolean; //Is this Party or Singleplayer
+ CurRound: Byte;
+
+ Modis: Array of TUS_ModiInfoEx;
+ Teams: TTeamInfo;
+
+ function IsWinner(Player, Winner: Byte): boolean;
+ procedure GenScores;
+ function GetRandomPlugin(TeamMode: Boolean): Cardinal;
+ function GetRandomPlayer(Team: Byte): Byte;
+ public
+ //Teams: TTeamInfo;
+ Rounds: array of TRoundInfo;
+
+ //TCoreModule methods to inherit
+ Constructor Create; override;
+ Procedure Info(const pInfo: PModuleInfo); override;
+ Function Load: Boolean; override;
+ Function Init: Boolean; override;
+ Procedure DeInit; override;
+ Procedure Free; override;
+
+ //Register Modi Service
+ Function RegisterModi(nothin: TwParam; pModiInfo: TlParam): integer; //Registers a new Modi. wParam: Pointer to TUS_ModiInfo
+
+ //Start new Party
+ Function StartParty(NumRounds: TwParam; PAofIRounds: TlParam): integer; //Starts new Party Mode. Returns Non Zero on Success
+ Function GetCurModi(wParam: TwParam; lParam: TlParam): integer; //Returns Pointer to Cur. Modis TUS_ModiInfo (to Use with Singscreen)
+ Function StopParty(wParam: TwParam; lParam: TlParam): integer; //Stops Party Mode. Returns 1 If Partymode was enabled before.
+ Function NextRound(wParam: TwParam; lParam: TlParam): integer; //Increases CurRound by 1; Returns num of Round or -1 if last Round is already played
+
+ Function CallModiInit(wParam: TwParam; lParam: TlParam): integer; //Calls CurModis Init Proc. If an Error occurs, Returns Nonzero. In this Case a New Plugin was Selected. Please renew Loading
+ Function CallModiDeInit(wParam: TwParam; lParam: TlParam): integer; //Calls DeInitProc and does the RoundEnding
+
+ Function GetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; //Writes TTeamInfo Record to Pointer at lParam. Returns Zero on Success
+ Function SetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; //Read TTeamInfo Record from Pointer at lParam. Returns Zero on Success
+
+ Function GetTeamOrder(wParam: TwParam; lParam: TlParam): integer; //Returns Team Order. Structure: Bits 1..3: Team at Place1; Bits 4..6: Team at Place2 ...
+ Function GetWinnerString(wParam: TwParam; lParam: TlParam): integer; //wParam is Roundnum. If (Pointer = nil) then Return Length of the String. Otherwise Write the String to Address at lParam
+ end;
+
+const
+ StandardModi = 0; //Modi ID that will be played in non party Mode
+
+implementation
+
+uses UCore, UGraphic, UMain, ULanguage, ULog, SysUtils;
+
+{*********************
+ TPluginLoader
+ Implentation
+*********************}
+
+//-------------
+// Function that gives some Infos about the Module to the Core
+//-------------
+Procedure TPartySession.Info(const pInfo: PModuleInfo);
+begin
+ pInfo^.Name := 'TPartySession';
+ pInfo^.Version := MakeVersion(1,0,0,chr(0));
+ pInfo^.Description := 'Manages Party Modi and Party Game';
+end;
+
+//-------------
+// Just the Constructor
+//-------------
+Constructor TPartySession.Create;
+begin
+ //UnSet PartyMode
+ bPartyMode := False;
+end;
+
+//-------------
+//Is Called on Loading.
+//In this Method only Events and Services should be created
+//to offer them to other Modules or Plugins during the Init process
+//If False is Returned this will cause a Forced Exit
+//-------------
+Function TPartySession.Load: Boolean;
+begin
+ //Add Register Party Modi Service
+ Result := True;
+ Core.Services.AddService('Party/RegisterModi', nil, Self.RegisterModi);
+ Core.Services.AddService('Party/StartParty', nil, Self.StartParty);
+ Core.Services.AddService('Party/GetCurModi', nil, Self.GetCurModi);
+end;
+
+//-------------
+//Is Called on Init Process
+//In this Method you can Hook some Events and Create + Init
+//your Classes, Variables etc.
+//If False is Returned this will cause a Forced Exit
+//-------------
+Function TPartySession.Init: Boolean;
+begin
+ //Just set Prvate Var to true.
+ Result := true;
+end;
+
+//-------------
+//Is Called if this Module has been Inited and there is a Exit.
+//Deinit is in backwards Initing Order
+//-------------
+Procedure TPartySession.DeInit;
+begin
+ //Force DeInit
+
+end;
+
+//-------------
+//Is Called if this Module will be unloaded and has been created
+//Should be used to Free Memory
+//-------------
+Procedure TPartySession.Free;
+begin
+ //Just save some Memory if it wasn't done now..
+ SetLength(Modis, 0);
+end;
+
+//-------------
+// Registers a new Modi. wParam: Pointer to TUS_ModiInfo
+// Service for Plugins
+//-------------
+Function TPartySession.RegisterModi(nothin: TwParam; pModiInfo: TlParam): integer;
+var
+ Len: Integer;
+ Info: PUS_ModiInfo;
+begin
+ Info := PModiInfo;
+ //Copy Info if cbSize is correct
+ If (Info.cbSize = SizeOf(TUS_ModiInfo)) then
+ begin
+ Len := Length(Modis);
+ SetLength(Modis, Len + 1);
+
+ Modis[Len].Info := Info^;
+ end
+ else
+ Core.ReportError(Integer(PChar('Plugins try to Register Modi with wrong Pointer, or wrong TUS_ModiInfo Record.')), PChar('TPartySession'));
+end;
+
+//----------
+// Returns a Number of a Random Plugin
+//----------
+Function TPartySession.GetRandomPlugin(TeamMode: Boolean): Cardinal;
+var
+ LowestTP: Byte;
+ NumPwithLTP: Word;
+ I: Integer;
+ R: Word;
+begin
+ Result := StandardModi; //If there are no matching Modis, Play StandardModi
+ LowestTP := high(Byte);
+ NumPwithLTP := 0;
+
+ //Search for Plugins not often played yet
+ For I := 0 to high(Modis) do
+ begin
+ if (Modis[I].TimesPlayed < lowestTP) And (((Modis[I].Info.LoadingSettings AND MLS_TeamOnly) <> 0) = TeamMode) then
+ begin
+ lowestTP := Modis[I].TimesPlayed;
+ NumPwithLTP := 1;
+ end
+ else if (Modis[I].TimesPlayed = lowestTP) And (((Modis[I].Info.LoadingSettings AND MLS_TeamOnly) <> 0) = TeamMode) then
+ begin
+ Inc(NumPwithLTP);
+ end;
+ end;
+
+ //Create Random No
+ R := Random(NumPwithLTP);
+
+ //Search for Random Plugin
+ For I := 0 to high(Modis) do
+ begin
+ if (Modis[I].TimesPlayed = lowestTP) And (((Modis[I].Info.LoadingSettings AND MLS_TeamOnly) <> 0) = TeamMode) then
+ begin
+ //Plugin Found
+ if (R = 0) then
+ begin
+ Result := I;
+ Inc(Modis[I].TimesPlayed);
+ Break;
+ end;
+
+ Dec(R);
+ end;
+ end;
+end;
+
+//----------
+// Starts new Party Mode. Returns Non Zero on Success
+//----------
+Function TPartySession.StartParty(NumRounds: TwParam; PAofIRounds: TlParam): integer;
+var
+ I: Integer;
+ aiRounds: PARounds;
+ TeamMode: Boolean;
+begin
+ Result := 0;
+ If (Teams.NumTeams >= 1) AND (NumRounds < High(Byte)-1) then
+ begin
+ bPartyMode := false;
+ aiRounds := PAofIRounds;
+
+ Try
+ //Is this Teammode(More then one Player per Team) ?
+ TeamMode := True;
+ For I := 0 to Teams.NumTeams-1 do
+ TeamMode := TeamMode AND (Teams.Teaminfo[I].NumPlayers > 1);
+
+ //Set Rounds
+ SetLength(Rounds, NumRounds);
+
+ For I := 0 to High(Rounds) do
+ begin //Set Plugins
+ If (aiRounds[I] = -1) then
+ Rounds[I].Modi := GetRandomPlugin(TeamMode)
+ Else If (aiRounds[I] >= 0) AND (aiRounds[I] <= High(Modis)) AND (TeamMode OR ((Modis[aiRounds[I]].Info.LoadingSettings AND MLS_TeamOnly) = 0)) then
+ Rounds[I].Modi := aiRounds[I]
+ Else
+ Rounds[I].Modi := StandardModi;
+
+ Rounds[I].Winner := High(Byte); //Set Winner to Not Played
+ end;
+
+ CurRound := High(Byte); //Set CurRound to not defined
+
+ //Return teh true and Set PartyMode
+ bPartyMode := True;
+ Result := 1;
+
+ Except
+ Core.ReportError(Integer(PChar('Can''t start PartyMode.')), PChar('TPartySession'));
+ end;
+ end;
+end;
+
+//----------
+// Returns Pointer to Cur. ModiInfoEx (to Use with Singscreen)
+//----------
+Function TPartySession.GetCurModi(wParam: TwParam; lParam: TlParam): integer;
+begin
+ If (bPartyMode) AND (CurRound <= High(Rounds)) then
+ begin //If PartyMode is enabled:
+ //Return the Plugin of the Cur Round
+ Result := Integer(@Modis[Rounds[CurRound].Modi]);
+ end
+ else
+ begin //Return StandardModi
+ Result := Integer(@Modis[StandardModi]);
+ end;
+end;
+
+//----------
+// Stops Party Mode. Returns 1 If Partymode was enabled before. And -1 if Change was not possible
+//----------
+Function TPartySession.StopParty(wParam: TwParam; lParam: TlParam): integer;
+begin
+ Result := -1;
+ If (bPartyMode) then
+ begin
+ // to-do : Whitü: Check here if SingScreen is not Shown atm.
+ bPartyMode := False;
+ Result := 1;
+ end
+ else
+ Result := 0;
+end;
+
+//----------
+//GetRandomPlayer - Gives back a Random Player to Play next Round
+//----------
+function TPartySession.GetRandomPlayer(Team: Byte): Byte;
+var
+ I, R: Integer;
+ lowestTP: Byte;
+ NumPwithLTP: Byte;
+begin
+ LowestTP := high(Byte);
+ NumPwithLTP := 0;
+ Result := 0;
+
+ //Search for Players that have not often played yet
+ For I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do
+ begin
+ if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed < lowestTP) then
+ begin
+ lowestTP := Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed;
+ NumPwithLTP := 1;
+ end
+ else if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP) then
+ begin
+ Inc(NumPwithLTP);
+ end;
+ end;
+
+ //Create Random No
+ R := Random(NumPwithLTP);
+
+ //Search for Random Player
+ For I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do
+ begin
+ if Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP then
+ begin
+ //Player Found
+ if (R = 0) then
+ begin
+ Result := I;
+ Break;
+ end;
+
+ Dec(R);
+ end;
+ end;
+end;
+
+//----------
+// NextRound - Increases CurRound by 1; Returns num of Round or -1 if last Round is already played
+//----------
+Function TPartySession.NextRound(wParam: TwParam; lParam: TlParam): integer;
+var I: Integer;
+begin
+ If ((CurRound < high(Rounds)) OR (CurRound = high(CurRound))) then
+ begin //everythings OK! -> Start the Round, maaaaan
+ Inc(CurRound);
+
+ //Set Players to play this Round
+ for I := 0 to Teams.NumTeams-1 do
+ Teams.Teaminfo[I].CurPlayer := GetRandomPlayer(I);
+ end
+ else
+ Result := -1;
+end;
+
+//----------
+//IsWinner - Returns True if the Players Bit is set in the Winner Byte
+//----------
+function TPartySession.IsWinner(Player, Winner: Byte): boolean;
+var
+ Bit: Byte;
+begin
+ Bit := 1 shl Player;
+
+ Result := ((Winner AND Bit) = Bit);
+end;
+
+//----------
+//GenScores - Inc Scores for Cur. Round
+//----------
+procedure TPartySession.GenScores;
+var
+ I: Byte;
+begin
+ for I := 0 to Teams.NumTeams-1 do
+ begin
+ if isWinner(I, Rounds[CurRound].Winner) then
+ Inc(Teams.Teaminfo[I].Score);
+ end;
+end;
+
+//----------
+// CallModiInit - Calls CurModis Init Proc. If an Error occurs, Returns Nonzero. In this Case a New Plugin was Selected. Please renew Loading
+//----------
+Function TPartySession.CallModiInit(wParam: TwParam; lParam: TlParam): integer;
+begin
+ If (not bPartyMode) then
+ begin //Set Rounds if not in PartyMode
+ SetLength(Rounds, 1);
+ Rounds[0].Modi := StandardModi;
+ Rounds[0].Winner := High(Byte);
+ CurRound := 0;
+ end;
+
+ Try
+ //Core.
+ Except
+ on E : Exception do
+ begin
+ Core.ReportError(Integer(PChar('Error starting Modi: ' + Modis[Rounds[CurRound].Modi].Info.Name + ' ErrorStr: ' + E.Message)), PChar('TPartySession'));
+ If (Rounds[CurRound].Modi = StandardModi) then
+ begin
+ Core.ReportError(Integer(PChar('Can''t start StandardModi, will exit now!')), PChar('TPartySession'));
+ Halt;
+ end
+ Else //Select StandardModi
+ begin
+ Rounds[CurRound].Modi := StandardModi
+ end;
+ end;
+ End;
+end;
+
+//----------
+// CallModiDeInit - Calls DeInitProc and does the RoundEnding
+//----------
+Function TPartySession.CallModiDeInit(wParam: TwParam; lParam: TlParam): integer;
+var
+ I: Integer;
+ MaxScore: Word;
+begin
+ If (bPartyMode) then
+ begin
+ //Get Winner Byte!
+ if (@Modis[Rounds[CurRound].Modi].Info.ModiDeInit <> nil) then //get Winners from Plugin
+ Rounds[CurRound].Winner := Modis[Rounds[CurRound].Modi].Info.ModiDeInit(Modis[Rounds[CurRound].Modi].Info.ID)
+ else
+ begin //Create winners by Score :/
+ Rounds[CurRound].Winner := 0;
+ MaxScore := 0;
+ for I := 0 to Teams.NumTeams-1 do
+ begin
+ // to-do : recode Percentage stuff
+ //PlayerInfo.Playerinfo[I].Percentage := PlayerInfo.Playerinfo[I].Score div 9999;
+ if (Player[I].ScoreTotalI > MaxScore) then
+ begin
+ MaxScore := Player[I].ScoreTotalI;
+ Rounds[CurRound].Winner := 1 shl I;
+ end
+ else if (Player[I].ScoreTotalI = MaxScore) AND (Player[I].ScoreTotalI <> 0) then
+ begin
+ Rounds[CurRound].Winner := Rounds[CurRound].Winner or (1 shl I);
+ end;
+ end;
+
+
+ //When nobody has Points -> Everybody loose
+ if (MaxScore = 0) then
+ Rounds[CurRound].Winner := 0;
+
+ end;
+
+ //Generate teh Scores
+ GenScores;
+
+ //Inc Players TimesPlayed
+ If ((Modis[Rounds[CurRound-1].Modi].Info.LoadingSettings AND MLS_IncTP) = MLS_IncTP) then
+ begin
+ For I := 0 to Teams.NumTeams-1 do
+ Inc(Teams.TeamInfo[I].Playerinfo[Teams.TeamInfo[I].CurPlayer].TimesPlayed);
+ end;
+ end
+ else if (@Modis[Rounds[CurRound].Modi].Info.ModiDeInit <> nil) then
+ Modis[Rounds[CurRound].Modi].Info.ModiDeInit(Modis[Rounds[CurRound].Modi].Info.ID);
+end;
+
+//----------
+// GetTeamInfo - Writes TTeamInfo Record to Pointer at lParam. Returns Zero on Success
+//----------
+Function TPartySession.GetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer;
+var Info: ^TTeamInfo;
+begin
+ Result := -1;
+ Info := pTeamInfo;
+ If (Info <> nil) then
+ begin
+ Try
+ // to - do : Check Delphi memory management in this case
+ //Not sure if i had to copy PChars to a new address or if delphi manages this o0
+ Info^ := Teams;
+ Result := 0;
+ Except
+ Result := -2;
+ End;
+ end;
+end;
+
+//----------
+// SetTeamInfo - Read TTeamInfo Record from Pointer at lParam. Returns Zero on Success
+//----------
+Function TPartySession.SetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer;
+var
+ TeamInfobackup: TTeamInfo;
+ Info: ^TTeamInfo;
+begin
+ Result := -1;
+ Info := pTeamInfo;
+ If (Info <> nil) then
+ begin
+ Try
+ TeamInfoBackup := Teams;
+ // to - do : Check Delphi memory management in this case
+ //Not sure if i had to copy PChars to a new address or if delphi manages this o0
+ Teams := Info^;
+ Result := 0;
+ Except
+ Teams := TeamInfoBackup;
+ Result := -2;
+ End;
+ end;
+end;
+
+//----------
+// GetTeamOrder - Returns Team Order. Structure: Bits 1..3: Team at Place1; Bits 4..6: Team at Place2 ...
+//----------
+Function TPartySession.GetTeamOrder(wParam: TwParam; lParam: TlParam): integer;
+var
+ I, J: Integer;
+ ATeams: array [0..5] of TeamOrderEntry;
+ TempTeam: TeamOrderEntry;
+begin
+ // to-do : PartyMode: Write this in another way, so that teams with the same scire get the same Placing
+ //Fill Team Array
+ For I := 0 to Teams.NumTeams-1 do
+ begin
+ ATeams[I].Teamnum := I;
+ ATeams[I].Score := Teams.Teaminfo[I].Score;
+ end;
+
+ //Sort Teams
+ for J := 0 to Teams.NumTeams-1 do
+ for I := 1 to Teams.NumTeams-1 do
+ if ATeams[I].Score > ATeams[I-1].Score then
+ begin
+ TempTeam := ATeams[I-1];
+ ATeams[I-1] := ATeams[I];
+ ATeams[I] := TempTeam;
+ end;
+
+ //Copy to Result
+ Result := 0;
+ For I := 0 to Teams.NumTeams-1 do
+ Result := Result or (ATeams[I].TeamNum Shl I*3);
+end;
+
+//----------
+// GetWinnerString - wParam is Roundnum. If (Pointer = nil) then Return Length of the String. Otherwise Write the String to Address at lParam
+//----------
+Function TPartySession.GetWinnerString(wParam: TwParam; lParam: TlParam): integer;
+var
+ Winners: Array of String;
+ I: Integer;
+ ResultStr: String;
+ S: ^String;
+begin
+ ResultStr := Language.Translate('PARTY_NOBODY');
+
+ if (wParam <= High(Rounds)) then
+ begin
+ if (Rounds[wParam].Winner <> 0) then
+ begin
+ if (Rounds[wParam].Winner = 255) then
+ begin
+ ResultStr := Language.Translate('PARTY_NOTPLAYEDYET');
+ end
+ else
+ begin
+ SetLength(Winners, 0);
+ for I := 0 to Teams.NumTeams-1 do
+ begin
+ if isWinner(I, Rounds[wParam].Winner) then
+ begin
+ SetLength(Winners, Length(Winners) + 1);
+ Winners[high(Winners)] := Teams.TeamInfo[I].Name;
+ end;
+ end;
+ ResultStr := Language.Implode(Winners);
+ end;
+ end;
+ end;
+
+ //Now Return what we have got
+ If (lParam = nil) then
+ begin //ReturnString Length
+ Result := Length(ResultStr);
+ end
+ Else
+ begin //Return String
+ Try
+ S := lParam;
+ S^ := ResultStr;
+ Result := 0;
+ Except
+ Result := -1;
+
+ End;
+ end;
+end;
+
+end.
|