aboutsummaryrefslogblamecommitdiffstats
path: root/Game/Code/Classes/UCore.pas
blob: 2e1304de0f965761a830479316a7b92f7ab6dbce (plain) (tree)
1
2
3
4
5
6
7
8
9
10









                  






               

































                                                                                    



                                                   
                                                
 
                                                  
                                    

                                   
                              

                                   
                              

                                     
                                

                      
                                  

                      
                                  

                        
                                    

                                  
                                  




                                                              





                                                                                                

                                                                                                                             



                                          
                                                                         

                                                                                 
                     

                                                                     
                                                                 



                                 






                                                                                                                                                                                                      






                




                 



                                                     
                                                                         
      

                    

                       

                      










                                                                           
                     
    












                                                                                

                









                                          


            






                        
        


                                          
 





                       
 
                        
        

                                          

       


























                                                                




                            
                                  

                   




                                            
                                    
    
              

                   
                                 

        


                                                           
           
                                                                                                                           
            
         
       
                  




                             
                              
    
              


                      
                                              

        
                                        

                       

         




                                                                                                                              





                             
                              
    
              


                      
                                              

        
                                        

                       

         






                                                                                                                              





                               
                                
    
              
      
 
                                                   
        



                                       
         
       

              

                  




                
                                  



















                                                                                                             

                  




                
                                  
      
                                
                  




                  
                                    
      
                                                             
                  


                
                                                               
                

                                                                 

                 


                                          
          
                                    

             
       




                                                              
                                                                       
                   
                      
         


                
                     
                          

                     
                   




                                                            
            
                                                          


           
                                            




                                                                                  
                                                                       

                                                 
                                              







                                                                                      
                                                                       






                                                
                                                                       
      
                                            




                           
                                                                          
      
                                               




                                                                                                                              
                                                                         






                                  

                                          




                                                                                              
           







                              
                                                                                



                       


                                   
                                                







                                 
     
unit UCore;

interface

{$IFDEF FPC}
  {$MODE Delphi}
{$ENDIF}

