{* UltraStar Deluxe - Karaoke Game * * UltraStar Deluxe is the legal property of its developers, whose names * are too numerous to list here. Please refer to the COPYRIGHT * file distributed with this source distribution. * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License * as published by the Free Software Foundation; either version 2 * of the License, or (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; see the file COPYING. If not, write to * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301, USA. * * $URL$ * $Id$ *} unit UCore; interface {$IFDEF FPC} {$MODE Delphi} {$ENDIF} {$I switches.inc} uses uPluginDefs, uCoreModule, UHooks, UServices, UModules; {********************* TCore Class manages all CoreModules, the StartUp, the MainLoop and the shutdown process Also, it does some error handling, and maybe sometime multithreaded loading ;) *********************} type TModuleListItem = record Module: TCoreModule; // Instance of the modules class Info: TModuleInfo; // ModuleInfo returned by modules modulinfo proc NeedsDeInit: boolean; // True if module was succesful inited end; TCore = class private // Some Hook Handles. See Plugin SDKs Hooks.txt for Infos hLoadingFinished: THandle; hMainLoop: THandle; hTranslate: THandle; hLoadTextures: THandle; hExitQuery: THandle; hExit: THandle; hDebug: THandle; hError: THandle; sReportError: THandle; sReportDebug: THandle; sShowMessage: THandle; sRetranslate: THandle; sReloadTextures: THandle; sGetModuleInfo: THandle; sGetApplicationHandle: THandle; Modules: array [0..High(CORE_MODULES_TO_LOAD)] of TModuleListItem; // Cur + Last Executed Setting and Getting ;) iCurExecuted: integer; iLastExecuted: integer; procedure SetCurExecuted(Value: integer); // Function Get all Modules and Creates them function GetModules: boolean; // Loads Core and all Modules function Load: boolean; // Inits Core and all Modules function Init: boolean; // DeInits Core and all Modules function DeInit: boolean; // Load the Core function LoadCore: boolean; // Init the Core function InitCore: boolean; // DeInit the Core function DeInitCore: boolean; // Called one time per frame function MainLoop: boolean; public Hooks: THookManager; // The Hook Manager ;) Services: TServiceManager; // The Service Manager Name: string; // Name of this application Version: LongWord; // Version of this ". For info look plugindefs functions LastErrorReporter: string; // Who reported the last error string LastErrorString: string; // Last error string reported property CurExecuted: integer read iCurExecuted write SetCurExecuted; //ID of plugin or module curently executed property LastExecuted: integer read iLastExecuted; //--------------- // Main methods to control the core: //--------------- constructor Create(const cName: string; const cVersion: LongWord); // Starts loading and init process. Then runs MainLoop. DeInits on shutdown procedure Run; // Method for other classes to get pointer to a specific module function GetModulebyName(const Name: string): PCoreModule; //-------------- // Hook and service procs: //-------------- function ShowMessage(wParam: TwParam; lParam: TlParam): integer; //Shows a Message (lParam: PChar Text, wParam: Symbol) function ReportError(wParam: TwParam; lParam: TlParam): integer; //Shows a Message (wParam: Pchar(Message), lParam: PChar(Reportername)) function ReportDebug(wParam: TwParam; lParam: TlParam): integer; //Shows a Message (wParam: Pchar(Message), lParam: PChar(Reportername)) function Retranslate(wParam: TwParam; lParam: TlParam): integer; //Calls Translate hook function ReloadTextures(wParam: TwParam; lParam: TlParam): integer; //Calls LoadTextures hook function GetModuleInfo(wParam: TwParam; lParam: TlParam): integer; //If lParam = nil then get length of Moduleinfo array. If lparam <> nil then write array of TModuleInfo to address at lparam function GetApplicationHandle(wParam: TwParam; lParam: TlParam): integer; //Returns Application Handle end; var Core: TCore; implementation uses {$IFDEF win32} Windows, {$ENDIF} SysUtils; //------------- // Create - Creates Class + Hook and Service Manager //------------- constructor TCore.Create(const cName: string; const cVersion: LongWord); begin inherited Create; Name := cName; Version := cVersion; iLastExecuted := 0; iCurExecuted := 0; LastErrorReporter := ''; LastErrorString := ''; Hooks := THookManager.Create(50); Services := TServiceManager.Create; end; //------------- // Starts Loading and Init process. Then runs MainLoop. DeInits on shutdown //------------- procedure TCore.Run; var Success: boolean; procedure HandleError(const ErrorMsg: string); begin if (LastErrorString <> '') then Self.ShowMessage(CORE_SM_ERROR, PChar(ErrorMsg + ': ' + LastErrorString)) else Self.ShowMessage(CORE_SM_ERROR, PChar(ErrorMsg)); // DeInit DeInit; end; begin // Get modules try Success := GetModules(); except Success := false; end; if (not Success) then begin HandleError('Error Getting Modules'); Exit; end; // Loading try Success := Load(); except Success := false; end; if (not Success) then begin HandleError('Error loading Modules'); Exit; end; // Init try Success := Init(); except Success := false; end; if (not Success) then begin HandleError('Error initing Modules'); Exit; end; // Call Translate Hook if (Hooks.CallEventChain(hTranslate, 0, nil) <> 0) then begin HandleError('Error translating'); Exit; end; // Calls LoadTextures Hook if (Hooks.CallEventChain(hLoadTextures, 0, nil) <> 0) then begin HandleError('Error loading textures'); Exit; end; // Calls Loading Finished Hook if (Hooks.CallEventChain(hLoadingFinished, 0, nil) <> 0) then begin HandleError('Error calling LoadingFinished Hook'); Exit; end; // Start MainLoop while Success do begin Success := MainLoop(); // to-do : Call Display Draw here end; end; //------------- // Called one time per frame //------------- function TCore.MainLoop: boolean; begin Result := false; end; //------------- // Function get all modules and creates them //------------- function TCore.GetModules: boolean; var i: integer; begin Result := false; for i := 0 to high(Modules) do begin try Modules[i].NeedsDeInit := false; Modules[i].Module := CORE_MODULES_TO_LOAD[i].Create; Modules[i].Module.Info(@Modules[i].Info); except ReportError(integer(PChar('Can''t get module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core')); Exit; end; end; Result := true; end; //------------- // Loads core and all modules //------------- function TCore.Load: boolean; var i: integer; begin Result := LoadCore; for i := 0 to High(CORE_MODULES_TO_LOAD) do begin try Result := Modules[i].Module.Load; except Result := false; end; if (not Result) then begin ReportError(integer(PChar('Error loading module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core')); break; end; end; end; //------------- // Inits core and all modules //------------- function TCore.Init: boolean; var i: integer; begin Result := InitCore; for i := 0 to High(CORE_MODULES_TO_LOAD) do begin try Result := Modules[i].Module.Init; except Result := false; end; if (not Result) then begin ReportError(integer(PChar('Error initing module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core')); break; end; Modules[i].NeedsDeInit := Result; end; end; //------------- // DeInits core and all modules //------------- function TCore.DeInit: boolean; var i: integer; begin for i := High(CORE_MODULES_TO_LOAD) downto 0 do begin try if (Modules[i].NeedsDeInit) then Modules[i].Module.DeInit; except end; end; DeInitCore; Result := true; end; //------------- // Load the Core //------------- function TCore.LoadCore: boolean; begin hLoadingFinished := Hooks.AddEvent('Core/LoadingFinished'); hMainLoop := Hooks.AddEvent('Core/MainLoop'); hTranslate := Hooks.AddEvent('Core/Translate'); hLoadTextures := Hooks.AddEvent('Core/LoadTextures'); hExitQuery := Hooks.AddEvent('Core/ExitQuery'); hExit := Hooks.AddEvent('Core/Exit'); hDebug := Hooks.AddEvent('Core/NewDebugInfo'); hError := Hooks.AddEvent('Core/NewError'); sReportError := Services.AddService('Core/ReportError', nil, Self.ReportError); sReportDebug := Services.AddService('Core/ReportDebug', nil, Self.ReportDebug); sShowMessage := Services.AddService('Core/ShowMessage', nil, Self.ShowMessage); sRetranslate := Services.AddService('Core/Retranslate', nil, Self.Retranslate); sReloadTextures := Services.AddService('Core/ReloadTextures', nil, Self.ReloadTextures); sGetModuleInfo := Services.AddService('Core/GetModuleInfo', nil, Self.GetModuleInfo); sGetApplicationHandle := Services.AddService('Core/GetApplicationHandle', nil, Self.GetApplicationHandle); // A little Test Hooks.AddSubscriber('Core/NewError', HookTest); result := true; end; //------------- // Init the Core //------------- function TCore.InitCore: boolean; begin //Don not init something atm. result := true; end; //------------- // DeInit the Core //------------- function TCore.DeInitCore: boolean; begin // TODO: write TService-/HookManager. Free and call it here Result := true; end; //------------- // Method for other classes to get pointer to a specific module //------------- function TCore.GetModuleByName(const Name: string): PCoreModule; var i: integer; begin Result := nil; for i := 0 to High(Modules) do begin if (Modules[i].Info.Name = Name) then begin Result := @Modules[i].Module; Break; end; end; end; //------------- // Shows a MessageDialog (lParam: PChar Text, wParam: Symbol) //------------- function TCore.ShowMessage(wParam: TwParam; lParam: TlParam): integer; {$IFDEF MSWINDOWS} var Params: Cardinal; {$ENDIF} begin Result := -1; {$IFDEF MSWINDOWS} if (lParam <> nil) then begin Params := MB_OK; case wParam of CORE_SM_ERROR: Params := Params or MB_ICONERROR; CORE_SM_WARNING: Params := Params or MB_ICONWARNING; CORE_SM_INFO: Params := Params or MB_ICONINFORMATION; end; // Show: Result := Messagebox(0, lParam, PChar(Name), Params); end; {$ENDIF} // TODO: write ShowMessage for other OSes end; //------------- // Calls NewError HookChain (wParam: Pchar(Message), lParam: PChar(Reportername)) //------------- function TCore.ReportError(wParam: TwParam; lParam: TlParam): integer; begin //Update LastErrorReporter and LastErrorString LastErrorReporter := string(PChar(lParam)); LastErrorString := string(PChar(Pointer(wParam))); Hooks.CallEventChain(hError, wParam, lParam); // FIXME: return a correct result Result := 0; end; //------------- // Calls NewDebugInfo HookChain (wParam: Pchar(Message), lParam: PChar(Reportername)) //------------- function TCore.ReportDebug(wParam: TwParam; lParam: TlParam): integer; begin Hooks.CallEventChain(hDebug, wParam, lParam); // FIXME: return a correct result Result := 0; end; //------------- // Calls Translate hook //------------- function TCore.Retranslate(wParam: TwParam; lParam: TlParam): integer; begin Hooks.CallEventChain(hTranslate, 1, nil); // FIXME: return a correct result Result := 0; end; //------------- // Calls LoadTextures hook //------------- function TCore.ReloadTextures(wParam: TwParam; lParam: TlParam): integer; begin Hooks.CallEventChain(hLoadTextures, 1, nil); // FIXME: return a correct result Result := 0; end; //------------- // If lParam = nil then get length of Moduleinfo array. If lparam <> nil then write array of TModuleInfo to address at lparam //------------- function TCore.GetModuleInfo(wParam: TwParam; lParam: TlParam): integer; var I: integer; begin if (Pointer(lParam) = nil) then begin Result := Length(Modules); end else begin try for I := 0 to High(Modules) do begin AModuleInfo(Pointer(lParam))[I].Name := Modules[I].Info.Name; AModuleInfo(Pointer(lParam))[I].Version := Modules[I].Info.Version; AModuleInfo(Pointer(lParam))[I].Description := Modules[I].Info.Description; end; Result := Length(Modules); except Result := -1; end; end; end; //------------- // Returns Application Handle //------------- function TCore.GetApplicationHandle(wParam: TwParam; lParam: TlParam): integer; begin Result := hInstance; end; //------------- // Called when setting CurExecuted //------------- procedure TCore.SetCurExecuted(Value: integer); begin // Set Last Executed iLastExecuted := iCurExecuted; // Set Cur Executed iCurExecuted := Value; end; end.