CHANGELOG
Version 2018.2.alpha:
- Misc fixes and enhancements.
- Added BasicScript and CallScriptRoutine demos to show case how to create compile a script, create an standalone exe and how to directly call a script routine from host side.
- Added compiled scripting support. Supports adding verinfo, exe icon, console & gui app and runtime themes. Supports making both EXE and DLLs. Good for adding scripting support for your project, modding etc all in Object Pascal.
SCRIPTING ROUTINES
EXAMPLECode:function Script_Create: TScript; external cDllName; procedure Script_Destroy(var aScript: TScript); external cDllName; procedure Script_Reset(aScript: TScript); external cDllName; function Script_Compile(aScript: TScript; aArchive: TArchive; aFilename: PChar): Boolean; external cDllName; function Script_CreateModule(aScript: TScript; aName: PChar; aConsoleApp: Boolean; aAddVerInfo: Boolean; aArchive: TArchive; aIconFilename: PChar; aEnableRuntimeThemes: Boolean): PChar; external cDllName; function Script_ErrorCount(aScript: TScript): Integer; external cDllName; function Script_WarningCount(aScript: TScript): Integer; external cDllName; function Script_ErrorMessage(aScript: TScript; aIndex: Integer): PChar; external cDllName; function Script_WarningMessage(aScript: TScript; aIndex: Integer): PChar; external cDllName; procedure Script_SaveProgram(aScript: TScript; aFilename: PChar); external cDllName; procedure Script_LoadProgram(aScript: TScript; aArchive: TArchive; aFilename: PChar); external cDllName; procedure Script_Run(aScript: TScript); external cDllName; function Script_CallRoutine(aScript: TScript; aFullname: PChar; aParamList: array of OleVariant): OleVariant; external cDllName; function Script_CreateObject(aScript: TScript; aClassName: PChar; aParamList: array of const): TObject; external cDllName; procedure Script_DestroyObject(aScript: TScript; aObject: TObject); external cDllName; function Script_CallMethod(aScript: TScript; aFullname: PChar; aInstance: TObject; aParamList: array of OleVariant): OleVariant; external cDllName; function Script_GetAddress(aScript: TScript; aFullname: PChar): Pointer; external cDllName; procedure Script_SetCompileEvent(aScript: TScript; aSender: Pointer; aHandler: TScriptCompileEvent); external cDllName; procedure Script_GetCompileEvent(aScript: TScript; var aSender: Pointer; var aHandler: TScriptCompileEvent); external cDllName; procedure Script_SetMessageEvent(aScript: TScript; aSender: Pointer; aHandler: TScriptMessageEvent); external cDllName; procedure Script_GetMessageEvent(aScript: TScript; var aSender: Pointer; var aHandler: TScriptMessageEvent); external cDllName; function Script_RegisterNamespace(aScript: TScript; aLevelId: Integer; aNamespaceName: PChar): Integer; external cDllName; function Script_RegisterRecordType(aScript: TScript; aLevelId: Integer; aTypeName: PChar): Integer; external cDllName; function Script_RegisterRecordTypeField(aScript: TScript; RecordTypeId: Integer; aFieldName: PChar; aFieldTypeID: Integer): Integer; external cDllName; function Script_RegisterSubrangeType(aScript: TScript; aLevelId: Integer; aTypeName: PChar; aTypeBaseId: Integer; aB1: Integer; aB2: Integer): Integer; external cDllName; function Script_RegisterArrayType(aScript: TScript; aLevelId: Integer; aTypeName: PChar; aRangeTypeId: Integer; aElemTypeId: Integer): Integer; external cDllName; function Script_RegisterPointerType(aScript: TScript; aLevelId: Integer; aTypeName: PChar; aOriginTypeId: Integer): Integer; external cDllName; function Script_RegisterSetType(aScript: TScript; aLevelId: Integer; aTypeName: PChar; aOriginTypeId: Integer): Integer; external cDllName; function Script_RegisterProceduralType(aScript: TScript; aLevelId: Integer; aTypeName: PChar; aSubId: Integer): Integer; external cDllName; function Script_RegisterVariableType(aScript: TScript; aLevelId: Integer; aName: PChar; aTypeId: Integer): Integer; external cDllName; function Script_RegisterVariable(aScript: TScript; aLevelId: Integer; aDeclaration: PChar; aAddress: Pointer): Integer; external cDllName; function Script_RegisterClassType(aScript: TScript; aLevelId: Integer; aClass: TClass): Integer; external cDllName; function Script_RegisterHeader(aScript: TScript; aLevelId: Integer; aHeader: PChar; aAddress: Pointer): Integer; external cDllName; function Script_RegisterConstant(aScript: TScript; aLevelId: Integer; aDeclaration: PChar): Integer; external cDllName; function Script_RegisterConstantValue(aScript: TScript; aLevelId: Integer; aName: PChar; aValue: Variant): Integer; external cDllName; function Script_LookupTypeId(aScript: TScript; aTypeName: PChar): Integer; external cDllName; function Script_LookupTypeNamespaceId(aScript: TScript; aTypeName: PChar): Integer; external cDllName; procedure Script_SetVersionInfo(aScript: TScript; aCompanyName: PChar; aFileVersion: PChar; aFileDescription: PChar; aInternalName: PChar; aLegalCopyright: PChar; aLegalTrademarks: PChar; aOriginalFilename: PChar; aProductName: PChar; aProductVersion: PChar; aComments: PChar); external cDllName;
SCRIPTCode:unit uBasicScriptDemo; interface uses System.SysUtils, dRez.Engine, uCommon; type { --- TBasicScriptDemo ------------------------------------------------------ } TBasicScriptDemo = class(TdeBaseGame) protected FArchive: TArchive; FScript: TScript; procedure ShowWarnings; procedure ShowErrors; public procedure CompileEvents(aFilename: string); procedure MessageEvents(aMessage: string); procedure Run; override; end; implementation uses System.IOUtils; { --- TBasicScriptDemo ------------------------------------------------------ } procedure TBasicScriptDemo_ScriptCompileEvents(aSender: Pointer; aFilename: PChar); begin TBasicScriptDemo(aSender).CompileEvents(aFilename); end; procedure TBasicScriptDemo_ScriptMessageEvents(aSender: Pointer; aMessage: PChar); begin TBasicScriptDemo(aSender).MessageEvents(aMessage); end; procedure TBasicScriptDemo.CompileEvents(aFilename: string); begin if not ConsoleApp then Exit; // display the current file being compiled WriteLn('Compiling ', aFilename, '...'); end; procedure TBasicScriptDemo.MessageEvents(aMessage: string); begin if not ConsoleApp then Exit; WriteLn(aMessage); end; procedure TBasicScriptDemo.ShowWarnings; var i,c: Integer; begin if not ConsoleApp then Exit; // get warning count c := Script_WarningCount(FScript); // display wanring message for i := 0 to c-1 do begin WriteLn(Script_WarningMessage(FScript, i)); end; end; // show compile errors procedure TBasicScriptDemo.ShowErrors; var i,c: Integer; begin if not ConsoleApp then Exit; // get error count c := Script_ErrorCount(FScript); // display error message for i := 0 to c-1 do begin WriteLn(Script_ErrorMessage(FScript, i)); end; end; procedure TBasicScriptDemo.Run; var fn: string; begin // check if archive exist, open it fn := TPath.ChangeExtension(ParamStr(0), 'arc'); if TFile.Exists(fn) then begin FArchive := Archive_Create; Archive_Open(FArchive, cArcPassword, 'Examples.arc'); end else begin // otherwise make sure its nil FArchive := nil; end; // create script object FScript := Script_Create; // set script compile event handler Script_SetCompileEvent(FScript, Self, TBasicScriptDemo_ScriptCompileEvents); // set script mesage event handler Script_SetMessageEvent(FScript, Self, TBasicScriptDemo_ScriptMessageEvents); // compile script. if FArchive is not nil will load from archive else // directly from filesystem if Script_Compile(FScript, FArchive, 'arc/scripts/test.pas') then begin // show compiler warnings ShowWarnings; // run whole script //Script_Run(FScript); Script_SetVersionInfo(FScript, 'dRez Games', // CompanyName '1.0.0.0', // FileVersion (must use x.x.x.x format) 'Basic Script Demo', // FileDescription 'Basic Script Demo', // InternalName 'Copyright (c) 2018 dRez Games', // LegalCopyright 'All Rights Reserved', // LegalTrademarks 'BasicScriptDemo.exe', // OriginalFilename 'Basic Script Demo', // ProductName '1.0.0.0', // ProductVersion 'https://drez.games'); // Comments fn := Script_CreateModule(FScript, 'BasicScriptDemo', False, True, FArchive, 'arc/icons/icon-2.ico', True); if fn <> '' then begin if ConsoleApp then begin WriteLn('Created module: ', fn); end; fn := Tpath.GetFullPath(fn); SelectFileInExplorer(PChar(fn)); end; end else begin // show comopiler errors ShowErrors; end; // destroy script object Script_Destroy(FScript); // dispose archive Archive_Destroy(FArchive); end; end.
Code:unit uTest; interface procedure Example_Script; implementation uses dRez.Engine; const cWindowWidth = 480; cWindowHeight = 600; cFullscreen = False; // window ready event handler - can be used for example to pause music/sound // if window does not have focus, mininized etc. procedure Window_ReadyEvent; begin if not ConsoleApp then Exit; if Window_Ready then WriteLn('Window ready...') else WriteLn('Window not ready...'); end; procedure Example_Script; var Starfield: TStarfield; begin // open app window Window_Open('dRez Engine - Basic Script Demo', cWindowWidth, cWindowHeight, cFullscreen, False); // set event handle that will be called if window is ready or not Window_SetReadyEvent(nil, @Window_ReadyEvent); Starfield := Starfield_Create; // LGL game loop - until app has terminated while not Terminated do begin // process events (kbd, mouse, window, etc) ProcessEvents; // check if app window is ready (has focus, not minimized) if not Window_Ready then begin // delay for 1 millisecond (allow background tasks to run) Delay(1); // continue to process events continue; end; // terminate on ESC if Keyboard_Pressed(KEY_ESCAPE) then Terminate(True); // toggle fullscreen on F11 if Keyboard_Pressed(KEY_F11) then Window_ToggleFullscreen; // screenshot on F12 if Keyboard_Pressed(KEY_F12) then Screenshot_Take; Starfield_Update(Starfield, DeltaTime); // clear background to a color Renderer_ClearFrame(BLACK); Starfield_Render(Starfield); // display hud Font_DrawFPS(ConsoleFont, 3, 3, GREEN, 12); Font_DrawText(ConsoleFont, 3, 15, GREEN, 12, 'ESC - Quit'); Font_DrawText(ConsoleFont, 3, 30, GREEN, 12, 'F11 - Toggle Fullscreen'); Font_DrawText(ConsoleFont, 3, 45, GREEN, 12, 'F12 - Screenshot'); // show frame buffer Renderer_ShowFrame; end; Starfield_Destroy(Starfield); // close app window Window_Close; end; end.
Bookmarks