diff options
author | whiteshark0 <whiteshark0@b956fd51-792f-4845-bead-9b4dfca2ff2c> | 2007-10-10 17:50:05 +0000 |
---|---|---|
committer | whiteshark0 <whiteshark0@b956fd51-792f-4845-bead-9b4dfca2ff2c> | 2007-10-10 17:50:05 +0000 |
commit | 621bfb05407a169f6511f5b115d0622e5ec8bdd5 (patch) | |
tree | 7edbf5de48b2914978b8575030c2d0a72dcf6011 /Game | |
parent | e64a9f34e7c08377990a8b3f11c24e9e9c5b8cc3 (diff) | |
download | usdx-621bfb05407a169f6511f5b115d0622e5ec8bdd5.tar.gz usdx-621bfb05407a169f6511f5b115d0622e5ec8bdd5.tar.xz usdx-621bfb05407a169f6511f5b115d0622e5ec8bdd5.zip |
Added Hook and Service Class for new Plugin System to Trunc
Added Core and CoreModule. That maybe will be used for new Core management.
Core needs many code to write
Some Info to Plugin SDK added
git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@497 b956fd51-792f-4845-bead-9b4dfca2ff2c
Diffstat (limited to 'Game')
-rw-r--r-- | Game/Code/Classes/UCore.pas | 278 | ||||
-rw-r--r-- | Game/Code/Classes/UCoreModule.pas | 105 | ||||
-rw-r--r-- | Game/Code/Classes/UHooks.pas | 375 | ||||
-rw-r--r-- | Game/Code/Classes/UModules.pas | 20 | ||||
-rw-r--r-- | Game/Code/Classes/UServices.pas | 312 | ||||
-rw-r--r-- | Game/Code/Classes/USingScores.pas | 1 | ||||
-rw-r--r-- | Game/Code/UltraStar.dpr | 15 | ||||
-rw-r--r-- | Game/Code/switches.inc | 2 |
8 files changed, 1098 insertions, 10 deletions
diff --git a/Game/Code/Classes/UCore.pas b/Game/Code/Classes/UCore.pas new file mode 100644 index 00000000..744fabe2 --- /dev/null +++ b/Game/Code/Classes/UCore.pas @@ -0,0 +1,278 @@ +unit UCore;
+
+interface
+uses uPluginDefs, uCoreModule, UHooks, UServices, uModules;
+{*********************
+ TCore
+ Class manages all CoreModules, teh StartUp, teh MainLoop and the shutdown process
+ Also it does some Error Handling, and maybe sometime multithreaded Loading ;)
+*********************}
+
+{$IFDEF FPC}
+ {$MODE Delphi} +{$ENDIF} + +{$I switches.inc}
+
+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;
+ hLoadTextures: THandle;
+ hExitQuery: THandle;
+ hExit: THandle;
+ hDebug: THandle;
+ hError: THandle;
+ sgiveError: THandle;
+ sgiveDebug: THandle;
+
+ Modules: Array [0..High(CORE_MODULES_TO_LOAD)] of TModuleListItem;
+
+ //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; //Teh Hook Manager ;)
+ Services: TServiceManager;//The Service Manager
+
+ CurExecuted: Integer; //ID of Plugin or Module curently Executed
+
+ Name: String; //Name of this Application
+ Version: LongWord; //Version of this ". For Info Look PluginDefs Functions
+
+ //---------------
+ //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;
+
+ //--------------
+ // Hook and Service Procs:
+ //--------------
+ Function ShowMessage(wParam, lParam: DWord): integer; //Shows a Message (lParam: PChar Text, wParam: Symbol)
+ Function ShowMessage(wParam, lParam: DWord): integer; //Shows a Message (lParam: PChar Text, wParam: Symbol)
+ Function ShowMessage(wParam, lParam: DWord): integer; //Shows a Message (lParam: PChar Text, wParam: Symbol)
+ end;
+
+var
+ Core: TCore;
+
+implementation
+{$IFDEF win32}
+uses Windows;
+{$ENDIF}
+
+//-------------
+// Create - Creates Class + Hook and Service Manager
+//-------------
+Constructor TCore.Create(const cName: String; const cVersion: LongWord);
+begin
+ Name := cName;
+ Version := cVersion;
+ CurExecuted := 0;
+
+ Hooks := THookManager.Create(50);
+ Services := TServiceManager.Create;
+end;
+
+//-------------
+//Starts Loading and Init Process. Then Runs MainLoop. DeInits on Shutdown
+//-------------
+Procedure TCore.Run;
+var
+ noError: Boolean;
+begin
+ //Get Modules
+ Try
+ noError := GetModules;
+ Except
+ noError := False;
+ end;
+
+ //Loading
+ if (noError) then
+ begin
+ Try
+ noError := Load;
+ Except
+ noError := False;
+ end;
+ end
+ else
+ Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('')));
+end;
+
+//-------------
+//Called one Time per Frame
+//-------------
+Function TCore.MainLoop: Boolean;
+begin
+ Result := True;
+
+end;
+
+//-------------
+//Function Get all Modules and Creates them
+//-------------
+Function TCore.GetModules: Boolean;
+var
+ I: Integer;
+begin
+ For I := 0 to high(Modules) do
+ begin
+ Modules[I].NeedsDeInit := False;
+ Modules[I].Module := CORE_MODULES_TO_LOAD[I].Create;
+ Modules[I].Module.Info(@Modules[I].Info);
+ end;
+end;
+
+//-------------
+//Loads Core and all Modules
+//-------------
+Function TCore.Load: Boolean;
+var
+ I: Integer;
+begin
+ Result := LoadCore;
+
+ I := 0;
+ While ((Result = True) AND (I <= High(CORE_MODULES_TO_LOAD))) do
+ begin
+ Result := Modules[I].Module.Load;
+ Inc(I);
+ end;
+end;
+
+//-------------
+//Inits Core and all Modules
+//-------------
+Function TCore.Init: Boolean;
+begin
+ Result := InitCore;
+
+ I := 0;
+ While ((Result = True) AND (I <= High(CORE_MODULES_TO_LOAD))) do
+ begin
+ Result := Modules[I].Module.Init;
+ Inc(I);
+ end;
+end;
+
+//-------------
+//DeInits Core and all Modules
+//-------------
+Function TCore.DeInit: Boolean;
+
+ label Continue;
+begin
+ I := High(CORE_MODULES_TO_LOAD);
+
+ Continue:
+ Try
+ While (I >= 0) do
+ begin
+ If (Modules[I].NeedsDeInit) then
+ Modules[I].Module.DeInit;
+
+ Dec(I);
+ end;
+ Except
+
+ GoTo Continue;
+ end;
+
+ DeInitCore;
+end;
+
+//-------------
+//Load the Core
+//-------------
+Function TCore.LoadCore: Boolean;
+begin
+ hLoadingFinished := Hooks.AddEvent('Core/LoadingFinished');
+ hMainLoop := Hooks.AddEvent('Core/MainLoop');
+ 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');
+ sReportDebug := Services.AddService('Core/ReportDebug');
+end;
+
+//-------------
+//Init the Core
+//-------------
+Function TCore.InitCore: Boolean;
+begin
+ //Dont Init s.th. atm.
+end;
+
+//-------------
+//DeInit the Core
+//-------------
+Function TCore.DeInitCore: Boolean;
+begin
+
+
+ // to-do : write TService-/HookManager.Free and call it here
+end;
+
+//-------------
+//Shows a MessageDialog (lParam: PChar Text, wParam: Symbol)
+//-------------
+Function TCore.ShowMessage(wParam, lParam: DWord): integer;
+var Params: Cardinal;
+begin
+ Result := -1;
+
+ {$IFDEF win32}
+ If (ptr(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;
+
+ //Anzeigen:
+ Result := Messagebox(0, ptr(lParam), PChar(Name), Params);
+ end;
+ {$ENDIF}
+
+ // to-do : write ShowMessage for other OSes
+end;
+
+end.
\ No newline at end of file diff --git a/Game/Code/Classes/UCoreModule.pas b/Game/Code/Classes/UCoreModule.pas new file mode 100644 index 00000000..4d36f925 --- /dev/null +++ b/Game/Code/Classes/UCoreModule.pas @@ -0,0 +1,105 @@ +unit UCoreModule;
+
+interface
+{*********************
+ TCoreModule
+ Dummy Class that has Methods that will be called from Core
+ In the Best case every Piece of this Software is a Module
+*********************}
+
+{$IFDEF FPC}
+ {$MODE Delphi} +{$ENDIF}
+
+type
+ PModuleInfo = ^TModuleInfo;
+ TModuleInfo = record
+ Name: String;
+ Version: LongWord;
+ Description: String;
+ end;
+
+ TCoreModule = class
+ public
+ //Function that gives some Infos about the Module to the Core
+ Procedure Info(const pInfo: PModuleInfo);
+
+ //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;
+ end;
+ cCoreModule = class of TCoreModule;
+
+implementation
+
+//-------------
+// 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;
+
+end.
\ No newline at end of file diff --git a/Game/Code/Classes/UHooks.pas b/Game/Code/Classes/UHooks.pas new file mode 100644 index 00000000..c73ccbbb --- /dev/null +++ b/Game/Code/Classes/UHooks.pas @@ -0,0 +1,375 @@ +unit UHooks;
+
+{*********************
+ THookManager
+ Class for saving, managing and calling of Hooks.
+ Saves all hookable events and their subscribers
+*********************}
+interface
+uses uPluginDefs, SysUtils, WINDOWS;
+
+{$IFDEF FPC}
+ {$MODE Delphi} +{$ENDIF} + +{$I switches.inc}
+
+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
+
+ //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)
+ 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, lParam: LongWord): Integer;
+ Function EventExists (const EventName: PChar): Integer;
+ end;
+
+function HookTest(wParam, lParam: DWord): integer; stdcall;
+function HookTest2(wParam, lParam: DWord): integer; stdcall;
+
+var
+ HookManager: THookManager;
+
+implementation
+
+//------------
+// Create - Creates Class and Set Standard Values
+//------------
+constructor THookManager.Create(const SpacetoAllocate: Word);
+var I: Integer;
+begin
+ //Get the Space and "Zero" it
+ SetLength (Events, SpacetoAllocate);
+ For I := 0 to SpacetoAllocate do
+ Events[I].Name[1] := chr(0);
+
+ SpaceinEvents := SpacetoAllocate;
+
+ {$IFDEF DEBUG}
+ WriteLn('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}
+ WriteLn('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}
+ WriteLn('HookManager: Add Event succesful: ''' + EventName + '');
+ {$ENDIF}
+ end
+ {$IFDEF DEBUG}
+ else
+ WriteLn('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}
+ WriteLn('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
+ WriteLn('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: Cardinal;
+ 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;
+
+ 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}
+ WriteLn('HookManager: Add Subscriber to Event ''' + Events[EventIndex].Name + ''' succesful. Handle: ''' + InttoStr(Result) + '');
+ {$ENDIF}
+ end;
+ end;
+end;
+
+//------------
+// DelSubscriber - Deletes a Subscribtion by Handle, return non Zero on Failure
+//------------
+Function THookManager.DelSubscriber (const hSubscriber: THandle): Integer;
+var
+ EventIndex: Cardinal;
+ 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
+ //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));
+
+ {$IFDEF DEBUG}
+ WriteLn('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, lParam: LongWord): Integer;
+var
+ EventIndex: Cardinal;
+ Cur: PSubscriberInfo;
+begin
+ Result := -1;
+ EventIndex := hEvent - 1;
+
+ If ((EventIndex <= High(Events)) AND (Events[EventIndex].Name[1] <> chr(0))) then
+ begin //Existing Event
+ //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
+ if (Cur.isClass) then
+ Result := Cur.ProcOfClass(wParam, lParam)
+ else
+ Result := Cur.Proc(wParam, lParam);
+
+ Cur := Cur.Next;
+ end;
+ end;
+
+ {$IFDEF DEBUG}
+ WriteLn('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;
+
+
+function HookTest(wParam, lParam: DWord): integer; stdcall;
+var Test: String[60];
+var T2: String;
+begin
+ Messagebox(0, 'Test', 'test', MB_ICONWARNING or MB_OK);
+
+ Result := 0; //Don't break the chain
+end;
+
+function HookTest2(wParam, lParam: DWord): integer; stdcall;
+begin
+ //Showmessage(String(PCHAR(Ptr(lParam)));
+ Messagebox(0, Ptr(lParam), 'test', MB_ICONWARNING or MB_OK);
+
+ Result := 0; //Don't break the chain
+end;
+
+end.
diff --git a/Game/Code/Classes/UModules.pas b/Game/Code/Classes/UModules.pas new file mode 100644 index 00000000..e8e759ff --- /dev/null +++ b/Game/Code/Classes/UModules.pas @@ -0,0 +1,20 @@ +unit UModules;
+
+interface
+{*********************
+ UModules
+ Unit Contains all used Modules in its uses clausel
+ and a const with an array of all Modules to load
+*********************}
+
+uses
+ UCoreModule;
+
+const
+ CORE_MODULES_TO_LOAD: Array[0..0] of cCoreModule = (
+ TCoreModule //Remove this later, just a dummy
+ );
+
+implementation
+
+end.
\ No newline at end of file diff --git a/Game/Code/Classes/UServices.pas b/Game/Code/Classes/UServices.pas new file mode 100644 index 00000000..fce81bd8 --- /dev/null +++ b/Game/Code/Classes/UServices.pas @@ -0,0 +1,312 @@ +unit UServices;
+
+interface
+uses uPluginDefs, SysUtils;
+{*********************
+ TServiceManager
+ Class for saving, managing and calling of Services.
+ Saves all Services and their Procs
+*********************}
+
+{$IFDEF FPC}
+ {$MODE Delphi} +{$ENDIF} + +{$I switches.inc}
+
+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, lParam: dWord): integer;
+
+ Function NametoHash(const ServiceName: TServiceName): Integer;
+ Function ServiceExists(const ServiceName: PChar): Integer;
+ end;
+
+var
+ ServiceManager: TServiceManager;
+
+implementation
+
+//------------
+// Create - Creates Class and Set Standard Values
+//------------
+Constructor TServiceManager.Create;
+begin
+ FirstService := nil;
+ LastService := nil;
+
+ ServiceCache[0] := nil;
+ ServiceCache[1] := nil;
+ ServiceCache[2] := nil;
+ ServiceCache[3] := nil;
+
+ NextCacheItem := 0;
+
+ NextHandle := 1;
+
+ {$IFDEF DEBUG}
+ WriteLn('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 Service to the List
+ If (FirstService = nil) then
+ FirstService := Cur;
+
+ If (LastService <> nil) then
+ LastService.Next := Cur;
+
+ LastService := Cur;
+
+ {$IFDEF DEBUG}
+ WriteLn('ServiceManager: Service added: ''' + ServiceName + ''', Handle: ' + InttoStr(Cur.Self));
+ {$ENDIF}
+
+ //Inc Next Handle
+ Inc(NextHandle);
+ end
+ {$IFDEF DEBUG}
+ else WriteLn('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}
+ WriteLn('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, lParam: dWord): integer;
+var
+ SExists: Integer;
+ Service: PServiceInfo;
+begin
+ Result := SERVICE_NOT_FOUND;
+ SExists := ServiceExists(ServiceName);
+ If (SExists <> 0) then
+ begin
+ Service := ptr(SExists);
+ If (Service.isClass) then
+ //Use Proc of Class
+ Result := Service.ProcOfClass(wParam, lParam)
+ Else
+ //Use normal Proc
+ Result := Service.Proc(wParam, lParam);
+ end;
+
+ {$IFDEF DEBUG}
+ WriteLn('ServiceManager: Service ''' + ServiceName + ''' called. Result: ' + InttoStr(Result));
+ {$ENDIF}
+end;
+
+//------------
+// Generates the Hash for the given Name
+//------------
+Function TServiceManager.NametoHash(const ServiceName: TServiceName): Integer;
+asm
+ { CL: Counter; EAX: Result; EDX: Current Memory Address }
+ Mov CL, 14 {Init Counter, Fold 14 Times to became 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;
+
+
+//------------
+// 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}
+ WriteLn('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}
+ WriteLn('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.
\ No newline at end of file diff --git a/Game/Code/Classes/USingScores.pas b/Game/Code/Classes/USingScores.pas index 7625c17c..11f1f07d 100644 --- a/Game/Code/Classes/USingScores.pas +++ b/Game/Code/Classes/USingScores.pas @@ -374,7 +374,6 @@ end; Procedure TSingScores.SpawnPopUp(const PlayerIndex: Byte; const Rating: Byte; const Score: Word);
var Cur: PScorePopUp;
begin
- Log.LogError('Spawn PopUp: Score: ' + InttoStr(Score));
if (PlayerIndex < PlayerCount) then
begin
//Get Memory and Add Data
diff --git a/Game/Code/UltraStar.dpr b/Game/Code/UltraStar.dpr index b9fa0530..b154c653 100644 --- a/Game/Code/UltraStar.dpr +++ b/Game/Code/UltraStar.dpr @@ -1,8 +1,5 @@ program UltraStar;
-{$DEFINE TRANSLATE}
-{$DEFINE DEBUG} //Remove b4 release
-
{$R 'UltraStar.res' 'UltraStar.rc'}
{$I switches.inc}
@@ -99,11 +96,11 @@ uses USingNotes in 'Classes\USingNotes.pas',
//New Plugin and Core Management
- {ULists in 'Classes\ULists.pas', //maybe drop this
- UHooks in 'Classes\UHooks.pas', //80 % - Whiteshark is about to work on this
- UServices in 'Classes\UServices.pas', //20 % - Whiteshark is about to work on this
- UCore in 'Classes\UCore.pas',
- UCoreModule in 'Classes\UCoreModule.pas', }
+ UModules in 'Classes\UModules.pas', //This Unit contains a const with the Modules to Load
+ UHooks in 'Classes\UHooks.pas', //Class for Hook Management //Write Freeing Methods for Both
+ UServices in 'Classes\UServices.pas', //95% - One Hack to remove ;)
+ UCore in 'Classes\UCore.pas', //30 % - Many Classes needs Rewriting or Manipulation
+ UCoreModule in 'Classes\UCoreModule.pas',
UPluginInterface in 'Classes\UPluginInterface.pas', //Some changes to work with unwriten classes, need to be done
//------------------------------
@@ -191,7 +188,7 @@ begin Inc(I);
hWnd := FindWindow(nil, PChar(WndTitle + ' Instance ' + InttoStr(I)));
until (hWnd = 0);
-
+ MessageBox(
WndTitle := WndTitle + ' Instance ' + InttoStr(I);
end
else
diff --git a/Game/Code/switches.inc b/Game/Code/switches.inc index fda3cd75..4e5deb2d 100644 --- a/Game/Code/switches.inc +++ b/Game/Code/switches.inc @@ -1,3 +1,5 @@ +{$DEFINE DEBUG} // to-do : Remove b4 release
+
{$IFDEF FPC}
{$UNDEF UseSerialPort}
{$UNDEF UseMIDIPort}
|