From 72a00aac9c8991c12021b47ff91212e0eb150294 Mon Sep 17 00:00:00 2001 From: Olly Date: Thu, 7 Mar 2024 02:21:31 +0000 Subject: [PATCH] Restructure some imports --- Source/forms/simba.functionlistform.pas | 110 ++++++++ Source/image/simba.image_stringconv.pas | 4 +- Source/script/imports/simba.import_misc.pas | 40 ++- .../script/imports/simba.import_process.pas | 30 +++ Source/script/imports/simba.import_random.pas | 21 +- Source/script/imports/simba.import_script.pas | 11 + Source/script/imports/simba.import_system.pas | 83 +----- Source/script/imports/simba.import_timing.pas | 13 +- .../script/imports/simba.import_variant.pas | 79 +++--- Source/script/simba.compiler_dump.pas | 174 ++++++------ Source/script/simba.script_compiler.pas | 254 ++++++++++++++++-- 11 files changed, 587 insertions(+), 232 deletions(-) diff --git a/Source/forms/simba.functionlistform.pas b/Source/forms/simba.functionlistform.pas index 125e8d298..79c7c0416 100644 --- a/Source/forms/simba.functionlistform.pas +++ b/Source/forms/simba.functionlistform.pas @@ -82,6 +82,10 @@ TFunctionListState = record function AddPluginDecl(ParentNode: TTreeNode; Decl: TDeclaration): TTreeNode; procedure AddSimbaNodes; + + procedure ArrangeBaseNodes; + + function CompareNodes(A, B: TTreeNode): Integer; public constructor Create(TheOwner: TComponent); override; destructor Destroy; override; @@ -663,6 +667,12 @@ procedure TSimbaFunctionListForm.AddSimbaNodes; AddSimbaDecl(ParentNode, Decl); end; + ParentNode := FSimbaNode.FindNode('Base'); + if Assigned(ParentNode) then + ParentNode.CustomSort(@CompareNodes); + + ArrangeBaseNodes(); + FSimbaNode.AlphaSort(); FSimbaNode.Expanded := True; // This needs to be on main thread it seems? @@ -670,6 +680,106 @@ procedure TSimbaFunctionListForm.AddSimbaNodes; FTreeView.EndUpdate(); end; +procedure TSimbaFunctionListForm.ArrangeBaseNodes; +var + BaseNode: TTreeNode; + Cur: Integer = 0; + + procedure MoveToTop(const NodeText: String); + var + Node: TTreeNode; + begin + Node := BaseNode.FindNode(NodeText); + if not Assigned(Node) then + begin + DebugLn('ArrangeBaseNodes: Not found: ' + NodeText); + Exit; + end; + + Node.Index := Cur; + Inc(Cur); + end; + +begin + BaseNode := FSimbaNode.FindNode('Base'); + if (BaseNode = nil) then + Exit; + + MoveToTop('Integer'); + MoveToTop('Byte'); + MoveToTop('Char'); + MoveToTop('Boolean'); + + MoveToTop('Int8'); + MoveToTop('Int16'); + MoveToTop('Int32'); + MoveToTop('Int64'); + MoveToTop('UInt8'); + MoveToTop('UInt16'); + MoveToTop('UInt32'); + MoveToTop('UInt64'); + + MoveToTop('NativeInt'); + MoveToTop('NativeUInt'); + MoveToTop('SizeInt'); + MoveToTop('SizeUInt'); + MoveToTop('PtrInt'); + MoveToTop('PtrUInt'); + + MoveToTop('Single'); + MoveToTop('Double'); + MoveToTop('Currency'); + + MoveToTop('ByteBool'); + MoveToTop('WordBool'); + MoveToTop('LongBool'); + MoveToTop('EvalBool'); + + MoveToTop('AnsiChar'); + MoveToTop('WideChar'); + + MoveToTop('string'); + MoveToTop('ShortString'); + MoveToTop('AnsiString'); + MoveToTop('WideString'); + MoveToTop('UnicodeString'); + + MoveToTop('Pointer'); + MoveToTop('ConstPointer'); + + MoveToTop('TByteArray'); + MoveToTop('TBooleanArray'); + MoveToTop('TSingleArray'); + MoveToTop('TDoubleArray'); + MoveToTop('TIntegerArray'); + MoveToTop('TInt64Array'); + MoveToTop('TStringArray'); + + MoveToTop('T2DIntegerArray'); + MoveToTop('T2DStringArray'); +end; + +function TSimbaFunctionListForm.CompareNodes(A, B: TTreeNode): Integer; +begin + Result := CompareText(A.Text, B.Text); + + case A.ImageIndex of + IMG_TYPE: Dec(Result, 2000); + IMG_CONST: Dec(Result, 1500); + IMG_VAR: Dec(Result, 1000); + IMG_PROC: Dec(Result, 500); + IMG_FUNC: Dec(Result, 500); + end; + + case B.ImageIndex of + IMG_TYPE: Inc(Result, 2000); + IMG_CONST: Inc(Result, 1500); + IMG_VAR: Inc(Result, 1000); + IMG_PROC: Inc(Result, 500); + IMG_FUNC: Inc(Result, 500); + end; +end; + procedure TSimbaFunctionListForm.DoIdleBegin(Sender: TObject); begin FIsIdle := True; diff --git a/Source/image/simba.image_stringconv.pas b/Source/image/simba.image_stringconv.pas index 5bf01825d..3c4ff08a7 100644 --- a/Source/image/simba.image_stringconv.pas +++ b/Source/image/simba.image_stringconv.pas @@ -28,7 +28,7 @@ interface Name: String[128]; end; -procedure SimbaImage_FromString(Image: TSimbaImage; const Str: String); +procedure SimbaImage_FromString(Image: TSimbaImage; Str: String); function SimbaImage_ToString(Image: TSimbaImage): String; implementation @@ -37,7 +37,7 @@ implementation FPReadPNG, FPWritePNG, simba.encoding, simba.image_lazbridge; -procedure SimbaImage_FromString(Image: TSimbaImage; const Str: String); +procedure SimbaImage_FromString(Image: TSimbaImage; Str: String); var Stream: TStringStream; Header: TImageStringHeader; diff --git a/Source/script/imports/simba.import_misc.pas b/Source/script/imports/simba.import_misc.pas index 8f3513fbb..f3729ee2e 100644 --- a/Source/script/imports/simba.import_misc.pas +++ b/Source/script/imports/simba.import_misc.pas @@ -14,8 +14,7 @@ implementation uses clipbrd, lptypes, - simba.nativeinterface, - simba.settings, simba.compress, simba.encoding; + simba.nativeinterface, simba.settings, simba.compress, simba.encoding, simba.env; (* Misc @@ -23,6 +22,31 @@ implementation Miscellaneous methods that dont go in any other sections. *) +(* +SimbaEnv +-------- +``` +type + SimbaEnv = record + const SimbaPath = 'PathToSimbaDir'; + const IncludesPath = 'PathToSimbaDir/Includes'; + const PluginsPath = 'PathToSimbaDir/Plugins'; + const ScriptsPath = 'PathToSimbaDir/Scripts'; + const ScreenshotsPath = 'PathToSimbaDir/Screenshots'; + const DataPath = 'PathToSimbaDir/Data'; + const TempPath = 'PathToSimbaDir/Data/Temp'; + end; +``` + +Record which contains constants to Simba environment paths. + +*Example:* + +``` +WriteLn(SimbaEnv.ScriptsPath); +``` +*) + (* ClearSimbaOutput ---------------- @@ -151,6 +175,18 @@ procedure ImportMisc(Compiler: TSimbaScript_Compiler); begin ImportingSection := 'Misc'; + addGlobalType([ + 'record', + ' const SimbaPath = "' + SimbaEnv.SimbaPath + '";', + ' const IncludesPath = "' + SimbaEnv.IncludesPath + '";', + ' const PluginsPath = "' + SimbaEnv.PluginsPath + '";', + ' const ScriptsPath = "' + SimbaEnv.ScriptsPath + '";', + ' const ScreenshotsPath = "' + SimbaEnv.ScreenshotsPath + '";', + ' const DataPath = "' + SimbaEnv.DataPath + '";', + ' const TempPath = "' + SimbaEnv.TempPath + '";', + 'end;' + ], 'SimbaEnv'); + addGlobalFunc( 'procedure SetSimbaTitle(S: String);', [ 'begin', diff --git a/Source/script/imports/simba.import_process.pas b/Source/script/imports/simba.import_process.pas index e4e44337a..095079a2e 100644 --- a/Source/script/imports/simba.import_process.pas +++ b/Source/script/imports/simba.import_process.pas @@ -142,6 +142,33 @@ procedure _LapeTerminateProcess(const Params: PParamArray; const Result: Pointer SimbaProcess.TerminateProcess(PProcessID(Params^[0])^); end; +procedure _LapeGetEnvVar(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +begin + PString(Result)^ := GetEnvironmentVariable(PString(Params^[0])^); +end; + +procedure _LapeGetEnvVars(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV + + function _GetEnvVars: TStringArray; + var + Count, I: Integer; + begin + Count := 0; + + SetLength(Result, GetEnvironmentVariableCount() + 1); + for I := 1 to GetEnvironmentVariableCount() do + if (GetEnvironmentString(I) <> '') then + begin + Result[Count] := GetEnvironmentString(I); + Inc(Count); + end; + SetLength(Result, Count); + end; + +begin + PStringArray(Result)^ := _GetEnvVars(); +end; + procedure ImportProcess(Compiler: TSimbaScript_Compiler); begin with Compiler do @@ -163,6 +190,9 @@ procedure ImportProcess(Compiler: TSimbaScript_Compiler); addGlobalFunc('function RunCommand(Executable: String; Commands: TStringArray): TProcessID; overload', @_LapeRunCommand); addGlobalFunc('function RunCommandTimeout(Executable: String; Commands: TStringArray; out Output: String; Timeout: Integer): Boolean', @_LapeRunCommandTimeout); + addGlobalFunc('function GetEnvVar(Name: String): String', @_LapeGetEnvVar); + addGlobalFunc('function GetEnvVars: TStringArray', @_LapeGetEnvVars); + ImportingSection := ''; end; end; diff --git a/Source/script/imports/simba.import_random.pas b/Source/script/imports/simba.import_random.pas index 07ee7a52f..916dc54c8 100644 --- a/Source/script/imports/simba.import_random.pas +++ b/Source/script/imports/simba.import_random.pas @@ -36,9 +36,28 @@ implementation Methods relating to generating random numbers. *) +(* +Random +------ +> function Random: Double;' +*) + +(* +Random +------ +> function Random(l: Int64): Int64; +*) + +(* +Random +------ +> function Random(min, max: Int64): Int64; +> function Random(min, max: Double): Double; +*) + (* RandSeed ----------- +-------- > var RandSeed: UInt32; The random seed used for all random number generation. diff --git a/Source/script/imports/simba.import_script.pas b/Source/script/imports/simba.import_script.pas index 2e40c406f..121e256f1 100644 --- a/Source/script/imports/simba.import_script.pas +++ b/Source/script/imports/simba.import_script.pas @@ -188,6 +188,17 @@ procedure ImportScript(Compiler: TSimbaScript_Compiler); begin ImportingSection := 'Script'; + // Assigned later in `TSimbaScript.Run` + addGlobalVar('String', '', 'SCRIPT_FILE').isConstant := True; + addGlobalVar('UInt64', '0', 'SCRIPT_START_TIME').isConstant := True; + + addDelayedCode([ + 'function GetTimeRunning: UInt64;', + 'begin', + ' Result := GetTickCount() - SCRIPT_START_TIME;', + 'end;' + ]); + addGlobalFunc('function RunScript(Script: String; Parameters: TStringArray; out Output: String): TProcessExitStatus; overload', @_LapeRunScript); addGlobalFunc('function RunScript(Script: String; Parameters: TStringArray): TProcessID; overload', @_LapeRunScriptEx); addGlobalFunc('function RunScriptOutputToFile(Script: String; Parameters: TStringArray; OutputFileName: String): TProcessID', @_LapeRunScriptOutputToFile); diff --git a/Source/script/imports/simba.import_system.pas b/Source/script/imports/simba.import_system.pas index 29eb14da1..a3992e457 100644 --- a/Source/script/imports/simba.import_system.pas +++ b/Source/script/imports/simba.import_system.pas @@ -23,38 +23,6 @@ implementation Base methods and types. *) -procedure _LapePreciseSleep(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - SimbaNativeInterface.PreciseSleep(PUInt32(Params^[0])^); -end; - -procedure _LapeGetEnvVar(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PString(Result)^ := GetEnvironmentVariable(PString(Params^[0])^); -end; - -procedure _LapeGetEnvVars(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV - - function _GetEnvVars: TStringArray; - var - Count, I: Integer; - begin - Count := 0; - - SetLength(Result, GetEnvironmentVariableCount() + 1); - for I := 1 to GetEnvironmentVariableCount() do - if (GetEnvironmentString(I) <> '') then - begin - Result[Count] := GetEnvironmentString(I); - Inc(Count); - end; - SetLength(Result, Count); - end; - -begin - PStringArray(Result)^ := _GetEnvVars(); -end; - (* GetMem ------ @@ -335,36 +303,11 @@ procedure _LapeGetEnvVars(const Params: PParamArray; const Result: Pointer); LAP > function FreeLibrary(Lib: TLibHandle): EvalBool; *) -(* -SimbaEnv --------- -``` -type - SimbaEnv = record - const SimbaPath = 'PathToSimbaDir'; - const IncludesPath = 'PathToSimbaDir/Includes'; - const PluginsPath = 'PathToSimbaDir/Plugins'; - const ScriptsPath = 'PathToSimbaDir/Scripts'; - const ScreenshotsPath = 'PathToSimbaDir/Screenshots'; - const DataPath = 'PathToSimbaDir/Data'; - const TempPath = 'PathToSimbaDir/Data/Temp'; - end; -``` - -Record which contains constants to Simba environment paths. - -*Example:* - -``` -WriteLn(SimbaEnv.ScriptsPath); -``` -*) - procedure ImportSystem(Compiler: TSimbaScript_Compiler); begin with Compiler do begin - ImportingSection := 'System'; + ImportingSection := 'Base'; addBaseDefine('SIMBA' + Format('%d', [SIMBA_VERSION])); addBaseDefine('SIMBAMAJOR' + Format('%d', [SIMBA_MAJOR])); @@ -386,6 +329,9 @@ procedure ImportSystem(Compiler: TSimbaScript_Compiler); addBaseDefine('LINUX'); {$ENDIF} + addGlobalType(getBaseType(DetermineIntType(SizeOf(Byte), False)).createCopy(), 'Byte'); + addGlobalType(getBaseType(DetermineIntType(SizeOf(Integer), True)).createCopy(), 'Integer'); + addGlobalType('Int32', 'TColor'); addGlobalType('array of TColor', 'TColorArray'); @@ -405,29 +351,8 @@ procedure ImportSystem(Compiler: TSimbaScript_Compiler); addGlobalType('record X1, Y1, X2, Y2: Integer; end', 'TBox'); addGlobalType('array of TBox', 'TBoxArray'); - addGlobalType('record X, Y: Single; end', 'TPointF'); - addGlobalType('(__LT__, __GT__, __EQ__, __LE__, __GE__, __NE__)', 'EComparator'); - addGlobalFunc('function GetEnvVar(Name: String): String', @_LapeGetEnvVar); - addGlobalFunc('function GetEnvVars: TStringArray', @_LapeGetEnvVars); - - addGlobalType([ - 'record', - ' const SimbaPath = "' + SimbaEnv.SimbaPath + '";', - ' const IncludesPath = "' + SimbaEnv.IncludesPath + '";', - ' const PluginsPath = "' + SimbaEnv.PluginsPath + '";', - ' const ScriptsPath = "' + SimbaEnv.ScriptsPath + '";', - ' const ScreenshotsPath = "' + SimbaEnv.ScreenshotsPath + '";', - ' const DataPath = "' + SimbaEnv.DataPath + '";', - ' const TempPath = "' + SimbaEnv.TempPath + '";', - 'end;' - ], 'SimbaEnv'); - - // Assigned later in `TSimbaScript.Run` - addGlobalVar('String', '', 'SCRIPT_FILE').isConstant := True; - addGlobalVar('UInt64', '0', 'SCRIPT_START_TIME').isConstant := True; - ImportingSection := ''; end; end; diff --git a/Source/script/imports/simba.import_timing.pas b/Source/script/imports/simba.import_timing.pas index 0f7f71745..be3bb6322 100644 --- a/Source/script/imports/simba.import_timing.pas +++ b/Source/script/imports/simba.import_timing.pas @@ -22,6 +22,12 @@ implementation Timing *) +(* +Sleep +----- +> procedure Sleep(MilliSeconds: UInt32); +*) + (* PreciseSleep ------------ @@ -140,13 +146,6 @@ procedure ImportTiming(Compiler: TSimbaScript_Compiler); addGlobalFunc('function FormatMilliseconds(Time: Double; Format: String): String; overload;', @_LapeFormatMilliseconds1); addGlobalFunc('function FormatMilliseconds(Time: Double; TimeSymbols: Boolean = False): String; overload;', @_LapeFormatMilliseconds2); - addDelayedCode([ - 'function GetTimeRunning: UInt64;', - 'begin', - ' Result := GetTickCount() - SCRIPT_START_TIME;', - 'end;' - ]); - addDelayedCode([ 'type', ' TStopwatch = record', diff --git a/Source/script/imports/simba.import_variant.pas b/Source/script/imports/simba.import_variant.pas index a76ef5694..6797811bd 100644 --- a/Source/script/imports/simba.import_variant.pas +++ b/Source/script/imports/simba.import_variant.pas @@ -30,13 +30,22 @@ implementation ``` var v: Variant; begin - WriteLn('Should be unassigned: ', v = Variant.UnAssigned); + WriteLn('Should be unassigned: ', not v.IsAssigned()); + WriteLn(); + v := 'I am a string'; - Writeln('Now should *not* be unassigned: ', v = Variant.Unassigned); + Writeln('Now should *not* be unassigned: ', v.IsAssigned()); WriteLn('And should be string:'); WriteLn(v.VarType, ' -> ', v); - v := 123; - WriteLn('Now should be integer:'); + WriteLn(); + + v := Int64(123); + WriteLn('Now should be Int64:'); + WriteLn(v.VarType, ' -> ', v); + WriteLn(); + + v := 0.123456; + WriteLn('Now should be Double:'); WriteLn(v.VarType, ' -> ', v); end; ``` @@ -56,7 +65,14 @@ InternalVariantData = record type {$SCOPEDENUMS ON} PVariantType = ^EVariantType; - EVariantType = (Unknown, Unassigned, Null, Int8, Int16, Int32, Int64, UInt8, UInt16, UInt32, UInt64, Single, Double, DateTime, Currency, Boolean, Variant, AString, UString, WString); + EVariantType = ( + Unknown, Unassigned, Null, + Int8, Int16, Int32, Int64, UInt8, UInt16, UInt32, UInt64, + Single, Double, DateTime, Currency, + Boolean, + Variant, + AString, UString, WString + ); {$SCOPEDENUMS OFF} (* @@ -175,13 +191,22 @@ procedure _LapeVariantIsVariant(const Params: PParamArray; const Result: Pointer end; (* -Variant.IsUnAssigned --------------------- -> function Variant.IsUnAssigned: Boolean; +Variant.IsAssigned +------------------ +> function Variant.IsAssigned: Boolean; + +Example: + +``` + if v.IsAssigned() then + WriteLn('Variant HAS been assigned to') + else + WriteLn('The variant has NOT been assigned to'); +``` *) -procedure _LapeVariantIsUnAssigned(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeVariantIsAssigned(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PBoolean(Result)^ := VarIsClear(PVariant(Params^[0])^); + PBoolean(Result)^ := not VarIsClear(PVariant(Params^[0])^); end; (* @@ -195,42 +220,23 @@ procedure _LapeVariantIsNull(const Params: PParamArray; const Result: Pointer); end; (* -Variant.Null +Variant.NULL ------------ -> function Variant.Null: Variant; static; +> function Variant.NULL: Variant; static; Static method that returns a null variant variable. Example: ``` - v := Variant.Null; + v := Variant.NULL; ``` *) -procedure _LapeVariantNull(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeVariantNULL(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin PVariant(Result)^ := Null; end; -(* -Variant.Unassigned ------------------- -> function Variant.Unassigned: Variant; static; - -Static method that returns a unassigned variant variable. - -Example: - -``` - if (v = Variant.Unassigned) then - WriteLn('The variant has not been assigned to!'); -``` -*) -procedure _LapeVariantUnassigned(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PVariant(Result)^ := Unassigned; -end; - procedure ImportVariant(Compiler: TSimbaScript_Compiler); begin with Compiler do @@ -247,11 +253,10 @@ procedure ImportVariant(Compiler: TSimbaScript_Compiler); addGlobalFunc('function Variant.IsString: Boolean;', @_LapeVariantIsString); addGlobalFunc('function Variant.IsBoolean: Boolean;', @_LapeVariantIsBoolean); addGlobalFunc('function Variant.IsVariant: Boolean;', @_LapeVariantIsVariant); - addGlobalFunc('function Variant.IsUnAssigned: Variant; static;', @_LapeVariantIsUnAssigned); - addGlobalFunc('function Variant.IsNull: Variant; static;', @_LapeVariantIsNull); + addGlobalFunc('function Variant.IsAssigned: Boolean;', @_LapeVariantIsAssigned); + addGlobalFunc('function Variant.IsNull: Boolean;', @_LapeVariantIsNull); - addGlobalFunc('function Variant.Null: Variant; static;', @_LapeVariantNull); - addGlobalFunc('function Variant.Unassigned: Variant; static;', @_LapeVariantUnassigned); + addGlobalFunc('function Variant.NULL: Variant; static;', @_LapeVariantNULL); ImportingSection := ''; end; diff --git a/Source/script/simba.compiler_dump.pas b/Source/script/simba.compiler_dump.pas index f09c1deac..79ab86d89 100644 --- a/Source/script/simba.compiler_dump.pas +++ b/Source/script/simba.compiler_dump.pas @@ -28,9 +28,7 @@ TSimbaCompilerDump = class(TSimbaScript_Compiler) FItems: TSimbaStringPairList; procedure InitBaseVariant; override; - procedure InitBaseMath; override; procedure InitBaseDefinitions; override; - procedure InitBaseDateTime; override; procedure InitBaseFile; override; procedure Add(Section, Str: String); @@ -39,6 +37,7 @@ TSimbaCompilerDump = class(TSimbaScript_Compiler) procedure AddCode(Str: String; EnsureSemicolon: Boolean = True); procedure Move(Str, FromSection, ToSection: String); + procedure Del(Str, Section: String); public constructor Create(ATokenizer: TLapeTokenizerBase; ManageTokenizer: Boolean=True; AEmitter: TLapeCodeEmitter = nil; ManageEmitter: Boolean = True); reintroduce; override; destructor Destroy; override; @@ -74,24 +73,64 @@ procedure TSimbaCompilerDump.InitBaseVariant; { nothing, we import our own variant } end; -procedure TSimbaCompilerDump.InitBaseMath; -begin - ImportingSection := 'Math'; - inherited InitBaseMath(); - ImportingSection := ''; -end; - procedure TSimbaCompilerDump.InitBaseDefinitions; +var + BaseType: ELapeBaseType; begin - ImportingSection := 'System'; + ImportingSection := 'Base'; + + // Base types + for BaseType in ELapeBaseType do + if (FBaseTypes[BaseType] <> nil) then + Add('Base', 'type %s = %s;'.Format([LapeTypeToString(BaseType), LapeTypeToString(BaseType)])); + inherited InitBaseDefinitions(); - ImportingSection := ''; -end; -procedure TSimbaCompilerDump.InitBaseDateTime; -begin - ImportingSection := 'DateTime'; - inherited InitBaseDateTime(); + // add internal methods + Add('Base', 'procedure Delete(A: array; Index: Int32; Count: Int32 = Length(A)); external;'); + Add('Base', 'procedure Insert(Item: Anything; A: array; Index: Int32); external;'); + Add('Base', 'procedure Copy(A: array; Index: Int32 = 0; Count: Int32 = Length(A)); overload; external;'); + Add('Base', 'procedure SetLength(A: array; Length: Int32); overload; external;'); + Add('Base', 'function Low(A: array): Int32; external;'); + Add('Base', 'function High(A: array): Int32; external;'); + Add('Base', 'function Length(A: array): Int32; overload; external;'); + Add('Base', 'procedure WriteLn(Args: Anything); external;'); + Add('Base', 'procedure Write(Args: Anything); external;'); + Add('Base', 'procedure Swap(var A, B: Anything); external;'); + Add('Base', 'function SizeOf(A: Anything): Int32; external;'); + Add('Base', 'function ToString(A: Anything): String; external;'); + Add('Base', 'function ToStr(A: Anything): String; external;'); + Add('Base', 'function Inc(var X: Ordinal; Amount: SizeInt = 1): Ordinal; overload; external;'); + Add('Base', 'function Dec(var X: Ordinal; Amount: SizeInt = 1): Ordinal; overload; external;'); + Add('Base', 'function Ord(X: Ordinal): Int32; external;'); + Add('Base', 'function SleepUntil(Condition: BoolExpr; Interval, Timeout: Int32): Boolean; external;'); + Add('Base', 'function Default(T: AnyType): AnyType; external;'); + Add('Base', 'procedure Sort(var A: array); overload; external;'); + Add('Base', 'procedure Sort(var A: array; Weights: array of Ordinal; LowToHigh: Boolean); overload; external;'); + Add('Base', 'procedure Sort(var A: array; CompareFunc: function(constref L, R: Anything): Int32); overload; external;'); + Add('Base', 'function Sorted(const A: array): array; overload; external;'); + Add('Base', 'function Sorted(const A: array; CompareFunc: function(constref L, R: Anything): Int32): array; overload; external;'); + Add('Base', 'function Sorted(const A: array; Weights: array of Ordinal; LowToHigh: Boolean): array; overload; external;'); + Add('Base', 'function Unique(const A: array): array; external;'); + Add('Base', 'procedure Reverse(var A: array); external;'); + Add('Base', 'function Reversed(const A: array): array; external;'); + Add('Base', 'function IndexOf(const Item: T; const A: array): Integer; external;'); + Add('Base', 'function IndicesOf(const Item: T; const A: array): TIntegerArray; external;'); + Add('Base', 'function Contains(const Item: T; const A: array): Boolean; external;'); + Add('Base', 'function RTTIFields(constref RecordTypeOrVar): TRTTIFields; external;'); + + Add('Base', 'function GetCallerAddress: Pointer; external;'); + Add('Base', 'function GetCallerName: String; external;'); + Add('Base', 'function GetCallerLocation: Pointer; external;'); + Add('Base', 'function GetCallerLocationStr: String; external;'); + + Add('Base', 'function GetExceptionLocation: Pointer; external;'); + Add('Base', 'function GetExceptionLocationStr: String; external;'); + Add('Base', 'function GetExceptionMessage: String; external;'); + + Add('Base', 'function GetScriptMethodName(Address: Pointer): String; external;'); + Add('Base', 'function DumpCallStack(Start: Integer = 0): String; external;'); + ImportingSection := ''; end; @@ -130,6 +169,18 @@ procedure TSimbaCompilerDump.Move(Str, FromSection, ToSection: String); end; end; +procedure TSimbaCompilerDump.Del(Str, Section: String); +var + I: Integer; +begin + for I := 0 to FItems.Count - 1 do + if (FItems[I].Name = Section) and FItems[I].Value.StartsWith(Str) then + begin + FItems.Delete(I); + Exit; + end; +end; + procedure TSimbaCompilerDump.AddMethod(Str: String); begin Str := Str.Trim(); @@ -228,8 +279,6 @@ function TSimbaCompilerDump.addGlobalVar(Typ: lpString; Value: lpString; AName: begin Result := inherited addGlobalVar(Typ, Value, AName); Result._DocPos.FileName := ImportingSection; - - // AddType end; function TSimbaCompilerDump.addGlobalVar(AVar: TLapeGlobalVar; AName: lpString): TLapeGlobalVar; @@ -240,18 +289,12 @@ function TSimbaCompilerDump.addGlobalVar(AVar: TLapeGlobalVar; AName: lpString): procedure TSimbaCompilerDump.DumpToFile(FileName: String); var - BaseType: ELapeBaseType; Decl: TLapeDeclaration; I: Integer; Str: String; begin Import(); - // Base types - for BaseType in ELapeBaseType do - if (FBaseTypes[BaseType] <> nil) then - Add('System', 'type %s = %s;'.Format([LapeTypeToString(BaseType), LapeTypeToString(BaseType)])); - // Variables & Constants for Decl in FGlobalDeclarations.GetByClass(TLapeGlobalVar, bTrue) do with TLapeGlobalVar(Decl) do @@ -275,70 +318,25 @@ procedure TSimbaCompilerDump.DumpToFile(FileName: String); Add(DocPos.FileName, Str); end; - // add internals - Add('System', 'procedure Delete(A: array; Index: Int32; Count: Int32 = Length(A)); external;'); - Add('System', 'procedure Insert(Item: Anything; A: array; Index: Int32); external;'); - Add('System', 'procedure Copy(A: array; Index: Int32 = 0; Count: Int32 = Length(A)); overload; external;'); - Add('System', 'procedure SetLength(A: array; Length: Int32); overload; external;'); - Add('System', 'function Low(A: array): Int32; external;'); - Add('System', 'function High(A: array): Int32; external;'); - Add('System', 'function Length(A: array): Int32; overload; external;'); - Add('System', 'procedure WriteLn(Args: Anything); external;'); - Add('System', 'procedure Write(Args: Anything); external;'); - Add('System', 'procedure Swap(var A, B: Anything); external;'); - Add('System', 'function SizeOf(A: Anything): Int32; external;'); - Add('System', 'function ToString(A: Anything): String; external;'); - Add('System', 'function ToStr(A: Anything): String; external;'); - Add('System', 'function Inc(var X: Ordinal; Amount: SizeInt = 1): Ordinal; overload; external;'); - Add('System', 'function Dec(var X: Ordinal; Amount: SizeInt = 1): Ordinal; overload; external;'); - Add('System', 'function Ord(X: Ordinal): Int32; external;'); - Add('System', 'function SleepUntil(Condition: BoolExpr; Interval, Timeout: Int32): Boolean; external;'); - Add('System', 'function Default(T: AnyType): AnyType; external;'); - Add('System', 'procedure Sort(var A: array); overload; external;'); - Add('System', 'procedure Sort(var A: array; Weights: array of Ordinal; LowToHigh: Boolean); overload; external;'); - Add('System', 'procedure Sort(var A: array; CompareFunc: function(constref L, R: Anything): Int32); overload; external;'); - Add('System', 'function Sorted(const A: array): array; overload; external;'); - Add('System', 'function Sorted(const A: array; CompareFunc: function(constref L, R: Anything): Int32): array; overload; external;'); - Add('System', 'function Sorted(const A: array; Weights: array of Ordinal; LowToHigh: Boolean): array; overload; external;'); - Add('System', 'function Unique(const A: array): array; external;'); - Add('System', 'procedure Reverse(var A: array); external;'); - Add('System', 'function Reversed(const A: array): array; external;'); - Add('System', 'function IndexOf(const Item: T; const A: array): Integer; external;'); - Add('System', 'function IndicesOf(const Item: T; const A: array): TIntegerArray; external;'); - Add('System', 'function Contains(const Item: T; const A: array): Boolean; external;'); - Add('System', 'function RTTIFields(constref RecordTypeOrVar): TRTTIFields; external;'); - - Add('System', 'function GetCallerAddress: Pointer; external;'); - Add('System', 'function GetCallerName: String; external;'); - Add('System', 'function GetCallerLocation: Pointer; external;'); - Add('System', 'function GetCallerLocationStr: String; external;'); - - Add('System', 'function GetExceptionLocation: Pointer; external;'); - Add('System', 'function GetExceptionLocationStr: String; external;'); - Add('System', 'function GetExceptionMessage: String; external;'); - - Add('System', 'function GetScriptMethodName(Address: Pointer): String; external;'); - Add('System', 'function DumpCallStack(Start: Integer = 0): String; external;'); - - // Move lape stuff to better sections - Move('function Random(min, max: Int64): Int64;', 'Math', 'Random'); - Move('function Random(min, max: Double): Double', 'Math', 'Random'); - Move('function Random(l: Int64): Int64', 'Math', 'Random'); - Move('function Random: Double', 'Math', 'Random'); - Move('procedure Randomize', 'Math', 'Random'); - Move('var RandSeed', 'Math', 'Random'); - - Move('function GetTickCount: UInt64', 'DateTime', 'Timing'); - Move('procedure Sleep(MilliSeconds: UInt32);', 'DateTime', 'Timing'); - - Move('type TBox = record X1, Y1, X2, Y2: Integer; end;', 'System', 'TBox'); - Move('type TBoxArray = array of TBox;', 'System', 'TBox'); - - Move('type TQuad = record Top, Right, Bottom, Left: TPoint; end;', 'System', 'TQuad'); - Move('type TQuadArray = array of TQuad;', 'System', 'TQuad'); - - Move('type TPoint = record X, Y: Integer; end;', 'System', 'TPoint'); - Move('type TPointArray = array of TPoint;', 'System', 'TPointArray'); + Move('type TBox = record X1, Y1, X2, Y2: Integer; end;', 'Base', 'TBox'); + Move('type TBoxArray = array of TBox;', 'Base', 'TBox'); + + Move('type TQuad = record Top, Right, Bottom, Left: TPoint; end;', 'Base', 'TQuad'); + Move('type TQuadArray = array of TQuad;', 'Base', 'TQuad'); + + Move('type TPoint = record X, Y: Integer; end;', 'Base', 'TPoint'); + Move('type TPointArray = array of TPoint;', 'Base', 'TPointArray'); + + Move('type TColor = Int32', 'Base', 'Color Math'); + Move('type TColorArray = array of TColor;', 'Base', 'Color Math'); + + Move('type Variant = Variant', 'Base', 'Variant'); + Move('type TVariantArray = array of Variant', 'Base', 'Variant'); + + Move('type T2DPointArray = array of TPointArray;', 'Base', 'T2DPointArray'); + + Del('function Hash(Str: String): UInt32', 'Base'); + Del('function Hash(constref Data; DataSize: UInt32): UInt32', 'Base'); with TStringList.Create() do try diff --git a/Source/script/simba.script_compiler.pas b/Source/script/simba.script_compiler.pas index 94811ce6a..1eb5a2a65 100644 --- a/Source/script/simba.script_compiler.pas +++ b/Source/script/simba.script_compiler.pas @@ -28,10 +28,10 @@ TSimbaScript_Compiler = class(TLapeCompiler) procedure InitBaseFile; override; procedure InitBaseVariant; override; procedure InitBaseDefinitions; override; + procedure InitBaseMath; override; + procedure InitBaseString; override; + procedure InitBaseDateTime; override; public - procedure pushTokenizer(ATokenizer: TLapeTokenizerBase); reintroduce; - procedure pushConditional(AEval: Boolean; ADocPos: TDocPos); reintroduce; - procedure addDelayedCode(Code: TStringArray; AFileName: lpString = ''); virtual; overload; function addGlobalFunc(Header: lpString; Body: TStringArray): TLapeTree_Method; virtual; overload; @@ -128,15 +128,11 @@ procedure TSimbaScript_Compiler.Import; try Options := Options + [lcoAutoInvoke, lcoExplicitSelf, lcoAutoObjectify, lcoRelativeFileNames] - [lcoInheritableRecords]; - ImportingSection := 'System'; - InitializeImageFromString(Self); InitializeSleepUntil(Self); InitializeFFI(Self); InitializeRTTI(Self); - ImportingSection := ''; - AddSimbaImports(Self); finally EndImporting(); @@ -187,12 +183,12 @@ function TSimbaScript_Compiler.GetImportingSection: String; procedure TSimbaScript_Compiler.InitBaseFile; begin - { nothing, we import our own file } + { nothing, we import our own file later } end; procedure TSimbaScript_Compiler.InitBaseVariant; begin - { nothing, we import our own variant } + { nothing, we import our own variant later } end; procedure TSimbaScript_Compiler.addGlobalFuncOverride(Header: lpString; Body: TStringArray); @@ -203,21 +199,247 @@ procedure TSimbaScript_Compiler.addGlobalFuncOverride(Header: lpString; Body: TS procedure TSimbaScript_Compiler.InitBaseDefinitions; begin - addGlobalType(getBaseType(DetermineIntType(SizeOf(Byte), False)).createCopy(), 'Byte'); - addGlobalType(getBaseType(DetermineIntType(SizeOf(Integer), True)).createCopy(), 'Integer'); - addGlobalType(getPointerType(ltChar, False).createCopy(), 'PChar'); + ImportingSection := 'Base'; inherited InitBaseDefinitions(); + + if (Globals['Hash'] <> nil) then + Globals['Hash'].Free(); + + ImportingSection := ''; +end; + +// lpeval_import_math.inc but moved Random functions under Random section +procedure TSimbaScript_Compiler.InitBaseMath; +begin + ImportingSection := 'Math'; + + addGlobalVar(Pi, 'Pi').isConstant := True; + + addGlobalFunc('function Min(x,y: Int64): Int64; overload;', @_LapeMin); + addGlobalFunc('function Min(x,y: Double): Double; overload;', @_LapeMinF); + addGlobalFunc('function Max(x,y: Int64): Int64; overload;', @_LapeMax); + addGlobalFunc('function Max(x,y: Double): Double; overload;', @_LapeMaxF); + addGlobalFunc('function EnsureRange(Value, Min, Max: Int64): Int64; overload;', @_LapeEnsureRange); + addGlobalFunc('function EnsureRange(Value, Min, Max: Double): Double; overload;', @_LapeEnsureRangeF); + addGlobalFunc('function InRange(Value, Min, Max: Int64): Boolean; overload;', @_LapeInRange); + addGlobalFunc('function InRange(Value, Min, Max: Double): Boolean; overload;', @_LapeInRangeF); + + addGlobalFunc('function Abs(x: Double): Double; overload;', @_LapeAbs); + addGlobalFunc('function Abs(x: Int64): Int64; overload;', @_LapeAbsI); + addGlobalFunc('function Sign(AValue: Int64): Int8; overload;', @_LapeSign); + addGlobalFunc('function Sign(AValue: Double): Int8; overload;', @_LapeSignF); + addGlobalFunc('function Power(Base, Exponent: Double): Double;', @_LapePower); + addGlobalFunc('function Sqr(x: Double): Double; overload;', @_LapeSqr); + addGlobalFunc('function Sqr(x: Int64): Int64; overload;', @_LapeSqrI); + addGlobalFunc('function Sqrt(x: Double): Double;', @_LapeSqrt); + addGlobalFunc('function ArcTan(x: Double): Double;', @_LapeArcTan); + addGlobalFunc('function Ln(x: Double): Double;', @_LapeLn); + addGlobalFunc('function Sin(x: Double): Double;', @_LapeSin); + addGlobalFunc('function Cos(x: Double): Double;', @_LapeCos); + addGlobalFunc('function Exp(x: Double): Double;', @_LapeExp); + addGlobalFunc('function Hypot(x,y: Double): Double', @_LapeHypot); + addGlobalFunc('function ArcTan2(x,y: Double): Double', @_LapeArcTan2); + addGlobalFunc('function Tan(x: Double): Double', @_LapeTan); + addGlobalFunc('function ArcSin(x: Double): Double', @_LapeArcSin); + addGlobalFunc('function ArcCos(x: Double): Double', @_LapeArcCos); + addGlobalFunc('function Cotan(x: Double): Double', @_LapeCotan); + addGlobalFunc('function Secant(x: Double): Double', @_LapeSecant); + addGlobalFunc('function Cosecant(x: Double): Double', @_LapeCosecant); + addGlobalFunc('function Round(x: Double): Int64; overload;', @_LapeRound); + addGlobalFunc('function Round(x: Double; Precision: Int8): Double; overload;', @_LapeRoundTo); + addGlobalFunc('function Frac(x: Double): Double;', @_LapeFrac); + addGlobalFunc('function Int(x: Double): Double;', @_LapeInt); + addGlobalFunc('function Trunc(x: Double): Int64;', @_LapeTrunc); + addGlobalFunc('function Ceil(x: Double): Int64; overload;', @_LapeCeil); + addGlobalFunc('function Ceil(x: Double; Precision: Int8): Double; overload;', @_LapeCeilTo); + addGlobalFunc('function Floor(x: Double): Int64;', @_LapeFloor); + addGlobalFunc('function CosH(x: Double): Double;', @_LapeCosH); + addGlobalFunc('function SinH(x: Double): Double;', @_LapeSinH); + addGlobalFunc('function TanH(x: Double): Double;', @_LapeTanH); + addGlobalFunc('function ArcCosH(x: Double): Double;', @_LapeArcCosH); + addGlobalFunc('function ArcSinH(x: Double): Double;', @_LapeArcSinH); + addGlobalFunc('function ArcTanH(x: Double): Double;', @_LapeArcTanH); + addGlobalFunc('procedure SinCos(theta: Double; out sinus, cosinus: Double);', @_LapeSinCos); + addGlobalFunc('procedure DivMod(Dividend: UInt32; Divisor: UInt16; var Result, Remainder: UInt16);', @_LapeDivMod); + + ImportingSection := 'Random'; + + addGlobalVar(ltUInt32, @RandSeed, 'RandSeed'); + + addGlobalFunc('function Random(min, max: Int64): Int64; overload;', @_LapeRandomRange); + addGlobalFunc('function Random(min, max: Double): Double; overload;', @_LapeRandomRangeF); + addGlobalFunc('function Random(l: Int64): Int64; overload;', @_LapeRandom); + addGlobalFunc('function Random: Double; overload;', @_LapeRandomF); + addGlobalFunc('procedure Randomize;', @_LapeRandomize); + + ImportingSection := ''; end; -procedure TSimbaScript_Compiler.pushTokenizer(ATokenizer: TLapeTokenizerBase); +// lpeval_import_string.inc but removed a few things +procedure TSimbaScript_Compiler.InitBaseString; begin - inherited pushTokenizer(ATokenizer); + ImportingSection := 'Base'; + + addGlobalType('set of (rfReplaceAll, rfIgnoreCase)', 'TReplaceFlags'); + + addGlobalFunc('function UTF8Encode(s: WideString): AnsiString; overload;', @_LapeUTF8EncodeW); + addGlobalFunc('function UTF8Encode(s: UnicodeString): AnsiString; overload;', @_LapeUTF8EncodeU); + addGlobalFunc('function UTF8Decode(s: AnsiString): WideString; overload;', @_LapeUTF8DecodeW); + addGlobalFunc('function UTF8Decode(s: AnsiString): UnicodeString; overload;', @_LapeUTF8DecodeU); + + // locale independent + addGlobalFunc('function UpperCase(s: string): string;', @_LapeUpperCase); + addGlobalFunc('function LowerCase(s: string): string;', @_LapeLowerCase); + addGlobalFunc('function UpCase(c: AnsiChar): AnsiChar; overload;', @_LapeUpCaseA); + addGlobalFunc('function UpCase(c: WideChar): WideChar; overload;', @_LapeUpCaseW); + + addGlobalFunc('function CompareStr(s1, s2: string): Int32;', @_LapeCompareStr); + addGlobalFunc('function CompareText(s1, s2: string): Int32;', @_LapeCompareText); + addGlobalFunc('function SameText(s1, s2: string): EvalBool;', @_LapeSameText); + + // Uses current user locale + addGlobalFunc('function AnsiUpperCase(s: string): string;', @_LapeAnsiUpperCase); + addGlobalFunc('function AnsiLowerCase(s: string): string;', @_LapeAnsiLowerCase); + addGlobalFunc('function AnsiCompareStr(s1, s2: string): Int32;', @_LapeAnsiCompareStr); + addGlobalFunc('function AnsiCompareText(s1, s2: string): Int32;', @_LapeAnsiCompareText); + addGlobalFunc('function AnsiSameText(s1,s2: string): EvalBool;', @_LapeAnsiSameText); + addGlobalFunc('function AnsiSameStr(s1,s2: string): EvalBool;', @_LapeAnsiSameStr); + + // Uses current user locale + addGlobalFunc('function WideUpperCase(s: WideString): WideString;', @_LapeWideUpperCase); + addGlobalFunc('function WideLowerCase(s: WideString): WideString;', @_LapeWideLowerCase); + addGlobalFunc('function WideCompareStr(s1, s2: WideString): Int32;', @_LapeWideCompareStr); + addGlobalFunc('function WideCompareText(s1, s2: WideString): Int32;', @_LapeWideCompareText); + addGlobalFunc('function WideSameText(s1,s2: WideString): EvalBool;', @_LapeWideSameText); + addGlobalFunc('function WideSameStr(s1,s2: WideString): EvalBool;', @_LapeWideSameStr); + addGlobalFunc('function WideFormat(Fmt: WideString; Args: array of Variant): WideString;', @_LapeWideFormat); + + addGlobalFunc('function Pos(Substr, Source: AnsiString): SizeInt; overload;', @_LapePosA); + addGlobalFunc('function Pos(Substr, Source: WideString): SizeInt; overload;', @_LapePosW); + addGlobalFunc('function Pos(Substr, Source: UnicodeString): SizeInt; overload;', @_LapePosU); + + addGlobalFunc('function StringReplace(S, OldPattern, NewPattern: string; Flags: TReplaceFlags = [rfReplaceAll]): string;', @_LapeStringReplace); + addGlobalFunc('function UnicodeStringReplace(S, OldPattern, NewPattern: UnicodeString; Flags: TReplaceFlags = [rfReplaceAll]): UnicodeString;', @_LapeUnicodeStringReplace); + addGlobalFunc('function WideStringReplace(S, OldPattern, NewPattern: WideString; Flags: TReplaceFlags = [rfReplaceAll]): WideString;', @_LapeWideStringReplace); + + addGlobalFunc('function Trim(s: string): string;', @_LapeTrim); + addGlobalFunc('function TrimLeft(s: string): string;', @_LapeTrimLeft); + addGlobalFunc('function TrimRight(s: string): string;', @_LapeTrimRight); + addGlobalFunc('function PadL(s: string; Len: SizeInt; c: Char = '' ''): string;', @_LapePadL); + addGlobalFunc('function PadR(s: string; Len: SizeInt; c: Char = '' ''): string;', @_LapePadR); + + addGlobalFunc('function IntToHex(Value: Int64; Digits: Int32 = 1): string; overload;', @_LapeIntToHex); + addGlobalFunc('function IntToHex(Value: UInt64; Digits: Int32 = 1): string; overload;', @_LapeUIntToHex); + addGlobalFunc('function IntToStr(i: Int64): string; overload;', @_LapeToString_Int64); + addGlobalFunc('function IntToStr(i: UInt64): string; overload;', @_LapeToString_UInt64); + + addGlobalFunc('function StrToInt(s: string): Int32; overload;', @_LapeStrToInt); + addGlobalFunc('function StrToInt(s: string; Def: Int32): Int32; overload;', @_LapeStrToIntDef); + addGlobalFunc('function StrToInt64(s: string): Int64; overload;', @_LapeStrToInt64); + addGlobalFunc('function StrToInt64(s: string; Def: Int64): Int64; overload;', @_LapeStrToInt64Def); + addGlobalFunc('function StrToUInt64(s: string): UInt64; overload;', @_LapeStrToUInt64); + addGlobalFunc('function StrToUInt64(s: string; Def: UInt64): UInt64; overload;', @_LapeStrToUInt64Def); + addGlobalFunc('function StrToFloat(s: string): Double; overload;', @_LapeStrToFloat); + addGlobalFunc('function StrToFloat(s: string; Def: Double): Double; overload;', @_LapeStrToFloatDef); + addGlobalFunc('function StrToCurr(s: string): Currency; overload;', @_LapeStrToCurr); + addGlobalFunc('function StrToCurr(s: string; Def: Currency): Currency; overload;', @_LapeStrToCurrDef); + addGlobalFunc('function StrToBool(s: string): EvalBool; overload;', @_LapeStrToBool); + addGlobalFunc('function StrToBool(s: string; Default: EvalBool): EvalBool; overload;', @_LapeStrToBoolDef); + + addGlobalFunc('function BoolToStr(B: EvalBool; TrueS: string = ''True''; FalseS: string = ''False''): string;', @_LapeBoolToStr); + addGlobalFunc('function FloatToStr(f: Double): string;', @_LapeToString_Double); + addGlobalFunc('function CurrToStr(Value: Currency): string;', @_LapeToString_Currency); + + addGlobalFunc('function Format(Fmt: string; Args: array of Variant): string;', @_LapeFormat); + addGlobalFunc('function FormatCurr(Format: string; Value: Currency): string;', @_LapeFormatCurr); + addGlobalFunc('function FormatFloat(Format: string; Value: Double): string;', @_LapeFormatFloat); + + addGlobalFunc('function StringOfChar(c: Char; l: SizeInt): string;', @_LapeStringOfChar); + + ImportingSection := ''; end; -procedure TSimbaScript_Compiler.pushConditional(AEval: Boolean; ADocPos: TDocPos); +// lpeval_import_datetime but moved sleep & gettickcount to timing section +procedure TSimbaScript_Compiler.InitBaseDateTime; begin - inherited pushConditional(AEval, ADocPos); + ImportingSection := 'DateTime'; + + addGlobalVar(HoursPerDay, 'HoursPerDay').isConstant := True; + addGlobalVar(MinsPerHour, 'MinsPerHour').isConstant := True; + addGlobalVar(SecsPerMin, 'SecsPerMin').isConstant := True; + addGlobalVar(MSecsPerSec, 'MSecsPerSec').isConstant := True; + addGlobalVar(MinsPerDay, 'MinsPerDay').isConstant := True; + addGlobalVar(SecsPerDay, 'SecsPerDay').isConstant := True; + addGlobalVar(MSecsPerDay, 'MSecsPerDay').isConstant := True; + + addGlobalType(getBaseType(ltDouble).createCopy(True), 'TDateTime', False); + + addGlobalFunc('function EncodeDate(Year, Month, Day: UInt16): TDateTime;', @_LapeEncodeDate); + addGlobalFunc('function EncodeTime(Hour, Min, Sec, MSec: UInt16): TDateTime;', @_LapeEncodeTime); + addGlobalFunc('procedure DecodeDate(DateTime: TDateTime; var Year, Month, Day: UInt16);', @_LapeDecodeDate); + addGlobalFunc('function DecodeDateFully(DateTime: TDateTime; var Year, Month, Day, DOW: UInt16): Boolean;', @_LapeDecodeDateFully); + addGlobalFunc('procedure DecodeTime(DateTime: TDateTime; var Hour, Min, Sec, MSec: UInt16);', @_LapeDecodeTime); + + addGlobalFunc('function DateTimeToStr(const DateTime: TDateTime): string;', @_LapeDateTimeToStr); + addGlobalFunc('function DateToStr(const DateTime: TDateTime): string;', @_LapeDateToStr); + addGlobalFunc('function TimeToStr(const DateTime: TDateTime): string;', @_LapeTimeToStr); + + TLapeType_OverloadedMethod(Globals['ToString'].VarType).addMethod( + TLapeType_Method(addManagedType( + TLapeType_Method.Create( + Self, + [getGlobalType('TDateTime')], + [lptConstRef], + [TLapeGlobalVar(nil)], + getBaseType(ltString) + ) + )).NewGlobalVar(@_LapeDateTimeToStr) + ); + + addGlobalFunc('function Date: TDateTime;', @_LapeDate); + addGlobalFunc('function Time: TDateTime;', @_LapeTime); + addGlobalFunc('function Now: TDateTime;', @_LapeNow); + addGlobalFunc('function NowUTC: TDateTime;', @_LapeNowUTC); + + addGlobalFunc('procedure ReplaceTime(var DateTime: TDateTime; NewTime: TDateTime);', @_LapeReplaceTime); + addGlobalFunc('procedure ReplaceDate(var DateTime: TDateTime; NewDate: TDateTime);', @_LapeReplaceDate); + + addGlobalFunc('function FormatDateTime(Format: string; DateTime: TDateTime): string;', @_LapeFormatDateTime); + addGlobalFunc('function StrToDate(s: string): TDateTime; overload;', @_LapeStrToDate); + addGlobalFunc('function StrToDate(s: string; Default: TDateTime): TDateTime; overload;', @_LapeStrToDateDef); + addGlobalFunc('function StrToTime(s: string): TDateTime; overload;', @_LapeStrToTime); + addGlobalFunc('function StrToTime(s: string; Default: TDateTime): TDateTime; overload;', @_LapeStrToTimeDef); + addGlobalFunc('function StrToDateTime(s: string): TDateTime; overload;', @_LapeStrToDateTime); + addGlobalFunc('function StrToDateTime(s: string; Default: TDateTime): TDateTime; overload;', @_LapeStrToDateTimeDef); + + addGlobalFunc('function DateTimeToUnix(const Value: TDateTime; InputIsUTC: Boolean = True): Int64;', @_LapeDateTimeToUnix); + addGlobalFunc('function UnixToDateTime(const Value: Int64; ReturnUTC: Boolean = True): TDateTime;', @_LapeUnixToDateTime); + addGlobalFunc('function UnixTime: Int64;', @_LapeUnixTime); + + addGlobalFunc('function YearsBetween(const ANow, AThen: TDateTime): Int32;', @_LapeYearsBetween); + addGlobalFunc('function MonthsBetween(const ANow, AThen: TDateTime): Int32;', @_LapeMonthsBetween); + addGlobalFunc('function WeeksBetween(const ANow, AThen: TDateTime): Int32;', @_LapeWeeksBetween); + addGlobalFunc('function DaysBetween(const ANow, AThen: TDateTime): Int32;', @_LapeDaysBetween); + addGlobalFunc('function HoursBetween(const ANow, AThen: TDateTime): Int64;', @_LapeHoursBetween); + addGlobalFunc('function MinutesBetween(const ANow, AThen: TDateTime): Int64;', @_LapeMinutesBetween); + addGlobalFunc('function SecondsBetween(const ANow, AThen: TDateTime): Int64;', @_LapeSecondsBetween); + addGlobalFunc('function MilliSecondsBetween(const ANow, AThen: TDateTime): Int64;', @_LapeMilliSecondsBetween); + + addGlobalFunc('function IncYear(const Value: TDateTime; const NumberOfYears: Int32 = 1): TDateTime;', @_LapeIncYear); + addGlobalFunc('function IncWeek(const Value: TDateTime; const NumberOfWeeks: Int32 = 1): TDateTime;', @_LapeIncWeek); + addGlobalFunc('function IncDay(const Value: TDateTime; const NumberOfDays: Int32 = 1): TDateTime;', @_LapeIncDay); + addGlobalFunc('function IncHour(const Value: TDateTime; const NumberOfHours: Int64 = 1): TDateTime;', @_LapeIncHour); + addGlobalFunc('function IncMinute(const Value: TDateTime; const NumberOfMinutes: Int64 = 1): TDateTime;', @_LapeIncMinute); + addGlobalFunc('function IncSecond(const Value: TDateTime; const NumberOfSeconds: Int64 = 1): TDateTime;', @_LapeIncSecond); + addGlobalFunc('function IncMilliSecond(const Value: TDateTime; const NumberOfMilliSeconds: Int64 = 1): TDateTime;', @_LapeIncMilliSecond); + + ImportingSection := 'Timing'; + + addGlobalFunc('function GetTickCount: UInt64;', @_LapeGetTickCount); + addGlobalFunc('procedure Sleep(MilliSeconds: UInt32);', @_LapeSleep); + + ImportingSection := ''; end; procedure TSimbaScript_Compiler.addDelayedCode(Code: TStringArray; AFileName: lpString);