{* 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.