{$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;

      //Cur + Last Executed Setting and Getting ;)
      iCurExecuted: Integer;
      iLastExecuted: Integer;

      procedure SetCurExecuted(Value: Integer);

      //Function Get all Modules and Creates them
      function GetModules: Boolean;

      //Loads Core and all Modules
      function Load: Boolean;

      //Inits Core and all Modules
      function Init: Boolean;

      //DeInits Core and all Modules
      function DeInit: Boolean;

      //Load the Core
      function LoadCore: Boolean;

      //Init the Core
      function InitCore: Boolean;

      //DeInit the Core
      function DeInitCore: Boolean;

      //Called one Time per Frame
      function MainLoop: Boolean;

    public
      Hooks:            THookManager;   //Teh Hook Manager ;)
      Services:         TServiceManager;//The Service Manager

      Name:             String;         //Name of this Application
      Version:          LongWord;       //Version of this ". For Info Look PluginDefs Functions

      LastErrorReporter:String;         //Who Reported the Last Error String
      LastErrorString:  String;         //Last Error String reported

      property CurExecuted: Integer read iCurExecuted write SetCurExecuted;       //ID of Plugin or Module curently Executed
      property LastExecuted: Integer read iLastExecuted;

      //---------------
      //Main Methods to control the Core:
      //---------------
      constructor Create(const cName: String; const cVersion: LongWord);

      //Starts Loading and Init Process. Then Runs MainLoop. DeInits on Shutdown
      procedure Run;

      //Method for other Classes to get Pointer to a specific Module
      function GetModulebyName(const Name: String): PCoreModule;

      //--------------
      // Hook and Service Procs:
      //--------------
      function ShowMessage(wParam: TwParam; lParam: TlParam): integer; //Shows a Message (lParam: PChar Text, wParam: Symbol)
      function ReportError(wParam: TwParam; lParam: TlParam): integer; //Shows a Message (wParam: Pchar(Message), lParam: PChar(Reportername))
      function ReportDebug(wParam: TwParam; lParam: TlParam): integer; //Shows a Message (wParam: Pchar(Message), lParam: PChar(Reportername))
      function Retranslate(wParam: TwParam; lParam: TlParam): integer; //Calls Translate hook
      function ReloadTextures(wParam: TwParam; lParam: TlParam): integer; //Calls LoadTextures hook
      function GetModuleInfo(wParam: TwParam; lParam: TlParam): integer; //If lParam = nil then get length of Moduleinfo Array. If lparam <> nil then write array of TModuleInfo to address at lparam
      function GetApplicationHandle(wParam: TwParam; lParam: TlParam): integer; //Returns Application Handle
  end;

var
  Core: TCore; 

implementation

uses
  {$IFDEF win32}
  Windows,
  {$ENDIF}
  SysUtils;

//-------------
// Create - Creates Class + Hook and Service Manager
//-------------
constructor TCore.Create(const cName: String; const cVersion: LongWord);
begin
  inherited Create;

  Name := cName;
  Version := cVersion;
  iLastExecuted := 0;
  iCurExecuted := 0;

  LastErrorReporter := '';
  LastErrorString   := '';

  Hooks := THookManager.Create(50);
  Services := TServiceManager.Create;
end;

//-------------
//Starts Loading and Init Process. Then Runs MainLoop. DeInits on Shutdown
//-------------
procedure TCore.Run;
var
  Success: Boolean;

  procedure HandleError(const ErrorMsg: string);
  begin
    if (LastErrorString <> '') then
      Self.ShowMessage(CORE_SM_ERROR, PChar(ErrorMsg + ': ' + LastErrorString))
    else
      Self.ShowMessage(CORE_SM_ERROR, PChar(ErrorMsg));

    //DeInit
    DeInit;
  end;

begin
  //Get Modules
  try
    Success := GetModules();
  except
    Success := False;
  end;

  if (not Success) then
  begin
    HandleError('Error Getting Modules');
    Exit;
  end;

  //Loading
  try
    Success := Load();
  except
    Success := False;
  end;

  if (not Success) then
  begin
    HandleError('Error loading Modules');
    Exit;
  end;

  //Init
  try
    Success := Init();
  except
    Success := False;
  end;

  if (not Success) then
  begin
    HandleError('Error initing Modules');
    Exit;
  end;

  //Call Translate Hook
  if (Hooks.CallEventChain(hTranslate, 0, nil) <> 0) then
  begin
    HandleError('Error translating');
    Exit;
  end;

  //Calls LoadTextures Hook
  if (Hooks.CallEventChain(hLoadTextures, 0, nil) <> 0) then
  begin
    HandleError('Error loading textures');
    Exit;
  end;
  
  //Calls Loading Finished Hook
  if (Hooks.CallEventChain(hLoadingFinished, 0, nil) <> 0) then
  begin
    HandleError('Error calling LoadingFinished Hook');
    Exit;
  end;
  
  //Start MainLoop
  while Success do
  begin
    Success := MainLoop();
    // to-do : Call Display Draw here
  end;
end;

//-------------
//Called one Time per Frame
//-------------
function TCore.MainLoop: Boolean;
begin
  Result := False;
end;

//-------------
//Function Get all Modules and Creates them
//-------------
function TCore.GetModules: Boolean;
var
  i: Integer;
begin
  Result := False;
  for i := 0 to high(Modules) do
  begin
    try
      Modules[i].NeedsDeInit := False;
      Modules[i].Module := CORE_MODULES_TO_LOAD[i].Create;
      Modules[i].Module.Info(@Modules[i].Info);
    except
      ReportError(Integer(PChar('Can''t get module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core'));
      Exit;
    end;
  end;
  Result := True;
end;

//-------------
//Loads Core and all Modules
//-------------
function TCore.Load: Boolean;
var
  i: Integer;
begin
  Result := LoadCore;

  for i := 0 to High(CORE_MODULES_TO_LOAD) do
  begin
    try
      Result := Modules[i].Module.Load;
    except
      Result := False;
    end;

    if (not Result) then
    begin
      ReportError(Integer(PChar('Error loading module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core'));
      break;
    end;
  end;
end;

//-------------
//Inits Core and all Modules
//-------------
function TCore.Init: Boolean;
var
  i: Integer;
begin
  Result := InitCore;

  for i := 0 to High(CORE_MODULES_TO_LOAD) do
  begin
    try
      Result := Modules[i].Module.Init;
    except
      Result := False;
    end;

    if (not Result) then
    begin
      ReportError(Integer(PChar('Error initing module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core'));
      break;
    end;

    Modules[i].NeedsDeInit := Result;
  end;
end;

//-------------
//DeInits Core and all Modules
//-------------
function TCore.DeInit: boolean;
var
  i: integer;
begin

  for i :=  High(CORE_MODULES_TO_LOAD) downto 0 do
  begin
    try
      if (Modules[i].NeedsDeInit) then
        Modules[i].Module.DeInit;
    except
    end;
  end;

  DeInitCore;

  Result := true;
end;

//-------------
//Load the Core
//-------------
function TCore.LoadCore: Boolean;
begin
  hLoadingFinished := Hooks.AddEvent('Core/LoadingFinished');
  hMainLoop        := Hooks.AddEvent('Core/MainLoop');
  hTranslate       := Hooks.AddEvent('Core/Translate');
  hLoadTextures    := Hooks.AddEvent('Core/LoadTextures');
  hExitQuery       := Hooks.AddEvent('Core/ExitQuery');
  hExit            := Hooks.AddEvent('Core/Exit');
  hDebug           := Hooks.AddEvent('Core/NewDebugInfo');
  hError           := Hooks.AddEvent('Core/NewError');
  
  sReportError     := Services.AddService('Core/ReportError', nil, Self.ReportError);
  sReportDebug     := Services.AddService('Core/ReportDebug', nil, Self.ReportDebug);
  sShowMessage     := Services.AddService('Core/ShowMessage', nil, Self.ShowMessage);
  sRetranslate     := Services.AddService('Core/Retranslate', nil, Self.Retranslate);
  sReloadTextures  := Services.AddService('Core/ReloadTextures', nil, Self.ReloadTextures);
  sGetModuleInfo   := Services.AddService('Core/GetModuleInfo', nil, Self.GetModuleInfo);
  sGetApplicationHandle := Services.AddService('Core/GetApplicationHandle', nil, Self.GetApplicationHandle);

  //A little Test
  Hooks.AddSubscriber('Core/NewError', HookTest);

  result := true;
end;

//-------------
//Init the Core
//-------------
function TCore.InitCore: Boolean;
begin
  //Don not init something atm.
  result := true;
end;

//-------------
//DeInit the Core
//-------------
function TCore.DeInitCore: Boolean;
begin
  // TODO: write TService-/HookManager.Free and call it here
  Result := true;
end;

//-------------
//Method for other classes to get pointer to a specific module
//-------------
function TCore.GetModuleByName(const Name: String): PCoreModule;
var i: Integer;
begin
  Result := nil;
  for i := 0 to High(Modules) do
  begin
    if (Modules[i].Info.Name = Name) then
    begin
      Result := @Modules[i].Module;
      Break;
    end;
  end;
end;

//-------------
// Shows a MessageDialog (lParam: PChar Text, wParam: Symbol)
//-------------
function TCore.ShowMessage(wParam: TwParam; lParam: TlParam): integer;
{$IFDEF MSWINDOWS}
var Params: Cardinal;
{$ENDIF}
begin
  Result := -1;

  {$IFDEF MSWINDOWS}
  if (lParam <> nil) then
  begin
    Params := MB_OK;
    case wParam of
      CORE_SM_ERROR: Params := Params or MB_ICONERROR;
      CORE_SM_WARNING: Params := Params or MB_ICONWARNING;
      CORE_SM_INFO: Params := Params or MB_ICONINFORMATION;
    end;

    //Show:
    Result := Messagebox(0, lParam, PChar(Name), Params);
  end;
  {$ENDIF}

  // TODO: write ShowMessage for other OSes
end;

//-------------
// Calls NewError HookChain (wParam: Pchar(Message), lParam: PChar(Reportername))
//-------------
function TCore.ReportError(wParam: TwParam; lParam: TlParam): integer;
begin
  //Update LastErrorReporter and LastErrorString
  LastErrorReporter := String(PChar(lParam));
  LastErrorString   := String(PChar(Pointer(wParam)));
  
  Hooks.CallEventChain(hError, wParam, lParam);
end;

//-------------
// Calls NewDebugInfo HookChain (wParam: Pchar(Message), lParam: PChar(Reportername))
//-------------
function TCore.ReportDebug(wParam: TwParam; lParam: TlParam): integer;
begin
  Hooks.CallEventChain(hDebug, wParam, lParam);
end;

//-------------
// Calls Translate hook
//-------------
function TCore.Retranslate(wParam: TwParam; lParam: TlParam): integer;
begin
  Hooks.CallEventChain(hTranslate, 1, nil);
end;

//-------------
// Calls LoadTextures hook
//-------------
function TCore.ReloadTextures(wParam: TwParam; lParam: TlParam): integer;
begin
  Hooks.CallEventChain(hLoadTextures, 1, nil);
end;

//-------------
// If lParam = nil then get length of Moduleinfo Array. If lparam <> nil then write array of TModuleInfo to address at lparam
//-------------
function TCore.GetModuleInfo(wParam: TwParam; lParam: TlParam): integer;
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: TwParam; lParam: TlParam): integer;
begin
  Result := hInstance;
end;

//-------------
// Called when setting CurExecuted
//-------------
procedure TCore.SetCurExecuted(Value: Integer);
begin
  //Set Last Executed
  iLastExecuted := iCurExecuted;

  //Set Cur Executed
  iCurExecuted := Value;
end;

end.