aboutsummaryrefslogtreecommitdiffstats
path: root/ServiceBasedPlugins/src/base
diff options
context:
space:
mode:
authortobigun <tobigun@b956fd51-792f-4845-bead-9b4dfca2ff2c>2009-03-21 19:59:22 +0000
committertobigun <tobigun@b956fd51-792f-4845-bead-9b4dfca2ff2c>2009-03-21 19:59:22 +0000
commitc08726cd35fc71e85ba767b67aa73b77538af307 (patch)
treee617a903dd2d4a6c9f8ff81da4b9527185745445 /ServiceBasedPlugins/src/base
parentb38772ffdbcc6bf2189d0e14a9828f911ea44a7d (diff)
downloadusdx-c08726cd35fc71e85ba767b67aa73b77538af307.tar.gz
usdx-c08726cd35fc71e85ba767b67aa73b77538af307.tar.xz
usdx-c08726cd35fc71e85ba767b67aa73b77538af307.zip
whiteshark's new plugin mode check-in
git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/branches/experimental@1644 b956fd51-792f-4845-bead-9b4dfca2ff2c
Diffstat (limited to 'ServiceBasedPlugins/src/base')
-rw-r--r--ServiceBasedPlugins/src/base/UCore.pas550
-rw-r--r--ServiceBasedPlugins/src/base/UCoreModule.pas154
-rw-r--r--ServiceBasedPlugins/src/base/UHooks.pas460
-rw-r--r--ServiceBasedPlugins/src/base/UMain.pas8
-rw-r--r--ServiceBasedPlugins/src/base/UModules.pas55
-rw-r--r--ServiceBasedPlugins/src/base/UNote.pas2
-rw-r--r--ServiceBasedPlugins/src/base/UParty.pas562
-rw-r--r--ServiceBasedPlugins/src/base/UPluginInterface.pas186
-rw-r--r--ServiceBasedPlugins/src/base/UPluginLoader.pas794
-rw-r--r--ServiceBasedPlugins/src/base/UServices.pas384
10 files changed, 3014 insertions, 141 deletions
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.