diff options
Diffstat (limited to '')
-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 | ||||
-rw-r--r-- | Modis/SDK/Hooks.txt | 19 | ||||
-rw-r--r-- | Modis/SDK/Plugin DLL Exports.txt | 0 | ||||
-rw-r--r-- | Modis/SDK/Services.txt | 9 | ||||
-rw-r--r-- | Modis/SDK/UPluginDefs.pas | 45 |
12 files changed, 1167 insertions, 14 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}
diff --git a/Modis/SDK/Hooks.txt b/Modis/SDK/Hooks.txt new file mode 100644 index 00000000..32237694 --- /dev/null +++ b/Modis/SDK/Hooks.txt @@ -0,0 +1,19 @@ +Ultrastar Deluxe Hook List
+-----------------------------------
+Here you can find the Events the Core offers to you:
+
+--------------------
+Core:
+--------------------
+Core/LoadingFinished <- Hook is called after all Modules and Plugins are loaded completely, before MainLoop
+Core/MainLoop <- Hook is called once in MainLoop before Drawing
+Core/LoadTextures <- Hook is called when Textures should be Loaded. This will be called in Ogl Thread. If Textures are Reloaded (e.g. on Display ReInit) LParam is non Zero.
+Core/ExitQuery <- Hook is called if someone querys an exit. (e.g. X is pressed). Not called on ForcedExit. If Chain is breaked the exit will be aborted.
+Core/Exit <- Hook is called before Module a. Plugin unload.
+Core/NewDebugInfo <- Hook is called everytime there is Debug Info to Output(only if Debug Mode is enabled). wParam: Pchar(Message), lParam: PChar(Reportername)
+Core/NewError <- Hook is called everytime an error is reported. wParam: Pchar(Message), lParam: PChar(Reportername)
+
+--------------------
+Display
+--------------------
+Display/onScreenChange <-Hook is called when there is an attemp to change Screen. wParam is address to Screens Name(Null Terminated). If Chain is breaked Screenchange will be aborted.
\ No newline at end of file diff --git a/Modis/SDK/Plugin DLL Exports.txt b/Modis/SDK/Plugin DLL Exports.txt new file mode 100644 index 00000000..e69de29b --- /dev/null +++ b/Modis/SDK/Plugin DLL Exports.txt diff --git a/Modis/SDK/Services.txt b/Modis/SDK/Services.txt new file mode 100644 index 00000000..ae8f4097 --- /dev/null +++ b/Modis/SDK/Services.txt @@ -0,0 +1,9 @@ +Ultrastar Deluxe Hook List
+-----------------------------------
+Here you can find the Services the Core offers to you:
+
+--------------------
+Core:
+--------------------
+Core/ReportError <- Calls the 'Core/NewError' Chain. wParam: Pchar(Message), lParam: PChar(Reportername)
+Core/ReportDebug <- Calls the 'Core/NewDebugInfo' Chain. wParam: Pchar(Message), lParam: PChar(Reportername)
\ No newline at end of file diff --git a/Modis/SDK/UPluginDefs.pas b/Modis/SDK/UPluginDefs.pas index 7428ae2e..42f888e4 100644 --- a/Modis/SDK/UPluginDefs.pas +++ b/Modis/SDK/UPluginDefs.pas @@ -13,6 +13,12 @@ type //----------------
// TUS_PluginInfo - Some Infos from Plugin to Core.
// Send when Plugininfo procedure is Called
+ // ---
+ // Version Structure:
+ // First Byte: Head Revison
+ // Second Byte: Sub Revison
+ // Third Byte: Sub Revision 2
+ // Fourth Byte: Letter (For Bug Fix releases. 0 or 'a' .. 'z')
//----------------
PUS_PluginInfo = ^TUS_PluginInfo;
TUS_PluginInfo = record
@@ -30,7 +36,7 @@ type // TUS_Hook - Structure of the Hook Function
// Return 0 if the Hook should be continue,
// or a non zero Value, if the Hook should be Interuped
- // In this Case the Caller of the Notivier gets the Return Value
+ // In this Case the Caller of the Notifier gets the Return Value
// Return Value Should not be -1
//----------------
TUS_Hook = Function (wParam, lParam: DWord): integer; stdcall;
@@ -54,7 +60,7 @@ type {Function Creates a new Hookable Event and Returns the Handle
or 0 on Failure. (Name already exists)}
CreateHookableEvent: Function (EventName: PChar): THandle; stdcall;
-
+
{Function Destroys an Event and Unhooks all Hooks to this Event.
0 on success, not 0 on Failure}
DestroyHookableEvent: Function (hEvent: THandle): integer; stdcall;
@@ -80,7 +86,7 @@ type {Function Creates a new Service and Returns the Services Handle
or 0 on Failure. (Name already exists)}
CreateService: Function (ServiceName: PChar; ServiceProc: TUS_Service): THandle; stdcall;
-
+
{Function Destroys a Service.
0 on success, not 0 on Failure}
DestroyService: Function (hService: THandle): integer; stdcall;
@@ -98,10 +104,41 @@ type // Some Default Constants
//----------------
const
- {Returned if Service is not Found from CallService}
+ {Returned if Service is not found from CallService}
SERVICE_NOT_FOUND=$80000000;
+ CORE_SM_NOSYMBOL= 0;
+ CORE_SM_ERROR = 1;
+ CORE_SM_WARNING = 2;
+ CORE_SM_INFO = 3;
+
+//----------------
+// Some Functions to Handle Version DWords
+//----------------
+Function MakeVersion(const HeadRevision, SubVersion, SubVersion2: Byte; Letter: Char): DWord;
+Function VersiontoSting(const Version: DWord): String;
+
implementation
+//--------------
+// MakeVersion - Converts 4 Values to a valid Version DWord
+//--------------
+Function MakeVersion(const HeadRevision, SubVersion, SubVersion2: Byte; Letter: Char): DWord;
+begin
+ If (letter < 'a') or (Letter > 'z') then
+ letter := chr(0);
+
+ Result := (HeadRevision shl 24) or (SubVersion shl 16) or (SubVersion2 shl 8) or Ord(Letter);
+end;
+
+//--------------
+// VersiontoString - Returns some beauty '1.0.2a' like String
+//--------------
+Function VersiontoSting(const Version: DWord): String;
+begin // to-do : Write VersiontoString without SysUtils depencies
+ //Result := InttoStr((ver and $FF000000) shr 24);
+ Result := '1.0.1
+end;
+
end.
|