From e4f413fdcf003ac0ad20d145f61dd370994e79db Mon Sep 17 00:00:00 2001 From: brunzelchen Date: Wed, 9 Dec 2009 18:35:28 +0000 Subject: just a first experimental version git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/branches/experimental@2011 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Medley/src/base/UParty.pas | 388 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 388 insertions(+) create mode 100644 Medley/src/base/UParty.pas (limited to 'Medley/src/base/UParty.pas') diff --git a/Medley/src/base/UParty.pas b/Medley/src/base/UParty.pas new file mode 100644 index 00000000..52eb5a05 --- /dev/null +++ b/Medley/src/base/UParty.pas @@ -0,0 +1,388 @@ +{* 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. -- cgit v1.2.3