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
Code:
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;
EXAMPLE
Code:
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.
SCRIPT
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.
Reply With Quote
Bookmarks