aboutsummaryrefslogtreecommitdiffstats
path: root/Game/Code/Classes
diff options
context:
space:
mode:
Diffstat (limited to 'Game/Code/Classes')
-rw-r--r--Game/Code/Classes/TextGL.pas10
-rw-r--r--Game/Code/Classes/UAudio_FFMpeg.pas8
-rw-r--r--Game/Code/Classes/UAudio_bass.pas20
-rw-r--r--Game/Code/Classes/UCatCovers.pas3
-rw-r--r--Game/Code/Classes/UCommandLine.pas3
-rw-r--r--Game/Code/Classes/UCommon.pas196
-rw-r--r--Game/Code/Classes/UCore.pas985
-rw-r--r--Game/Code/Classes/UCoreModule.pas7
-rw-r--r--Game/Code/Classes/UCovers.pas4
-rw-r--r--Game/Code/Classes/UDLLManager.pas17
-rw-r--r--Game/Code/Classes/UDataBase.pas5
-rw-r--r--Game/Code/Classes/UDraw.pas8
-rw-r--r--Game/Code/Classes/UFiles.pas4
-rw-r--r--Game/Code/Classes/UGraphic.pas4
-rw-r--r--Game/Code/Classes/UGraphicClasses.pas4
-rw-r--r--Game/Code/Classes/UHooks.pas9
-rw-r--r--Game/Code/Classes/UIni.pas4
-rw-r--r--Game/Code/Classes/ULCD.pas1
-rw-r--r--Game/Code/Classes/ULanguage.pas6
-rw-r--r--Game/Code/Classes/ULight.pas8
-rw-r--r--Game/Code/Classes/ULog.pas10
-rw-r--r--Game/Code/Classes/ULyrics.pas4
-rw-r--r--Game/Code/Classes/ULyrics_bak.pas4
-rw-r--r--Game/Code/Classes/UMain.pas275
-rw-r--r--Game/Code/Classes/UMedia_dummy.pas5
-rw-r--r--Game/Code/Classes/UModules.pas3
-rw-r--r--Game/Code/Classes/UMusic.pas4
-rw-r--r--Game/Code/Classes/UParty.pas5
-rw-r--r--Game/Code/Classes/UPlaylist.pas6
-rw-r--r--Game/Code/Classes/UPliki.pas2
-rw-r--r--Game/Code/Classes/UPluginInterface.pas3
-rw-r--r--Game/Code/Classes/URecord.pas4
-rw-r--r--Game/Code/Classes/UServices.pas11
-rw-r--r--Game/Code/Classes/USingNotes.pas3
-rw-r--r--Game/Code/Classes/USingScores.pas8
-rw-r--r--Game/Code/Classes/USkins.pas7
-rw-r--r--Game/Code/Classes/USongs.pas88
-rw-r--r--Game/Code/Classes/UTextClasses.pas3
-rw-r--r--Game/Code/Classes/UTexture.pas12
-rw-r--r--Game/Code/Classes/UThemes.pas4
-rw-r--r--Game/Code/Classes/UTime.pas4
-rw-r--r--Game/Code/Classes/UVideo.pas4
-rw-r--r--Game/Code/Classes/uPluginLoader.pas1582
43 files changed, 1825 insertions, 1532 deletions
diff --git a/Game/Code/Classes/TextGL.pas b/Game/Code/Classes/TextGL.pas
index fbe9a050..af60c4ff 100644
--- a/Game/Code/Classes/TextGL.pas
+++ b/Game/Code/Classes/TextGL.pas
@@ -2,9 +2,7 @@ unit TextGL;
interface
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
+{$I switches.inc}
uses OpenGL12,
@@ -80,7 +78,7 @@ uses UMain,
lcltype,
{$ENDIF}
SysUtils,
- {$IFDEF FPC}
+ {$IFDEF LAZARUS}
LResources,
{$ENDIF}
UGraphic;
@@ -88,7 +86,7 @@ uses UMain,
procedure BuildFont; // Build Our Bitmap Font
procedure loadfont( aID : integer; aType, aResourceName : String);
- {$IFDEF FPC}
+ {$IFDEF LAZARUS}
var
lLazRes : TLResource;
lResData : TStringStream;
@@ -541,7 +539,7 @@ begin
end;
-{$IFDEF FPC}
+{$IFDEF LAZARUS}
{$IFDEF win32}
initialization
{$I UltraStar.lrs}
diff --git a/Game/Code/Classes/UAudio_FFMpeg.pas b/Game/Code/Classes/UAudio_FFMpeg.pas
index 35822a3b..675dfd3c 100644
--- a/Game/Code/Classes/UAudio_FFMpeg.pas
+++ b/Game/Code/Classes/UAudio_FFMpeg.pas
@@ -13,9 +13,7 @@ This unit is primarily based upon -
interface
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
+{$I switches.inc}
uses Classes,
@@ -67,7 +65,7 @@ type
implementation
uses
- {$IFDEF FPC}
+ {$IFDEF LAZARUS}
lclintf,
libc,
{$ENDIF}
@@ -590,7 +588,7 @@ begin
len1 := len;
- {$ifdef win32}
+ {$ifdef WIN32}
lSrc := PUInt8( integer( laudio_buf ) + audio_buf_index );
CopyMemory(stream, lSrc , len1);
{$else}
diff --git a/Game/Code/Classes/UAudio_bass.pas b/Game/Code/Classes/UAudio_bass.pas
index 985eede5..463a6c7f 100644
--- a/Game/Code/Classes/UAudio_bass.pas
+++ b/Game/Code/Classes/UAudio_bass.pas
@@ -2,9 +2,7 @@ unit UAudio_bass;
interface
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
+{$I switches.inc}
uses Classes,
@@ -24,7 +22,7 @@ uses Classes,
implementation
uses
- {$IFDEF FPC}
+ {$IFDEF LAZARUS}
lclintf,
{$ENDIF}
URecord,
@@ -111,7 +109,7 @@ var
function TAudio_bass.GetName: String;
begin
- result := 'BASS';
+ result := 'BASS';
end;
procedure TAudio_bass.InitializePlayback;
@@ -637,11 +635,11 @@ initialization
writeln( 'UAudio_Bass - Register Input' );
AudioManager.add( IAudioInput( singleton_MusicBass ) );
-finalization
- writeln( 'UAudio_Bass - UnRegister Playback' );
- AudioManager.Remove( IAudioPlayback( singleton_MusicBass ) );
-
- writeln( 'UAudio_Bass - UnRegister Input' );
- AudioManager.Remove( IAudioInput( singleton_MusicBass ) );
+finalization
+ writeln( 'UAudio_Bass - UnRegister Playback' );
+ AudioManager.Remove( IAudioPlayback( singleton_MusicBass ) );
+
+ writeln( 'UAudio_Bass - UnRegister Input' );
+ AudioManager.Remove( IAudioInput( singleton_MusicBass ) );
end.
diff --git a/Game/Code/Classes/UCatCovers.pas b/Game/Code/Classes/UCatCovers.pas
index d40b2564..b1c91e48 100644
--- a/Game/Code/Classes/UCatCovers.pas
+++ b/Game/Code/Classes/UCatCovers.pas
@@ -5,6 +5,9 @@ unit UCatCovers;
/////////////////////////////////////////////////////////////////////////
interface
+
+{$I switches.inc}
+
uses UIni;
type
diff --git a/Game/Code/Classes/UCommandLine.pas b/Game/Code/Classes/UCommandLine.pas
index 259c6e16..1539ffaf 100644
--- a/Game/Code/Classes/UCommandLine.pas
+++ b/Game/Code/Classes/UCommandLine.pas
@@ -2,6 +2,9 @@ unit UCommandLine;
interface
+{$I switches.inc}
+
+
type
//-----------
// TCMDParams - Class Reaads Infos from ParamStr and set some easy Interface Variables
diff --git a/Game/Code/Classes/UCommon.pas b/Game/Code/Classes/UCommon.pas
index 44ec6bb3..b532f775 100644
--- a/Game/Code/Classes/UCommon.pas
+++ b/Game/Code/Classes/UCommon.pas
@@ -2,16 +2,17 @@ unit UCommon;
interface
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
+{$I switches.inc}
uses
SysUtils,
-{$IFDEF FPC}
+{$IFDEF LAZARUS}
lResources,
{$ENDIF}
ULog,
+{$IFDEF DARWIN}
+ messages,
+{$ENDIF}
{$IFDEF win32}
windows;
{$ELSE}
@@ -27,22 +28,23 @@ type
TWin32FindData = LongInt;
{$ENDIF}
-{$IFDEF FPC}
-
-type
- TWndMethod = procedure(var Message: TMessage) of object;
+{$IFDEF LAZARUS}
+ function LazFindResource( const aName, aType : String ): TLResource;
+{$ENDIF}
-function LazFindResource( const aName, aType : String ): TLResource;
+{$IFDEF FPC}
function RandomRange(aMin: Integer; aMax: Integer) : Integer;
function MaxValue(const Data: array of Double): Double;
function MinValue(const Data: array of Double): Double;
-{$IFDEF Win32}
-function AllocateHWnd(Method: TWndMethod): HWND;
-procedure DeallocateHWnd(Wnd: HWND);
-{$ENDIF} // Win32
+ {$IFDEF WIN32}
+ type
+ TWndMethod = procedure(var Message: TMessage) of object;
+ function AllocateHWnd(Method: TWndMethod): HWND;
+ procedure DeallocateHWnd(Wnd: HWND);
+ {$ENDIF} // Win32
{$ENDIF} // FPC Only
@@ -58,24 +60,24 @@ function AdaptFilePaths( const aPath : widestring ): widestring;
procedure ZeroMemory( Destination: Pointer; Length: DWORD );
{$ENDIF}
-{$IFDEF Win32}
+{$IFDEF MSWINDOWS}
type
TSearchRecW = record
- Time: Integer;
- Size: Integer;
- Attr: Integer;
- Name: WideString;
- ExcludeAttr: Integer;
- FindHandle: THandle;
- FindData: TWin32FindDataW;
- end;
-
- function FindFirstW(const Path: WideString; Attr: Integer; var F: TSearchRecW): Integer;
- function FindNextW(var F: TSearchRecW): Integer;
- procedure FindCloseW(var F: TSearchRecW);
- function FindMatchingFileW(var F: TSearchRecW): Integer;
- function DirectoryExistsW(const Directory: widestring): Boolean;
+ Time: Integer;
+ Size: Integer;
+ Attr: Integer;
+ Name: WideString;
+ ExcludeAttr: Integer;
+ FindHandle: THandle;
+ FindData: TWin32FindDataW;
+ end;
+
+ function FindFirstW(const Path: WideString; Attr: Integer; var F: TSearchRecW): Integer;
+ function FindNextW(var F: TSearchRecW): Integer;
+ procedure FindCloseW(var F: TSearchRecW);
+ function FindMatchingFileW(var F: TSearchRecW): Integer;
+ function DirectoryExistsW(const Directory: widestring): Boolean;
{$endif}
implementation
@@ -143,7 +145,7 @@ end;
{$ENDIF}
-{$IFDEF FPC}
+{$IFDEF LAZARUS}
function LazFindResource( const aName, aType : String ): TLResource;
var
@@ -161,7 +163,9 @@ begin
end;
end;
end;
+{$ENDIF}
+{$IFDEF FPC}
function MaxValue(const Data: array of Double): Double;
var
I: Integer;
@@ -191,7 +195,7 @@ end;
// NOTE !!!!!!!!!!
// AllocateHWnd is in lclintfh.inc
-{$IFDEF Win32}
+{$IFDEF MSWINDOWS}
// TODO : JB this is dodgey and bad... find a REAL solution !
function AllocateHWnd(Method: TWndMethod): HWND;
var
@@ -209,72 +213,82 @@ begin
DestroyWindow(Wnd);
end;
{$ENDIF}
+{$IFDEF DARWIN}
+// TODO : Situation for the mac isn't better !
+function AllocateHWnd(Method: TWndMethod): HWND;
+begin
+end;
+
+procedure DeallocateHWnd(Wnd: HWND);
+begin
+end;
+{$ENDIF}
+
-
{$ENDIF}
-{$ifdef win32}
-function FindFirstW(const Path: widestring; Attr: Integer; var F: TSearchRecW): Integer;
-const
- faSpecial = faHidden or faSysFile or faVolumeID or faDirectory;
-begin
- F.ExcludeAttr := not Attr and faSpecial;
- F.FindHandle := FindFirstFileW(PWideChar(Path), F.FindData);
- if F.FindHandle <> INVALID_HANDLE_VALUE then
- begin
- Result := FindMatchingFileW(F);
- if Result <> 0 then FindCloseW(F);
- end else
- Result := GetLastError;
-end;
-
-function FindNextW(var F: TSearchRecW): Integer;
-begin
- if FindNextFileW(F.FindHandle, F.FindData) then
- Result := FindMatchingFileW(F)
- else
- Result := GetLastError;
-end;
-
-procedure FindCloseW(var F: TSearchRecW);
-begin
- if F.FindHandle <> INVALID_HANDLE_VALUE then
- begin
- Windows.FindClose(F.FindHandle);
- F.FindHandle := INVALID_HANDLE_VALUE;
- end;
-end;
-
-function FindMatchingFileW(var F: TSearchRecW): Integer;
-var
- LocalFileTime: TFileTime;
-begin
- with F do
- begin
- while FindData.dwFileAttributes and ExcludeAttr <> 0 do
- if not FindNextFileW(FindHandle, FindData) then
- begin
- Result := GetLastError;
- Exit;
- end;
- FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
- FileTimeToDosDateTime(LocalFileTime, LongRec(Time).Hi, LongRec(Time).Lo);
- Size := FindData.nFileSizeLow;
- Attr := FindData.dwFileAttributes;
- Name := FindData.cFileName;
- end;
- Result := 0;
-end;
-
-function DirectoryExistsW(const Directory: widestring): Boolean;
-var
- Code: Integer;
-begin
- Code := GetFileAttributesW(PWideChar(Directory));
- Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
-end;
+{$ifdef MSWINDOWS}
+function FindFirstW(const Path: widestring; Attr: Integer; var F: TSearchRecW): Integer;
+const
+ faSpecial = faHidden or faSysFile or faVolumeID or faDirectory;
+begin
+ F.ExcludeAttr := not Attr and faSpecial;
+ F.FindHandle := FindFirstFileW(PWideChar(Path), F.FindData);
+ if F.FindHandle <> INVALID_HANDLE_VALUE then
+ begin
+ Result := FindMatchingFileW(F);
+ if Result <> 0 then FindCloseW(F);
+ end else
+ Result := GetLastError;
+end;
+
+function FindNextW(var F: TSearchRecW): Integer;
+begin
+ if FindNextFileW(F.FindHandle, F.FindData) then
+ Result := FindMatchingFileW(F)
+ else
+ Result := GetLastError;
+end;
+
+procedure FindCloseW(var F: TSearchRecW);
+begin
+ if F.FindHandle <> INVALID_HANDLE_VALUE then
+ begin
+ Windows.FindClose(F.FindHandle);
+ F.FindHandle := INVALID_HANDLE_VALUE;
+ end;
+end;
+
+function FindMatchingFileW(var F: TSearchRecW): Integer;
+var
+ LocalFileTime: TFileTime;
+begin
+ with F do
+ begin
+ while FindData.dwFileAttributes and ExcludeAttr <> 0 do
+ if not FindNextFileW(FindHandle, FindData) then
+ begin
+ Result := GetLastError;
+ Exit;
+ end;
+ FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
+ FileTimeToDosDateTime(LocalFileTime, LongRec(Time).Hi, LongRec(Time).Lo);
+ Size := FindData.nFileSizeLow;
+ Attr := FindData.dwFileAttributes;
+ Name := FindData.cFileName;
+ end;
+ Result := 0;
+end;
+
+function DirectoryExistsW(const Directory: widestring): Boolean;
+var
+ Code: Integer;
+begin
+ Code := GetFileAttributesW(PWideChar(Directory));
+ Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
+end;
{$endif}
diff --git a/Game/Code/Classes/UCore.pas b/Game/Code/Classes/UCore.pas
index 9c31e79a..091868f2 100644
--- a/Game/Code/Classes/UCore.pas
+++ b/Game/Code/Classes/UCore.pas
@@ -1,495 +1,492 @@
-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;
- 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;
-
- //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
-
- LastErrorReporter:String; //Who Reported the Last Error String
- LastErrorString: String; //Last Error String reported
-
-
- //---------------
- //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, lParam: DWord): integer; //Shows a Message (lParam: PChar Text, wParam: Symbol)
- Function ReportError(wParam, lParam: DWord): integer; //Shows a Message (wParam: Pchar(Message), lParam: PChar(Reportername))
- Function ReportDebug(wParam, lParam: DWord): integer; //Shows a Message (wParam: Pchar(Message), lParam: PChar(Reportername))
- Function Retranslate(wParam, lParam: DWord): integer; //Calls Translate hook
- Function ReloadTextures(wParam, lParam: DWord): integer; //Calls LoadTextures hook
- Function GetModuleInfo(wParam, lParam: DWord): 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, lParam: DWord): integer; //Returns Application Handle
- end;
-
-var
- Core: TCore;
-
-implementation
-uses SysUtils,
-{$IFDEF win32}
-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;
-
- 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
- noError: Boolean;
-begin
- //Get Modules
- Try
- noError := GetModules;
- Except
- noError := False;
- end;
-
- //Loading
- if (noError) then
- begin
- Try
- noError := Load;
- Except
- noError := False;
- end;
-
- if (noError) then
- begin //Init
- Try
- noError := Init;
- Except
- noError := False;
- end;
-
- If noError then
- begin
- //Call Translate Hook
- noError := (Hooks.CallEventChain(hTranslate, 0, 0) = 0);
-
- If noError then
- begin //Calls LoadTextures Hook
- noError := (Hooks.CallEventChain(hLoadTextures, 0, 0) = 0);
-
- if noError then
- begin //Calls Loading Finished Hook
- noError := (Hooks.CallEventChain(hLoadingFinished, 0, 0) = 0);
-
- If noError then
- begin
- //Start MainLoop
- While noError do
- begin
- noError := MainLoop;
- // to-do : Call Display Draw here
- end;
- end
- else
- begin
- If (LastErrorString <> '') then
- Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error calling LoadingFinished Hook: ' + LastErrorString)))
- else
- Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error calling LoadingFinished Hook')));
- end;
- end
- else
- begin
- If (LastErrorString <> '') then
- Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error loading textures: ' + LastErrorString)))
- else
- Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error loading textures')));
- end;
- end
- else
- begin
- If (LastErrorString <> '') then
- Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error translating: ' + LastErrorString)))
- else
- Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error translating')));
- end;
-
- end
- else
- begin
- If (LastErrorString <> '') then
- Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error initing Modules: ' + LastErrorString)))
- else
- Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error initing Modules')));
- end;
- end
- else
- begin
- If (LastErrorString <> '') then
- Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error loading Modules: ' + LastErrorString)))
- else
- Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error loading Modules')));
- end;
- end
- else
- begin
- If (LastErrorString <> '') then
- Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error Getting Modules: ' + LastErrorString)))
- else
- Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error Getting Modules')));
- end;
-
- //DeInit
- DeInit;
-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;
- try
- 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;
- Result := True;
- except
- ReportError(Integer(PChar('Can''t get module #' + InttoStr(I) + ' "' + Modules[I].Info.Name + '"')), Integer(PChar('Core')));
- 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
- try
- Result := Modules[I].Module.Load;
- except
- Result := False;
- ReportError(Integer(PChar('Error loading module #' + InttoStr(I) + ' "' + Modules[I].Info.Name + '"')), Integer(PChar('Core')));
- end;
-
- Inc(I);
- end;
-end;
-
-//-------------
-//Inits Core and all Modules
-//-------------
-Function TCore.Init: Boolean;
-var
- I: Integer;
-begin
- Result := InitCore;
-
- I := 0;
- While ((Result = True) AND (I <= High(CORE_MODULES_TO_LOAD))) do
- begin
- try
- Result := Modules[I].Module.Init;
- except
- Result := False;
- ReportError(Integer(PChar('Error initing module #' + InttoStr(I) + ' "' + Modules[I].Info.Name + '"')), Integer(PChar('Core')));
- end;
-
- Modules[I].NeedsDeInit := Result;
- Inc(I);
- end;
-end;
-
-//-------------
-//DeInits Core and all Modules
-//-------------
-Function TCore.DeInit: Boolean;
-var
- I: Integer;
-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
-
-
- end;
- If (I >= 0) then
- GoTo Continue;
-
- DeInitCore;
-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);
-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;
-
-//-------------
-//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
- If (Modules[I].Info.Name = Name) then
- begin
- Result := @Modules[I].Module;
- Break;
- end;
-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;
-
-//-------------
-// Calls NewError HookChain (wParam: Pchar(Message), lParam: PChar(Reportername))
-//-------------
-Function TCore.ReportError(wParam, lParam: DWord): integer;
-begin
- //Update LastErrorReporter and LastErrorString
- LastErrorReporter := String(PChar(Ptr(lParam)));
- LastErrorString := String(PChar(Ptr(wParam)));
-
- Hooks.CallEventChain(hError, wParam, lParam);
-end;
-
-//-------------
-// Calls NewDebugInfo HookChain (wParam: Pchar(Message), lParam: PChar(Reportername))
-//-------------
-Function TCore.ReportDebug(wParam, lParam: DWord): integer;
-begin
- Hooks.CallEventChain(hDebug, wParam, lParam);
-end;
-
-//-------------
-// Calls Translate hook
-//-------------
-Function TCore.Retranslate(wParam, lParam: DWord): integer;
-begin
- Hooks.CallEventChain(hTranslate, 0, 1);
-end;
-
-//-------------
-// Calls LoadTextures hook
-//-------------
-Function TCore.ReloadTextures(wParam, lParam: DWord): integer;
-begin
- Hooks.CallEventChain(hLoadTextures, 0, 1);
-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, lParam: DWord): integer;
-begin
- if (ptr(lParam) = nil) then
- begin
- Result := Length(Modules);
- end
- else
- begin
- Try
- For Result := 0 to High(Modules) do
- begin
- AModuleInfo(ptr(lParam))[Result].Name := Modules[Result].Info.Name;
- AModuleInfo(ptr(lParam))[Result].Version := Modules[Result].Info.Version;
- AModuleInfo(ptr(lParam))[Result].Description := Modules[Result].Info.Description;
- end;
- Except
- Result := -1;
- end;
- end;
-end;
-
-//-------------
-// Returns Application Handle
-//-------------
-Function TCore.GetApplicationHandle(wParam, lParam: DWord): integer;
-begin
- Result := hInstance;
-end;
-
+unit UCore;
+
+interface
+
+{$I switches.inc}
+
+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 ;)
+*********************}
+
+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;
+
+ //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
+
+ LastErrorReporter:String; //Who Reported the Last Error String
+ LastErrorString: String; //Last Error String reported
+
+
+ //---------------
+ //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, lParam: DWord): integer; //Shows a Message (lParam: PChar Text, wParam: Symbol)
+ Function ReportError(wParam, lParam: DWord): integer; //Shows a Message (wParam: Pchar(Message), lParam: PChar(Reportername))
+ Function ReportDebug(wParam, lParam: DWord): integer; //Shows a Message (wParam: Pchar(Message), lParam: PChar(Reportername))
+ Function Retranslate(wParam, lParam: DWord): integer; //Calls Translate hook
+ Function ReloadTextures(wParam, lParam: DWord): integer; //Calls LoadTextures hook
+ Function GetModuleInfo(wParam, lParam: DWord): 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, lParam: DWord): integer; //Returns Application Handle
+ end;
+
+var
+ Core: TCore;
+
+implementation
+uses SysUtils,
+{$IFDEF win32}
+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;
+
+ 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
+ noError: Boolean;
+begin
+ //Get Modules
+ Try
+ noError := GetModules;
+ Except
+ noError := False;
+ end;
+
+ //Loading
+ if (noError) then
+ begin
+ Try
+ noError := Load;
+ Except
+ noError := False;
+ end;
+
+ if (noError) then
+ begin //Init
+ Try
+ noError := Init;
+ Except
+ noError := False;
+ end;
+
+ If noError then
+ begin
+ //Call Translate Hook
+ noError := (Hooks.CallEventChain(hTranslate, 0, 0) = 0);
+
+ If noError then
+ begin //Calls LoadTextures Hook
+ noError := (Hooks.CallEventChain(hLoadTextures, 0, 0) = 0);
+
+ if noError then
+ begin //Calls Loading Finished Hook
+ noError := (Hooks.CallEventChain(hLoadingFinished, 0, 0) = 0);
+
+ If noError then
+ begin
+ //Start MainLoop
+ While noError do
+ begin
+ noError := MainLoop;
+ // to-do : Call Display Draw here
+ end;
+ end
+ else
+ begin
+ If (LastErrorString <> '') then
+ Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error calling LoadingFinished Hook: ' + LastErrorString)))
+ else
+ Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error calling LoadingFinished Hook')));
+ end;
+ end
+ else
+ begin
+ If (LastErrorString <> '') then
+ Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error loading textures: ' + LastErrorString)))
+ else
+ Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error loading textures')));
+ end;
+ end
+ else
+ begin
+ If (LastErrorString <> '') then
+ Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error translating: ' + LastErrorString)))
+ else
+ Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error translating')));
+ end;
+
+ end
+ else
+ begin
+ If (LastErrorString <> '') then
+ Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error initing Modules: ' + LastErrorString)))
+ else
+ Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error initing Modules')));
+ end;
+ end
+ else
+ begin
+ If (LastErrorString <> '') then
+ Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error loading Modules: ' + LastErrorString)))
+ else
+ Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error loading Modules')));
+ end;
+ end
+ else
+ begin
+ If (LastErrorString <> '') then
+ Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error Getting Modules: ' + LastErrorString)))
+ else
+ Self.ShowMessage(CORE_SM_ERROR, Integer(PChar('Error Getting Modules')));
+ end;
+
+ //DeInit
+ DeInit;
+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;
+ try
+ 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;
+ Result := True;
+ except
+ ReportError(Integer(PChar('Can''t get module #' + InttoStr(I) + ' "' + Modules[I].Info.Name + '"')), Integer(PChar('Core')));
+ 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
+ try
+ Result := Modules[I].Module.Load;
+ except
+ Result := False;
+ ReportError(Integer(PChar('Error loading module #' + InttoStr(I) + ' "' + Modules[I].Info.Name + '"')), Integer(PChar('Core')));
+ end;
+
+ Inc(I);
+ end;
+end;
+
+//-------------
+//Inits Core and all Modules
+//-------------
+Function TCore.Init: Boolean;
+var
+ I: Integer;
+begin
+ Result := InitCore;
+
+ I := 0;
+ While ((Result = True) AND (I <= High(CORE_MODULES_TO_LOAD))) do
+ begin
+ try
+ Result := Modules[I].Module.Init;
+ except
+ Result := False;
+ ReportError(Integer(PChar('Error initing module #' + InttoStr(I) + ' "' + Modules[I].Info.Name + '"')), Integer(PChar('Core')));
+ end;
+
+ Modules[I].NeedsDeInit := Result;
+ Inc(I);
+ end;
+end;
+
+//-------------
+//DeInits Core and all Modules
+//-------------
+Function TCore.DeInit: Boolean;
+var
+ I: Integer;
+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
+
+
+ end;
+ If (I >= 0) then
+ GoTo Continue;
+
+ DeInitCore;
+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);
+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;
+
+//-------------
+//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
+ If (Modules[I].Info.Name = Name) then
+ begin
+ Result := @Modules[I].Module;
+ Break;
+ end;
+end;
+
+//-------------
+// Shows a MessageDialog (lParam: PChar Text, wParam: Symbol)
+//-------------
+Function TCore.ShowMessage(wParam, lParam: DWord): integer;
+var Params: Cardinal;
+begin
+ Result := -1;
+
+ {$IFDEF MSWINDOWS}
+ 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;
+
+//-------------
+// Calls NewError HookChain (wParam: Pchar(Message), lParam: PChar(Reportername))
+//-------------
+Function TCore.ReportError(wParam, lParam: DWord): integer;
+begin
+ //Update LastErrorReporter and LastErrorString
+ LastErrorReporter := String(PChar(Pointer(lParam)));
+ LastErrorString := String(PChar(Pointer(wParam)));
+
+ Hooks.CallEventChain(hError, wParam, lParam);
+end;
+
+//-------------
+// Calls NewDebugInfo HookChain (wParam: Pchar(Message), lParam: PChar(Reportername))
+//-------------
+Function TCore.ReportDebug(wParam, lParam: DWord): integer;
+begin
+ Hooks.CallEventChain(hDebug, wParam, lParam);
+end;
+
+//-------------
+// Calls Translate hook
+//-------------
+Function TCore.Retranslate(wParam, lParam: DWord): integer;
+begin
+ Hooks.CallEventChain(hTranslate, 0, 1);
+end;
+
+//-------------
+// Calls LoadTextures hook
+//-------------
+Function TCore.ReloadTextures(wParam, lParam: DWord): integer;
+begin
+ Hooks.CallEventChain(hLoadTextures, 0, 1);
+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, lParam: DWord): integer;
+begin
+ if (Pointer(lParam) = nil) then
+ begin
+ Result := Length(Modules);
+ end
+ else
+ begin
+ Try
+ For Result := 0 to High(Modules) do
+ begin
+ AModuleInfo(Pointer(lParam))[Result].Name := Modules[Result].Info.Name;
+ AModuleInfo(Pointer(lParam))[Result].Version := Modules[Result].Info.Version;
+ AModuleInfo(Pointer(lParam))[Result].Description := Modules[Result].Info.Description;
+ end;
+ Except
+ Result := -1;
+ end;
+ end;
+end;
+
+//-------------
+// Returns Application Handle
+//-------------
+Function TCore.GetApplicationHandle(wParam, lParam: DWord): integer;
+begin
+ Result := hInstance;
+end;
+
end. \ No newline at end of file
diff --git a/Game/Code/Classes/UCoreModule.pas b/Game/Code/Classes/UCoreModule.pas
index e5a874f0..b135089c 100644
--- a/Game/Code/Classes/UCoreModule.pas
+++ b/Game/Code/Classes/UCoreModule.pas
@@ -1,6 +1,9 @@
unit UCoreModule;
interface
+
+{$I switches.inc}
+
{*********************
TCoreModule
Dummy Class that has Methods that will be called from Core
@@ -8,10 +11,6 @@ interface
*********************}
uses UPluginDefs;
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
type
PCoreModule = ^TCoreModule;
TCoreModule = class
diff --git a/Game/Code/Classes/UCovers.pas b/Game/Code/Classes/UCovers.pas
index 966277cd..f4ede329 100644
--- a/Game/Code/Classes/UCovers.pas
+++ b/Game/Code/Classes/UCovers.pas
@@ -2,9 +2,7 @@ unit UCovers;
interface
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
+{$I switches.inc}
uses OpenGL12,
{$IFDEF win32}
diff --git a/Game/Code/Classes/UDLLManager.pas b/Game/Code/Classes/UDLLManager.pas
index ff6c16a4..358be9af 100644
--- a/Game/Code/Classes/UDLLManager.pas
+++ b/Game/Code/Classes/UDLLManager.pas
@@ -1,12 +1,9 @@
unit UDLLManager;
-{$IFDEF FPC}
- {$MODE DELPHI}
-{$ENDIF}
-
-
interface
+{$I switches.inc}
+
uses ModiSDK,
UFiles;
@@ -44,15 +41,19 @@ var
const
DLLPath = 'Plugins';
- {$IFDEF win32}
+ {$IFDEF MSWINDOWS}
DLLExt = '.dll';
- {$ELSE}
+ {$ENDIF}
+ {$IFDEF LINUX}
DLLExt = '.so';
{$ENDIF}
+ {$IFDEF DARWIN}
+ DLLExt = '.dylib';
+ {$ENDIF}
implementation
-uses {$IFDEF win32}
+uses {$IFDEF MSWINDOWS}
windows,
{$ELSE}
dynlibs,
diff --git a/Game/Code/Classes/UDataBase.pas b/Game/Code/Classes/UDataBase.pas
index bacb0d98..0cafc9fd 100644
--- a/Game/Code/Classes/UDataBase.pas
+++ b/Game/Code/Classes/UDataBase.pas
@@ -2,10 +2,7 @@ unit UDataBase;
interface
-{$IFDEF FPC}
- {$MODE DELPHI}
-{$ENDIF}
-
+{$I switches.inc}
uses USongs,
SQLiteTable3;
diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas
index 2a5528b8..350926d8 100644
--- a/Game/Code/Classes/UDraw.pas
+++ b/Game/Code/Classes/UDraw.pas
@@ -2,9 +2,7 @@ unit UDraw;
interface
-{$IFDEF FPC}
- {$MODE DELPHI}
-{$ENDIF}
+{$I switches.inc}
uses UThemes,
ModiSDK,
@@ -243,7 +241,7 @@ begin
lTmpA := (Right-Left);
lTmpB := (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote);
- {$IFDEF FPC}
+ {$IFDEF LAZARUS}
(*
writeln( 'UDRAW (Right-Left) : ' + floattostr( lTmpA ) );
writeln( 'UDRAW : ' + floattostr( lTmpB ) );
@@ -479,7 +477,7 @@ begin
lTmpA := (Right-Left);
lTmpB := (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote);
- {$IFDEF FPC}
+ {$IFDEF LAZARUS}
{*
writeln( 'UDRAW (Right-Left) : ' + floattostr( lTmpA ) );
writeln( 'UDRAW : ' + floattostr( lTmpB ) );
diff --git a/Game/Code/Classes/UFiles.pas b/Game/Code/Classes/UFiles.pas
index 717d20e2..5f168ead 100644
--- a/Game/Code/Classes/UFiles.pas
+++ b/Game/Code/Classes/UFiles.pas
@@ -2,9 +2,7 @@ unit UFiles;
interface
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
+{$I switches.inc}
uses SysUtils,
ULog,
diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas
index 5847e41c..26601f2d 100644
--- a/Game/Code/Classes/UGraphic.pas
+++ b/Game/Code/Classes/UGraphic.pas
@@ -4,10 +4,6 @@ interface
{$I switches.inc}
-{$IFDEF FPC}
- {$MODE DELPHI}
-{$ENDIF}
-
uses
SDL,
OpenGL12,
diff --git a/Game/Code/Classes/UGraphicClasses.pas b/Game/Code/Classes/UGraphicClasses.pas
index c04a0ad8..2acd5530 100644
--- a/Game/Code/Classes/UGraphicClasses.pas
+++ b/Game/Code/Classes/UGraphicClasses.pas
@@ -5,10 +5,6 @@ interface
{$I switches.inc}
-{$IFDEF FPC}
- {$MODE DELPHI}
-{$ENDIF}
-
uses UTexture;
const DelayBetweenFrames : Cardinal = 60;
diff --git a/Game/Code/Classes/UHooks.pas b/Game/Code/Classes/UHooks.pas
index c3684ed1..ea31ec50 100644
--- a/Game/Code/Classes/UHooks.pas
+++ b/Game/Code/Classes/UHooks.pas
@@ -6,14 +6,11 @@ unit UHooks;
Saves all hookable events and their subscribers
*********************}
interface
-uses uPluginDefs, SysUtils;
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
{$I switches.inc}
+uses uPluginDefs, SysUtils;
+
type
//Record that saves info from Subscriber
PSubscriberInfo = ^TSubscriberInfo;
@@ -422,7 +419,7 @@ end;
function HookTest(wParam, lParam: DWord): integer; stdcall;
begin
Result := 0; //Don't break the chain
- Core.ShowMessage(CORE_SM_INFO, Integer(PChar(String(PChar(Ptr(lParam))) + ': ' + String(PChar(Ptr(wParam))))));
+ Core.ShowMessage(CORE_SM_INFO, Integer(PChar(String(PChar(Pointer(lParam))) + ': ' + String(PChar(Pointer(wParam))))));
end;
end.
diff --git a/Game/Code/Classes/UIni.pas b/Game/Code/Classes/UIni.pas
index 6b7f3cea..36ba2180 100644
--- a/Game/Code/Classes/UIni.pas
+++ b/Game/Code/Classes/UIni.pas
@@ -2,9 +2,7 @@ unit UIni;
interface
-{$IFDEF FPC}
- {$MODE DELPHI}
-{$ENDIF}
+{$I switches.inc}
uses IniFiles, ULog, SysUtils;
diff --git a/Game/Code/Classes/ULCD.pas b/Game/Code/Classes/ULCD.pas
index 50214ad0..13736729 100644
--- a/Game/Code/Classes/ULCD.pas
+++ b/Game/Code/Classes/ULCD.pas
@@ -1,6 +1,7 @@
unit ULCD;
interface
+
{$I switches.inc}
type
diff --git a/Game/Code/Classes/ULanguage.pas b/Game/Code/Classes/ULanguage.pas
index 679f6405..25986263 100644
--- a/Game/Code/Classes/ULanguage.pas
+++ b/Game/Code/Classes/ULanguage.pas
@@ -2,10 +2,8 @@ unit ULanguage;
interface
-{$IFDEF FPC}
- {$MODE DELPHI}
-{$ENDIF}
-
+{$I switches.inc}
+
type
TLanguageEntry = record
diff --git a/Game/Code/Classes/ULight.pas b/Game/Code/Classes/ULight.pas
index 99edc88c..6621cf59 100644
--- a/Game/Code/Classes/ULight.pas
+++ b/Game/Code/Classes/ULight.pas
@@ -2,10 +2,6 @@ unit ULight;
interface
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
{$I switches.inc}
type
@@ -55,7 +51,11 @@ uses
begin
GetLocalTime(SystemTime);
with SystemTime do
+{$IFDEF DARWIN}
+ Result := EncodeTime(Hour, Minute, Second, MilliSecond);
+{$ELSE}
Result := EncodeTime(wHour, wMinute, wSecond, wMilliSeconds);
+{$ENDIF}
end;
{$ELSE}
Type
diff --git a/Game/Code/Classes/ULog.pas b/Game/Code/Classes/ULog.pas
index 7e464b57..2ce70a11 100644
--- a/Game/Code/Classes/ULog.pas
+++ b/Game/Code/Classes/ULog.pas
@@ -4,10 +4,6 @@ interface
{$I switches.inc}
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
uses Classes;
type
@@ -191,7 +187,7 @@ begin
{$DEFINE DEBUG} //How can i check if this is set in *.dpr file o0
//If Debug => Write to Console Output
{$IFDEF DEBUG}
- WriteLn('Error: ' + Text);
+ WriteLn('Error: ' + Text);
{$ENDIF}
end;
@@ -229,7 +225,7 @@ begin
//If Debug => Write to Console Output
{$IFDEF DEBUG}
- WriteLn(Log2 + ': ' + Log1);
+ WriteLn(Log2 + ': ' + Log1);
{$ENDIF}
end;
@@ -243,7 +239,7 @@ begin
//Write Error to Logfile:
LogError (Text);
- {$IFDEF win32}
+ {$IFDEF MSWINDOWS}
//Show Errormessage
Messagebox(0, PChar(Text), PChar(Title), MB_ICONERROR or MB_OK);
{$ELSE}
diff --git a/Game/Code/Classes/ULyrics.pas b/Game/Code/Classes/ULyrics.pas
index e4ac2024..96b9d43b 100644
--- a/Game/Code/Classes/ULyrics.pas
+++ b/Game/Code/Classes/ULyrics.pas
@@ -2,10 +2,6 @@ unit ULyrics;
interface
-{$IFDEF FPC}
- {$MODE DELPHI}
-{$ENDIF}
-
{$I switches.inc}
uses OpenGL12,
diff --git a/Game/Code/Classes/ULyrics_bak.pas b/Game/Code/Classes/ULyrics_bak.pas
index 43fa46f5..b5a9d798 100644
--- a/Game/Code/Classes/ULyrics_bak.pas
+++ b/Game/Code/Classes/ULyrics_bak.pas
@@ -2,10 +2,6 @@ unit ULyrics_bak;
interface
-{$IFDEF FPC}
- {$MODE DELPHI}
-{$ENDIF}
-
{$I switches.inc}
uses SysUtils,
diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas
index 82fb92e4..bbc64f80 100644
--- a/Game/Code/Classes/UMain.pas
+++ b/Game/Code/Classes/UMain.pas
@@ -2,10 +2,6 @@ unit UMain;
interface
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
{$I switches.inc}
uses
@@ -119,6 +115,7 @@ var
procedure InitializePaths;
+Procedure Main;
procedure MainLoop;
procedure CheckEvents;
procedure Sing(Sender: TScreenSing);
@@ -133,7 +130,275 @@ function GetTimeFromBeat(Beat: integer): real;
procedure ClearScores(PlayerNum: integer);
implementation
-uses USongs, UJoystick, math, UCommandLine;
+
+uses USongs, UJoystick, math, UCommandLine, ULanguage, SDL_ttf,
+ USkins, UCovers, UCatCovers, UDataBase, UPlaylist, UDLLManager,
+ UParty, UCore, UGraphicClasses, UPluginDefs;
+
+const
+ Version = 'UltraStar Deluxe V 1.10 Alpha Build';
+
+{$IFDEF WIN32}
+Procedure Main;
+var
+ WndTitle: string;
+ hWnd: THandle;
+ I: Integer;
+begin
+ WndTitle := Version;
+
+// InitializeSound();
+// writeln( 'DONE' );
+// exit;
+
+
+ {$IFDEF MSWINDOWS}
+ //------------------------------
+ //Start more than One Time Prevention
+ //------------------------------
+ hWnd:= FindWindow(nil, PChar(WndTitle));
+ //Programm already started
+ if (hWnd <> 0) then
+ begin
+ I := Messagebox(0, PChar('Another Instance of Ultrastar is already running. Continue ?'), PChar(WndTitle), MB_ICONWARNING or MB_YESNO);
+ if (I = IDYes) then
+ begin
+ I := 1;
+ repeat
+ Inc(I);
+ hWnd := FindWindow(nil, PChar(WndTitle + ' Instance ' + InttoStr(I)));
+ until (hWnd = 0);
+ WndTitle := WndTitle + ' Instance ' + InttoStr(I);
+ end
+ else
+ Exit;
+ end;
+ {$ENDIF}
+
+ //------------------------------
+ //StartUp - Create Classes and Load Files
+ //------------------------------
+ USTime := TTime.Create;
+
+ // Commandline Parameter Parser
+ Params := TCMDParams.Create;
+
+ // Log + Benchmark
+ Log := TLog.Create;
+ Log.Title := WndTitle;
+ Log.Enabled := Not Params.NoLog;
+ Log.BenchmarkStart(0);
+
+ // Language
+ Log.BenchmarkStart(1);
+ Log.LogStatus('Initialize Paths', 'Initialization');
+ InitializePaths;
+ Log.LogStatus('Load Language', 'Initialization');
+ Language := TLanguage.Create;
+ //Add Const Values:
+ Language.AddConst('US_VERSION', Version);
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Loading Language', 1);
+
+ // SDL
+ Log.BenchmarkStart(1);
+ Log.LogStatus('Initialize SDL', 'Initialization');
+ SDL_Init(SDL_INIT_VIDEO or SDL_INIT_AUDIO);
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Initializing SDL', 1);
+
+ // SDL_ttf
+ Log.BenchmarkStart(1);
+ Log.LogStatus('Initialize SDL_ttf', 'Initialization');
+ TTF_Init(); //ttf_quit();
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Initializing SDL_ttf', 1);
+
+ // Skin
+ Log.BenchmarkStart(1);
+ Log.LogStatus('Loading Skin List', 'Initialization');
+ Skin := TSkin.Create;
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Loading Skin List', 1);
+
+ // Sound Card List
+ Log.BenchmarkStart(1);
+ Log.LogStatus('Loading Soundcard list', 'Initialization');
+ Recording := TRecord.Create;
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Loading Soundcard list', 1);
+
+ // Ini + Paths
+ Log.BenchmarkStart(1);
+ Log.LogStatus('Load Ini', 'Initialization');
+ Ini := TIni.Create;
+ Ini.Load;
+
+ //Load Languagefile
+ if (Params.Language <> -1) then
+ Language.ChangeLanguage(ILanguage[Params.Language])
+ else
+ Language.ChangeLanguage(ILanguage[Ini.Language]);
+
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Loading Ini', 1);
+
+
+ // LCD
+ Log.BenchmarkStart(1);
+ Log.LogStatus('Load LCD', 'Initialization');
+ LCD := TLCD.Create;
+ if Ini.LPT = 1 then begin
+// LCD.HalfInterface := true;
+ LCD.Enable;
+ LCD.Clear;
+ LCD.WriteText(1, ' UltraStar ');
+ LCD.WriteText(2, ' Loading... ');
+ end;
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Loading LCD', 1);
+
+ // Light
+ Log.BenchmarkStart(1);
+ Log.LogStatus('Load Light', 'Initialization');
+ Light := TLight.Create;
+ if Ini.LPT = 2 then begin
+ Light.Enable;
+ end;
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Loading Light', 1);
+
+
+
+ // Theme
+ Log.BenchmarkStart(1);
+ Log.LogStatus('Load Themes', 'Initialization');
+ Theme := TTheme.Create('Themes\' + ITheme[Ini.Theme] + '.ini', Ini.Color);
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Loading Themes', 1);
+
+ // Covers Cache
+ Log.BenchmarkStart(1);
+ Log.LogStatus('Creating Covers Cache', 'Initialization');
+ Covers := TCovers.Create;
+ Log.LogBenchmark('Loading Covers Cache Array', 1);
+ Log.BenchmarkStart(1);
+
+ // Category Covers
+ Log.BenchmarkStart(1);
+ Log.LogStatus('Creating Category Covers Array', 'Initialization');
+ CatCovers:= TCatCovers.Create;
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Loading Category Covers Array', 1);
+
+ // Songs
+ //Log.BenchmarkStart(1);
+ Log.LogStatus('Creating Song Array', 'Initialization');
+ Songs := TSongs.Create;
+ Songs.LoadSongList;
+ Log.LogStatus('Creating 2nd Song Array', 'Initialization');
+ CatSongs := TCatSongs.Create;
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Loading Songs', 1);
+
+ // PluginManager
+ Log.BenchmarkStart(1);
+ Log.LogStatus('PluginManager', 'Initialization');
+ DLLMan := TDLLMan.Create; //Load PluginList
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Loading PluginManager', 1);
+
+ // Party Mode Manager
+ Log.BenchmarkStart(1);
+ Log.LogStatus('PartySession Manager', 'Initialization');
+ PartySession := TParty_Session.Create; //Load PartySession
+
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Loading PartySession Manager', 1);
+
+ // Sound
+ Log.BenchmarkStart(1);
+ Log.LogStatus('Initialize Sound', 'Initialization');
+ InitializeSound();
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Initializing Sound', 1);
+
+// exit;
+
+ // Graphics
+ Log.BenchmarkStart(1);
+ Log.LogStatus('Initialize 3D', 'Initialization');
+ Initialize3D(WndTitle);
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Initializing 3D', 1);
+
+ // Score Saving System
+ Log.BenchmarkStart(1);
+ Log.LogStatus('DataBase System', 'Initialization');
+ DataBase := TDataBaseSystem.Create;
+
+ if (Params.ScoreFile = '') then
+ DataBase.Init ('Ultrastar.db')
+ else
+ DataBase.Init (Params.ScoreFile);
+
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Loading DataBase System', 1);
+
+ //Playlist Manager
+ Log.BenchmarkStart(1);
+ Log.LogStatus('Playlist Manager', 'Initialization');
+ PlaylistMan := TPlaylistManager.Create;
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Loading Playlist Manager', 1);
+
+ //GoldenStarsTwinkleMod
+ Log.BenchmarkStart(1);
+ Log.LogStatus('Effect Manager', 'Initialization');
+ GoldenRec := TEffectManager.Create;
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Loading Particel System', 1);
+
+ // Joypad
+ if (Ini.Joypad = 1) OR (Params.Joypad) then begin
+ Log.BenchmarkStart(1);
+ Log.LogStatus('Initialize Joystick', 'Initialization');
+ Joy := TJoy.Create;
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Initializing Joystick', 1);
+ end;
+
+ Log.BenchmarkEnd(0);
+ Log.LogBenchmark('Loading Time', 0);
+
+ Log.LogError('Creating Core');
+ Core := TCore.Create('Ultrastar Deluxe Beta', MakeVersion(1,1,0, chr(0)));
+
+ Log.LogError('Running Core');
+ Core.Run;
+
+ //------------------------------
+ //Start- Mainloop
+ //------------------------------
+ //Music.SetLoop(true);
+ //Music.SetVolume(50);
+ //Music.Open(SkinPath + 'Menu Music 3.mp3');
+ //Music.Play;
+ Log.LogStatus('Main Loop', 'Initialization');
+ MainLoop;
+
+ //------------------------------
+ //Finish Application
+ //------------------------------
+ if Ini.LPT = 1 then LCD.Clear;
+ if Ini.LPT = 2 then Light.TurnOff;
+
+ Log.LogStatus('Main Loop', 'Finished');
+
+ Log.Free;
+
+end;
+{$ENDIF}
procedure MainLoop;
var
diff --git a/Game/Code/Classes/UMedia_dummy.pas b/Game/Code/Classes/UMedia_dummy.pas
index bf3ad727..37e311af 100644
--- a/Game/Code/Classes/UMedia_dummy.pas
+++ b/Game/Code/Classes/UMedia_dummy.pas
@@ -12,10 +12,7 @@ unit UMedia_dummy;
interface
-{$IFDEF FPC}
- {$MODE DELPHI}
-{$ENDIF}
-
+{$I switches.inc}
implementation
diff --git a/Game/Code/Classes/UModules.pas b/Game/Code/Classes/UModules.pas
index 493fc393..fe623343 100644
--- a/Game/Code/Classes/UModules.pas
+++ b/Game/Code/Classes/UModules.pas
@@ -1,6 +1,9 @@
unit UModules;
interface
+
+{$I switches.inc}
+
{*********************
UModules
Unit Contains all used Modules in its uses clausel
diff --git a/Game/Code/Classes/UMusic.pas b/Game/Code/Classes/UMusic.pas
index f3342625..e2d2cc60 100644
--- a/Game/Code/Classes/UMusic.pas
+++ b/Game/Code/Classes/UMusic.pas
@@ -4,10 +4,6 @@ interface
{$I switches.inc}
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
uses Classes ;
type
diff --git a/Game/Code/Classes/UParty.pas b/Game/Code/Classes/UParty.pas
index 9be0df3e..4f351dc5 100644
--- a/Game/Code/Classes/UParty.pas
+++ b/Game/Code/Classes/UParty.pas
@@ -2,10 +2,7 @@ unit UParty;
interface
-{$IFDEF FPC}
- {$MODE DELPHI}
-{$ENDIF}
-
+{$I switches.inc}
uses ModiSDK;
diff --git a/Game/Code/Classes/UPlaylist.pas b/Game/Code/Classes/UPlaylist.pas
index 3f89ffed..b18d4833 100644
--- a/Game/Code/Classes/UPlaylist.pas
+++ b/Game/Code/Classes/UPlaylist.pas
@@ -2,10 +2,8 @@ unit UPlaylist;
interface
-{$IFDEF FPC}
- {$MODE DELPHI}
-{$ENDIF}
-
+{$I switches.inc}
+
type
TPlaylistItem = record
diff --git a/Game/Code/Classes/UPliki.pas b/Game/Code/Classes/UPliki.pas
index f7692990..f4e8ff97 100644
--- a/Game/Code/Classes/UPliki.pas
+++ b/Game/Code/Classes/UPliki.pas
@@ -2,6 +2,8 @@ unit UPliki;
interface
+{$I switches.inc}
+
uses USongs, SysUtils, ULog, UMusic;
procedure InitializePaths;
diff --git a/Game/Code/Classes/UPluginInterface.pas b/Game/Code/Classes/UPluginInterface.pas
index a9cc7e46..56293848 100644
--- a/Game/Code/Classes/UPluginInterface.pas
+++ b/Game/Code/Classes/UPluginInterface.pas
@@ -6,6 +6,9 @@ unit uPluginInterface;
*********************}
interface
+
+{$I switches.inc}
+
uses uPluginDefs;
//---------------
diff --git a/Game/Code/Classes/URecord.pas b/Game/Code/Classes/URecord.pas
index b553504d..8d3fa5f7 100644
--- a/Game/Code/Classes/URecord.pas
+++ b/Game/Code/Classes/URecord.pas
@@ -4,10 +4,6 @@ interface
{$I switches.inc}
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
uses Classes,
Math,
SysUtils,
diff --git a/Game/Code/Classes/UServices.pas b/Game/Code/Classes/UServices.pas
index 0028576b..92b61e85 100644
--- a/Game/Code/Classes/UServices.pas
+++ b/Game/Code/Classes/UServices.pas
@@ -1,6 +1,9 @@
unit UServices;
interface
+
+{$I switches.inc}
+
uses uPluginDefs, SysUtils;
{*********************
TServiceManager
@@ -8,12 +11,6 @@ uses uPluginDefs, SysUtils;
Saves all Services and their Procs
*********************}
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
type
TServiceName = String[60];
PServiceInfo = ^TServiceInfo;
@@ -221,7 +218,7 @@ begin
//Backup CurExecuted
CurExecutedBackup := Core.CurExecuted;
- Service := ptr(SExists);
+ Service := Pointer(SExists);
If (Service.isClass) then
//Use Proc of Class
diff --git a/Game/Code/Classes/USingNotes.pas b/Game/Code/Classes/USingNotes.pas
index e2162bf1..f0754105 100644
--- a/Game/Code/Classes/USingNotes.pas
+++ b/Game/Code/Classes/USingNotes.pas
@@ -1,6 +1,9 @@
unit USingNotes;
interface
+
+{$I switches.inc}
+
{ Dummy Unit atm
For further expantation
Placeholder for Class that will handle the Notes Drawing}
diff --git a/Game/Code/Classes/USingScores.pas b/Game/Code/Classes/USingScores.pas
index 11f1f07d..d5256dc9 100644
--- a/Game/Code/Classes/USingScores.pas
+++ b/Game/Code/Classes/USingScores.pas
@@ -2,9 +2,7 @@ unit USingScores;
interface
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
+{$I switches.inc}
uses UThemes,
OpenGl12,
@@ -425,7 +423,7 @@ begin
// TODO : JB_Lazarus - Exception=Invalid floating point operation
// AT THIS LINE !
- {$IFDEF FPC}
+ {$IFDEF LAZARUS}
(*
writeln( 'USINGSCORES-aPlayers[Cur.Player].RBTarget : ' + floattostr( aPlayers[Cur.Player].RBTarget ) );
writeln( 'USINGSCORES-(Cur.ScoreDiff - Cur.ScoreGiven) : ' + floattostr( (Cur.ScoreDiff - Cur.ScoreGiven) ) );
@@ -438,7 +436,7 @@ begin
lTempA := ( aPlayers[Cur.Player].RBTarget + (Cur.ScoreDiff - Cur.ScoreGiven) );
lTempB := ( Cur.ScoreDiff * (Cur.Rating / 20 - 0.26) );
- {$IFDEF FPC}
+ {$IFDEF LAZARUS}
(*
writeln( 'USINGSCORES-lTempA : ' + floattostr( lTempA ) );
writeln( 'USINGSCORES-lTempB : ' + floattostr( lTempB ) );
diff --git a/Game/Code/Classes/USkins.pas b/Game/Code/Classes/USkins.pas
index c9d7f2fd..5bab885b 100644
--- a/Game/Code/Classes/USkins.pas
+++ b/Game/Code/Classes/USkins.pas
@@ -1,12 +1,9 @@
unit USkins;
-{$IFDEF FPC}
- {$MODE DELPHI}
-{$ENDIF}
-
-
interface
+{$I switches.inc}
+
type
TSkinTexture = record
Name: string;
diff --git a/Game/Code/Classes/USongs.pas b/Game/Code/Classes/USongs.pas
index 5ce35201..9e0d6ca5 100644
--- a/Game/Code/Classes/USongs.pas
+++ b/Game/Code/Classes/USongs.pas
@@ -2,14 +2,15 @@ unit USongs;
interface
-{$IFDEF FPC}
- {$MODE DELPHI}
-{$ENDIF}
-
+{$I switches.inc}
uses SysUtils,
- {$ifndef win32}
- oldlinux,
+ {$ifndef MSWINDOWS}
+ {$IFDEF DARWIN}
+ baseunix,
+ {$ELSE}
+ oldlinux,
+ {$ENDIF}
{$endif}
ULog,
UTexture,
@@ -115,6 +116,12 @@ uses StrUtils,
UMain,
UIni;
+{$IFDEF DARWIN}
+function AnsiContainsText(const AText, ASubText: string): Boolean;
+begin
+ Result := AnsiPos(AnsiUppercase(ASubText), AnsiUppercase(AText)) > 0;
+end;
+{$ENDIF}
procedure TSongs.LoadSongList;
begin
@@ -136,7 +143,7 @@ procedure TSongs.BrowseDir(Dir: widestring);
var
SLen: integer;
- {$ifdef win32}
+ {$ifdef MSWINDOWS}
SR: TSearchRecW; // for parsing Songs Directory
{$else} // This should work on all posix systems.
TheDir : pdir;
@@ -145,7 +152,7 @@ var
info : stat;
{$endif}
begin
- {$ifdef win32}
+ {$ifdef MSWINDOWS}
if FindFirstW(Dir + '*', faDirectory, SR) = 0 then // JB_Unicode - windows
begin
repeat
@@ -186,8 +193,9 @@ begin
until FindNextW(SR) <> 0;
end; // if FindFirst
FindCloseW(SR);
-
- {$else}
+ {$ENDIF}
+
+ {$IFDEF LINUX}
// Itterate the Songs Directory... ( With unicode capable functions for linux )
TheDir := opendir( Dir ); // JB_Unicode - linux
if TheDir <> nil then
@@ -245,6 +253,66 @@ begin
Until ADirent=Nil;
end; // if FindFirst
+ {$endif}
+
+ {$IFDEF DARWIN}
+ // Itterate the Songs Directory... ( With unicode capable functions for linux )
+ TheDir := FPOpenDir( Dir ); // JB_Unicode - linux
+ if TheDir <> nil then
+ begin
+ repeat
+ ADirent := FPReadDir(TheDir);
+
+ If ADirent<>Nil then
+ begin
+ With ADirent^ do
+ begin
+
+ if ( d_name[0] <> '.') then
+ BrowseDir( Dir + d_name + pathdelim );
+
+ end;
+ end;
+ Until ADirent=Nil;
+ end;
+
+
+
+ TheDir := FPOpenDir( Dir ); // JB_Unicode - linux
+ if TheDir <> nil then
+ begin
+ repeat
+ ADirent := FPReadDir(TheDir);
+
+ if ( ADirent <> Nil ) AND
+ ( pos( '.txt', ADirent^.d_name ) > -1 ) then
+ begin
+ SLen := BrowsePos;
+
+ Song[SLen].Path := Dir;
+ Song[SLen].Folder := Copy(Dir, Length(SongPath)+1, 10000);
+ Song[SLen].Folder := Copy(Song[SLen].Folder, 1, Pos( PathDelim , Song[SLen].Folder)-1);
+ Song[SLen].FileName := ADirent^.d_name;
+
+ if (AnalyseFile(Song[SLen]) = false) then
+ Dec(BrowsePos)
+ else
+ begin
+ if Song[SLen].Cover = '' then
+ Song[SLen].Cover := FindSongFile(Dir, '*[CO].jpg');
+ end;
+
+ //Change Length Only every 50 Entrys
+ Inc(BrowsePos);
+
+ if (BrowsePos mod 50 = 0) AND (BrowsePos <> 0) then
+ begin
+ SetLength(Song, Length(Song) + 50);
+ end;
+ end;
+
+ Until ADirent=Nil;
+ end; // if FindFirst
{$endif}
diff --git a/Game/Code/Classes/UTextClasses.pas b/Game/Code/Classes/UTextClasses.pas
index 5a0655e5..a09456b8 100644
--- a/Game/Code/Classes/UTextClasses.pas
+++ b/Game/Code/Classes/UTextClasses.pas
@@ -1,6 +1,9 @@
unit UTextClasses;
interface
+
+{$I switches.inc}
+
uses OpenGL12,
SDL,
UTexture,
diff --git a/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas
index 5ef29316..76d78f5b 100644
--- a/Game/Code/Classes/UTexture.pas
+++ b/Game/Code/Classes/UTexture.pas
@@ -19,10 +19,6 @@ interface
{$I switches.inc}
-{$IFDEF FPC}
- {$MODE DELPHI}
-{$ENDIF}
-
uses OpenGL12,
{$IFDEF win32}
windows,
@@ -131,7 +127,7 @@ implementation
uses ULog,
DateUtils,
UCovers,
- {$IFDEF FPC}
+ {$IFDEF LAZARUS}
LResources,
{$ENDIF}
StrUtils, dialogs;
@@ -247,7 +243,7 @@ var
TexRWops: PSDL_RWops;
dHandle: THandle;
- {$IFDEF FPC}
+ {$IFDEF LAZARUS}
lLazRes : TLResource;
lResData : TStringStream;
{$ELSE}
@@ -277,7 +273,7 @@ begin
Log.LogStatus( 'IS Resource, because file does not exist.('+Identifier+')', ' LoadImage' );
// load from resource stream
- {$IFNDEF FPC}
+ {$IFDEF WIN32}
dHandle := FindResource(hInstance, Identifier, 'TEX');
if dHandle=0 then
begin
@@ -1134,7 +1130,7 @@ begin
end;
end;
-{$IFDEF FPC}
+{$IFDEF LAZARUS}
initialization
{$I UltraStar.lrs}
{$ENDIF}
diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas
index 00b763f0..c27f9c9e 100644
--- a/Game/Code/Classes/UThemes.pas
+++ b/Game/Code/Classes/UThemes.pas
@@ -2,9 +2,7 @@ unit UThemes;
interface
-{$IFDEF FPC}
- {$MODE DELPHI}
-{$ENDIF}
+{$I switches.inc}
uses
ULog,
diff --git a/Game/Code/Classes/UTime.pas b/Game/Code/Classes/UTime.pas
index 87d17ee5..f714fed5 100644
--- a/Game/Code/Classes/UTime.pas
+++ b/Game/Code/Classes/UTime.pas
@@ -2,9 +2,7 @@ unit UTime;
interface
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
+{$I switches.inc}
{$UNDEF DebugDisplay}
diff --git a/Game/Code/Classes/UVideo.pas b/Game/Code/Classes/UVideo.pas
index 154cd04c..c18eea6c 100644
--- a/Game/Code/Classes/UVideo.pas
+++ b/Game/Code/Classes/UVideo.pas
@@ -20,9 +20,7 @@ unit UVideo;
interface
-{$IFDEF FPC}
- {$MODE DELPHI}
-{$ENDIF}
+{$I switches.inc}
(*
diff --git a/Game/Code/Classes/uPluginLoader.pas b/Game/Code/Classes/uPluginLoader.pas
index 442e76e0..55c89878 100644
--- a/Game/Code/Classes/uPluginLoader.pas
+++ b/Game/Code/Classes/uPluginLoader.pas
@@ -1,793 +1,797 @@
-unit UPluginLoader;
-{*********************
- UPluginLoader
- Unit contains to Classes
- TPluginLoader: Class Searching for and Loading the Plugins
- TtehPlugins: Class that represents the Plugins in Modules chain
-*********************}
-
-interface
-uses UPluginDefs, UCoreModule;
-{$IFDEF FPC}
- {$MODE DELPHI}
-{$ENDIF}
-
-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: Cardinal);
- 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;
- Procedure Free; 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: Cardinal): Integer;
- Function CallInit(Index: Cardinal): Integer;
- Procedure CallDeInit(Index: Cardinal);
-
- //Services offered
- Function LoadPlugin(wParam, lParam: DWord): integer; //wParam PChar(PluginName/PluginPath) | lParam (if wParam = nil) ID of the Plugin
- Function UnloadPlugin(wParam, lParam: DWord): integer; //wParam PChar(PluginName/PluginPath) | lParam (if wParam = nil) ID of the Plugin
- Function GetPluginInfo(wParam, lParam: DWord): 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, lParam: DWord): 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
- {$IFDEF win32}
- PluginFileExtension = '.dll';
- {$ELSE}
- PluginFileExtension = '.so';
- {$ENDIF}
-
-implementation
-uses UCore, UPluginInterface,
-{$IFDEF win32}
+unit UPluginLoader;
+{*********************
+ UPluginLoader
+ Unit contains to Classes
+ TPluginLoader: Class Searching for and Loading the Plugins
+ TtehPlugins: Class that represents the Plugins in Modules chain
+*********************}
+
+interface
+
+{$I switches.inc}
+
+uses UPluginDefs, UCoreModule;
+
+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: Cardinal);
+ 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;
+ Procedure Free; 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: Cardinal): Integer;
+ Function CallInit(Index: Cardinal): Integer;
+ Procedure CallDeInit(Index: Cardinal);
+
+ //Services offered
+ Function LoadPlugin(wParam, lParam: DWord): integer; //wParam PChar(PluginName/PluginPath) | lParam (if wParam = nil) ID of the Plugin
+ Function UnloadPlugin(wParam, lParam: DWord): integer; //wParam PChar(PluginName/PluginPath) | lParam (if wParam = nil) ID of the Plugin
+ Function GetPluginInfo(wParam, lParam: DWord): 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, lParam: DWord): 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
+ {$IFDEF MSWINDOWS}
+ PluginFileExtension = '.dll';
+ {$ENDIF}
+ {$IFDEF LINUX}
+ PluginFileExtension = '.so';
+ {$ENDIF}
+ {$IFDEF DARWIN}
+ PluginFileExtension = '.dylib';
+ {$ENDIF}
+
+implementation
+uses UCore, UPluginInterface,
+{$IFDEF MSWINDOWS}
windows,
{$ELSE}
dynlibs,
{$ENDIF}
-UMain, SysUtils;
-
-{*********************
- TPluginLoader
- Implentation
-*********************}
-
-//-------------
-// 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
- //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.')), Integer(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 Prvate 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
-//-------------
-Procedure TPluginLoader.Free;
-begin
- //Just save some Memory if it wasn't done now..
- SetLength(Plugins, 0);
-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)), Integer(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)), Integer(PChar('TPluginLoader')));
- end;
-
- //Emulate loading process if this Plugin is loaded to 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: ' + Info.Name)), Integer(PChar('TPluginLoader')));
-
- //Unload Old Plugin
- UnloadPlugin(Integer(nil), PluginID);
-
- //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)), Integer(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: ' + Info.Name)), Integer(PChar('TPluginLoader')));
- end;
- end
- else
- begin
- FreeLibrary(hLib);
- Core.ReportError(Integer(PChar('No name reported: ' + Filename)), Integer(PChar('TPluginLoader')));
- end;
- end
- else
- begin
- FreeLibrary(hLib);
- Core.ReportError(Integer(PChar('Can''t find Info Procedure: ' + Filename)), Integer(PChar('TPluginLoader')));
- end;
- end
- else
- Core.ReportError(Integer(PChar('Can''t load Plugin Libary: ' + Filename)), Integer(PChar('TPluginLoader')));
- end;
-end;
-
-//--------------
-// Calls Load Func of Plugin with the given Index
-//--------------
-Function TPluginLoader.CallLoad(Index: Cardinal): 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: ' + Plugins[Index].Info.Name)), Integer(PChar('TPluginLoader')));
- end;
- end;
- end;
-end;
-
-//--------------
-// Calls Init Func of Plugin with the given Index
-//--------------
-Function TPluginLoader.CallInit(Index: Cardinal): 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: ' + Plugins[Index].Info.Name)), Integer(PChar('TPluginLoader')));
- end;
- end;
- end;
-end;
-
-//--------------
-// Calls DeInit Proc of Plugin with the given Index
-//--------------
-Procedure TPluginLoader.CallDeInit(Index: Cardinal);
-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: Cardinal);
-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) | lParam (if wParam = nil) ID of the Plugin
-//--------------
-Function TPluginLoader.LoadPlugin(wParam, lParam: DWord): integer;
-var
- Index: Integer;
- sFile: String;
-begin
- Result := -1;
- sFile := '';
- //lParam is ID
- If (Ptr(wParam) = nil) then
- begin
- Index := lParam;
- end
- else
- begin //wParam is PChar
- try
- sFile := String(PChar(Ptr(wParam)));
- 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) | lParam (if wParam = nil) ID of the Plugin
-//--------------
-Function TPluginLoader.UnloadPlugin(wParam, lParam: DWord): integer;
-var
- Index: Integer;
- sName: String;
-begin
- Result := -1;
- //lParam is ID
- If (Ptr(wParam) = nil) then
- begin
- Index := lParam;
- end
- else
- begin //wParam is PChar
- try
- sName := String(PChar(Ptr(wParam)));
- 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, lParam: DWord): integer;
-var I: Integer;
-begin
- Result := 0;
- If (wParam < 0) then
- begin //Get Info of 1 Plugin
- If (Ptr(lParam) <> nil) AND (wParam < Length(Plugins)) then
- begin
- Try
- Result := 1;
- PUS_PluginInfo(Ptr(lParam))^ := Plugins[wParam].Info;
- Except
-
- End;
- end;
- end
- Else If (Ptr(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(Ptr(lParam))^[I] := Plugins[I].Info;
- Result := Length(Plugins);
- Except
- Core.ReportError(Integer(PChar('Could not write PluginInfo Array')), Integer(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, lParam: DWord): 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 (Ptr(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(Ptr(lParam + I)^) := Plugins[I].State;
- Result := Length(Plugins);
- Except
- Core.ReportError(Integer(PChar('Could not write PluginState Array')), Integer(PChar('TPluginLoader')));
- End;
- end;
-end;
-
-
-
-
-
-{*********************
- TtehPlugins
- Implentation
-*********************}
-
-//-------------
-// 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
- 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
-label Continue;
-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')), Integer(PChar('TtehPlugins')));
- end
- else
- begin
- Result := True;
-
- //Backup CurExecuted
- CurExecutedBackup := Core.CurExecuted;
-
- //Start Loading the Plugins
- I := 0;
- Continue:
- Try
- While (I <= High(PluginLoader.Plugins)) do
- begin
- Core.CurExecuted := -1 - I;
-
- //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: ' + PluginLoader.Plugins[I].Info.Name)), Integer(PChar('TtehPlugins')));
- end
- else
- Core.ReportDebug(Integer(PChar('Plugin loaded succesful: ' + PluginLoader.Plugins[I].Info.Name)), Integer(PChar('TtehPlugins')));
-
- Inc(I);
- 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 + '"')), Integer(PChar('TtehPlugins')));
-
-
- //don't forget to increase I
- Inc(I);
- end;
- End;
-
- If (I <= High(PluginLoader.Plugins)) then
- Goto Continue;
-
- //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
-label Continue;
-begin
- Result := True;
-
- //Backup CurExecuted
- CurExecutedBackup := Core.CurExecuted;
-
- //Start Loading the Plugins
- I := 0;
- Continue:
- Try
- While (I <= High(PluginLoader.Plugins)) do
- begin
- 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: ' + PluginLoader.Plugins[I].Info.Name)), Integer(PChar('TtehPlugins')));
- end
- else
- Core.ReportDebug(Integer(PChar('Plugin inited succesful: ' + PluginLoader.Plugins[I].Info.Name)), Integer(PChar('TtehPlugins')));
-
- //don't forget to increase I
- Inc(I);
- end;
- Except
- //Plugin could not be loaded.
- // => Show Error Message, then ShutDown Plugin
- PluginLoader.CallDeInit(I);
- PluginLoader.Plugins[I].State := 255; //Plugin causes Error
- Core.ReportError(Integer(PChar('Plugin causes Error during init process: ' + PluginLoader.Plugins[I].Info.Name)), Integer(PChar('TtehPlugins')));
-
- //don't forget to increase I
- Inc(I);
- End;
-
- If (I <= High(PluginLoader.Plugins)) then
- GoTo Continue;
-
- //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
-label Continue;
-begin
- //Backup CurExecuted
- CurExecutedBackup := Core.CurExecuted;
-
- //Start Loop
- I := 0;
-
- Continue:
- Try
- While (I <= High(PluginLoader.Plugins)) do
- begin
- //DeInit Plugin
- PluginLoader.CallDeInit(I);
-
- Inc(I);
- end;
- Except
- Inc(I);
- End;
-
- If I <= High(PluginLoader.Plugins) then
- Goto Continue;
-
- //Reset CurExecuted
- Core.CurExecuted := CurExecutedBackup;
-end;
-
-end.
+UMain, SysUtils;
+
+{*********************
+ TPluginLoader
+ Implentation
+*********************}
+
+//-------------
+// 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
+ //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.')), Integer(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 Prvate 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
+//-------------
+Procedure TPluginLoader.Free;
+begin
+ //Just save some Memory if it wasn't done now..
+ SetLength(Plugins, 0);
+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)), Integer(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)), Integer(PChar('TPluginLoader')));
+ end;
+
+ //Emulate loading process if this Plugin is loaded to 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))), Integer(PChar('TPluginLoader')));
+
+ //Unload Old Plugin
+ UnloadPlugin(Integer(nil), PluginID);
+
+ //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)), Integer(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))), Integer(PChar('TPluginLoader')));
+ end;
+ end
+ else
+ begin
+ FreeLibrary(hLib);
+ Core.ReportError(Integer(PChar('No name reported: ' + Filename)), Integer(PChar('TPluginLoader')));
+ end;
+ end
+ else
+ begin
+ FreeLibrary(hLib);
+ Core.ReportError(Integer(PChar('Can''t find Info Procedure: ' + Filename)), Integer(PChar('TPluginLoader')));
+ end;
+ end
+ else
+ Core.ReportError(Integer(PChar('Can''t load Plugin Libary: ' + Filename)), Integer(PChar('TPluginLoader')));
+ end;
+end;
+
+//--------------
+// Calls Load Func of Plugin with the given Index
+//--------------
+Function TPluginLoader.CallLoad(Index: Cardinal): 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))), Integer(PChar('TPluginLoader')));
+ end;
+ end;
+ end;
+end;
+
+//--------------
+// Calls Init Func of Plugin with the given Index
+//--------------
+Function TPluginLoader.CallInit(Index: Cardinal): 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))), Integer(PChar('TPluginLoader')));
+ end;
+ end;
+ end;
+end;
+
+//--------------
+// Calls DeInit Proc of Plugin with the given Index
+//--------------
+Procedure TPluginLoader.CallDeInit(Index: Cardinal);
+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: Cardinal);
+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) | lParam (if wParam = nil) ID of the Plugin
+//--------------
+Function TPluginLoader.LoadPlugin(wParam, lParam: DWord): integer;
+var
+ Index: Integer;
+ sFile: String;
+begin
+ Result := -1;
+ sFile := '';
+ //lParam is ID
+ If (Pointer(wParam) = nil) then
+ begin
+ Index := lParam;
+ end
+ else
+ begin //wParam is PChar
+ try
+ sFile := String(PChar(Pointer(wParam)));
+ 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) | lParam (if wParam = nil) ID of the Plugin
+//--------------
+Function TPluginLoader.UnloadPlugin(wParam, lParam: DWord): integer;
+var
+ Index: Integer;
+ sName: String;
+begin
+ Result := -1;
+ //lParam is ID
+ If (Pointer(wParam) = nil) then
+ begin
+ Index := lParam;
+ end
+ else
+ begin //wParam is PChar
+ try
+ sName := String(PChar(Pointer(wParam)));
+ 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, lParam: DWord): integer;
+var I: Integer;
+begin
+ Result := 0;
+ If (wParam < 0) then
+ begin //Get Info of 1 Plugin
+ If (Pointer(lParam) <> nil) AND (wParam < Length(Plugins)) then
+ begin
+ Try
+ Result := 1;
+ PUS_PluginInfo(Pointer(lParam))^ := Plugins[wParam].Info;
+ Except
+
+ End;
+ end;
+ end
+ Else If (Pointer(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(Pointer(lParam))^[I] := Plugins[I].Info;
+ Result := Length(Plugins);
+ Except
+ Core.ReportError(Integer(PChar('Could not write PluginInfo Array')), Integer(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, lParam: DWord): 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 (Pointer(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(lParam + I)^) := Plugins[I].State;
+ Result := Length(Plugins);
+ Except
+ Core.ReportError(Integer(PChar('Could not write PluginState Array')), Integer(PChar('TPluginLoader')));
+ End;
+ end;
+end;
+
+
+
+
+
+{*********************
+ TtehPlugins
+ Implentation
+*********************}
+
+//-------------
+// 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
+ 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
+label Continue;
+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')), Integer(PChar('TtehPlugins')));
+ end
+ else
+ begin
+ Result := True;
+
+ //Backup CurExecuted
+ CurExecutedBackup := Core.CurExecuted;
+
+ //Start Loading the Plugins
+ I := 0;
+ Continue:
+ Try
+ While (I <= High(PluginLoader.Plugins)) do
+ begin
+ Core.CurExecuted := -1 - I;
+
+ //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))), Integer(PChar('TtehPlugins')));
+ end
+ else
+ Core.ReportDebug(Integer(PChar('Plugin loaded succesful: ' + String(PluginLoader.Plugins[I].Info.Name))), Integer(PChar('TtehPlugins')));
+
+ Inc(I);
+ 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 + '"')), Integer(PChar('TtehPlugins')));
+
+
+ //don't forget to increase I
+ Inc(I);
+ end;
+ End;
+
+ If (I <= High(PluginLoader.Plugins)) then
+ Goto Continue;
+
+ //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
+label Continue;
+begin
+ Result := True;
+
+ //Backup CurExecuted
+ CurExecutedBackup := Core.CurExecuted;
+
+ //Start Loading the Plugins
+ I := 0;
+ Continue:
+ Try
+ While (I <= High(PluginLoader.Plugins)) do
+ begin
+ 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))), Integer(PChar('TtehPlugins')));
+ end
+ else
+ Core.ReportDebug(Integer(PChar('Plugin inited succesful: ' + String(PluginLoader.Plugins[I].Info.Name))), Integer(PChar('TtehPlugins')));
+
+ //don't forget to increase I
+ Inc(I);
+ end;
+ Except
+ //Plugin could not be loaded.
+ // => Show Error Message, then ShutDown 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))), Integer(PChar('TtehPlugins')));
+
+ //don't forget to increase I
+ Inc(I);
+ End;
+
+ If (I <= High(PluginLoader.Plugins)) then
+ GoTo Continue;
+
+ //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
+label Continue;
+begin
+ //Backup CurExecuted
+ CurExecutedBackup := Core.CurExecuted;
+
+ //Start Loop
+ I := 0;
+
+ Continue:
+ Try
+ While (I <= High(PluginLoader.Plugins)) do
+ begin
+ //DeInit Plugin
+ PluginLoader.CallDeInit(I);
+
+ Inc(I);
+ end;
+ Except
+ Inc(I);
+ End;
+
+ If I <= High(PluginLoader.Plugins) then
+ Goto Continue;
+
+ //Reset CurExecuted
+ Core.CurExecuted := CurExecutedBackup;
+end;
+
+end.