diff options
Diffstat (limited to '')
21 files changed, 3162 insertions, 210 deletions
diff --git a/ServiceBasedPlugins/plugins/SDK/Hooks.txt b/ServiceBasedPlugins/plugins/SDK/Hooks.txt new file mode 100644 index 00000000..999f552f --- /dev/null +++ b/ServiceBasedPlugins/plugins/SDK/Hooks.txt @@ -0,0 +1,20 @@ +Ultrastar Deluxe Hook List +----------------------------------- +Here you can find the Events the Core offers to you: + +-------------------- +Core: +-------------------- +Core/LoadingFinished <- Hook is called after all Modules and Plugins are loaded completely, before MainLoop +Core/MainLoop <- Hook is called once in MainLoop before Drawing +Core/Translate <- Hook is called when Strings should be translated. If this is Retranslating lParam is Non Zero +Core/LoadTextures <- Hook is called when Textures should be Loaded. This will be called in Ogl Thread. If Textures are Reloaded (e.g. on Display ReInit) LParam is non Zero. +Core/ExitQuery <- Hook is called if someone querys an exit. (e.g. X is pressed). Not called on ForcedExit. If Chain is breaked the exit will be aborted. +Core/Exit <- Hook is called before Module a. Plugin unload. +Core/NewDebugInfo <- Hook is called everytime there is Debug Info to Output(only if Debug Mode is enabled). wParam: Pchar(Message), lParam: PChar(Reportername) +Core/NewError <- Hook is called everytime an error is reported. wParam: Pchar(Message), lParam: PChar(Reportername) + +-------------------- +Display +-------------------- +Display/onScreenChange <-Hook is called when there is an attemp to change Screen. wParam is address to Screens Name(Null Terminated). If Chain is breaked Screenchange will be aborted.
\ No newline at end of file diff --git a/ServiceBasedPlugins/plugins/SDK/Plugin DLL Exports.txt b/ServiceBasedPlugins/plugins/SDK/Plugin DLL Exports.txt new file mode 100644 index 00000000..930e18ac --- /dev/null +++ b/ServiceBasedPlugins/plugins/SDK/Plugin DLL Exports.txt @@ -0,0 +1,11 @@ +Ultrastar Plugin DLL(Libary) Exports +----------------------------------- +This are the Procedurs and Functions that a UsDx Plugin has to export to get Loaded. + + +USPlugin_Info(PInfo: PUS_PluginInfo); stdcall; +----------------------------------- +Ultrastar uses this Procedure to identify the Plugins. +At the given Address there is a PUS_PluginInfo Record. cbSize +attribut is already set. Please asure not to overwrite this assigned +memory amount. diff --git a/ServiceBasedPlugins/plugins/SDK/Services.txt b/ServiceBasedPlugins/plugins/SDK/Services.txt new file mode 100644 index 00000000..8db031d8 --- /dev/null +++ b/ServiceBasedPlugins/plugins/SDK/Services.txt @@ -0,0 +1,22 @@ +Ultrastar Deluxe Service List +----------------------------------- +Here you can find the Services the Core offers to you: + +-------------------- +Core: +-------------------- +Core/ReportError <- Calls the 'Core/NewError' Chain. wParam: Pchar(Message), lParam: PChar(Reportername) +Core/ReportDebug <- Calls the 'Core/NewDebugInfo' Chain. wParam: Pchar(Message), lParam: PChar(Reportername) +Core/ShowMessage <- Shows a Message Dialog. (lParam: PChar Text, wParam: Symbol) +Core/Retranslate <- Calls Translate Hook +Core/ReloadTextures <- Calls LoadTextures Hook +Core/GetModuleInfo <- If lParam = nil then get length of Moduleinfo Array. If lparam <> nil then write array of TModuleInfo to address at lparam +Core/GetApplicationHandle <- Returns Main-Applications Handle (Win32 Only) + +-------------------- +PluginLoader +-------------------- +PluginLoader/GetPluginInfo <- If wParam = -1 then (If lParam = nil then get length of Moduleinfo Array. If lparam <> nil then write array of TUS_PluginInfo to address at lparam) Else (Get PluginInfo of Plugin with Index(wParam) to Address at lParam) +PluginLoader/GetPluginState <- If wParam = -1 then (If lParam = nil then get length of Moduleinfo Array. If lparam <> nil then write array of TUS_PluginInfo to address at lparam) Else (Return PluginInfo of Plugin with Index(wParam)) +PluginLoader/LoadPlugin <- wParam PChar(PluginName/PluginPath) | lParam (if wParam = nil) ID of the Plugin +PluginLoader/UnloadPlugin <- wParam PChar(PluginName/PluginPath) | lParam (if wParam = nil) ID of the Plugin
\ No newline at end of file diff --git a/ServiceBasedPlugins/src/base/UCore.pas b/ServiceBasedPlugins/src/base/UCore.pas new file mode 100644 index 00000000..a7f9e56e --- /dev/null +++ b/ServiceBasedPlugins/src/base/UCore.pas @@ -0,0 +1,550 @@ +{* 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 UCore; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + uPluginDefs, + uCoreModule, + UHooks, + UServices, + UModules; + +{********************* + TCore + Class manages all CoreModules, the StartUp, the MainLoop and the shutdown process + Also, it does some error handling, and maybe sometime multithreaded loading ;) +*********************} + +type + TModuleListItem = record + Module: TCoreModule; // Instance of the modules class + Info: TModuleInfo; // ModuleInfo returned by modules modulinfo proc + NeedsDeInit: boolean; // True if module was succesful inited + end; + + TCore = class + private + // Some Hook Handles. See Plugin SDKs Hooks.txt for Infos + hLoadingFinished: THandle; + hMainLoop: THandle; + hTranslate: THandle; + hLoadTextures: THandle; + hExitQuery: THandle; + hExit: THandle; + hDebug: THandle; + hError: THandle; + sReportError: THandle; + sReportDebug: THandle; + sShowMessage: THandle; + sRetranslate: THandle; + sReloadTextures: THandle; + sGetModuleInfo: THandle; + sGetApplicationHandle: THandle; + + Modules: array [0..High(CORE_MODULES_TO_LOAD)] of TModuleListItem; + + // Cur + Last Executed Setting and Getting ;) + iCurExecuted: integer; + iLastExecuted: integer; + + procedure SetCurExecuted(Value: integer); + + // Function Get all Modules and Creates them + function GetModules: boolean; + + // Loads Core and all Modules + function Load: boolean; + + // Inits Core and all Modules + function Init: boolean; + + // DeInits Core and all Modules + function DeInit: boolean; + + // Load the Core + function LoadCore: boolean; + + // Init the Core + function InitCore: boolean; + + // DeInit the Core + function DeInitCore: boolean; + + // Called one time per frame + function MainLoop: boolean; + + public + Hooks: THookManager; // The Hook Manager ;) + Services: TServiceManager; // The Service Manager + + Name: string; // Name of this application + Version: LongWord; // Version of this ". For info look plugindefs functions + + LastErrorReporter: string; // Who reported the last error string + LastErrorString: string; // Last error string reported + + property CurExecuted: integer read iCurExecuted write SetCurExecuted; //ID of plugin or module curently executed + property LastExecuted: integer read iLastExecuted; + + //--------------- + // Main methods to control the core: + //--------------- + constructor Create(const cName: string; const cVersion: LongWord); + + // Starts loading and init process. Then runs MainLoop. DeInits on shutdown + procedure Run; + + // Method for other classes to get pointer to a specific module + function GetModulebyName(const Name: string): PCoreModule; + + //-------------- + // Hook and service procs: + //-------------- + function ShowMessage(wParam: TwParam; lParam: TlParam): integer; //Shows a Message (lParam: PChar Text, wParam: Symbol) + function ReportError(wParam: TwParam; lParam: TlParam): integer; //Shows a Message (wParam: Pchar(Message), lParam: PChar(Reportername)) + function ReportDebug(wParam: TwParam; lParam: TlParam): integer; //Shows a Message (wParam: Pchar(Message), lParam: PChar(Reportername)) + function Retranslate(wParam: TwParam; lParam: TlParam): integer; //Calls Translate hook + function ReloadTextures(wParam: TwParam; lParam: TlParam): integer; //Calls LoadTextures hook + function GetModuleInfo(wParam: TwParam; lParam: TlParam): integer; //If lParam = nil then get length of Moduleinfo array. If lparam <> nil then write array of TModuleInfo to address at lparam + function GetApplicationHandle(wParam: TwParam; lParam: TlParam): integer; //Returns Application Handle + end; + +var + Core: TCore; + +implementation + +uses + {$IFDEF win32} + Windows, + {$ENDIF} + SysUtils; + +//------------- +// Create - Creates Class + Hook and Service Manager +//------------- +constructor TCore.Create(const cName: string; const cVersion: LongWord); +begin + inherited Create; + + Name := cName; + Version := cVersion; + iLastExecuted := 0; + iCurExecuted := 0; + + LastErrorReporter := ''; + LastErrorString := ''; + + Hooks := THookManager.Create(50); + Services := TServiceManager.Create; +end; + +//------------- +// Starts Loading and Init process. Then runs MainLoop. DeInits on shutdown +//------------- +procedure TCore.Run; +var + Success: boolean; + + procedure HandleError(const ErrorMsg: string); + begin + if (LastErrorString <> '') then + Self.ShowMessage(CORE_SM_ERROR, PChar(ErrorMsg + ': ' + LastErrorString)) + else + Self.ShowMessage(CORE_SM_ERROR, PChar(ErrorMsg)); + + // DeInit + DeInit; + end; + +begin + // Get modules + try + Success := GetModules(); + except + Success := false; + end; + + if (not Success) then + begin + HandleError('Error Getting Modules'); + Exit; + end; + + // Loading + try + Success := Load(); + except + Success := false; + end; + + if (not Success) then + begin + HandleError('Error loading Modules'); + Exit; + end; + + // Init + try + Success := Init(); + except + Success := false; + end; + + if (not Success) then + begin + HandleError('Error initing Modules'); + Exit; + end; + + // Call Translate Hook + if (Hooks.CallEventChain(hTranslate, 0, nil) <> 0) then + begin + HandleError('Error translating'); + Exit; + end; + + // Calls LoadTextures Hook + if (Hooks.CallEventChain(hLoadTextures, 0, nil) <> 0) then + begin + HandleError('Error loading textures'); + Exit; + end; + + // Calls Loading Finished Hook + if (Hooks.CallEventChain(hLoadingFinished, 0, nil) <> 0) then + begin + HandleError('Error calling LoadingFinished Hook'); + Exit; + end; + + // Start MainLoop + while Success do + begin + Success := MainLoop(); + // to-do : Call Display Draw here + end; +end; + +//------------- +// Called one time per frame +//------------- +function TCore.MainLoop: boolean; +begin + Result := false; +end; + +//------------- +// Function get all modules and creates them +//------------- +function TCore.GetModules: boolean; +var + i: integer; +begin + Result := false; + for i := 0 to high(Modules) do + begin + try + Modules[i].NeedsDeInit := false; + Modules[i].Module := CORE_MODULES_TO_LOAD[i].Create; + Modules[i].Module.Info(@Modules[i].Info); + except + ReportError(integer(PChar('Can''t get module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core')); + Exit; + end; + end; + Result := true; +end; + +//------------- +// Loads core and all modules +//------------- +function TCore.Load: boolean; +var + i: integer; +begin + Result := LoadCore; + + for i := 0 to High(CORE_MODULES_TO_LOAD) do + begin + try + Result := Modules[i].Module.Load; + except + Result := false; + end; + + if (not Result) then + begin + ReportError(integer(PChar('Error loading module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core')); + break; + end; + end; +end; + +//------------- +// Inits core and all modules +//------------- +function TCore.Init: boolean; +var + i: integer; +begin + Result := InitCore; + + for i := 0 to High(CORE_MODULES_TO_LOAD) do + begin + try + Result := Modules[i].Module.Init; + except + Result := false; + end; + + if (not Result) then + begin + ReportError(integer(PChar('Error initing module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core')); + break; + end; + + Modules[i].NeedsDeInit := Result; + end; +end; + +//------------- +// DeInits core and all modules +//------------- +function TCore.DeInit: boolean; +var + i: integer; +begin + + for i := High(CORE_MODULES_TO_LOAD) downto 0 do + begin + try + if (Modules[i].NeedsDeInit) then + Modules[i].Module.DeInit; + except + end; + end; + + DeInitCore; + + Result := true; +end; + +//------------- +// Load the Core +//------------- +function TCore.LoadCore: boolean; +begin + hLoadingFinished := Hooks.AddEvent('Core/LoadingFinished'); + hMainLoop := Hooks.AddEvent('Core/MainLoop'); + hTranslate := Hooks.AddEvent('Core/Translate'); + hLoadTextures := Hooks.AddEvent('Core/LoadTextures'); + hExitQuery := Hooks.AddEvent('Core/ExitQuery'); + hExit := Hooks.AddEvent('Core/Exit'); + hDebug := Hooks.AddEvent('Core/NewDebugInfo'); + hError := Hooks.AddEvent('Core/NewError'); + + sReportError := Services.AddService('Core/ReportError', nil, Self.ReportError); + sReportDebug := Services.AddService('Core/ReportDebug', nil, Self.ReportDebug); + sShowMessage := Services.AddService('Core/ShowMessage', nil, Self.ShowMessage); + sRetranslate := Services.AddService('Core/Retranslate', nil, Self.Retranslate); + sReloadTextures := Services.AddService('Core/ReloadTextures', nil, Self.ReloadTextures); + sGetModuleInfo := Services.AddService('Core/GetModuleInfo', nil, Self.GetModuleInfo); + sGetApplicationHandle := Services.AddService('Core/GetApplicationHandle', nil, Self.GetApplicationHandle); + + // A little Test + Hooks.AddSubscriber('Core/NewError', HookTest); + + result := true; +end; + +//------------- +// Init the Core +//------------- +function TCore.InitCore: boolean; +begin + //Don not init something atm. + result := true; +end; + +//------------- +// DeInit the Core +//------------- +function TCore.DeInitCore: boolean; +begin + // TODO: write TService-/HookManager. Free and call it here + Result := true; +end; + +//------------- +// Method for other classes to get pointer to a specific module +//------------- +function TCore.GetModuleByName(const Name: string): PCoreModule; +var i: integer; +begin + Result := nil; + for i := 0 to High(Modules) do + begin + if (Modules[i].Info.Name = Name) then + begin + Result := @Modules[i].Module; + Break; + end; + end; +end; + +//------------- +// Shows a MessageDialog (lParam: PChar Text, wParam: Symbol) +//------------- +function TCore.ShowMessage(wParam: TwParam; lParam: TlParam): integer; +{$IFDEF MSWINDOWS} +var Params: Cardinal; +{$ENDIF} +begin + Result := -1; + + {$IFDEF MSWINDOWS} + if (lParam <> nil) then + begin + Params := MB_OK; + case wParam of + CORE_SM_ERROR: Params := Params or MB_ICONERROR; + CORE_SM_WARNING: Params := Params or MB_ICONWARNING; + CORE_SM_INFO: Params := Params or MB_ICONINFORMATION; + end; + + // Show: + Result := Messagebox(0, lParam, PChar(Name), Params); + end; + {$ENDIF} + + // TODO: write ShowMessage for other OSes +end; + +//------------- +// Calls NewError HookChain (wParam: Pchar(Message), lParam: PChar(Reportername)) +//------------- +function TCore.ReportError(wParam: TwParam; lParam: TlParam): integer; +begin + //Update LastErrorReporter and LastErrorString + LastErrorReporter := string(PChar(lParam)); + LastErrorString := string(PChar(Pointer(wParam))); + + Hooks.CallEventChain(hError, wParam, lParam); + + // FIXME: return a correct result + Result := 0; +end; + +//------------- +// Calls NewDebugInfo HookChain (wParam: Pchar(Message), lParam: PChar(Reportername)) +//------------- +function TCore.ReportDebug(wParam: TwParam; lParam: TlParam): integer; +begin + Hooks.CallEventChain(hDebug, wParam, lParam); + + // FIXME: return a correct result + Result := 0; +end; + +//------------- +// Calls Translate hook +//------------- +function TCore.Retranslate(wParam: TwParam; lParam: TlParam): integer; +begin + Hooks.CallEventChain(hTranslate, 1, nil); + + // FIXME: return a correct result + Result := 0; +end; + +//------------- +// Calls LoadTextures hook +//------------- +function TCore.ReloadTextures(wParam: TwParam; lParam: TlParam): integer; +begin + Hooks.CallEventChain(hLoadTextures, 1, nil); + + // FIXME: return a correct result + Result := 0; +end; + +//------------- +// If lParam = nil then get length of Moduleinfo array. If lparam <> nil then write array of TModuleInfo to address at lparam +//------------- +function TCore.GetModuleInfo(wParam: TwParam; lParam: TlParam): integer; +var + I: integer; +begin + if (Pointer(lParam) = nil) then + begin + Result := Length(Modules); + end + else + begin + try + for I := 0 to High(Modules) do + begin + AModuleInfo(Pointer(lParam))[I].Name := Modules[I].Info.Name; + AModuleInfo(Pointer(lParam))[I].Version := Modules[I].Info.Version; + AModuleInfo(Pointer(lParam))[I].Description := Modules[I].Info.Description; + end; + Result := Length(Modules); + except + Result := -1; + end; + end; +end; + +//------------- +// Returns Application Handle +//------------- +function TCore.GetApplicationHandle(wParam: TwParam; lParam: TlParam): integer; +begin + Result := hInstance; +end; + +//------------- +// Called when setting CurExecuted +//------------- +procedure TCore.SetCurExecuted(Value: integer); +begin + // Set Last Executed + iLastExecuted := iCurExecuted; + + // Set Cur Executed + iCurExecuted := Value; +end; + +end. diff --git a/ServiceBasedPlugins/src/base/UCoreModule.pas b/ServiceBasedPlugins/src/base/UCoreModule.pas new file mode 100644 index 00000000..b87fec85 --- /dev/null +++ b/ServiceBasedPlugins/src/base/UCoreModule.pas @@ -0,0 +1,154 @@ +{* 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 UCoreModule; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +{********************* + TCoreModule + Dummy class that has methods that will be called from core + In the best case every piece of this software is a module +*********************} +uses + UPluginDefs; + +type + PCoreModule = ^TCoreModule; + TCoreModule = class + public + Constructor Create; virtual; + + //Function that gives some Infos about the Module to the Core + Procedure Info(const pInfo: PModuleInfo); virtual; + + //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 Load: Boolean; virtual; + + //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 Init: Boolean; virtual; + + //Is Called during Mainloop before 'Core/MainLoop' Hook and Drawing + //If False is Returned this will cause a Forced Exit + Function MainLoop: Boolean; virtual; + + //Is Called if this Module has been Inited and there is a Exit. + //Deinit is in backwards Initing Order + //If False is Returned this will cause a Forced Exit + Procedure DeInit; virtual; + + //Is Called if this Module will be unloaded and has been created + //Should be used to Free Memory + Destructor Destroy; override; + end; + cCoreModule = class of TCoreModule; + +implementation + +//------------- +// Just the Constructor +//------------- +Constructor TCoreModule.Create; +begin + //Dummy maaaan ;) + inherited; +end; + +//------------- +// Function that gives some Infos about the Module to the Core +//------------- +Procedure TCoreModule.Info(const pInfo: PModuleInfo); +begin + pInfo^.Name := 'Not Set'; + pInfo^.Version := 0; + pInfo^.Description := 'Not Set'; +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 TCoreModule.Load: Boolean; +begin + //Dummy ftw!! + Result := True; +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 TCoreModule.Init: Boolean; +begin + //Dummy ftw!! + Result := True; +end; + +//------------- +//Is Called during Mainloop before 'Core/MainLoop' Hook and Drawing +//If False is Returned this will cause a Forced Exit +//------------- +Function TCoreModule.MainLoop: Boolean; +begin + //Dummy ftw!! + Result := True; +end; + +//------------- +//Is Called if this Module has been Inited and there is a Exit. +//Deinit is in backwards Initing Order +//------------- +Procedure TCoreModule.DeInit; +begin + //Dummy ftw!! +end; + +//------------- +//Is Called if this Module will be unloaded and has been created +//Should be used to Free Memory +//------------- +Destructor TCoreModule.Destroy; +begin + //Dummy ftw!! + inherited; +end; + +end. diff --git a/ServiceBasedPlugins/src/base/UHooks.pas b/ServiceBasedPlugins/src/base/UHooks.pas new file mode 100644 index 00000000..acf2bba7 --- /dev/null +++ b/ServiceBasedPlugins/src/base/UHooks.pas @@ -0,0 +1,460 @@ +{* 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 UHooks; + +{********************* + THookManager + Class for saving, managing and calling of hooks. + Saves all hookable events and their subscribers +*********************} +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + uPluginDefs, + SysUtils; + +type + //Record that saves info from Subscriber + PSubscriberInfo = ^TSubscriberInfo; + TSubscriberInfo = record + Self: THandle; // ID of this Subscription (First word: ID of Subscription; 2nd word: ID of Hook) + Next: PSubscriberInfo; // Pointer to next Item in HookChain + + Owner: integer; //For Error Handling and Plugin Unloading. + + // Here is s/t tricky + // To avoid writing of Wrapping Functions to Hook an Event with a Class + // We save a Normal Proc or a Method of a Class + case isClass: boolean of + false: (Proc: TUS_Hook); //Proc that will be called on Event + true: (ProcOfClass: TUS_Hook_of_Object); + end; + + TEventInfo = record + Name: string[60]; // Name of Event + FirstSubscriber: PSubscriberInfo; // First subscriber in chain + LastSubscriber: PSubscriberInfo; // Last " (for easier subscriber adding) + end; + + THookManager = class + private + Events: array of TEventInfo; + SpaceinEvents: word; //Number of empty Items in Events Array. (e.g. Deleted Items) + + procedure FreeSubscriber(const EventIndex: word; const Last, Cur: PSubscriberInfo); + public + constructor Create(const SpacetoAllocate: word); + + function AddEvent (const EventName: Pchar): THandle; + function DelEvent (hEvent: THandle): integer; + + function AddSubscriber (const EventName: Pchar; const Proc: TUS_Hook = nil; const ProcOfClass: TUS_Hook_of_Object = nil): THandle; + function DelSubscriber (const hSubscriber: THandle): integer; + + function CallEventChain (const hEvent: THandle; const wParam: TwParam; lParam: TlParam): integer; + function EventExists (const EventName: Pchar): integer; + + procedure DelbyOwner(const Owner: integer); + end; + +function HookTest(wParam: TwParam; lParam: TlParam): integer; stdcall; + +var + HookManager: THookManager; + +implementation + +uses + ULog, + UCore; + +//------------ +// Create - Creates Class and Set Standard Values +//------------ +constructor THookManager.Create(const SpacetoAllocate: word); +var + I: integer; +begin + inherited Create(); + + //Get the Space and "Zero" it + SetLength (Events, SpacetoAllocate); + for I := 0 to SpacetoAllocate-1 do + Events[I].Name[1] := chr(0); + + SpaceinEvents := SpacetoAllocate; + + {$IFDEF DEBUG} + debugWriteLn('HookManager: Succesful Created.'); + {$ENDIF} +end; + +//------------ +// AddEvent - Adds an Event and return the Events Handle or 0 on Failure +//------------ +function THookManager.AddEvent (const EventName: Pchar): THandle; +var + I: integer; +begin + Result := 0; + + if (EventExists(EventName) = 0) then + begin + if (SpaceinEvents > 0) then + begin + //There is already Space available + //Go Search it! + for I := 0 to High(Events) do + if (Events[I].Name[1] = chr(0)) then + begin //Found Space + Result := I; + Dec(SpaceinEvents); + Break; + end; + + {$IFDEF DEBUG} + debugWriteLn('HookManager: Found Space for Event at Handle: ''' + InttoStr(Result+1) + ''); + {$ENDIF} + end + else + begin //There is no Space => Go make some! + Result := Length(Events); + SetLength(Events, Result + 1); + end; + + //Set Events Data + Events[Result].Name := EventName; + Events[Result].FirstSubscriber := nil; + Events[Result].LastSubscriber := nil; + + //Handle is Index + 1 + Inc(Result); + + {$IFDEF DEBUG} + debugWriteLn('HookManager: Add Event succesful: ''' + EventName + ''); + {$ENDIF} + end + {$IFDEF DEBUG} + else + debugWriteLn('HookManager: Trying to ReAdd Event: ''' + EventName + ''); + {$ENDIF} +end; + +//------------ +// DelEvent - Deletes an Event by Handle Returns False on Failure +//------------ +function THookManager.DelEvent (hEvent: THandle): integer; +var + Cur, Last: PSubscriberInfo; +begin + hEvent := hEvent - 1; //Arrayindex is Handle - 1 + Result := -1; + + if (Length(Events) > hEvent) and (Events[hEvent].Name[1] <> chr(0)) then + begin //Event exists + //Free the Space for all Subscribers + Cur := Events[hEvent].FirstSubscriber; + + while (Cur <> nil) do + begin + Last := Cur; + Cur := Cur.Next; + FreeMem(Last, SizeOf(TSubscriberInfo)); + end; + + {$IFDEF DEBUG} + debugWriteLn('HookManager: Removed Event succesful: ''' + Events[hEvent].Name + ''); + {$ENDIF} + + //Free the Event + Events[hEvent].Name[1] := chr(0); + Inc(SpaceinEvents); //There is one more space for new events + end + + {$IFDEF DEBUG} + else + debugWriteLn('HookManager: Try to Remove not Existing Event. Handle: ''' + InttoStr(hEvent) + ''); + {$ENDIF} +end; + +//------------ +// AddSubscriber - Adds an Subscriber to the Event by Name +// Returns Handle of the Subscribtion or 0 on Failure +//------------ +function THookManager.AddSubscriber (const EventName: Pchar; const Proc: TUS_Hook; const ProcOfClass: TUS_Hook_of_Object): THandle; +var + EventHandle: THandle; + EventIndex: integer; + Cur: PSubscriberInfo; +begin + Result := 0; + + if (@Proc <> nil) or (@ProcOfClass <> nil) then + begin + EventHandle := EventExists(EventName); + + if (EventHandle <> 0) then + begin + EventIndex := EventHandle - 1; + + //Get Memory + GetMem(Cur, SizeOf(TSubscriberInfo)); + + //Fill it with Data + Cur.Next := nil; + + //Add Owner + Cur.Owner := Core.CurExecuted; + + if (@Proc = nil) then + begin //Use the ProcofClass Method + Cur.isClass := true; + Cur.ProcOfClass := ProcofClass; + end + else //Use the normal Proc + begin + Cur.isClass := false; + Cur.Proc := Proc; + end; + + //Create Handle (1st word: Handle of Event; 2nd word: unique ID + if (Events[EventIndex].LastSubscriber = nil) then + begin + if (Events[EventIndex].FirstSubscriber = nil) then + begin + Result := (EventHandle SHL 16); + Events[EventIndex].FirstSubscriber := Cur; + end + else + begin + Result := Events[EventIndex].FirstSubscriber.Self + 1; + end; + end + else + begin + Result := Events[EventIndex].LastSubscriber.Self + 1; + Events[EventIndex].LastSubscriber.Next := Cur; + end; + + Cur.Self := Result; + + //Add to Chain + Events[EventIndex].LastSubscriber := Cur; + + {$IFDEF DEBUG} + debugWriteLn('HookManager: Add Subscriber to Event ''' + Events[EventIndex].Name + ''' succesful. Handle: ''' + InttoStr(Result) + ''' Owner: ' + InttoStr(Cur.Owner)); + {$ENDIF} + end; + end; +end; + +//------------ +// FreeSubscriber - Helper for DelSubscriber. Prevents Loss of Chain Items. Frees Memory. +//------------ +procedure THookManager.FreeSubscriber(const EventIndex: word; const Last, Cur: PSubscriberInfo); +begin + //Delete from Chain + if (Last <> nil) then + begin + Last.Next := Cur.Next; + end + else //Was first Popup + begin + Events[EventIndex].FirstSubscriber := Cur.Next; + end; + + //Was this Last subscription ? + if (Cur = Events[EventIndex].LastSubscriber) then + begin //Change Last Subscriber + Events[EventIndex].LastSubscriber := Last; + end; + + //Free Space: + FreeMem(Cur, SizeOf(TSubscriberInfo)); +end; + +//------------ +// DelSubscriber - Deletes a Subscribtion by Handle, return non Zero on Failure +//------------ +function THookManager.DelSubscriber (const hSubscriber: THandle): integer; +var + EventIndex: integer; + Cur, Last: PSubscriberInfo; +begin + Result := -1; + EventIndex := ((hSubscriber and (High(THandle) xor High(word))) SHR 16) - 1; + + //Existing Event ? + if (EventIndex < Length(Events)) and (Events[EventIndex].Name[1] <> chr(0)) then + begin + Result := -2; //Return -1 on not existing Event, -2 on not existing Subscription + + //Search for Subscription + Cur := Events[EventIndex].FirstSubscriber; + Last := nil; + + //go through the chain ... + while (Cur <> nil) do + begin + if (Cur.Self = hSubscriber) then + begin //Found Subscription we searched for + FreeSubscriber(EventIndex, Last, Cur); + + {$IFDEF DEBUG} + debugWriteLn('HookManager: Del Subscriber from Event ''' + Events[EventIndex].Name + ''' succesful. Handle: ''' + InttoStr(hSubscriber) + ''); + {$ENDIF} + + //Set Result and Break the Loop + Result := 0; + Break; + end; + + Last := Cur; + Cur := Cur.Next; + end; + + end; +end; + +//------------ +// CallEventChain - Calls the Chain of a specified EventHandle +// Returns: -1: Handle doesn't Exist, 0 Chain is called until the End +//------------ +function THookManager.CallEventChain (const hEvent: THandle; const wParam: TwParam; lParam: TlParam): integer; +var + EventIndex: integer; + Cur: PSubscriberInfo; + CurExecutedBackup: integer; // backup of Core.CurExecuted Attribute +begin + Result := -1; + EventIndex := hEvent - 1; + + if ((EventIndex <= High(Events)) and (Events[EventIndex].Name[1] <> chr(0))) then + begin //Existing Event + //Backup CurExecuted + CurExecutedBackup := Core.CurExecuted; + + //Start calling the Chain !!!11 + Cur := Events[EventIndex].FirstSubscriber; + Result := 0; + //Call Hooks until the Chain is at the End or breaked + while ((Cur <> nil) and (Result = 0)) do + begin + //Set CurExecuted + Core.CurExecuted := Cur.Owner; + if (Cur.isClass) then + Result := Cur.ProcOfClass(wParam, lParam) + else + Result := Cur.Proc(wParam, lParam); + + Cur := Cur.Next; + end; + + //Restore CurExecuted + Core.CurExecuted := CurExecutedBackup; + end; + + {$IFDEF DEBUG} + debugWriteLn('HookManager: Called Chain from Event ''' + Events[EventIndex].Name + ''' succesful. Result: ''' + InttoStr(Result) + ''); + {$ENDIF} +end; + +//------------ +// EventExists - Returns non Zero if an Event with the given Name exists +//------------ +function THookManager.EventExists (const EventName: Pchar): integer; +var + I: integer; + Name: string[60]; +begin + Result := 0; + //if (Length(EventName) < + Name := string(EventName); + + //Sure not to search for empty space + if (Name[1] <> chr(0)) then + begin + //Search for Event + for I := 0 to High(Events) do + if (Events[I].Name = Name) then + begin //Event found + Result := I + 1; + Break; + end; + end; +end; + +//------------ +// DelbyOwner - Dels all Subscriptions by a specific Owner. (For Clean Plugin/Module unloading) +//------------ +procedure THookManager.DelbyOwner(const Owner: integer); +var + I: integer; + Cur, Last: PSubscriberInfo; +begin + //Search for Owner in all Hooks Chains + for I := 0 to High(Events) do + begin + if (Events[I].Name[1] <> chr(0)) then + begin + + Last := nil; + Cur := Events[I].FirstSubscriber; + //Went Through Chain + while (Cur <> nil) do + begin + if (Cur.Owner = Owner) then + begin //Found Subscription by Owner -> Delete + FreeSubscriber(I, Last, Cur); + if (Last <> nil) then + Cur := Last.Next + else + Cur := Events[I].FirstSubscriber; + end + else + begin + //Next Item: + Last := Cur; + Cur := Cur.Next; + end; + end; + end; + end; +end; + +function HookTest(wParam: TwParam; lParam: TlParam): integer; stdcall; +begin + Result := 0; //Don't break the chain + Core.ShowMessage(CORE_SM_INFO, Pchar(string(Pchar(Pointer(lParam))) + ': ' + string(Pchar(Pointer(wParam))))); +end; + +end. diff --git a/ServiceBasedPlugins/src/base/UMain.pas b/ServiceBasedPlugins/src/base/UMain.pas index 469a658b..fec1903f 100644 --- a/ServiceBasedPlugins/src/base/UMain.pas +++ b/ServiceBasedPlugins/src/base/UMain.pas @@ -66,6 +66,11 @@ implementation uses Math, gl, +{ + SDL_ttf, + UParty, + UCore, +} UCatCovers, UCommandLine, UCommon, @@ -87,7 +92,6 @@ uses USkins, USongs, UThemes, - UParty, UTime; procedure Main; @@ -232,12 +236,14 @@ begin Log.BenchmarkEnd(1); Log.LogBenchmark('Loading PluginManager', 1); +{ // Party Mode Manager Log.BenchmarkStart(1); Log.LogStatus('PartySession Manager', 'Initialization'); PartySession := TPartySession.Create; //Load PartySession Log.BenchmarkEnd(1); Log.LogBenchmark('Loading PartySession Manager', 1); +} // Graphics Log.BenchmarkStart(1); diff --git a/ServiceBasedPlugins/src/base/UModules.pas b/ServiceBasedPlugins/src/base/UModules.pas new file mode 100644 index 00000000..97494180 --- /dev/null +++ b/ServiceBasedPlugins/src/base/UModules.pas @@ -0,0 +1,55 @@ +{* 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 UModules; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +{********************* + UModules + Unit Contains all used Modules in its uses clausel + and a const with an array of all Modules to load +*********************} + +uses + UCoreModule, + UPluginLoader; + +const + CORE_MODULES_TO_LOAD: Array[0..2] of cCoreModule = ( + TPluginLoader, //First because it has to look if there are Module replacements (Feature o/t Future) + TCoreModule, //Remove this later, just a dummy + TtehPlugins //Represents the Plugins. Last because they may use CoreModules Services etc. + ); + +implementation + +end.
\ No newline at end of file diff --git a/ServiceBasedPlugins/src/base/UNote.pas b/ServiceBasedPlugins/src/base/UNote.pas index 6da4cf07..5e70bfe1 100644 --- a/ServiceBasedPlugins/src/base/UNote.pas +++ b/ServiceBasedPlugins/src/base/UNote.pas @@ -126,10 +126,12 @@ uses UDLLManager, UParty, UConfig, + UCore, UCommon, UGraphic, UGraphicClasses, UPath, + UPluginDefs, UPlatform, UThemes; diff --git a/ServiceBasedPlugins/src/base/UParty.pas b/ServiceBasedPlugins/src/base/UParty.pas index 9d70e2be..23012dfe 100644 --- a/ServiceBasedPlugins/src/base/UParty.pas +++ b/ServiceBasedPlugins/src/base/UParty.pas @@ -34,85 +34,208 @@ interface {$I switches.inc} uses - ModiSDK; + UPartyDefs, + UCoreModule, + UPluginDefs; type + ARounds = array [0..252] of integer; //0..252 needed for + PARounds = ^ARounds; + TRoundInfo = record - Plugin: word; + Modi: cardinal; Winner: byte; end; TeamOrderEntry = record - TeamNum: byte; + Teamnum: byte; Score: byte; end; TeamOrderArray = array[0..5] of byte; - TPartyPlugin = record - ID: byte; - TimesPlayed: byte; + TUS_ModiInfoEx = record + Info: TUS_ModiInfo; + Owner: integer; + TimesPlayed: byte; //Helper for setting round plugins end; - TPartySession = class + TPartySession = class (TCoreModule) private - function GetRandomPlayer(Team: Byte): Byte; - function GetRandomPlugin(Plugins: array of TPartyPlugin): byte; - function IsWinner(Player, Winner: Byte): boolean; + 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; + //Teams: TTeamInfo; Rounds: array of TRoundInfo; - CurRound: Byte; - constructor Create; + //TCoreModule methods to inherit + constructor Create; override; + procedure Info(const pInfo: PModuleInfo); override; + function Load: boolean; override; + function Init: boolean; override; + procedure DeInit; override; + destructor Destroy; override; - procedure StartNewParty(NumRounds: Byte); - procedure StartRound; - procedure EndRound; - function GetTeamOrder: TeamOrderArray; - function GetWinnerString(Round: Byte): String; + //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; -var - PartySession: TPartySession; +const + StandardModus = 0; //Modus ID that will be played in non-party mode implementation uses - UDLLManager, + UCore, UGraphic, - UNote, ULanguage, - ULog; + ULog, + UNote, + SysUtils; + +{********************* + TPluginLoader + Implentation +*********************} +//------------- +// function that gives some infos about the module to the core +//------------- +procedure 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 +//------------- +function 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 + Result := 0; end; //---------- // Returns a number of a random plugin //---------- -function TPartySession.GetRandomPlugin(Plugins: array of TPartyPlugin): byte; +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(Plugins) do + for I := 0 to high(Modis) do begin - if (Plugins[I].TimesPlayed < lowestTP) then + if (Modis[I].TimesPlayed < lowestTP) and (((Modis[I].Info.LoadingSettings and MLS_TeamOnly) <> 0) = TeamMode) then begin - lowestTP := Plugins[I].TimesPlayed; + lowestTP := Modis[I].TimesPlayed; NumPwithLTP := 1; end - else if (Plugins[I].TimesPlayed = lowestTP) then + else if (Modis[I].TimesPlayed = lowestTP) and (((Modis[I].Info.LoadingSettings and MLS_TeamOnly) <> 0) = TeamMode) then begin Inc(NumPwithLTP); end; @@ -122,89 +245,110 @@ begin R := Random(NumPwithLTP); //Search for random plugin - for I := 0 to high(Plugins) do + for I := 0 to high(Modis) do begin - if Plugins[I].TimesPlayed = LowestTP then + 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 := Plugins[I].ID; - Inc(Plugins[I].TimesPlayed); + Result := I; + Inc(Modis[I].TimesPlayed); Break; end; + Dec(R); end; end; end; //---------- -//StartNewParty - Reset and prepares for new party +// Starts new party mode. Returns non zero on success //---------- -procedure TPartySession.StartNewParty(NumRounds: Byte); +function TPartySession.StartParty(NumRounds: TwParam; PAofIRounds: TlParam): integer; var - Plugins: array of TPartyPlugin; + I: integer; + aiRounds: PARounds; TeamMode: boolean; - Len: integer; - I, J: integer; begin - //Set current round to 1 - CurRound := 255; + 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; - PlayersPlay := Teams.NumTeams; + CurRound := High(byte); //Set CurRound to not defined - //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; + //Return true and set party mode + bPartyMode := true; + Result := 1; + + except + Core.ReportError(integer(PChar('Can''t start party mode.')), PChar('TPartySession')); end; - Teams.Teaminfo[I].Joker := Round(NumRounds*0.7); - Teams.Teaminfo[I].Score := 0; end; +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; +//---------- +// 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; - //Set rounds - if (Length(Plugins) >= 1) then +//---------- +// 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 - SetLength (Rounds, NumRounds); - for I := 0 to NumRounds-1 do - begin - PartySession.Rounds[I].Plugin := GetRandomPlugin(Plugins); - PartySession.Rounds[I].Winner := 255; - end; + // to-do : Whitü: Check here if sing screen is not shown atm. + bPartyMode := false; + Result := 1; end else - SetLength (Rounds, 0); + Result := 0; end; -{** - * Returns a random player to play next round - *} +//---------- +//GetRandomPlayer - gives back a random player to play next round +//---------- function TPartySession.GetRandomPlayer(Team: byte): byte; var I, R: integer; - LowestTP: byte; + lowestTP: byte; NumPwithLTP: byte; begin LowestTP := high(byte); @@ -225,7 +369,7 @@ begin end; end; - //Create random number + //Create random no R := Random(NumPwithLTP); //Search for random player @@ -245,83 +389,202 @@ begin end; end; -{** - * Prepares ScreenSingModi for next round and loads plugin - *} -procedure TPartySession.StartRound; +//---------- +// 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 - //Increase Current Round + if ((CurRound < high(Rounds)) or (CurRound = high(CurRound))) then + begin //everythings OK! -> Start the Round, maaaaan Inc(CurRound); - Rounds[CurRound].Winner := 255; - DllMan.LoadPlugin(Rounds[CurRound].Plugin); - - //Select Players + //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; - //Set ScreenSingModie Variables - ScreenSingModi.TeamInfo := Teams; + 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; //---------- -//EndRound - Get Winner from ScreenSingModi and Save Data to RoundArray +// CallModiDeInit - calls DeInitProc and ends the round //---------- -procedure TPartySession.EndRound; +function TPartySession.CallModiDeInit(wParam: TwParam; lParam: TlParam): integer; var - I: Integer; + I: integer; + MaxScore: word; begin - //Copy Winner - Rounds[CurRound].Winner := ScreenSingModi.Winner; - //Set Scores - GenScores; + 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; + - //Increase TimesPlayed 4 all Players - For I := 0 to Teams.NumTeams-1 do - Inc(Teams.Teaminfo[I].Playerinfo[Teams.Teaminfo[I].CurPlayer].TimesPlayed); + //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; //---------- -//IsWinner - returns true if the player's bit is set in the winner byte +// GetTeamInfo - writes TTeamInfo record to pointer at lParam. Returns zero on success //---------- -function TPartySession.IsWinner(Player, Winner: byte): boolean; +function TPartySession.GetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; var - Mask: byte; + Info: ^TTeamInfo; begin - Mask := 1 shl Player; - Result := (Winner and Mask) <> 0; + 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; //---------- -//GenScores - increase scores for current round +// SetTeamInfo - read TTeamInfo record from pointer at lParam. Returns zero on success //---------- -procedure TPartySession.GenScores; +function TPartySession.SetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; var - I: byte; + TeamInfobackup: TTeamInfo; + Info: ^TTeamInfo; begin - for I := 0 to Teams.NumTeams-1 do + Result := -1; + Info := pTeamInfo; + if (Info <> nil) then begin - if isWinner(I, Rounds[CurRound].Winner) then - Inc(Teams.Teaminfo[I].Score); + 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 the placement of each Team [First Position of Array is Teamnum of first placed Team, ...] +// GetTeamOrder - returns team order. Structure: Bits 1..3: Team at place1; Bits 4..6: Team at place2 ... //---------- -function TPartySession.GetTeamOrder: TeamOrderArray; +function TPartySession.GetTeamOrder(wParam: TwParam; lParam: TlParam): integer; 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 + // 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 @@ -340,44 +603,63 @@ begin end; //Copy to Result + Result := 0; for I := 0 to Teams.NumTeams-1 do - Result[I] := ATeams[I].TeamNum; + Result := Result or (ATeams[I].TeamNum Shl I*3); end; //---------- -//GetWinnerString - Get String with WinnerTeam Name, when there is more than one Winner than Connect with and or , +// GetWinnerString - wParam is Roundnum. If (pointer = nil) then return length of the string. Otherwise write the string to address at lParam //---------- -function TPartySession.GetWinnerString(Round: byte): string; +function TPartySession.GetWinnerString(wParam: TwParam; lParam: TlParam): integer; var - Winners: array of string; + Winners: array of String; I: integer; + ResultStr: String; + S: ^String; begin - Result := Language.Translate('PARTY_NOBODY'); - - if (Round > High(Rounds)) then - exit; + ResultStr := Language.Translate('PARTY_NOBODY'); - if (Rounds[Round].Winner = 0) then + if (wParam <= High(Rounds)) then begin - exit; + 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; - if (Rounds[Round].Winner = 255) then - begin - Result := Language.Translate('PARTY_NOTPLAYEDYET'); - exit; - 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; - 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. diff --git a/ServiceBasedPlugins/src/base/UPluginInterface.pas b/ServiceBasedPlugins/src/base/UPluginInterface.pas new file mode 100644 index 00000000..f299796f --- /dev/null +++ b/ServiceBasedPlugins/src/base/UPluginInterface.pas @@ -0,0 +1,186 @@ +{* 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 uPluginInterface; +{********************* + uPluginInterface + Unit fills a TPluginInterface structure with method pointers + Unit contains all functions called directly by plugins +*********************} + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + uPluginDefs; + +//--------------- +// Methods for Plugin +//--------------- + {******** Hook specific Methods ********} + {Function Creates a new Hookable Event and Returns the Handle + or 0 on Failure. (Name already exists)} + Function CreateHookableEvent (EventName: PChar): THandle; stdcall; + + {Function Destroys an Event and Unhooks all Hooks to this Event. + 0 on success, not 0 on Failure} + Function DestroyHookableEvent (hEvent: THandle): integer; stdcall; + + {Function start calling the Hook Chain + 0 if Chain is called until the End, -1 if Event Handle is not valid + otherwise Return Value of the Hook that breaks the Chain} + Function NotivyEventHooks (hEvent: THandle; wParam: TwParam; lParam: TlParam): integer; stdcall; + + {Function Hooks an Event by Name. + Returns Hook Handle on Success, otherwise 0} + Function HookEvent (EventName: PChar; HookProc: TUS_Hook): THandle; stdcall; + + {Function Removes the Hook from the Chain + Returns 0 on Success} + Function UnHookEvent (hHook: THandle): Integer; stdcall; + + {Function Returns Non Zero if a Event with the given Name Exists, + otherwise 0} + Function EventExists (EventName: PChar): Integer; stdcall; + + {******** Service specific Methods ********} + {Function Creates a new Service and Returns the Services Handle + or 0 on Failure. (Name already exists)} + Function CreateService (ServiceName: PChar; ServiceProc: TUS_Service): THandle; stdcall; + + {Function Destroys a Service. + 0 on success, not 0 on Failure} + Function DestroyService (hService: THandle): integer; stdcall; + + {Function Calls a Services Proc + Returns Services Return Value or SERVICE_NOT_FOUND on Failure} + Function CallService (ServiceName: PChar; wParam: TwParam; lParam: TlParam): integer; stdcall; + + {Function Returns Non Zero if a Service with the given Name Exists, + otherwise 0} + Function ServiceExists (ServiceName: PChar): Integer; stdcall; + +implementation +uses UCore; + +{******** Hook specific Methods ********} +//--------------- +// Function Creates a new Hookable Event and Returns the Handle +// or 0 on Failure. (Name already exists) +//--------------- +Function CreateHookableEvent (EventName: PChar): THandle; stdcall; +begin + Result := Core.Hooks.AddEvent(EventName); +end; + +//--------------- +// Function Destroys an Event and Unhooks all Hooks to this Event. +// 0 on success, not 0 on Failure +//--------------- +Function DestroyHookableEvent (hEvent: THandle): integer; stdcall; +begin + Result := Core.Hooks.DelEvent(hEvent); +end; + +//--------------- +// Function start calling the Hook Chain +// 0 if Chain is called until the End, -1 if Event Handle is not valid +// otherwise Return Value of the Hook that breaks the Chain +//--------------- +Function NotivyEventHooks (hEvent: THandle; wParam: TwParam; lParam: TlParam): integer; stdcall; +begin + Result := Core.Hooks.CallEventChain(hEvent, wParam, lParam); +end; + +//--------------- +// Function Hooks an Event by Name. +// Returns Hook Handle on Success, otherwise 0 +//--------------- +Function HookEvent (EventName: PChar; HookProc: TUS_Hook): THandle; stdcall; +begin + Result := Core.Hooks.AddSubscriber(EventName, HookProc); +end; + +//--------------- +// Function Removes the Hook from the Chain +// Returns 0 on Success +//--------------- +Function UnHookEvent (hHook: THandle): Integer; stdcall; +begin + Result := Core.Hooks.DelSubscriber(hHook); +end; + +//--------------- +// Function Returns Non Zero if a Event with the given Name Exists, +// otherwise 0 +//--------------- +Function EventExists (EventName: PChar): Integer; stdcall; +begin + Result := Core.Hooks.EventExists(EventName); +end; + + {******** Service specific Methods ********} +//--------------- +// Function Creates a new Service and Returns the Services Handle +// or 0 on Failure. (Name already exists) +//--------------- +Function CreateService (ServiceName: PChar; ServiceProc: TUS_Service): THandle; stdcall; +begin + Result := Core.Services.AddService(ServiceName, ServiceProc); +end; + +//--------------- +// Function Destroys a Service. +// 0 on success, not 0 on Failure +//--------------- +Function DestroyService (hService: THandle): integer; stdcall; +begin + Result := Core.Services.DelService(hService); +end; + +//--------------- +// Function Calls a Services Proc +// Returns Services Return Value or SERVICE_NOT_FOUND on Failure +//--------------- +Function CallService (ServiceName: PChar; wParam: TwParam; lParam: TlParam): integer; stdcall; +begin + Result := Core.Services.CallService(ServiceName, wParam, lParam); +end; + +//--------------- +// Function Returns Non Zero if a Service with the given Name Exists, +// otherwise 0 +//--------------- +Function ServiceExists (ServiceName: PChar): Integer; stdcall; +begin + Result := Core.Services.ServiceExists(ServiceName); +end; + +end. diff --git a/ServiceBasedPlugins/src/base/UPluginLoader.pas b/ServiceBasedPlugins/src/base/UPluginLoader.pas new file mode 100644 index 00000000..84891739 --- /dev/null +++ b/ServiceBasedPlugins/src/base/UPluginLoader.pas @@ -0,0 +1,794 @@ +{* 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 UPluginLoader; +{********************* + UPluginLoader + Unit contains two classes + TPluginLoader: Class searching for and loading the plugins + TtehPlugins: Class representing the plugins in modules chain +*********************} + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + UPluginDefs, + UCoreModule, + UPath; + +type + TPluginListItem = record + Info: TUS_PluginInfo; + State: byte; // State of this plugin: 0 - undefined; 1 - loaded; 2 - inited / running; 4 - unloaded; 254 - loading aborted by plugin; 255 - unloaded because of error + Path: string; // path to this plugin + NeedsDeInit: boolean; // if this is inited correctly this should be true + hLib: THandle; // handle of loaded libary + Procs: record // procs offered by plugin. Don't call this directly use wrappers of TPluginLoader + Load: Func_Load; + Init: Func_Init; + DeInit: Proc_DeInit; + end; + end; + {********************* + TPluginLoader + Class searches for plugins and manages loading and unloading + *********************} + PPluginLoader = ^TPluginLoader; + TPluginLoader = class (TCoreModule) + private + LoadingProcessFinished: boolean; + sUnloadPlugin: THandle; + sLoadPlugin: THandle; + sGetPluginInfo: THandle; + sGetPluginState: THandle; + + procedure FreePlugin(Index: integer); + public + PluginInterface: TUS_PluginInterface; + Plugins: array of TPluginListItem; + + // TCoreModule methods to inherit + constructor Create; override; + procedure Info(const pInfo: PModuleInfo); override; + function Load: boolean; override; + function Init: boolean; override; + procedure DeInit; override; + Destructor Destroy; override; + + // New methods + procedure BrowseDir(Path: string); // browses the path at _Path_ for plugins + function PluginExists(Name: string): integer; // if plugin exists: Index of plugin, else -1 + procedure AddPlugin(Filename: string); // adds plugin to the array + + function CallLoad(Index: integer): integer; + function CallInit(Index: integer): integer; + procedure CallDeInit(Index: integer); + + //Services offered + function LoadPlugin(wParam: TwParam; lParam: TlParam): integer; //wParam PChar(PluginName/PluginPath) | lParam (if wParam = nil) ID of the Plugin + function UnloadPlugin(wParam: TwParam; lParam: TlParam): integer; //wParam PChar(PluginName/PluginPath) | lParam (if wParam = nil) ID of the Plugin + function GetPluginInfo(wParam: TwParam; lParam: TlParam): integer; //If wParam = -1 then (If lParam = nil then get length of Moduleinfo Array. If lparam <> nil then write array of TUS_PluginInfo to address at lparam) else (Get PluginInfo of Plugin with Index(wParam) to Address at lParam) + function GetPluginState(wParam: TwParam; lParam: TlParam): integer; //If wParam = -1 then (If lParam = nil then get length of Moduleinfo Array. If lparam <> nil then write array of TUS_PluginInfo to address at lparam) else (Return PluginInfo of Plugin with Index(wParam)) + + end; + + {********************* + TtehPlugins + Class represents the plugins in module chain. + It calls the plugins procs and funcs + *********************} + TtehPlugins = class (TCoreModule) + private + PluginLoader: PPluginLoader; + public + // TCoreModule methods to inherit + constructor Create; override; + + procedure Info(const pInfo: PModuleInfo); override; + function Load: boolean; override; + function Init: boolean; override; + procedure DeInit; override; + end; + +const +{$IF Defined(MSWINDOWS)} + PluginFileExtension = '.dll'; +{$ELSEIF Defined(DARWIN)} + PluginFileExtension = '.dylib'; +{$ELSEIF Defined(UNIX)} + PluginFileExtension = '.so'; +{$IFEND} + +implementation + +uses + UCore, + UPluginInterface, +{$IFDEF MSWINDOWS} + windows, +{$ELSE} + dynlibs, +{$ENDIF} + UMain, + SysUtils; + +{********************* + TPluginLoader + Implementation +*********************} + +//------------- +// function that gives some infos about the module to the core +//------------- +procedure TPluginLoader.Info(const pInfo: PModuleInfo); +begin + pInfo^.Name := 'TPluginLoader'; + pInfo^.Version := MakeVersion(1,0,0,chr(0)); + pInfo^.Description := 'Searches for plugins, loads and unloads them'; +end; + +//------------- +// Just the constructor +//------------- +constructor TPluginLoader.Create; +begin + inherited; + + // Init PluginInterface + // Using methods from UPluginInterface + PluginInterface.CreateHookableEvent := CreateHookableEvent; + PluginInterface.DestroyHookableEvent := DestroyHookableEvent; + PluginInterface.NotivyEventHooks := NotivyEventHooks; + PluginInterface.HookEvent := HookEvent; + PluginInterface.UnHookEvent := UnHookEvent; + PluginInterface.EventExists := EventExists; + + PluginInterface.CreateService := @CreateService; + PluginInterface.DestroyService := DestroyService; + PluginInterface.CallService := CallService; + PluginInterface.ServiceExists := ServiceExists; + + // UnSet private var + LoadingProcessFinished := 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 TPluginLoader.Load: boolean; +begin + Result := true; + + try + // Start searching for plugins + BrowseDir(PluginPath); + except + Result := false; + Core.ReportError(integer(PChar('Error browsing and loading.')), PChar('TPluginLoader')); + end; +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 TPluginLoader.Init: boolean; +begin + // Just set private var to true. + LoadingProcessFinished := true; + Result := true; +end; + +//------------- +// Is called if this module has been inited and there is a exit. +// Deinit is in backwards initing order +//------------- +procedure TPluginLoader.DeInit; +var + I: integer; +begin + // Force deinit + // if some plugins aren't deinited for some reason o0 + for I := 0 to High(Plugins) do + begin + if (Plugins[I].State < 4) then + FreePlugin(I); + end; + + // Nothing to do here. Core will remove the hooks +end; + +//------------- +// Is called if this module will be unloaded and has been created +// Should be used to free memory +//------------- +Destructor TPluginLoader.Destroy; +begin + // Just save some memory if it wasn't done now.. + SetLength(Plugins, 0); + inherited; +end; + +//-------------- +// Browses the path at _Path_ for plugins +//-------------- +procedure TPluginLoader.BrowseDir(Path: string); +var + SR: TSearchRec; +begin + // Search for other dirs to browse + if FindFirst(Path + '*', faDirectory, SR) = 0 then begin + repeat + if (SR.Name <> '.') and (SR.Name <> '..') then + BrowseDir(Path + Sr.Name + PathDelim); + until FindNext(SR) <> 0; + end; + FindClose(SR); + + // Search for plugins at path + if FindFirst(Path + '*' + PluginFileExtension, 0, SR) = 0 then + begin + repeat + AddPlugin(Path + SR.Name); + until FindNext(SR) <> 0; + end; + FindClose(SR); +end; + +//-------------- +// If plugin exists: Index of plugin, else -1 +//-------------- +function TPluginLoader.PluginExists(Name: string): integer; +var + I: integer; +begin + Result := -1; + + if (Length(Name) <= 32 { =>Length(TUS_PluginInfo.Name)}) then + begin + for I := 0 to High(Plugins) do + if (Plugins[I].Info.Name = Name) then + begin //Found the Plugin + Result := I; + Break; + end; + end; +end; + +//-------------- +// Adds plugin to the array +//-------------- +procedure TPluginLoader.AddPlugin(Filename: string); +var + hLib: THandle; + PInfo: Proc_PluginInfo; + Info: TUS_PluginInfo; + PluginID: integer; +begin + if (FileExists(Filename)) then + begin //Load Libary + hLib := LoadLibrary(PChar(Filename)); + if (hLib <> 0) then + begin // Try to get address of the info proc + PInfo := GetProcAddress (hLib, PChar('USPlugin_Info')); + if (@PInfo <> nil) then + begin + Info.cbSize := SizeOf(TUS_PluginInfo); + + try // Call info proc + PInfo(@Info); + except + Info.Name := ''; + Core.ReportError(integer(PChar('Error getting plugin info: ' + Filename)), PChar('TPluginLoader')); + end; + + // Is name set ? + if (Trim(Info.Name) <> '') then + begin + PluginID := PluginExists(Info.Name); + + if (PluginID > 0) and (Plugins[PluginID].State >=4) then + PluginID := -1; + + if (PluginID = -1) then + begin + // Add new item to array + PluginID := Length(Plugins); + SetLength(Plugins, PluginID + 1); + + // Fill with info: + Plugins[PluginID].Info := Info; + Plugins[PluginID].State := 0; + Plugins[PluginID].Path := Filename; + Plugins[PluginID].NeedsDeInit := false; + Plugins[PluginID].hLib := hLib; + + // Try to get procs + Plugins[PluginID].Procs.Load := GetProcAddress (hLib, PChar('USPlugin_Load')); + Plugins[PluginID].Procs.Init := GetProcAddress (hLib, PChar('USPlugin_Init')); + Plugins[PluginID].Procs.DeInit := GetProcAddress (hLib, PChar('USPlugin_DeInit')); + + if (@Plugins[PluginID].Procs.Load = nil) or (@Plugins[PluginID].Procs.Init = nil) or (@Plugins[PluginID].Procs.DeInit = nil) then + begin + Plugins[PluginID].State := 255; + FreeLibrary(hLib); + Core.ReportError(integer(PChar('Can''t get plugin procs from libary: "' + Info.Name + '" ' + Filename)), PChar('TPluginLoader')); + end; + + // Emulate loading process if this plugin is loaded too late + if (LoadingProcessFinished) then + begin + CallLoad(PluginID); + CallInit(PluginID); + end; + end + else if (LoadingProcessFinished = false) then + begin + if (Plugins[PluginID].Info.Version < Info.Version) then + begin // Found newer version of this plugin + Core.ReportDebug(integer(PChar('Found a newer version of plugin: ' + string(Info.Name))), PChar('TPluginLoader')); + + // Unload old plugin + UnloadPlugin(PluginID, nil); + + // Fill with new info + Plugins[PluginID].Info := Info; + Plugins[PluginID].State := 0; + Plugins[PluginID].Path := Filename; + Plugins[PluginID].NeedsDeInit := false; + Plugins[PluginID].hLib := hLib; + + // Try to get procs + Plugins[PluginID].Procs.Load := GetProcAddress (hLib, PChar('USPlugin_Load')); + Plugins[PluginID].Procs.Init := GetProcAddress (hLib, PChar('USPlugin_Init')); + Plugins[PluginID].Procs.DeInit := GetProcAddress (hLib, PChar('USPlugin_DeInit')); + + if (@Plugins[PluginID].Procs.Load = nil) or (@Plugins[PluginID].Procs.Init = nil) or (@Plugins[PluginID].Procs.DeInit = nil) then + begin + FreeLibrary(hLib); + Plugins[PluginID].State := 255; + Core.ReportError(integer(PChar('Can''t get plugin procs from libary: "' + Info.Name + '" ' + Filename)), PChar('TPluginLoader')); + end; + end + else + begin // Newer Version already loaded + FreeLibrary(hLib); + end; + end + else + begin + FreeLibrary(hLib); + Core.ReportError(integer(PChar('Plugin with this name already exists: ' + string(Info.Name))), PChar('TPluginLoader')); + end; + end + else + begin + FreeLibrary(hLib); + Core.ReportError(integer(PChar('No name reported: ' + Filename)), PChar('TPluginLoader')); + end; + end + else + begin + FreeLibrary(hLib); + Core.ReportError(integer(PChar('Can''t find info procedure: ' + Filename)), PChar('TPluginLoader')); + end; + end + else + Core.ReportError(integer(PChar('Can''t load plugin libary: ' + Filename)), PChar('TPluginLoader')); + end; +end; + +//-------------- +// Calls load func of plugin with the given index +//-------------- +function TPluginLoader.CallLoad(Index: integer): integer; +begin + Result := -2; + if(Index < Length(Plugins)) then + begin + if (@Plugins[Index].Procs.Load <> nil) and (Plugins[Index].State = 0) then + begin + try + Result := Plugins[Index].Procs.Load(@PluginInterface); + except + Result := -3; + end; + + if (Result = 0) then + Plugins[Index].State := 1 + else + begin + FreePlugin(Index); + Plugins[Index].State := 255; + Core.ReportError(integer(PChar('Error calling load function from plugin: ' + string(Plugins[Index].Info.Name))), PChar('TPluginLoader')); + end; + end; + end; +end; + +//-------------- +// Calls init func of plugin with the given index +//-------------- +function TPluginLoader.CallInit(Index: integer): integer; +begin + Result := -2; + if(Index < Length(Plugins)) then + begin + if (@Plugins[Index].Procs.Init <> nil) and (Plugins[Index].State = 1) then + begin + try + Result := Plugins[Index].Procs.Init(@PluginInterface); + except + Result := -3; + end; + + if (Result = 0) then + begin + Plugins[Index].State := 2; + Plugins[Index].NeedsDeInit := true; + end + else + begin + FreePlugin(Index); + Plugins[Index].State := 255; + Core.ReportError(integer(PChar('Error calling init function from plugin: ' + string(Plugins[Index].Info.Name))), PChar('TPluginLoader')); + end; + end; + end; +end; + +//-------------- +// Calls deinit proc of plugin with the given index +//-------------- +procedure TPluginLoader.CallDeInit(Index: integer); +begin + if(Index < Length(Plugins)) then + begin + if (Plugins[Index].State < 4) then + begin + if (@Plugins[Index].Procs.DeInit <> nil) and (Plugins[Index].NeedsDeInit) then + try + Plugins[Index].Procs.DeInit(@PluginInterface); + except + + end; + + // Don't forget to remove services and subscriptions by this plugin + Core.Hooks.DelbyOwner(-1 - Index); + + FreePlugin(Index); + end; + end; +end; + +//-------------- +// Frees all plugin sources (procs and handles) - helper for deiniting functions +//-------------- +procedure TPluginLoader.FreePlugin(Index: integer); +begin + Plugins[Index].State := 4; + Plugins[Index].Procs.Load := nil; + Plugins[Index].Procs.Init := nil; + Plugins[Index].Procs.DeInit := nil; + + if (Plugins[Index].hLib <> 0) then + FreeLibrary(Plugins[Index].hLib); +end; + +//-------------- +// wParam PChar(PluginName/PluginPath) | wParam (if lParam = nil) ID of the plugin +//-------------- +function TPluginLoader.LoadPlugin(wParam: TwParam; lParam: TlParam): integer; +var + Index: integer; + sFile: string; +begin + Result := -1; + sFile := ''; + // lParam is ID + if (lParam = nil) then + begin + Index := wParam; + end + else + begin //lParam is PChar + try + sFile := string(PChar(lParam)); + Index := PluginExists(sFile); + if (Index < 0) and FileExists(sFile) then + begin // Is filename + AddPlugin(sFile); + Result := Plugins[High(Plugins)].State; + end; + except + Index := -2; + end; + end; + + if (Index >= 0) and (Index < Length(Plugins)) then + begin + AddPlugin(Plugins[Index].Path); + Result := Plugins[Index].State; + end; +end; + +//-------------- +// wParam PChar(PluginName/PluginPath) | wParam (if lParam = nil) ID of the plugin +//-------------- +function TPluginLoader.UnloadPlugin(wParam: TwParam; lParam: TlParam): integer; +var + Index: integer; + sName: string; +begin + Result := -1; + // lParam is ID + if (lParam = nil) then + begin + Index := wParam; + end + else + begin // wParam is PChar + try + sName := string(PChar(lParam)); + Index := PluginExists(sName); + except + Index := -2; + end; + end; + + if (Index >= 0) and (Index < Length(Plugins)) then + CallDeInit(Index) +end; + +//-------------- +// if wParam = -1 then (if lParam = nil then get length of moduleinfo array. if lparam <> nil then write array of TUS_PluginInfo to address at lparam) else (Get PluginInfo of plugin with Index(wParam) to address at lParam) +//-------------- +function TPluginLoader.GetPluginInfo(wParam: TwParam; lParam: TlParam): integer; +var I: integer; +begin + Result := 0; + if (wParam > 0) then + begin // Get info of 1 plugin + if (lParam <> nil) and (wParam < Length(Plugins)) then + begin + try + Result := 1; + PUS_PluginInfo(lParam)^ := Plugins[wParam].Info; + except + + end; + end; + end + else if (lParam = nil) then + begin // Get length of plugin (info) array + Result := Length(Plugins); + end + else //Write PluginInfo Array to Address in lParam + begin + try + for I := 0 to high(Plugins) do + PAUS_PluginInfo(lParam)^[I] := Plugins[I].Info; + Result := Length(Plugins); + except + Core.ReportError(integer(PChar('Could not write PluginInfo Array')), PChar('TPluginLoader')); + end; + end; + +end; + +//-------------- +// if wParam = -1 then (if lParam = nil then get length of plugin state array. if lparam <> nil then write array of byte to address at lparam) else (return state of plugin with index(wParam)) +//-------------- +function TPluginLoader.GetPluginState(wParam: TwParam; lParam: TlParam): integer; +var I: integer; +begin + Result := -1; + if (wParam > 0) then + begin // Get state of 1 plugin + if (wParam < Length(Plugins)) then + begin + Result := Plugins[wParam].State; + end; + end + else if (lParam = nil) then + begin // Get length of plugin (info) array + Result := Length(Plugins); + end + else // Write plugininfo array to address in lParam + begin + try + for I := 0 to high(Plugins) do + byte(Pointer(integer(lParam) + I)^) := Plugins[I].State; + Result := Length(Plugins); + except + Core.ReportError(integer(PChar('Could not write pluginstate array')), PChar('TPluginLoader')); + end; + end; +end; + +{********************* + TtehPlugins + Implementation +*********************} + +//------------- +// function that gives some infos about the module to the core +//------------- +procedure TtehPlugins.Info(const pInfo: PModuleInfo); +begin + pInfo^.Name := 'TtehPlugins'; + pInfo^.Version := MakeVersion(1,0,0,chr(0)); + pInfo^.Description := 'Module executing the Plugins!'; +end; + +//------------- +// Just the constructor +//------------- +constructor TtehPlugins.Create; +begin + inherited; + PluginLoader := nil; +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 TtehPlugins.Load: boolean; +var + i: integer; // Counter + CurExecutedBackup: integer; //backup of Core.CurExecuted Attribute +begin + // Get pointer to pluginloader + PluginLoader := PPluginLoader(Core.GetModulebyName('TPluginLoader')); + if (PluginLoader = nil) then + begin + Result := false; + Core.ReportError(integer(PChar('Could not get pointer to pluginLoader')), PChar('TtehPlugins')); + end + else + begin + Result := true; + + // Backup curexecuted + CurExecutedBackup := Core.CurExecuted; + + // Start loading the plugins + for i := 0 to High(PluginLoader.Plugins) do + begin + Core.CurExecuted := -1 - i; + + try + // Unload plugin if not correctly executed + if (PluginLoader.CallLoad(i) <> 0) then + begin + PluginLoader.CallDeInit(i); + PluginLoader.Plugins[i].State := 254; // Plugin asks for unload + Core.ReportDebug(integer(PChar('Plugin selfabort during loading process: ' + string(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); + end + else + begin + Core.ReportDebug(integer(PChar('Plugin loaded succesfully: ' + string(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); + end; + except + // Plugin could not be loaded. + // => Show error message, then shutdown plugin + on E: Exception do + begin + PluginLoader.CallDeInit(i); + PluginLoader.Plugins[i].State := 255; // Plugin causes error + Core.ReportError(integer(PChar('Plugin causes error during loading process: ' + PluginLoader.Plugins[i].Info.Name + ', ErrorMsg: "' + E.Message + '"')), PChar('TtehPlugins')); + end; + end; + end; + + // Reset CurExecuted + Core.CurExecuted := CurExecutedBackup; + end; +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 TtehPlugins.Init: boolean; +var + i: integer; // Counter + CurExecutedBackup: integer; // backup of Core.CurExecuted attribute +begin + Result := true; + + // Backup CurExecuted + CurExecutedBackup := Core.CurExecuted; + + // Start loading the plugins + for i := 0 to High(PluginLoader.Plugins) do + try + Core.CurExecuted := -1 - i; + + // Unload plugin if not correctly executed + if (PluginLoader.CallInit(i) <> 0) then + begin + PluginLoader.CallDeInit(i); + PluginLoader.Plugins[i].State := 254; //Plugin asks for unload + Core.ReportDebug(integer(PChar('Plugin selfabort during init process: ' + string(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); + end + else + Core.ReportDebug(integer(PChar('Plugin inited succesfully: ' + string(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); + except + // Plugin could not be loaded. + // => Show error message, then shut down plugin + PluginLoader.CallDeInit(i); + PluginLoader.Plugins[i].State := 255; //Plugin causes Error + Core.ReportError(integer(PChar('Plugin causes error during init process: ' + string(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); + end; + + // Reset CurExecuted + Core.CurExecuted := CurExecutedBackup; +end; + +//------------- +// Is called if this module has been inited and there is a exit. +// Deinit is in backwards initing order +//------------- +procedure TtehPlugins.DeInit; +var + i: integer; // Counter + CurExecutedBackup: integer; // backup of Core.CurExecuted attribute +begin + // Backup CurExecuted + CurExecutedBackup := Core.CurExecuted; + + // Start loop + + for i := 0 to High(PluginLoader.Plugins) do + begin + try + // DeInit plugin + PluginLoader.CallDeInit(i); + except + end; + end; + + // Reset CurExecuted + Core.CurExecuted := CurExecutedBackup; +end; + +end. diff --git a/ServiceBasedPlugins/src/base/UServices.pas b/ServiceBasedPlugins/src/base/UServices.pas new file mode 100644 index 00000000..3783c543 --- /dev/null +++ b/ServiceBasedPlugins/src/base/UServices.pas @@ -0,0 +1,384 @@ +{* 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 UServices; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + uPluginDefs, + SysUtils; +{********************* + TServiceManager + Class for saving, managing and calling of Services. + Saves all Services and their Procs +*********************} + +type + TServiceName = String[60]; + PServiceInfo = ^TServiceInfo; + TServiceInfo = record + Self: THandle; //Handle of this Service + Hash: Integer; //4 Bit Hash of the Services Name + Name: TServiceName; //Name of this Service + + Owner: Integer; //If < 0 [-(DLLMan Pluginindex + 1)]; 0 - undefined, On Error Full shutdown, If < 0 [ModuleIndex - 1] + + Next: PServiceInfo; //Pointer to the Next Service in teh list + + //Here is s/t tricky + //To avoid writing of Wrapping Functions to offer a Service from a Class + //We save a Normal Proc or a Method of a Class + Case isClass: boolean of + False: (Proc: TUS_Service); //Proc that will be called on Event + True: (ProcOfClass: TUS_Service_of_Object); + end; + + TServiceManager = class + private + //Managing Service List + FirstService: PServiceInfo; + LastService: PServiceInfo; + + //Some Speed improvement by caching the last 4 called Services + //Most of the time a Service is called multiple times + ServiceCache: Array[0..3] of PServiceInfo; + NextCacheItem: Byte; + + //Next Service added gets this Handle: + NextHandle: THandle; + public + Constructor Create; + + Function AddService(const ServiceName: PChar; const Proc: TUS_Service = nil; const ProcofClass: TUS_Service_of_Object = nil): THandle; + Function DelService(const hService: THandle): integer; + + Function CallService(const ServiceName: PChar; const wParam: TwParam; lParam: TlParam): integer; + + Function NametoHash(const ServiceName: TServiceName): Integer; + Function ServiceExists(const ServiceName: PChar): Integer; + end; + +var + ServiceManager: TServiceManager; + +implementation +uses + ULog, + UCore; + +//------------ +// Create - Creates Class and Set Standard Values +//------------ +Constructor TServiceManager.Create; +begin + inherited; + + FirstService := nil; + LastService := nil; + + ServiceCache[0] := nil; + ServiceCache[1] := nil; + ServiceCache[2] := nil; + ServiceCache[3] := nil; + + NextCacheItem := 0; + + NextHandle := 1; + + {$IFDEF DEBUG} + debugWriteln('ServiceManager: Succesful created!'); + {$ENDIF} +end; + +//------------ +// Function Creates a new Service and Returns the Services Handle, +// 0 on Failure. (Name already exists) +//------------ +Function TServiceManager.AddService(const ServiceName: PChar; const Proc: TUS_Service; const ProcofClass: TUS_Service_of_Object): THandle; +var + Cur: PServiceInfo; +begin + Result := 0; + + If (@Proc <> nil) or (@ProcOfClass <> nil) then + begin + If (ServiceExists(ServiceName) = 0) then + begin //There is a Proc and the Service does not already exist + //Ok Add it! + + //Get Memory + GetMem(Cur, SizeOf(TServiceInfo)); + + //Fill it with Data + Cur.Next := nil; + + If (@Proc = nil) then + begin //Use the ProcofClass Method + Cur.isClass := True; + Cur.ProcOfClass := ProcofClass; + end + else //Use the normal Proc + begin + Cur.isClass := False; + Cur.Proc := Proc; + end; + + Cur.Self := NextHandle; + //Zero Name + Cur.Name := #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0; + Cur.Name := String(ServiceName); + Cur.Hash := NametoHash(Cur.Name); + + //Add Owner to Service + Cur.Owner := Core.CurExecuted; + + //Add Service to the List + If (FirstService = nil) then + FirstService := Cur; + + If (LastService <> nil) then + LastService.Next := Cur; + + LastService := Cur; + + {$IFDEF DEBUG} + debugWriteln('ServiceManager: Service added: ''' + ServiceName + ''', Handle: ' + InttoStr(Cur.Self)); + {$ENDIF} + + //Inc Next Handle + Inc(NextHandle); + end + {$IFDEF DEBUG} + else debugWriteln('ServiceManager: Try to readd Service: ' + ServiceName); + {$ENDIF} + end; +end; + +//------------ +// Function Destroys a Service, 0 on success, not 0 on Failure +//------------ +Function TServiceManager.DelService(const hService: THandle): integer; +var + Last, Cur: PServiceInfo; + I: Integer; +begin + Result := -1; + + Last := nil; + Cur := FirstService; + + //Search for Service to Delete + While (Cur <> nil) do + begin + If (Cur.Self = hService) then + begin //Found Service => Delete it + + //Delete from List + If (Last = nil) then //Found first Service + FirstService := Cur.Next + Else //Service behind the first + Last.Next := Cur.Next; + + //IF this is the LastService, correct LastService + If (Cur = LastService) then + LastService := Last; + + //Search for Service in Cache and delete it if found + For I := 0 to High(ServiceCache) do + If (ServiceCache[I] = Cur) then + begin + ServiceCache[I] := nil; + end; + + {$IFDEF DEBUG} + debugWriteln('ServiceManager: Removed Service succesful: ' + Cur.Name); + {$ENDIF} + + //Free Memory + Freemem(Cur, SizeOf(TServiceInfo)); + + //Break the Loop + Break; + end; + + //Go to Next Service + Last := Cur; + Cur := Cur.Next; + end; +end; + +//------------ +// Function Calls a Services Proc +// Returns Services Return Value or SERVICE_NOT_FOUND on Failure +//------------ +Function TServiceManager.CallService(const ServiceName: PChar; const wParam: TwParam; lParam: TlParam): integer; +var + SExists: Integer; + Service: PServiceInfo; + CurExecutedBackup: Integer; //backup of Core.CurExecuted Attribute +begin + Result := SERVICE_NOT_FOUND; + SExists := ServiceExists(ServiceName); + If (SExists <> 0) then + begin + //Backup CurExecuted + CurExecutedBackup := Core.CurExecuted; + + Service := Pointer(SExists); + + If (Service.isClass) then + //Use Proc of Class + Result := Service.ProcOfClass(wParam, lParam) + Else + //Use normal Proc + Result := Service.Proc(wParam, lParam); + + //Restore CurExecuted + Core.CurExecuted := CurExecutedBackup; + end; + + {$IFDEF DEBUG} + debugWriteln('ServiceManager: Service ''' + ServiceName + ''' called. Result: ' + InttoStr(Result)); + {$ENDIF} +end; + +//------------ +// Generates the Hash for the given Name +//------------ +Function TServiceManager.NametoHash(const ServiceName: TServiceName): Integer; +// FIXME: check if the non-asm version is fast enough and use it by default if so +{$IF Defined(CPUX86_64)} +{$IFDEF FPC} + {$ASMMODE Intel} +{$ENDIF} +asm + { CL: Counter; RAX: Result; RDX: Current Memory Address } + Mov RCX, 14 + Mov RDX, ServiceName {Save Address of String that should be "Hashed"} + Mov RAX, [RDX] + @FoldLoop: ADD RDX, 4 {jump 4 Byte(32 Bit) to the next tile } + ADD RAX, [RDX] {Add the Value of the next 4 Byte of the String to the Hash} + LOOP @FoldLoop {Fold again if there are Chars Left} +end; +{$ELSEIF Defined(CPU386) or Defined(CPUI386)} +{$IFDEF FPC} + {$ASMMODE Intel} +{$ENDIF} +asm + { CL: Counter; EAX: Result; EDX: Current Memory Address } + Mov ECX, 14 {Init Counter, Fold 14 Times to get 4 Bytes out of 60} + Mov EDX, ServiceName {Save Address of String that should be "Hashed"} + Mov EAX, [EDX] + @FoldLoop: ADD EDX, 4 {jump 4 Byte(32 Bit) to the next tile } + ADD EAX, [EDX] {Add the Value of the next 4 Byte of the String to the Hash} + LOOP @FoldLoop {Fold again if there are Chars Left} +end; +{$ELSE} +var + i: integer; + ptr: ^integer; +begin + ptr := @ServiceName; + Result := 0; + for i := 1 to 14 do + begin + Result := Result + ptr^; + Inc(ptr); + end; +end; +{$IFEND} + + +//------------ +// Function Returns Non Zero if a Service with the given Name Exists, otherwise 0 +//------------ +Function TServiceManager.ServiceExists(const ServiceName: PChar): Integer; +var + Name: TServiceName; + Hash: Integer; + Cur: PServiceInfo; + I: Byte; +begin + Result := 0; + // to-do : Write a Metbod (in ASM) to Zero and Add in one turn (faster then this dirty hack ;) + //Zero Name: + Name := #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0; + //Add Service Name + Name := String(ServiceName); + Hash := NametoHash(Name); + + //First of all Look for the Service in Cache + For I := 0 to High(ServiceCache) do + begin + If (ServiceCache[I] <> nil) AND (ServiceCache[I].Hash = Hash) then + begin + If (ServiceCache[I].Name = Name) then + begin //Found Service in Cache + Result := Integer(ServiceCache[I]); + + {$IFDEF DEBUG} + debugWriteln('ServiceManager: Found Service in Cache: ''' + ServiceName + ''''); + {$ENDIF} + + Break; + end; + end; + end; + + If (Result = 0) then + begin + Cur := FirstService; + While (Cur <> nil) do + begin + If (Cur.Hash = Hash) then + begin + If (Cur.Name = Name) then + begin //Found the Service + Result := Integer(Cur); + + {$IFDEF DEBUG} + debugWriteln('ServiceManager: Found Service in List: ''' + ServiceName + ''''); + {$ENDIF} + + //Add to Cache + ServiceCache[NextCacheItem] := Cur; + NextCacheItem := (NextCacheItem + 1) AND 3; + Break; + end; + end; + + Cur := Cur.Next; + end; + end; +end; + +end. diff --git a/ServiceBasedPlugins/src/screens/UScreenPartyNewRound.pas b/ServiceBasedPlugins/src/screens/UScreenPartyNewRound.pas index f95f2ff1..01de9df7 100644 --- a/ServiceBasedPlugins/src/screens/UScreenPartyNewRound.pas +++ b/ServiceBasedPlugins/src/screens/UScreenPartyNewRound.pas @@ -215,15 +215,15 @@ var function GetTeamPlayers(const Num: Byte): String; var Players: Array of String; - J: Byte; - begin - if (Num-1 >= PartySession.Teams.NumTeams) then + //J: Byte; + begin // to-do : Party + if (Num-1 >= {PartySession.Teams.NumTeams}0) then exit; - //Create Players Array + {//Create Players Array SetLength(Players, PartySession.Teams.TeamInfo[Num-1].NumPlayers); For J := 0 to PartySession.Teams.TeamInfo[Num-1].NumPlayers-1 do - Players[J] := String(PartySession.Teams.TeamInfo[Num-1].PlayerInfo[J].Name); + Players[J] := String(PartySession.Teams.TeamInfo[Num-1].PlayerInfo[J].Name);} //Implode and Return Result := Language.Implode(Players); @@ -231,10 +231,12 @@ var begin inherited; - PartySession.StartRound; + // to-do : Party + //PartySession.StartRound; //Set Visibility of Round Infos - I := Length(PartySession.Rounds); + // to-do : Party + I := {Length(PartySession.Rounds)}0; if (I >= 1) then begin Static[StaticRound1].Visible := True; @@ -242,8 +244,8 @@ begin Text[TextWinner1].Visible := True; //Texts: - Text[TextRound1].Text := Language.Translate(DllMan.Plugins[PartySession.Rounds[0].Plugin].Name); - Text[TextWinner1].Text := PartySession.GetWinnerString(0); + //Text[TextRound1].Text := Language.Translate(DllMan.Plugins[PartySession.Rounds[0].Plugin].Name); + //Text[TextWinner1].Text := PartySession.GetWinnerString(0); end else begin @@ -259,8 +261,8 @@ begin Text[TextWinner2].Visible := True; //Texts: - Text[TextRound2].Text := Language.Translate(DllMan.Plugins[PartySession.Rounds[1].Plugin].Name); - Text[TextWinner2].Text := PartySession.GetWinnerString(1); + //Text[TextRound2].Text := Language.Translate(DllMan.Plugins[PartySession.Rounds[1].Plugin].Name); + //Text[TextWinner2].Text := PartySession.GetWinnerString(1); end else begin @@ -276,8 +278,8 @@ begin Text[TextWinner3].Visible := True; //Texts: - Text[TextRound3].Text := Language.Translate(DllMan.Plugins[PartySession.Rounds[2].Plugin].Name); - Text[TextWinner3].Text := PartySession.GetWinnerString(2); + //Text[TextRound3].Text := Language.Translate(DllMan.Plugins[PartySession.Rounds[2].Plugin].Name); + //Text[TextWinner3].Text := PartySession.GetWinnerString(2); end else begin @@ -293,8 +295,8 @@ begin Text[TextWinner4].Visible := True; //Texts: - Text[TextRound4].Text := Language.Translate(DllMan.Plugins[PartySession.Rounds[3].Plugin].Name); - Text[TextWinner4].Text := PartySession.GetWinnerString(3); + //Text[TextRound4].Text := Language.Translate(DllMan.Plugins[PartySession.Rounds[3].Plugin].Name); + //Text[TextWinner4].Text := PartySession.GetWinnerString(3); end else begin @@ -310,8 +312,8 @@ begin Text[TextWinner5].Visible := True; //Texts: - Text[TextRound5].Text := Language.Translate(DllMan.Plugins[PartySession.Rounds[4].Plugin].Name); - Text[TextWinner5].Text := PartySession.GetWinnerString(4); + //Text[TextRound5].Text := Language.Translate(DllMan.Plugins[PartySession.Rounds[4].Plugin].Name); + //Text[TextWinner5].Text := PartySession.GetWinnerString(4); end else begin @@ -327,8 +329,8 @@ begin Text[TextWinner6].Visible := True; //Texts: - Text[TextRound6].Text := Language.Translate(DllMan.Plugins[PartySession.Rounds[5].Plugin].Name); - Text[TextWinner6].Text := PartySession.GetWinnerString(5); + //Text[TextRound6].Text := Language.Translate(DllMan.Plugins[PartySession.Rounds[5].Plugin].Name); + //Text[TextWinner6].Text := PartySession.GetWinnerString(5); end else begin @@ -344,8 +346,8 @@ begin Text[TextWinner7].Visible := True; //Texts: - Text[TextRound7].Text := Language.Translate(DllMan.Plugins[PartySession.Rounds[6].Plugin].Name); - Text[TextWinner7].Text := PartySession.GetWinnerString(6); + //Text[TextRound7].Text := Language.Translate(DllMan.Plugins[PartySession.Rounds[6].Plugin].Name); + //Text[TextWinner7].Text := PartySession.GetWinnerString(6); end else begin @@ -355,7 +357,7 @@ begin end; //Display Scores - if (PartySession.Teams.NumTeams >= 1) then + {if (PartySession.Teams.NumTeams >= 1) then begin Text[TextScoreTeam1].Text := InttoStr(PartySession.Teams.TeamInfo[0].Score); Text[TextNameTeam1].Text := String(PartySession.Teams.TeamInfo[0].Name); @@ -443,7 +445,7 @@ begin Text[TextNextPlayer3].Visible := True; end else - Text[TextNextPlayer3].Visible := False; + Text[TextNextPlayer3].Visible := False; } end; procedure TScreenPartyNewRound.SetAnimationProgress(Progress: real); diff --git a/ServiceBasedPlugins/src/screens/UScreenPartyOptions.pas b/ServiceBasedPlugins/src/screens/UScreenPartyOptions.pas index 147cb80f..d6839778 100644 --- a/ServiceBasedPlugins/src/screens/UScreenPartyOptions.pas +++ b/ServiceBasedPlugins/src/screens/UScreenPartyOptions.pas @@ -138,10 +138,10 @@ begin //Save Num Teams: - PartySession.Teams.NumTeams := NumTeams + 2; + {PartySession.Teams.NumTeams := NumTeams + 2; PartySession.Teams.Teaminfo[0].NumPlayers := NumPlayer1+1; PartySession.Teams.Teaminfo[1].NumPlayers := NumPlayer2+1; - PartySession.Teams.Teaminfo[2].NumPlayers := NumPlayer3+1; + PartySession.Teams.Teaminfo[2].NumPlayers := NumPlayer3+1;} //Save Playlist PlaylistMan.Mode := TSingMode( Playlist ); @@ -170,7 +170,8 @@ begin PlaylistMan.CurPlayList := Playlist2; //Start Party - PartySession.StartNewParty(Rounds + 2); + // to-do : Party + //PartySession.StartNewParty(Rounds + 2); AudioPlayback.PlaySound(SoundLib.Start); //Go to Player Screen diff --git a/ServiceBasedPlugins/src/screens/UScreenPartyPlayer.pas b/ServiceBasedPlugins/src/screens/UScreenPartyPlayer.pas index ea8e8bc5..d38a6435 100644 --- a/ServiceBasedPlugins/src/screens/UScreenPartyPlayer.pas +++ b/ServiceBasedPlugins/src/screens/UScreenPartyPlayer.pas @@ -71,18 +71,11 @@ type implementation -uses - UGraphic, - UMain, - UIni, - UTexture, - UParty; +uses UGraphic, UMain, UIni, UTexture, UParty; function TScreenPartyPlayer.ParseInput(PressedKey: Cardinal; CharCode: WideChar; PressedDown: Boolean): Boolean; var - SDL_ModState: word; - I, J: integer; - + SDL_ModState: Word; procedure IntNext; begin repeat @@ -241,7 +234,7 @@ begin SDLK_RETURN: begin - //Save PlayerNames + {//Save PlayerNames for I := 0 to PartySession.Teams.NumTeams-1 do begin PartySession.Teams.Teaminfo[I].Name := PChar(Button[I*5].Text[0].Text); @@ -252,8 +245,8 @@ begin end; end; - AudioPlayback.PlaySound(SoundLib.Start); - FadeTo(@ScreenPartyNewRound); + AudioPlayback.PlayStart; + FadeTo(@ScreenPartyNewRound);} end; // Up and Down could be done at the same time, @@ -268,6 +261,8 @@ begin end; constructor TScreenPartyPlayer.Create; +//var +// I: integer; // Auto Removed, Unused Variable begin inherited Create; @@ -315,7 +310,7 @@ begin Button[10].Text[0].Text := Ini.NameTeam[2]; // Templates for Names Mod end - If (PartySession.Teams.NumTeams>=1) then + {If (PartySession.Teams.NumTeams>=1) then begin Button[0].Visible := True; Button[1].Visible := (PartySession.Teams.Teaminfo[0].NumPlayers >=1); @@ -364,7 +359,7 @@ begin Button[12].Visible := False; Button[13].Visible := False; Button[14].Visible := False; - end; + end; } end; diff --git a/ServiceBasedPlugins/src/screens/UScreenPartyScore.pas b/ServiceBasedPlugins/src/screens/UScreenPartyScore.pas index 87b4a886..bd54d55e 100644 --- a/ServiceBasedPlugins/src/screens/UScreenPartyScore.pas +++ b/ServiceBasedPlugins/src/screens/UScreenPartyScore.pas @@ -93,21 +93,22 @@ begin SDLK_BACKSPACE : begin AudioPlayback.PlaySound(SoundLib.Start); - if (PartySession.CurRound < High(PartySession.Rounds)) then + {if (PartySession.CurRound < High(PartySession.Rounds)) then FadeTo(@ScreenPartyNewRound) - else + else // to-do : Party begin - PartySession.EndRound; + PartySession.EndRound; } FadeTo(@ScreenPartyWin); - end; + //end; end; SDLK_RETURN: begin AudioPlayback.PlaySound(SoundLib.Start); - if (PartySession.CurRound < High(PartySession.Rounds)) then + // to-do : Party + {if (PartySession.CurRound < High(PartySession.Rounds)) then FadeTo(@ScreenPartyNewRound) - else + else } FadeTo(@ScreenPartyWin); end; end; @@ -219,11 +220,11 @@ begin if Static[StaticTeam2].Texture.ScaleW > 99 then Static[StaticTeam2].Texture.ScaleW := 99; if Static[StaticTeam3].Texture.ScaleW > 99 then Static[StaticTeam3].Texture.ScaleW := 99; - //End Last Round - PartySession.EndRound; + //End Last Round // to-do : Party + //PartySession.EndRound; //Set Winnertext - Text[TextWinner].Text := Format(Language.Translate('PARTY_SCORE_WINS'), [PartySession.GetWinnerString(PartySession.CurRound)]); + //Text[TextWinner].Text := Format(Language.Translate('PARTY_SCORE_WINS'), [PartySession.GetWinnerString(PartySession.CurRound)]); if (ScreenSingModi.PlayerInfo.NumPlayers >= 1) then begin diff --git a/ServiceBasedPlugins/src/screens/UScreenPartyWin.pas b/ServiceBasedPlugins/src/screens/UScreenPartyWin.pas index 64a50737..6b4a55c0 100644 --- a/ServiceBasedPlugins/src/screens/UScreenPartyWin.pas +++ b/ServiceBasedPlugins/src/screens/UScreenPartyWin.pas @@ -127,9 +127,9 @@ begin end; procedure TScreenPartyWin.onShow; -var - I: Integer; - Placing: TeamOrderArray; +//var +// I: Integer; // Auto Removed, Unused Variable +// Placing: Integer; // Auto Removed, Unused Variable Function GetTeamColor(Team: Byte): Cardinal; var @@ -143,12 +143,13 @@ var begin inherited; + // to-do : Party //Get Team Placing - Placing := PartySession.GetTeamOrder; + //Placing := PartySession.GetTeamOrder; //Set Winnertext - Text[TextWinner].Text := Format(Language.Translate('PARTY_SCORE_WINS'), [PartySession.Teams.Teaminfo[Placing[0]].Name]); - if (PartySession.Teams.NumTeams >= 1) then + //Text[TextWinner].Text := Format(Language.Translate('PARTY_SCORE_WINS'), [PartySession.Teams.Teaminfo[Placing[0]].Name]); + {if (PartySession.Teams.NumTeams >= 1) then begin Text[TextScoreTeam1].Text := InttoStr(PartySession.Teams.TeamInfo[Placing[0]].Score); Text[TextNameTeam1].Text := String(PartySession.Teams.TeamInfo[Placing[0]].Name); @@ -275,7 +276,7 @@ begin Static[StaticTeam3].Visible := False; Static[StaticTeam3BG].Visible := False; Static[StaticTeam3Deco].Visible := False; - end; + end; } end; procedure TScreenPartyWin.SetAnimationProgress(Progress: real); diff --git a/ServiceBasedPlugins/src/screens/UScreenSong.pas b/ServiceBasedPlugins/src/screens/UScreenSong.pas index 8f6fafea..8aa5acca 100644 --- a/ServiceBasedPlugins/src/screens/UScreenSong.pas +++ b/ServiceBasedPlugins/src/screens/UScreenSong.pas @@ -706,36 +706,36 @@ begin end; SDLK_1: - begin //Joker - if (Mode = smPartyMode) and (PartySession.Teams.NumTeams >= 1) and (PartySession.Teams.Teaminfo[0].Joker > 0) then + begin //Joker // to-do : Party + {if (Mode = smPartyMode) and (PartySession.Teams.NumTeams >= 1) and (PartySession.Teams.Teaminfo[0].Joker > 0) then begin //Use Joker Dec(PartySession.Teams.Teaminfo[0].Joker); SelectRandomSong; SetJoker; - end; + end; } end; SDLK_2: begin //Joker - if (Mode = smPartyMode) and (PartySession.Teams.NumTeams >= 2) and (PartySession.Teams.Teaminfo[1].Joker > 0) then + {if (Mode = smPartyMode) and (PartySession.Teams.NumTeams >= 2) and (PartySession.Teams.Teaminfo[1].Joker > 0) then begin //Use Joker Dec(PartySession.Teams.Teaminfo[1].Joker); SelectRandomSong; SetJoker; - end; + end; } end; SDLK_3: begin //Joker - if (Mode = smPartyMode) and (PartySession.Teams.NumTeams >= 3) and (PartySession.Teams.Teaminfo[2].Joker > 0) then + {if (Mode = smPartyMode) and (PartySession.Teams.NumTeams >= 3) and (PartySession.Teams.Teaminfo[2].Joker > 0) then begin //Use Joker Dec(PartySession.Teams.Teaminfo[2].Joker); SelectRandomSong; SetJoker; - end; + end; } end; end; end; // if (PressedDown) @@ -1775,8 +1775,10 @@ end; procedure TScreenSong.SetJoker; begin // If Party Mode + // to-do : Party if Mode = smPartyMode then //Show Joker that are available begin + (* if (PartySession.Teams.NumTeams >= 1) then begin Static[StaticTeam1Joker1].Visible := (PartySession.Teams.Teaminfo[0].Joker >= 1); @@ -1827,6 +1829,7 @@ begin Static[StaticTeam3Joker4].Visible := false; Static[StaticTeam3Joker5].Visible := false; end; + *) end else begin //Hide all @@ -1917,6 +1920,7 @@ end; //Team No of Team (0-5) procedure TScreenSong.DoJoker (Team: Byte); begin + { if (Mode = smPartyMode) and (PartySession.Teams.NumTeams >= Team + 1) and (PartySession.Teams.Teaminfo[Team].Joker > 0) then @@ -1926,6 +1930,7 @@ begin SelectRandomSong; SetJoker; end; + } end; //Detailed Cover Unloading. Unloads the Detailed, uncached Cover of the cur. Song diff --git a/ServiceBasedPlugins/src/screens/UScreenSongMenu.pas b/ServiceBasedPlugins/src/screens/UScreenSongMenu.pas index 8d75eb67..fb3b0f93 100644 --- a/ServiceBasedPlugins/src/screens/UScreenSongMenu.pas +++ b/ServiceBasedPlugins/src/screens/UScreenSongMenu.pas @@ -399,16 +399,19 @@ begin begin CurMenu := sMenu; Text[0].Text := Language.Translate('SONG_MENU_NAME_PARTY_JOKER'); - - Button[0].Visible := (PartySession.Teams.NumTeams >= 1) and (PartySession.Teams.Teaminfo[0].Joker > 0); + // to-do : Party +{ + Button[0].Visible := (PartySession.Teams.NumTeams >= 1) and (PartySession.Teams.Teaminfo[0].Joker > 0); Button[1].Visible := (PartySession.Teams.NumTeams >= 2) and (PartySession.Teams.Teaminfo[1].Joker > 0); Button[2].Visible := (PartySession.Teams.NumTeams >= 3) and (PartySession.Teams.Teaminfo[2].Joker > 0); +} Button[3].Visible := true; SelectsS[0].Visible := false; - - Button[0].Text[0].Text := String(PartySession.Teams.Teaminfo[0].Name); +{ + Button[0].Text[0].Text := String(PartySession.Teams.Teaminfo[0].Name); Button[1].Text[0].Text := String(PartySession.Teams.Teaminfo[1].Name); Button[2].Text[0].Text := String(PartySession.Teams.Teaminfo[2].Name); +} Button[3].Text[0].Text := Language.Translate('SONG_MENU_CANCEL'); // set right interaction @@ -419,10 +422,10 @@ begin if (not Button[2].Visible) then Interaction := 4 else - Interaction := 2; + Interaction := 2; end else - Interaction := 1; + Interaction := 1; end; end; diff --git a/ServiceBasedPlugins/src/ultrastardx.dpr b/ServiceBasedPlugins/src/ultrastardx.dpr index 630135cc..f2896cd2 100644 --- a/ServiceBasedPlugins/src/ultrastardx.dpr +++ b/ServiceBasedPlugins/src/ultrastardx.dpr @@ -204,6 +204,22 @@ uses //------------------------------ //Includes - Plugin Support //------------------------------ + {UPluginDefines in 'pluginsupport\UPluginDefines.pas', + UPartyDefines in 'pluginsupport\UPartyDefines.pas', + + UPartyMode in 'pluginsupport\UPartyMode.pas', + UPartyManager in 'pluginsupport\UPartyManager.pas', + UPartyModePlugin in 'pluginsupport\UPartyModePlugin.pas', + UPluginLoader in 'pluginsupport\UPluginLoader.pas', } + + UModules in 'base\UModules.pas', //List of Modules to Load + UHooks in 'base\UHooks.pas', //Hook Managing + UServices in 'base\UServices.pas', //Service Managing + UCore in 'base\UCore.pas', //Core, Maybe remove this + UCoreModule in 'base\UCoreModule.pas', //^ + UPluginInterface in 'base\UPluginInterface.pas', //Interface offered by Core to Plugins + UPluginLoader in 'base\UPluginLoader.pas', //New Plugin Loader Module + UParty in 'base\UParty.pas', // TODO: rewrite Party Manager as Module, reomplent ability to offer party Mody by Plugin //------------------------------ @@ -315,6 +331,8 @@ uses //Includes - Modi SDK //------------------------------ ModiSDK in '..\plugins\SDK\ModiSDK.pas', //Old SDK, will be deleted soon + UPluginDefs in '..\plugins\SDK\UPluginDefs.pas', //New SDK, not only Modis + UPartyDefs in '..\plugins\SDK\UPartyDefs.pas', //Headers to register Party Modes SysUtils; |