From 3260749d369d3466c345d40a8b2189c32c8c1b60 Mon Sep 17 00:00:00 2001 From: Alexander Sulfrian Date: Mon, 7 Nov 2011 15:26:44 +0100 Subject: removed pascal code --- src/base/UParty.pas | 388 ---------------------------------------------------- 1 file changed, 388 deletions(-) delete mode 100644 src/base/UParty.pas (limited to 'src/base/UParty.pas') diff --git a/src/base/UParty.pas b/src/base/UParty.pas deleted file mode 100644 index 52eb5a05..00000000 --- a/src/base/UParty.pas +++ /dev/null @@ -1,388 +0,0 @@ -{* 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