aboutsummaryrefslogtreecommitdiffstats
path: root/src/base
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/base/UCore.pas550
-rw-r--r--src/base/UCoreModule.pas154
-rw-r--r--src/base/UHooks.pas460
-rw-r--r--src/base/UMain.pas8
-rw-r--r--src/base/UModules.pas55
-rw-r--r--src/base/UNote.pas2
-rw-r--r--src/base/UParty.pas562
-rw-r--r--src/base/UPluginInterface.pas186
-rw-r--r--src/base/UPluginLoader.pas794
-rw-r--r--src/base/UServices.pas384
10 files changed, 141 insertions, 3014 deletions
diff --git a/src/base/UCore.pas b/src/base/UCore.pas
deleted file mode 100644
index a7f9e56e..00000000
--- a/src/base/UCore.pas
+++ /dev/null
@@ -1,550 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * This program is free software; you can redistribute it and/or
- * modify it under the terms of the GNU General Public License
- * as published by the Free Software Foundation; either version 2
- * of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit 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/src/base/UCoreModule.pas b/src/base/UCoreModule.pas
deleted file mode 100644
index b87fec85..00000000
--- a/src/base/UCoreModule.pas
+++ /dev/null
@@ -1,154 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * This program is free software; you can redistribute it and/or
- * modify it under the terms of the GNU General Public License
- * as published by the Free Software Foundation; either version 2
- * of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit 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/src/base/UHooks.pas b/src/base/UHooks.pas
deleted file mode 100644
index acf2bba7..00000000
--- a/src/base/UHooks.pas
+++ /dev/null
@@ -1,460 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * This program is free software; you can redistribute it and/or
- * modify it under the terms of the GNU General Public License
- * as published by the Free Software Foundation; either version 2
- * of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit 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/src/base/UMain.pas b/src/base/UMain.pas
index fec1903f..469a658b 100644
--- a/src/base/UMain.pas
+++ b/src/base/UMain.pas
@@ -66,11 +66,6 @@ implementation
uses
Math,
gl,
-{
- SDL_ttf,
- UParty,
- UCore,
-}
UCatCovers,
UCommandLine,
UCommon,
@@ -92,6 +87,7 @@ uses
USkins,
USongs,
UThemes,
+ UParty,
UTime;
procedure Main;
@@ -236,14 +232,12 @@ 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/src/base/UModules.pas b/src/base/UModules.pas
deleted file mode 100644
index 97494180..00000000
--- a/src/base/UModules.pas
+++ /dev/null
@@ -1,55 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * This program is free software; you can redistribute it and/or
- * modify it under the terms of the GNU General Public License
- * as published by the Free Software Foundation; either version 2
- * of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit 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/src/base/UNote.pas b/src/base/UNote.pas
index 5e70bfe1..6da4cf07 100644
--- a/src/base/UNote.pas
+++ b/src/base/UNote.pas
@@ -126,12 +126,10 @@ uses
UDLLManager,
UParty,
UConfig,
- UCore,
UCommon,
UGraphic,
UGraphicClasses,
UPath,
- UPluginDefs,
UPlatform,
UThemes;
diff --git a/src/base/UParty.pas b/src/base/UParty.pas
index 23012dfe..9d70e2be 100644
--- a/src/base/UParty.pas
+++ b/src/base/UParty.pas
@@ -34,208 +34,85 @@ interface
{$I switches.inc}
uses
- UPartyDefs,
- UCoreModule,
- UPluginDefs;
+ ModiSDK;
type
- ARounds = array [0..252] of integer; //0..252 needed for
- PARounds = ^ARounds;
-
TRoundInfo = record
- Modi: cardinal;
+ Plugin: word;
Winner: byte;
end;
TeamOrderEntry = record
- Teamnum: byte;
+ TeamNum: byte;
Score: byte;
end;
TeamOrderArray = array[0..5] of byte;
- TUS_ModiInfoEx = record
- Info: TUS_ModiInfo;
- Owner: integer;
- TimesPlayed: byte; //Helper for setting round plugins
+ TPartyPlugin = record
+ ID: byte;
+ TimesPlayed: byte;
end;
- TPartySession = class (TCoreModule)
+ TPartySession = class
private
- bPartyMode: boolean; //Is this party or single player
- CurRound: byte;
-
- Modis: array of TUS_ModiInfoEx;
- Teams: TTeamInfo;
-
- function IsWinner(Player, Winner: byte): boolean;
+ function GetRandomPlayer(Team: Byte): Byte;
+ function GetRandomPlugin(Plugins: array of TPartyPlugin): byte;
+ 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;
- //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;
+ constructor Create;
- //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
+ procedure StartNewParty(NumRounds: Byte);
+ procedure StartRound;
+ procedure EndRound;
+ function GetTeamOrder: TeamOrderArray;
+ function GetWinnerString(Round: Byte): String;
end;
-const
- StandardModus = 0; //Modus ID that will be played in non-party mode
+var
+ PartySession: TPartySession;
implementation
uses
- UCore,
+ UDLLManager,
UGraphic,
- ULanguage,
- 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;
+ ULanguage,
+ ULog;
-//-------------
-// 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(TeamMode: boolean): cardinal;
+function TPartySession.GetRandomPlugin(Plugins: array of TPartyPlugin): byte;
var
LowestTP: byte;
NumPwithLTP: word;
I: integer;
R: word;
begin
- Result := StandardModus; //If there are no matching modi, play standard modus
LowestTP := high(byte);
NumPwithLTP := 0;
//Search for Plugins not often played yet
- for I := 0 to high(Modis) do
+ for I := 0 to high(Plugins) do
begin
- if (Modis[I].TimesPlayed < lowestTP) and (((Modis[I].Info.LoadingSettings and MLS_TeamOnly) <> 0) = TeamMode) then
+ if (Plugins[I].TimesPlayed < lowestTP) then
begin
- lowestTP := Modis[I].TimesPlayed;
+ lowestTP := Plugins[I].TimesPlayed;
NumPwithLTP := 1;
end
- else if (Modis[I].TimesPlayed = lowestTP) and (((Modis[I].Info.LoadingSettings and MLS_TeamOnly) <> 0) = TeamMode) then
+ else if (Plugins[I].TimesPlayed = lowestTP) then
begin
Inc(NumPwithLTP);
end;
@@ -245,110 +122,89 @@ begin
R := Random(NumPwithLTP);
//Search for random plugin
- for I := 0 to high(Modis) do
+ for I := 0 to high(Plugins) do
begin
- if (Modis[I].TimesPlayed = lowestTP) and (((Modis[I].Info.LoadingSettings and MLS_TeamOnly) <> 0) = TeamMode) then
+ if Plugins[I].TimesPlayed = LowestTP then
begin
//Plugin found
if (R = 0) then
begin
- Result := I;
- Inc(Modis[I].TimesPlayed);
+ Result := Plugins[I].ID;
+ Inc(Plugins[I].TimesPlayed);
Break;
end;
-
Dec(R);
end;
end;
end;
//----------
-// Starts new party mode. Returns non zero on success
+//StartNewParty - Reset and prepares for new party
//----------
-function TPartySession.StartParty(NumRounds: TwParam; PAofIRounds: TlParam): integer;
+procedure TPartySession.StartNewParty(NumRounds: Byte);
var
- I: integer;
- aiRounds: PARounds;
+ Plugins: array of TPartyPlugin;
TeamMode: boolean;
+ Len: integer;
+ I, J: integer;
begin
- Result := 0;
- if (Teams.NumTeams >= 1) and (NumRounds < High(byte)-1) then
- begin
- bPartyMode := false;
- aiRounds := PAofIRounds;
-
- try
- //Is this team mode (More than one player per team) ?
- TeamMode := true;
- for I := 0 to Teams.NumTeams-1 do
- TeamMode := TeamMode and (Teams.Teaminfo[I].NumPlayers > 1);
-
- //Set Rounds
- SetLength(Rounds, NumRounds);
-
- for I := 0 to High(Rounds) do
- begin //Set plugins
- if (aiRounds[I] = -1) then
- Rounds[I].Modi := GetRandomPlugin(TeamMode)
- else if (aiRounds[I] >= 0) and (aiRounds[I] <= High(Modis)) and (TeamMode or ((Modis[aiRounds[I]].Info.LoadingSettings and MLS_TeamOnly) = 0)) then
- Rounds[I].Modi := aiRounds[I]
- else
- Rounds[I].Modi := StandardModus;
-
- Rounds[I].Winner := High(byte); //Set winner to not played
- end;
-
- CurRound := High(byte); //Set CurRound to not defined
+ //Set current round to 1
+ CurRound := 255;
- //Return true and set party mode
- bPartyMode := true;
- Result := 1;
+ PlayersPlay := Teams.NumTeams;
- except
- Core.ReportError(integer(PChar('Can''t start party mode.')), PChar('TPartySession'));
+ //Get team-mode and set joker, also set TimesPlayed
+ TeamMode := true;
+ for I := 0 to Teams.NumTeams-1 do
+ begin
+ if Teams.Teaminfo[I].NumPlayers < 2 then
+ begin
+ TeamMode := false;
+ end;
+ //Set player attributes
+ for J := 0 to Teams.TeamInfo[I].NumPlayers-1 do
+ begin
+ Teams.TeamInfo[I].Playerinfo[J].TimesPlayed := 0;
end;
+ Teams.Teaminfo[I].Joker := Round(NumRounds*0.7);
+ Teams.Teaminfo[I].Score := 0;
end;
-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]);
+ //Fill plugin array
+ SetLength(Plugins, 0);
+ for I := 0 to high(DLLMan.Plugins) do
+ begin
+ if TeamMode or (not DLLMan.Plugins[I].TeamModeOnly) then
+ begin
+ //Add only those plugins playable with current PlayerConfiguration
+ Len := Length(Plugins);
+ SetLength(Plugins, Len + 1);
+ Plugins[Len].ID := I;
+ Plugins[Len].TimesPlayed := 0;
+ end;
end;
-end;
-//----------
-// Stops party mode. Returns 1 if party mode was enabled before and -1 if change was not possible
-//----------
-function TPartySession.StopParty(wParam: TwParam; lParam: TlParam): integer;
-begin
- Result := -1;
- if (bPartyMode) then
+ //Set rounds
+ if (Length(Plugins) >= 1) then
begin
- // to-do : Whitü: Check here if sing screen is not shown atm.
- bPartyMode := false;
- Result := 1;
+ SetLength (Rounds, NumRounds);
+ for I := 0 to NumRounds-1 do
+ begin
+ PartySession.Rounds[I].Plugin := GetRandomPlugin(Plugins);
+ PartySession.Rounds[I].Winner := 255;
+ end;
end
else
- Result := 0;
+ SetLength (Rounds, 0);
end;
-//----------
-//GetRandomPlayer - gives back a random player to play next round
-//----------
+{**
+ * Returns 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);
@@ -369,7 +225,7 @@ begin
end;
end;
- //Create random no
+ //Create random number
R := Random(NumPwithLTP);
//Search for random player
@@ -389,202 +245,83 @@ begin
end;
end;
-//----------
-// NextRound - Increases CurRound by 1; Returns num of round or -1 if last round is already played
-//----------
-function TPartySession.NextRound(wParam: TwParam; lParam: TlParam): integer;
+{**
+ * Prepares ScreenSingModi for next round and loads plugin
+ *}
+procedure TPartySession.StartRound;
var
I: integer;
begin
- if ((CurRound < high(Rounds)) or (CurRound = high(CurRound))) then
- begin //everythings OK! -> Start the Round, maaaaan
+ if ((CurRound < high(Rounds)) OR (CurRound = high(CurRound))) then
+ begin
+ //Increase Current Round
Inc(CurRound);
- //Set Players to play this Round
+ Rounds[CurRound].Winner := 255;
+ DllMan.LoadPlugin(Rounds[CurRound].Plugin);
+
+ //Select Players
for I := 0 to Teams.NumTeams-1 do
Teams.Teaminfo[I].CurPlayer := GetRandomPlayer(I);
-
- // FIXME: return a valid result
- Result := 0;
- end
- else
- Result := -1;
-end;
-
-//----------
-//IsWinner - returns true if the players bit is set in the winner byte
-//----------
-function TPartySession.IsWinner(Player, Winner: byte): boolean;
-var
- Bit: byte;
-begin
- Bit := 1 shl Player;
- Result := ((Winner and Bit) = Bit);
-end;
-
-//----------
-//GenScores - inc scores for cur. round
-//----------
-procedure TPartySession.GenScores;
-var
- I: byte;
-begin
- for I := 0 to Teams.NumTeams-1 do
- begin
- if isWinner(I, Rounds[CurRound].Winner) then
- Inc(Teams.Teaminfo[I].Score);
- end;
-end;
-
-//----------
-// CallModiInit - calls CurModis Init Proc. If an error occurs, returns nonzero. In this case a new plugin was selected. Please renew loading
-//----------
-function TPartySession.CallModiInit(wParam: TwParam; lParam: TlParam): integer;
-begin
- if (not bPartyMode) then
- begin //Set rounds if not in party mode
- SetLength(Rounds, 1);
- Rounds[0].Modi := StandardModus;
- Rounds[0].Winner := High(byte);
- CurRound := 0;
+ //Set ScreenSingModie Variables
+ ScreenSingModi.TeamInfo := Teams;
end;
-
- try
- //Core.
- except
- on E : Exception do
- begin
- Core.ReportError(integer(PChar('Error starting modus: ' + Modis[Rounds[CurRound].Modi].Info.Name + ' ErrorStr: ' + E.Message)), PChar('TPartySession'));
- if (Rounds[CurRound].Modi = StandardModus) then
- begin
- Core.ReportError(integer(PChar('Can''t start standard modus, will exit now!')), PChar('TPartySession'));
- Halt;
- end
- else //Select standard modus
- begin
- Rounds[CurRound].Modi := StandardModus
- end;
- end;
- end;
-
- // FIXME: return a valid result
- Result := 0;
end;
//----------
-// CallModiDeInit - calls DeInitProc and ends the round
+//EndRound - Get Winner from ScreenSingModi and Save Data to RoundArray
//----------
-function TPartySession.CallModiDeInit(wParam: TwParam; lParam: TlParam): integer;
+procedure TPartySession.EndRound;
var
- I: integer;
- MaxScore: word;
+ I: Integer;
begin
- if (bPartyMode) then
- begin
- //Get Winner Byte!
- if (@Modis[Rounds[CurRound].Modi].Info.ModiDeInit <> nil) then //get winners from plugin
- Rounds[CurRound].Winner := Modis[Rounds[CurRound].Modi].Info.ModiDeInit(Modis[Rounds[CurRound].Modi].Info.ID)
- else
- begin //Create winners by score :/
- Rounds[CurRound].Winner := 0;
- MaxScore := 0;
- for I := 0 to Teams.NumTeams-1 do
- begin
- // to-do : recode percentage stuff
- //PlayerInfo.Playerinfo[I].Percentage := PlayerInfo.Playerinfo[I].Score div 9999;
- if (Player[I].ScoreTotalInt > MaxScore) then
- begin
- MaxScore := Player[I].ScoreTotalInt;
- Rounds[CurRound].Winner := 1 shl I;
- end
- else if (Player[I].ScoreTotalInt = MaxScore) and (Player[I].ScoreTotalInt <> 0) then
- begin
- Rounds[CurRound].Winner := Rounds[CurRound].Winner or (1 shl I);
- end;
- end;
-
+ //Copy Winner
+ Rounds[CurRound].Winner := ScreenSingModi.Winner;
+ //Set Scores
+ GenScores;
- //When nobody has points -> everybody looses
- if (MaxScore = 0) then
- Rounds[CurRound].Winner := 0;
+ //Increase TimesPlayed 4 all Players
+ For I := 0 to Teams.NumTeams-1 do
+ Inc(Teams.Teaminfo[I].Playerinfo[Teams.Teaminfo[I].CurPlayer].TimesPlayed);
- end;
-
- //Generate the scores
- GenScores;
-
- //Inc players TimesPlayed
- if ((Modis[Rounds[CurRound-1].Modi].Info.LoadingSettings and MLS_IncTP) = MLS_IncTP) then
- begin
- for I := 0 to Teams.NumTeams-1 do
- Inc(Teams.TeamInfo[I].Playerinfo[Teams.TeamInfo[I].CurPlayer].TimesPlayed);
- end;
- end
- else if (@Modis[Rounds[CurRound].Modi].Info.ModiDeInit <> nil) then
- Modis[Rounds[CurRound].Modi].Info.ModiDeInit(Modis[Rounds[CurRound].Modi].Info.ID);
-
- // FIXME: return a valid result
- Result := 0;
end;
//----------
-// GetTeamInfo - writes TTeamInfo record to pointer at lParam. Returns zero on success
+//IsWinner - returns true if the player's bit is set in the winner byte
//----------
-function TPartySession.GetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer;
+function TPartySession.IsWinner(Player, Winner: byte): boolean;
var
- Info: ^TTeamInfo;
+ Mask: byte;
begin
- Result := -1;
- Info := pTeamInfo;
- if (Info <> nil) then
- begin
- try
- // to - do : Check Delphi memory management in this case
- //Not sure if i had to copy PChars to a new address or if delphi manages this o0
- Info^ := Teams;
- Result := 0;
- except
- Result := -2;
- end;
- end;
+ Mask := 1 shl Player;
+ Result := (Winner and Mask) <> 0;
end;
//----------
-// SetTeamInfo - read TTeamInfo record from pointer at lParam. Returns zero on success
+//GenScores - increase scores for current round
//----------
-function TPartySession.SetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer;
+procedure TPartySession.GenScores;
var
- TeamInfobackup: TTeamInfo;
- Info: ^TTeamInfo;
+ I: byte;
begin
- Result := -1;
- Info := pTeamInfo;
- if (Info <> nil) then
+ for I := 0 to Teams.NumTeams-1 do
begin
- try
- TeamInfoBackup := Teams;
- // to - do : Check Delphi memory management in this case
- //Not sure if i had to copy PChars to a new address or if delphi manages this o0
- Teams := Info^;
- Result := 0;
- except
- Teams := TeamInfoBackup;
- Result := -2;
- end;
+ if isWinner(I, Rounds[CurRound].Winner) then
+ Inc(Teams.Teaminfo[I].Score);
end;
end;
//----------
-// GetTeamOrder - returns team order. Structure: Bits 1..3: Team at place1; Bits 4..6: Team at place2 ...
+//GetTeamOrder - returns the placement of each Team [First Position of Array is Teamnum of first placed Team, ...]
//----------
-function TPartySession.GetTeamOrder(wParam: TwParam; lParam: TlParam): integer;
+function TPartySession.GetTeamOrder: TeamOrderArray;
var
I, J: integer;
ATeams: array [0..5] of TeamOrderEntry;
TempTeam: TeamOrderEntry;
begin
- // to-do : PartyMode: Write this in another way, so that teams with the same score get the same place
+ // TODO: PartyMode: Write this in another way, so that teams with the same score get the same place
//Fill Team array
for I := 0 to Teams.NumTeams-1 do
begin
@@ -603,63 +340,44 @@ begin
end;
//Copy to Result
- Result := 0;
for I := 0 to Teams.NumTeams-1 do
- Result := Result or (ATeams[I].TeamNum Shl I*3);
+ Result[I] := ATeams[I].TeamNum;
end;
//----------
-// GetWinnerString - wParam is Roundnum. If (pointer = nil) then return length of the string. Otherwise write the string to address at lParam
+//GetWinnerString - Get String with WinnerTeam Name, when there is more than one Winner than Connect with and or ,
//----------
-function TPartySession.GetWinnerString(wParam: TwParam; lParam: TlParam): integer;
+function TPartySession.GetWinnerString(Round: byte): string;
var
- Winners: array of String;
+ Winners: array of string;
I: integer;
- ResultStr: String;
- S: ^String;
begin
- ResultStr := Language.Translate('PARTY_NOBODY');
+ Result := Language.Translate('PARTY_NOBODY');
+
+ if (Round > High(Rounds)) then
+ exit;
- if (wParam <= High(Rounds)) then
+ if (Rounds[Round].Winner = 0) then
begin
- if (Rounds[wParam].Winner <> 0) then
- begin
- if (Rounds[wParam].Winner = 255) then
- begin
- ResultStr := Language.Translate('PARTY_NOTPLAYEDYET');
- end
- else
- begin
- SetLength(Winners, 0);
- for I := 0 to Teams.NumTeams-1 do
- begin
- if isWinner(I, Rounds[wParam].Winner) then
- begin
- SetLength(Winners, Length(Winners) + 1);
- Winners[high(Winners)] := Teams.TeamInfo[I].Name;
- end;
- end;
- ResultStr := Language.Implode(Winners);
- end;
- end;
+ 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;
+ if (Rounds[Round].Winner = 255) then
+ begin
+ Result := Language.Translate('PARTY_NOTPLAYEDYET');
+ exit;
+ end;
+ SetLength(Winners, 0);
+ for I := 0 to Teams.NumTeams-1 do
+ begin
+ if isWinner(I, Rounds[Round].Winner) then
+ begin
+ SetLength(Winners, Length(Winners) + 1);
+ Winners[high(Winners)] := Teams.TeamInfo[I].Name;
end;
end;
+ Result := Language.Implode(Winners);
end;
end.
diff --git a/src/base/UPluginInterface.pas b/src/base/UPluginInterface.pas
deleted file mode 100644
index f299796f..00000000
--- a/src/base/UPluginInterface.pas
+++ /dev/null
@@ -1,186 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * This program is free software; you can redistribute it and/or
- * modify it under the terms of the GNU General Public License
- * as published by the Free Software Foundation; either version 2
- * of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit 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/src/base/UPluginLoader.pas b/src/base/UPluginLoader.pas
deleted file mode 100644
index 8836cb78..00000000
--- a/src/base/UPluginLoader.pas
+++ /dev/null
@@ -1,794 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * This program is free software; you can redistribute it and/or
- * modify it under the terms of the GNU General Public License
- * as published by the Free Software Foundation; either version 2
- * of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL: https://ultrastardx.svn.sourceforge.net/svnroot/ultrastardx/trunk/src/base/uPluginLoader.pas $
- * $Id: uPluginLoader.pas 1403 2008-09-23 21:17:22Z k-m_schindler $
- *}
-
-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/src/base/UServices.pas b/src/base/UServices.pas
deleted file mode 100644
index 3783c543..00000000
--- a/src/base/UServices.pas
+++ /dev/null
@@ -1,384 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * This program is free software; you can redistribute it and/or
- * modify it under the terms of the GNU General Public License
- * as published by the Free Software Foundation; either version 2
- * of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit 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.