aboutsummaryrefslogtreecommitdiffstats
path: root/src/Classes/UParty.pas
diff options
context:
space:
mode:
Diffstat (limited to 'src/Classes/UParty.pas')
-rw-r--r--src/Classes/UParty.pas630
1 files changed, 0 insertions, 630 deletions
diff --git a/src/Classes/UParty.pas b/src/Classes/UParty.pas
deleted file mode 100644
index 01a182b1..00000000
--- a/src/Classes/UParty.pas
+++ /dev/null
@@ -1,630 +0,0 @@
-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;
- Destructor Destroy; 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
- inherited;
- //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
-//-------------
-Destructor TPartySession.Destroy;
-begin
- //Just save some Memory if it wasn't done now..
- SetLength(Modis, 0);
- inherited;
-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'));
-
- // FIXME: return a valid result
- Result := 0;
-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);
-
- // FIXME: return a valid result
- Result := 0;
- 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;
-
- // FIXME: return a valid result
- Result := 0;
-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].ScoreTotalInt > MaxScore) then
- begin
- MaxScore := Player[I].ScoreTotalInt;
- Rounds[CurRound].Winner := 1 shl I;
- end
- else if (Player[I].ScoreTotalInt = MaxScore) AND (Player[I].ScoreTotalInt <> 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);
-
- // FIXME: return a valid result
- Result := 0;
-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.