{* 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 //UPartyDefs, //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; // some things copied from UPartyDefs, remove this later //---------------- // TUS_Party_Proc_Init - Structure of the Party Init Proc // This Function is called on SingScreen Init Everytime this Modi should be sung // Return Non Zero to Abort Party Modi Loading... In this Case another Plugin will be loaded //---------------- TUS_Party_Proc_Init = Function (ID: Integer): integer; stdcall; //---------------- // TUS_Party_Proc_Draw - Structure of the Party Draw Proc // This Function is called on SingScreen Draw (Not when Paused). You should draw in this Proc // Return Non Zero to Finish Song... In this Case Score Screen is loaded //---------------- TUS_Party_Proc_Draw = Function (ID: Integer): integer; stdcall; //---------------- // TUS_Party_Proc_DeInit - Structure of the Party DeInit Proc // This Function is called on SingScreen DeInit When Plugin abort Song or Song finishes // Return Winner //---------------- TUS_Party_Proc_DeInit = Function (ID: Integer): integer; stdcall; //---------------- // TUS_ModiInfo - Some Infos from Plugin to Partymode. // Used to register party modi to Party manager // --- // Version Structure: // First Byte: Head Revison // Second Byte: Sub Revison // Third Byte: Sub Revision 2 // Fourth Byte: Letter (For Bug Fix releases. 0 or 'a' .. 'z') //---------------- TModiInfo_Name = Array [0..31] of Char; TModiInfo_Desc = Array [0..63] of Char; PUS_ModiInfo = ^TUS_ModiInfo; TUS_ModiInfo = record //Size of this record (usefull if record will be extended in the future) cbSize: Integer; //Don't forget to set this as Plugin! //Infos about the Modi Name : TModiInfo_Name; //Modiname to Register for the Plugin Description: TModiInfo_Desc; //Plugin Description //------------ // Loading Settings // --- // Bit to Set | Triggered Option // 1 | Song should be loaded // 2 | Song has to be Non Duett // 4 | Song has to be Duett (If 2 and 4 is set, both will be ignored) // 8 | Only Playable with 2 and more players // 16 | Restrict Background Loading // 32 | Restrict Video Loading // 64 | Increase TimesPlayed for Cur. Player // 128 | Not in Use, Don't set it! LoadingSettings: Byte; // SingScreen Settings // --- // Bit to Set | Triggered Option // 1 | ShowNotes // 2 | ShowScores // 4 | ShowTime // 8 | Start Audio Playback automaticaly // 16 | Not in Use, Don't set it! // 32 | Not in Use, Don't set it! // 64 | Not in Use, Don't set it! // 128 | Not in Use, Don't set it! SingScreenSettings: Byte; // With which count of players can this modi be played // --- //Set different Bits //1 -> One Player //2 -> Two Players //4 -> Three Players //8 -> Four Players //16-> Six Players //e.g. : 10 -> Playable with 2 and 4 Players NumPlayers: Byte; // ID that is given to the Party Procs when they are called // If this Modi is running // (e.g. to register Until 2000 and Until 5000 with the same Procs // ID is the Max Point Count in this example) ID: Integer; // Party Procs called on Party // --- // Set to nil(C: NULL) if u don't want to use this method ModiInit: TUS_Party_Proc_Init; ModiDraw: TUS_Party_Proc_Draw; ModiDeInit: TUS_Party_Proc_DeInit; end; //-------------- // Team Info Record. Used by "Party/GetTeamInfo" and "Party/SetTeamInfo" //-------------- TTeamInfo = record NumTeams: Byte; Teaminfo: array[0..5] of record Name: PChar; //Teamname Score: Word; //TeamScore Joker: Byte; //Team Jokers available CurPlayer: Byte; //Id of Cur. Playing Player NumPlayers: Byte; Playerinfo: array[0..3] of record Name: PChar; //Playername TimesPlayed: Byte; //How often this Player has Sung end; end; end; //---------------- // Some Default Constants //---------------- const // to use for TUS_ModiInfo.LoadingSettings MLS_LoadSong = 1; //Song should be loaded MLS_NotDuett = 2; //Song has to be Non Duett MLS_ForceDuett = 4; //Song has to be Duett (If 2 and 4 is set, both will be ignored) MLS_TeamOnly = 8; //Only Playable with 2 and more players MLS_RestrictBG = 16; //Restrict Background Loading MLS_RestrictVid = 32; //Restrict Video Loading MLS_IncTP = 64; //Increase TimesPlayed for Cur. Player // to use with TUS_ModiInfo.SingScreenSettings MSS_ShowNotes = 1; //ShowNotes MSS_ShowScores = 2; //ShowScores MSS_ShowTime = 4; //ShowTime MSS_AutoPlayback= 8; //Start Audio Playback automaticaly //Standard (Duell) for TUS_ModiInfo.LoadingSettings and TUS_ModiInfo.SingScreenSettings MLS_Standard = MLS_LoadSong or MLS_IncTP; MSS_Standard = MSS_ShowNotes or MSS_ShowScores or MSS_ShowTime or MSS_AutoPlayback; type TUS_ModiInfoEx = record Info: TUS_ModiInfo; Owner: integer; TimesPlayed: byte; //Helper for setting round plugins end; TPartySession = class private bPartyMode: boolean; //Is this party or single player 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; //procedure Info(const pInfo: PModuleInfo); function Load: boolean; function Init: boolean; procedure DeInit; destructor Destroy; {//Register modus service function RegisterModi(nothin: TwParam; pModiInfo: TlParam): integer; //Registers a new modus. 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 party mode 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 ends the round 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 StandardModus = 0; //Modus ID that will be played in non-party mode implementation uses UGraphic, ULanguage, ULog, UNote, SysUtils; {********************* TPluginLoader Implentation *********************} //------------- // function that gives some infos about the module to the core //------------- {rocedure 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 modus 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 private var to true. Result := true; end; //------------- //Is called if this module has been inited and there is an exit. //Deinit is in reverse 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 modus. wParam: Pointer to TUS_ModiInfo // Service for plugins //------------- {unction 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 modus with wrong pointer, or wrong TUS_ModiInfo record.')), PChar('TPartySession'));} // FIXME: return a valid result { {esult := 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 := StandardModus; //If there are no matching modi, play standard modus 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 //---------- {unction 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 team mode (More than 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 := StandardModus; Rounds[I].Winner := High(byte); //Set winner to not played end; CurRound := High(byte); //Set CurRound to not defined //Return true and set party mode bPartyMode := true; Result := 1; except //Core.ReportError(integer(PChar('Can''t start party mode.')), PChar('TPartySession')); end; end; end; //---------- // Returns pointer to Cur. ModiInfoEx (to use with sing screen) //---------- 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 standard modus Result := integer(@Modis[StandardModus]); end; end; //---------- // Stops party mode. Returns 1 if party mode 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 sing screen 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 party mode SetLength(Rounds, 1); Rounds[0].Modi := StandardModus; Rounds[0].Winner := High(byte); CurRound := 0; end; try //Core. except on E : Exception do begin //Core.ReportError(integer(PChar('Error starting modus: ' + Modis[Rounds[CurRound].Modi].Info.Name + ' ErrorStr: ' + E.Message)), PChar('TPartySession')); if (Rounds[CurRound].Modi = StandardModus) then begin //Core.ReportError(integer(PChar('Can''t start standard modus, will exit now!')), PChar('TPartySession')); Halt; end else //Select standard modus begin Rounds[CurRound].Modi := StandardModus end; end; end; // FIXME: return a valid result Result := 0; end; //---------- // CallModiDeInit - calls DeInitProc and ends the round //---------- 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 looses if (MaxScore = 0) then Rounds[CurRound].Winner := 0; end; //Generate the 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 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 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 //Return string length Result := Length(ResultStr); end else begin //Return string try S := lParam; S^ := ResultStr; Result := 0; except Result := -1; end; end; end; } end.