{* UltraStar Deluxe - Karaoke Game
*
* UltraStar Deluxe is the legal property of its developers, whose names
* are too numerous to list here. Please refer to the COPYRIGHT
* file distributed with this source distribution.
*
* This program is free software; you can redistribute it and/or
* modify it under the terms of the GNU General Public License
* as published by the Free Software Foundation; either version 2
* of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
* Boston, MA 02110-1301, USA.
*
* $URL$
* $Id$
*}
unit UParty;
interface
{$IFDEF FPC}
{$MODE DELPHI}
{$ENDIF}
{$I switches.inc}
uses
ModiSDK;
type
TRoundInfo = record
Plugin: word;
Winner: byte;
end;
TeamOrderEntry = record
TeamNum: byte;
Score: byte;
end;
TeamOrderArray = array[0..5] of byte;
TPartyPlugin = record
ID: byte;
TimesPlayed: byte;
end;
TPartySession = class
private
function GetRandomPlayer(Team: byte): byte;
function GetRandomPlugin(Plugins: array of TPartyPlugin): byte;
function IsWinner(Player, Winner: byte): boolean;
procedure GenScores;
public
Teams: TTeamInfo;
Rounds: array of TRoundInfo;
CurRound: byte;
constructor Create;
procedure StartNewParty(NumRounds: byte);
procedure StartRound;
procedure EndRound;
function GetTeamOrder: TeamOrderArray;
function GetWinnerString(Round: byte): UTF8String;
end;
var
PartySession: TPartySession;
implementation
uses
UDLLManager,
UGraphic,
UNote,
ULanguage,
ULog;
constructor TPartySession.Create;
begin
inherited;
end;
//----------
// Returns a number of a random plugin
//----------
function TPartySession.GetRandomPlugin(Plugins: array of TPartyPlugin): byte;
var
LowestTP: byte;
NumPwithLTP: word;
I: integer;
R: word;
begin
LowestTP := high(byte);
NumPwithLTP := 0;
//Search for Plugins not often played yet
for I := 0 to high(Plugins) do
begin
if (Plugins[I].TimesPlayed < lowestTP) then
begin
lowestTP := Plugins[I].TimesPlayed;
NumPwithLTP := 1;
end
else if (Plugins[I].TimesPlayed = lowestTP) then
begin
Inc(NumPwithLTP);
end;
end;
//Create random no
R := Random(NumPwithLTP);
//Search for random plugin
for I := 0 to high(Plugins) do
begin
if Plugins[I].TimesPlayed = LowestTP then
begin
//Plugin found
if (R = 0) then
begin
Result := Plugins[I].ID;
Inc(Plugins[I].TimesPlayed);
Break;
end;
Dec(R);
end;
end;
end;
//----------
//StartNewParty - Reset and prepares for new party
//----------
procedure TPartySession.StartNewParty(NumRounds: byte);
var
Plugins: array of TPartyPlugin;
TeamMode: boolean;
Len: integer;
I, J: integer;
begin
//Set current round to 1
CurRound := 255;
PlayersPlay := Teams.NumTeams;
//Get team-mode and set joker, also set TimesPlayed
TeamMode := true;
for I := 0 to Teams.NumTeams - 1 do
begin
if Teams.Teaminfo[I].NumPlayers < 2 then
begin
TeamMode := false;
end;
//Set player attributes
for J := 0 to Teams.TeamInfo[I].NumPlayers-1 do
begin
Teams.TeamInfo[I].Playerinfo[J].TimesPlayed := 0;
end;
Teams.Teaminfo[I].Joker := Round(NumRounds * 0.7);
Teams.Teaminfo[I].Score := 0;
end;
//Fill plugin array
SetLength(Plugins, 0);
for I := 0 to high(DLLMan.Plugins) do
begin
if TeamMode or (not DLLMan.Plugins[I].TeamModeOnly) then
begin
//Add only those plugins playable with current PlayerConfiguration
Len := Length(Plugins);
SetLength(Plugins, Len + 1);
Plugins[Len].ID := I;
Plugins[Len].TimesPlayed := 0;
end;
end;
//Set rounds
if (Length(Plugins) >= 1) then
begin
SetLength (Rounds, NumRounds);
for I := 0 to NumRounds - 1 do
begin
PartySession.Rounds[I].Plugin := GetRandomPlugin(Plugins);
PartySession.Rounds[I].Winner := 255;
end;
end
else
SetLength (Rounds, 0);
end;
{**
* Returns 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 number
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;
{**
* Prepares ScreenSingModi for next round and loads plugin
*}
procedure TPartySession.StartRound;
var
I: integer;
begin
if ((CurRound < high(Rounds)) or (CurRound = high(CurRound))) then
begin
// Increase Current Round but not beyond its limit
// CurRound is set to 255 to begin with!
// Ugly solution if you ask me.
if CurRound < high(CurRound) then
Inc(CurRound)
else
CurRound := 0;
Rounds[CurRound].Winner := 255;
DllMan.LoadPlugin(Rounds[CurRound].Plugin);
//Select Players
for I := 0 to Teams.NumTeams - 1 do
Teams.Teaminfo[I].CurPlayer := GetRandomPlayer(I);
//Set ScreenSingModie Variables
ScreenSingModi.TeamInfo := Teams;
end;
end;
//----------
//EndRound - Get Winner from ScreenSingModi and Save Data to RoundArray
//----------
procedure TPartySession.EndRound;
var
I: Integer;
begin
//Copy Winner
Rounds[CurRound].Winner := ScreenSingModi.Winner;
//Set Scores
GenScores;
//Increase TimesPlayed 4 all Players
For I := 0 to Teams.NumTeams-1 do
Inc(Teams.Teaminfo[I].Playerinfo[Teams.Teaminfo[I].CurPlayer].TimesPlayed);
end;
//----------
//IsWinner - returns true if the player's bit is set in the winner byte
//----------
function TPartySession.IsWinner(Player, Winner: byte): boolean;
var
Mask: byte;
begin
Mask := 1 shl Player;
Result := (Winner and Mask) <> 0;
end;
//----------
//GenScores - increase scores for current 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;
//----------
//GetTeamOrder - returns the placement of each Team [First Position of Array is Teamnum of first placed Team, ...]
//----------
function TPartySession.GetTeamOrder: TeamOrderArray;
var
I, J: integer;
ATeams: array [0..5] of TeamOrderEntry;
TempTeam: TeamOrderEntry;
begin
// TODO: PartyMode: Write this in another way, so that teams with the same score get the same place
//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
for I := 0 to Teams.NumTeams-1 do
Result[I] := ATeams[I].TeamNum;
end;
//----------
//GetWinnerString - Get string with WinnerTeam Name, when there is more than one Winner than Connect with and or ,
//----------
function TPartySession.GetWinnerString(Round: byte): UTF8String;
var
Winners: array of UTF8String;
I: integer;
begin
Result := Language.Translate('PARTY_NOBODY');
if (Round > High(Rounds)) then
exit;
if (Rounds[Round].Winner = 0) then
begin
exit;
end;
if (Rounds[Round].Winner = 255) then
begin
Result := Language.Translate('PARTY_NOTPLAYEDYET');
exit;
end;
SetLength(Winners, 0);
for I := 0 to Teams.NumTeams - 1 do
begin
if isWinner(I, Rounds[Round].Winner) then
begin
SetLength(Winners, Length(Winners) + 1);
Winners[high(Winners)] := Teams.TeamInfo[I].Name;
end;
end;
Result := Language.Implode(Winners);
end;
end.
