diff --git a/DocGen/rundocgen.simba b/DocGen/rundocgen.simba new file mode 100644 index 000000000..624514c65 --- /dev/null +++ b/DocGen/rundocgen.simba @@ -0,0 +1,16 @@ +var + p: TRunningProcessPiped; + s: String; +begin + p := StartProcessPiped('python.exe', ['-u', 'docgen.py'], 'DocGen'); + while p.Running do + begin + s := p.ReadString; + if (s <> '') then + WriteLn(s); + Sleep(100); + end; + p.Free(); + + WriteLn('Link: "' + PathNormalize('DocGen/build/index.html') + '"'); +end; diff --git a/DocGen/source/tutorials/Targets.rst b/DocGen/source/tutorials/Targets.rst index 8d47adad8..ba6a4f1e4 100644 --- a/DocGen/source/tutorials/Targets.rst +++ b/DocGen/source/tutorials/Targets.rst @@ -24,4 +24,23 @@ You can declare as many TTarget variables as you like, all with different target begin MyOtherTarget.SetWindow(12345); // some window handle WriteLn MyOtherTarget.CountColor($0000FF, 10); // Count a red color, with 10 tolerance. - end; \ No newline at end of file + end; + +---- + +Searching on a image +==================== + +:code:`TImage` has basic :code:`FindColor` and :code:`FindImage` methods however if you need the full finder methods you can do: + +.. code-block:: + var MyTarget: TTarget; + + MyTarget.SetImage(MyImage); + Edges := MyTarget.FindEdges(5); + +Or use the :code:`TImage.Target` property which returns a :code:`TTarget` already targeted to the image. + +.. code-block:: + + Edges := MyImage.Target.FindEdges(5); \ No newline at end of file diff --git a/Source/ide/codetools/simba.ide_codetools_arrayhelpers.pas b/Source/ide/codetools/simba.ide_codetools_arrayhelpers.pas index bce2896c9..8a1a05792 100644 --- a/Source/ide/codetools/simba.ide_codetools_arrayhelpers.pas +++ b/Source/ide/codetools/simba.ide_codetools_arrayhelpers.pas @@ -14,22 +14,6 @@ interface simba.base, simba.ide_codetools_parser; const - HELPERS_STRING: TStringArray = ( - 'property .Length: Integer;', - 'property .First: ;', - 'property .Last: ;', - 'property .Pop: ;', - 'procedure .SetLength(NewLength: Integer);', - 'function .Copy: ;', - 'function .Copy(StartIndex: Integer; Count: Integer = High(Integer)): ;', - 'procedure .Delete(StartIndex: Integer; Count: Integer = High(Integer));', - 'function .Remove(Value: ): ;', - 'function .RandomValue: ;', - 'procedure .Reverse;', - 'function .Reversed: ;', - 'procedure .Clear;' - ); - HELPERS_DYNARRAY: TStringArray = ( 'property .Length: Integer;', 'property .Low: Integer;', @@ -57,19 +41,17 @@ interface 'function .Sorted(CompareFunc: function(constref L, R: ): Integer): ;', 'function .Sorted(Weights: TIntegerArray; LowToHigh: Boolean): ;', 'function .Copy: ;', - 'function .Copy(StartIndex: Integer; Count: Integer = High(Integer)): ;', - 'function .RandomValue: ;', + 'function .CopyRange(StartIndex, EndIndex: Integer): ;', + 'function .Random: ;', 'function .Reversed: ;', 'function .Slice(Start, Stop, Step: Integer): ;', 'function .Remove(Value: ): ;', - 'procedure .Delete(Index: Integer; Count: Integer = High(Integer));', + 'function .DeleteIndex(Index: Integer; Count: Integer): ;', + 'procedure .DeleteRange(StartIndex, EndIndex: Integer);', 'procedure .Insert(Item: ; Index: Integer);', 'procedure .SetLength(NewLength: Integer);', - 'function .RandomValue: ;', 'procedure .Reverse;', 'procedure .Clear;', - 'procedure .Append(Value: );', - 'procedure .Extend(Value: );', 'function .Equals(Other: ): Boolean;', 'function .Intersection(Other: ): ;', 'function .Difference(Other: ): ;', @@ -143,14 +125,7 @@ function GetArrayHelpers(Decl: TDeclaration): TDeclarationArray; ElementType := Decl.Items.GetTextOfClass(TDeclaration_VarType); if (ElementType <> '') then Parser := Get(HELPERS_DYNARRAY, IfThen(Decl.Name <> '', Decl.Name, 'array'), ElementType, IfThen(Decl.Name <> '', Decl.Name, 'array of ' + ElementType)); - end - else if (Decl is TDeclaration_TypeAlias) then - case UpperCase(Decl.Name) of - 'STRING': Parser := Get(HELPERS_STRING, 'String', 'Char', 'String'); - 'ANSISTRING': Parser := Get(HELPERS_STRING, 'AnsiString', 'Char', 'AnsiString'); - 'WIDESTRING': Parser := Get(HELPERS_STRING, 'WideString', 'WideChar', 'WideString'); - 'UNICODESTRING': Parser := Get(HELPERS_STRING, 'UnicodeString', 'UnicodeChar', 'UnicodeString'); - end; + end; if (Parser <> nil) then Result := Parser.Items.ToArray diff --git a/Source/ide/codetools/simba.ide_codetools_generics.pas b/Source/ide/codetools/simba.ide_codetools_generics.pas index 8f5ccbfbc..80eb7b279 100644 --- a/Source/ide/codetools/simba.ide_codetools_generics.pas +++ b/Source/ide/codetools/simba.ide_codetools_generics.pas @@ -48,6 +48,18 @@ interface 'procedure .Clear; external;' + LineEnding + 'function .ToString: String; external;' + LineEnding; + ARRAYBUFFER_METHODS = + 'property .Count: Integer; external;' + LineEnding + + 'property .Items: array of ; external;' + LineEnding + + 'property .First: ; external;' + LineEnding + + 'property .Last: ; external;' + LineEnding + + 'property .Pop: ; external;' + LineEnding + + 'property .ToArray: array of ; external;' + LineEnding + + 'procedure .Add(Value: ); overload; external;' + LineEnding + + 'procedure .Add(Values: array of ); overload; external;' + LineEnding + + 'procedure .Clear; external;' + LineEnding + + 'function .ToString: String; external;' + LineEnding; + function GetGeneric(Decl: TDeclaration): TDeclarationArray; implementation @@ -57,7 +69,7 @@ implementation function GetGeneric(Decl: TDeclaration): TDeclarationArray; - function RunStrMap(Name, Key, Value: String): TCodeParser; + function RunStrMap(Name, Value: String): TCodeParser; var I: Integer; Methods, FileName: String; @@ -68,12 +80,12 @@ function GetGeneric(Decl: TDeclaration): TDeclarationArray; Exit(GenericParsers[I]); Methods := STRINGMAP_METHODS; - Methods := Methods.Replace('', Name); - Methods := Methods.Replace('', Key); + Methods := Methods.Replace('', IfThen(Name <> '', Name, 'TStringMap')); + Methods := Methods.Replace('', 'String'); Methods := Methods.Replace('', Value); Result := TCodeParser.Create(); - Result.SetScript(Methods); + Result.SetScript(Methods, FileName); Result.Run(); GenericParsers.Add(Result); @@ -90,12 +102,12 @@ function GetGeneric(Decl: TDeclaration): TDeclarationArray; Exit(GenericParsers[I]); Methods := MAP_METHODS; - Methods := Methods.Replace('', Name); + Methods := Methods.Replace('', IfThen(Name <> '', Name, 'TMap')); Methods := Methods.Replace('', Key); Methods := Methods.Replace('', Value); Result := TCodeParser.Create(); - Result.SetScript(Methods); + Result.SetScript(Methods, FileName); Result.Run(); GenericParsers.Add(Result); @@ -112,11 +124,32 @@ function GetGeneric(Decl: TDeclaration): TDeclarationArray; Exit(GenericParsers[I]); Methods := HEAP_METHODS; - Methods := Methods.Replace('', Name); + Methods := Methods.Replace('', IfThen(Name <> '', Name, 'THeap')); + Methods := Methods.Replace('', Value); + + Result := TCodeParser.Create(); + Result.SetScript(Methods, FileName); + Result.Run(); + + GenericParsers.Add(Result); + end; + + function RunArrayBuffer(Name, Value: String): TCodeParser; + var + I: Integer; + Methods, FileName: String; + begin + FileName := '!GenericArrayBuffer::' + Name + '::' + Value; + for I := 0 to GenericParsers.Count - 1 do + if (GenericParsers[I].Lexer.FileName = FileName) then + Exit(GenericParsers[I]); + + Methods := ARRAYBUFFER_METHODS; + Methods := Methods.Replace('', IfThen(Name <> '', Name, 'TArrayBuffer')); Methods := Methods.Replace('', Value); Result := TCodeParser.Create(); - Result.SetScript(Methods); + Result.SetScript(Methods, FileName); Result.Run(); GenericParsers.Add(Result); @@ -124,39 +157,35 @@ function GetGeneric(Decl: TDeclaration): TDeclarationArray; var Parser: TCodeParser; + Typ: TDeclaration; Params: TDeclarationArray; - Name, Kind: String; begin Parser := nil; - if (Decl is TDeclaration_TypeFakeGeneric) then + if (Decl is TDeclaration_TypeGeneric) then begin - Kind := Decl.Items.GetTextOfClass(TDeclaration_Identifier); - Name := Decl.Name; - if (Name = '') then - Name := Kind; - - case LowerCase(Kind) of - 'stringmap': - begin - Params := Decl.Items.GetByClass(TDeclaration_Parameter, True, True); - if Length(Params) = 1 then - Parser := RunStrMap(Name, 'String', Params[0].Name); - end; - - 'map': - begin - Params := Decl.Items.GetByClass(TDeclaration_Parameter, True, True); - if Length(Params) = 2 then - Parser := RunMap(Name, Params[0].Name, Params[1].Name); - end; - - 'heap': - begin - Params := Decl.Items.GetByClass(TDeclaration_Parameter, True, True); - if Length(Params) = 1 then - Parser := RunHeap(Name, Params[0].Name); - end; + Typ := TDeclaration_TypeGeneric(Decl).Typ; + Params := TDeclaration_TypeGeneric(Decl).Params; + + if (Typ <> nil) and (Length(Params) > 0) then + begin + case UpperCase(Typ.Text) of + 'TSTRINGMAP': + if (Length(Params) = 1) then + Parser := RunStrMap(Decl.Name, Params[0].Text); + + 'TMAP': + if (Length(Params) = 2) then + Parser := RunMap(Decl.Name, Params[0].Text, Params[1].Text); + + 'THEAP': + if (Length(Params) = 1) then + Parser := RunHeap(Decl.Name, Params[0].Text); + + 'TARRAYBUFFER': + if (Length(Params) = 1) then + Parser := RunArrayBuffer(Decl.Name, Params[0].Text); + end; end; end; diff --git a/Source/ide/codetools/simba.ide_codetools_parser.pas b/Source/ide/codetools/simba.ide_codetools_parser.pas index 617391691..39a783660 100644 --- a/Source/ide/codetools/simba.ide_codetools_parser.pas +++ b/Source/ide/codetools/simba.ide_codetools_parser.pas @@ -170,6 +170,17 @@ TDeclaration_Type = class(TDeclaration) function GetHeader: String; override; end; + TDeclaration_GenericSpecialize = class(TDeclaration); + TDeclaration_GenericParam = class(TDeclaration); + TDeclaration_TypeGeneric = class(TDeclaration_Type) + protected + function GetTyp: TDeclaration; + function GetParams: TDeclarationArray; + public + property Typ: TDeclaration read GetTyp; + property Params: TDeclarationArray read GetParams; + end; + TDeclaration_TypeRecord = class(TDeclaration_Type) protected FFields: TDeclarationCache; @@ -247,7 +258,6 @@ TDeclaration_TypeMethod = class(TDeclaration_Type) property Method: TDeclaration_Method read GetMethod; end; - TDeclaration_TypeFakeGeneric = class(TDeclaration_Type); TDeclaration_TypeNativeMethod = class(TDeclaration_Type); TDeclaration_TypeRange = class(TDeclaration_Type); @@ -473,6 +483,11 @@ TCodeParser = class(TPasParser) procedure TypeDeclaration; override; procedure TypeName; override; + // types - generics + procedure GenericType; override; + procedure GenericSpecialize; override; + procedure GenericParam; override; + // types - alias procedure TypeAlias; override; @@ -492,8 +507,6 @@ TCodeParser = class(TPasParser) // types - native procedure NativeType; override; - procedure FakeGenericType; override; - // types = record procedure UnionType; override; procedure RecordType; override; @@ -1010,6 +1023,16 @@ function TDeclaration_Type.GetHeader: String; Result := FHeader; end; +function TDeclaration_TypeGeneric.GetTyp: TDeclaration; +begin + Result := FItems.GetByClassFirst(TDeclaration_GenericSpecialize); +end; + +function TDeclaration_TypeGeneric.GetParams: TDeclarationArray; +begin + Result := FItems.GetByClass(TDeclaration_GenericParam); +end; + function TDeclaration_EnumElement.GetName: string; begin if FName.IsNull then @@ -1713,6 +1736,27 @@ procedure TCodeParser.TypeName; inherited; end; +procedure TCodeParser.GenericType; +begin + PushStack(TDeclaration_TypeGeneric); + inherited; + PopStack(); +end; + +procedure TCodeParser.GenericSpecialize; +begin + PushStack(TDeclaration_GenericSpecialize); + inherited; + PopStack(); +end; + +procedure TCodeParser.GenericParam; +begin + PushStack(TDeclaration_GenericParam); + inherited; + PopStack(); +end; + procedure TCodeParser.TypeCopy; begin PushStack(TDeclaration_TypeCopy); @@ -1726,7 +1770,7 @@ procedure TCodeParser.PointerType; begin PushStack(TDeclaration_TypePointer); PushStack(TDeclaration_VarType); - inherited PointerType(); + inherited; PopStack(); PopStack(); end; @@ -1897,13 +1941,6 @@ procedure TCodeParser.NativeType; PopStack(); end; -procedure TCodeParser.FakeGenericType; -begin - PushStack(TDeclaration_TypeFakeGeneric); - inherited; - PopStack(); -end; - procedure TCodeParser.RecordType; begin PushStack(TDeclaration_TypeRecord); diff --git a/Source/ide/codetools/simba.ide_codetools_pasparser.pas b/Source/ide/codetools/simba.ide_codetools_pasparser.pas index 20cb38cad..20f6cba63 100644 --- a/Source/ide/codetools/simba.ide_codetools_pasparser.pas +++ b/Source/ide/codetools/simba.ide_codetools_pasparser.pas @@ -84,6 +84,9 @@ TPasParser = class(TObject) procedure FieldName; virtual; procedure ForStatement; virtual; procedure ForwardDeclaration; virtual; + procedure GenericType; virtual; + procedure GenericSpecialize; virtual; + procedure GenericParam; virtual; procedure Identifier; virtual; procedure IdentifierList; virtual; procedure IfStatement; virtual; @@ -96,7 +99,6 @@ TPasParser = class(TObject) procedure OrdinalType; virtual; procedure ParseFile; virtual; procedure PointerType; virtual; - procedure FakeGenericType; virtual; procedure Method; virtual; procedure MethodOfType; virtual; @@ -183,6 +185,29 @@ procedure TPasParser.ForwardDeclaration; SemiColon; end; +procedure TPasParser.GenericType; +begin + GenericSpecialize(); + Expected(tokLower); + GenericParam(); + while (Lexer.TokenID = tokComma) do + begin + NextToken(); + GenericParam(); + end; + Expected(tokGreater); +end; + +procedure TPasParser.GenericSpecialize; +begin + Expected(tokIdentifier); +end; + +procedure TPasParser.GenericParam; +begin + TypeKind(); +end; + procedure TPasParser.Run; begin try @@ -1572,12 +1597,6 @@ procedure TPasParser.PointerType; TypeIdentifer; end; -procedure TPasParser.FakeGenericType; -begin - TypeIdentifer; - Parameters; -end; - procedure TPasParser.Method; var Typ: ELexerToken; @@ -1785,15 +1804,6 @@ procedure TPasParser.TypeCopy; end; procedure TPasParser.TypeKind; - - function isMaybeFakeGeneric: Boolean; - var - S: String; - begin - S := UpperCase(fLexer.Token); - Result := (S = 'STRINGMAP') or (S = 'MAP') or (S = 'HEAP'); - end; - begin if (fLexer.TokenID = tokIdentifier) and (fLexer.TokenID = tokPrivate) then NextToken; @@ -1813,14 +1823,10 @@ procedure TPasParser.TypeKind; end; tokIdentifier: begin - if isMaybeFakeGeneric() then - begin - fLexer.InitAhead; - if fLexer.AheadTokenID = tokRoundOpen then - FakeGenericType - else - TypeIdentifer; - end else + fLexer.InitAhead; + if fLexer.AheadTokenID = tokLower then + GenericType + else TypeIdentifer; end; tokAsciiChar, tokFloat, tokIntegerConst, tokMinus, tokPlus, tokSquareOpen, tokStringConst, tokRoundOpen, tokEnum: diff --git a/Source/ide/simba.form_main.pas b/Source/ide/simba.form_main.pas index 2d9851c8c..fd51444aa 100644 --- a/Source/ide/simba.form_main.pas +++ b/Source/ide/simba.form_main.pas @@ -801,8 +801,8 @@ procedure TSimbaMainForm.MenuGotoClick(Sender: TObject); if SimbaTabsForm.CurrentEditor <> nil then begin Value := ''; - if InputQuery('Goto line', 'Goto line:', Value) and Value.IsInteger() then - SimbaTabsForm.CurrentEditor.TopLine := StrToInt(Value) - (SimbaTabsForm.CurrentEditor.LinesInWindow div 2); + if InputQuery('Goto line', 'Goto line:', Value) and Value.IsNumeric then + SimbaTabsForm.CurrentEditor.TopLine := Value.ToInteger - (SimbaTabsForm.CurrentEditor.LinesInWindow div 2); end; end; diff --git a/Source/ide/simba.ide_package.pas b/Source/ide/simba.ide_package.pas index fa6384b13..c826125e5 100644 --- a/Source/ide/simba.ide_package.pas +++ b/Source/ide/simba.ide_package.pas @@ -156,7 +156,7 @@ procedure TSimbaPackageEndpoint.ParseTime(Str: String; out Time: TDateTime; out if (Str <> '') then begin - if Str.IsInteger() then + if Str.IsNumeric then Time := Str.ToDateTime('unix', 0) else Time := Str.ToDateTime('iso8601', 0); diff --git a/Source/script/imports/simba.import_base.pas b/Source/script/imports/simba.import_base.pas index 00ff188d8..80a503013 100644 --- a/Source/script/imports/simba.import_base.pas +++ b/Source/script/imports/simba.import_base.pas @@ -16,7 +16,8 @@ implementation uses Graphics, Variants, simba.nativeinterface, simba.env, simba.baseclass, simba.vartype_ordarray, - simba.vartype_string, simba.vartype_pointarray, simba.vartype_matrix; + simba.vartype_string, simba.vartype_pointarray, simba.vartype_matrix, + simba.vartype_box, simba.array_algorithm; (* Base @@ -551,16 +552,6 @@ procedure _LapeBaseClass_FreeOnTerminate_Write(const Params: PParamArray); LAPE_ TSimbaBaseClass(Params^[0]^).FreeOnTerminate := PBoolean(Params^[1])^; end; -procedure _LapeByteArray_ToString(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PString(Result)^ := PByteArray(Params^[0])^.ToString(); -end; - -procedure _LapeByteArray_FromString(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - PByteArray(Params^[0])^.FromString(PString(Params^[1])^); -end; - procedure _LapeWrite(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin Debug(PString(Params^[0])^); @@ -572,11 +563,16 @@ procedure _LapeWriteLn(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV end; // Sort -procedure _LapeSort_IntegerArray(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV +procedure _LapeSort_Int32Array(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin PIntegerArray(Params^[0])^.Sort(); end; +procedure _LapeSort_Int64Array(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV +begin + PInt64Array(Params^[0])^.Sort(); +end; + procedure _LapeSort_SingleArray(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin PSingleArray(Params^[0])^.Sort(); @@ -593,11 +589,16 @@ procedure _LapeSort_StringArray(const Params: PParamArray); LAPE_WRAPPER_CALLING end; // Unique -procedure _LapeUnique_IntegerArray(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeUnique_Int32Array(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin PIntegerArray(Result)^ := PIntegerArray(Params^[0])^.Unique(); end; +procedure _LapeUnique_Int64Array(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +begin + PInt64Array(Result)^ := PInt64Array(Params^[0])^.Unique(); +end; + procedure _LapeUnique_SingleArray(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin PSingleArray(Result)^ := PSingleArray(Params^[0])^.Unique(); @@ -618,116 +619,139 @@ procedure _LapeUnique_PointArray(const Params: PParamArray; const Result: Pointe PPointArray(Result)^ := PPointArray(Params^[0])^.Unique(); end; -// Sum -procedure _LapeArraySum_IntegerArray(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeUnique_BoxArray(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PInt64(Result)^ := PIntegerArray(Params^[0])^.Sum(); + PBoxArray(Result)^ := PBoxArray(Params^[0])^.Unique(); end; -procedure _LapeArraySum_SingleArray(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +// Sum +procedure _LapeArraySum_Int32Array(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PDouble(Result)^ := PSingleArray(Params^[0])^.Sum(); + PInt64(Result)^ := PIntegerArray(Params^[0])^.Sum(); end; -procedure _LapeArraySum_DoubleArray(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeArraySum_Int64Array(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PDouble(Result)^ := PDoubleArray(Params^[0])^.Sum(); + PInt64(Result)^ := PInt64Array(Params^[0])^.Sum(); end; // Min -procedure _LapeArrayMin_IntegerArray(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeArrayMin_Int32Array(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin PInteger(Result)^ := PIntegerArray(Params^[0])^.Min(); end; -procedure _LapeArrayMin_SingleArray(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeArrayMin_Int64Array(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PSingle(Result)^ := PSingleArray(Params^[0])^.Min(); + PInt64(Result)^ := PInt64Array(Params^[0])^.Min(); end; -procedure _LapeArrayMin_DoubleArray(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +// Max +procedure _LapeArrayMax_Int32Array(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PDouble(Result)^ := PDoubleArray(Params^[0])^.Min(); + PInteger(Result)^ := PIntegerArray(Params^[0])^.Max(); end; -procedure _LapeArrayMin_SingleMatrix(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeArrayMax_Int64Array(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PSingle(Result)^ := PSingleMatrix(Params^[0])^.Min(); + PInt64(Result)^ := PInt64Array(Params^[0])^.Max(); end; -// Max -procedure _LapeArrayMax_IntegerArray(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +// IndexOf +procedure _LapeArrayIndexOf_Int32Array(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PInteger(Result)^ := PIntegerArray(Params^[0])^.Max(); + PInteger(Result)^ := PIntegerArray(Params^[1])^.IndexOf(PInteger(Params^[0])^); end; -procedure _LapeArrayMax_SingleArray(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeArrayIndexOf_StringArray(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PSingle(Result)^ := PSingleArray(Params^[0])^.Max(); + PInteger(Result)^ := PStringArray(Params^[1])^.IndexOf(PString(Params^[0])^); end; -procedure _LapeArrayMax_DoubleArray(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeArrayIndexOf_PointArray(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PDouble(Result)^ := PDoubleArray(Params^[0])^.Max(); + PInteger(Result)^ := PPointArray(Params^[1])^.IndexOf(PPoint(Params^[0])^); end; -procedure _LapeArrayMax_SingleMatrix(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +// IndicesOf +procedure _LapeArrayIndicesOf_Int32Array(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PSingle(Result)^ := PSingleMatrix(Params^[0])^.Max(); + PIntegerArray(Result)^ := PIntegerArray(Params^[1])^.IndicesOf(PInteger(Params^[0])^); end; -// Mean -procedure _LapeArrayMean_PointArray(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeArrayIndicesOf_StringArray(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PPoint(Result)^ := PPointArray(Params^[0])^.Mean(); + PIntegerArray(Result)^ := PStringArray(Params^[1])^.IndicesOf(PString(Params^[0])^); end; -procedure _LapeArrayMean_2DPointArray(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeArrayIndicesOf_PointArray(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PPoint(Result)^ := P2DPointArray(Params^[0])^.Mean(); + PIntegerArray(Result)^ := PPointArray(Params^[1])^.IndicesOf(PPoint(Params^[0])^); end; -procedure _LapeArrayMean_SingleMatrix(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +// Intersection +procedure _LapeArrayIntersection_Int32Array(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PSingle(Result)^ := PSingleMatrix(Params^[0])^.Mean(); + PIntegerArray(Result)^ := PIntegerArray(Params^[0])^.Intersection(PIntegerArray(Params^[1])^); end; -// Median -procedure _LapeArrayMedian_PointArray(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeArrayIntersection_Int64Array(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PPoint(Result)^ := PPointArray(Params^[0])^.Median(); + PInt64Array(Result)^ := PInt64Array(Params^[0])^.Intersection(PInt64Array(Params^[1])^); end; -// IndexOf -procedure _LapeArrayIndexOf_StringArray(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeArrayIntersection_PointArray(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PInteger(Result)^ := PStringArray(Params^[0])^.IndexOf(PString(Params^[1])^); + PPointArray(Result)^ := PPointArray(Params^[0])^.Intersection(PPointArray(Params^[1])^); end; -// IndicesOf -procedure _LapeArrayIndicesOf_StringArray(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeArrayIntersection_BoxArray(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PIntegerArray(Result)^ := PStringArray(Params^[0])^.IndicesOf(PString(Params^[1])^); + PBoxArray(Result)^ := PBoxArray(Params^[0])^.Intersection(PBoxArray(Params^[1])^); end; -// Intersection -procedure _LapeArrayIntersection_PointArray(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +// Difference +procedure _LapeArrayDifference_Int32Array(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PPointArray(Result)^ := PPointArray(Params^[0])^.Intersection(PPointArray(Params^[1])^); + PIntegerArray(Result)^ := PIntegerArray(Params^[0])^.Difference(PIntegerArray(Params^[1])^); +end; + +procedure _LapeArrayDifference_Int64Array(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +begin + PInt64Array(Result)^ := PInt64Array(Params^[0])^.Difference(PInt64Array(Params^[1])^); end; -// Difference procedure _LapeArrayDifference_PointArray(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin PPointArray(Result)^ := PPointArray(Params^[0])^.Difference(PPointArray(Params^[1])^); end; +procedure _LapeArrayDifference_BoxArray(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +begin + PBoxArray(Result)^ := PBoxArray(Params^[0])^.Difference(PBoxArray(Params^[1])^); +end; + // SymDifference +procedure _LapeArraySymDifference_Int32Array(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +begin + PIntegerArray(Result)^ := PIntegerArray(Params^[0])^.SymmetricDifference(PIntegerArray(Params^[1])^); +end; + +procedure _LapeArraySymDifference_Int64Array(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +begin + PInt64Array(Result)^ := PInt64Array(Params^[0])^.SymmetricDifference(PInt64Array(Params^[1])^); +end; + procedure _LapeArraySymDifference_PointArray(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin PPointArray(Result)^ := PPointArray(Params^[0])^.SymmetricDifference(PPointArray(Params^[1])^); end; +procedure _LapeArraySymDifference_BoxArray(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +begin + PBoxArray(Result)^ := PBoxArray(Params^[0])^.SymmetricDifference(PBoxArray(Params^[1])^); +end; + procedure ImportBase(Script: TSimbaScript); begin with Script.Compiler do @@ -777,9 +801,7 @@ procedure ImportBase(Script: TSimbaScript); addGlobalType('(__LT__, __GT__, __EQ__, __LE__, __GE__, __NE__)', 'EComparator'); addGlobalType('enum(Unknown, Unassigned, Null, Int8, Int16, Int32, Int64, UInt8, UInt16, UInt32, UInt64, Single, Double, DateTime, Currency, Boolean, Variant, AString, UString, WString)', 'EVariantVarType'); - addGlobalFunc('function Variant.VarType: EVariantVarType;', @_LapeVariantVarType); - addGlobalFunc('function Variant.IsNumeric: Boolean;', @_LapeVariantIsNumeric); addGlobalFunc('function Variant.IsInteger: Boolean;', @_LapeVariantIsInteger); addGlobalFunc('function Variant.IsFloat: Boolean;', @_LapeVariantIsFloat); @@ -788,12 +810,8 @@ procedure ImportBase(Script: TSimbaScript); addGlobalFunc('function Variant.IsVariant: Boolean;', @_LapeVariantIsVariant); addGlobalFunc('function Variant.IsAssigned: Boolean;', @_LapeVariantIsAssigned); addGlobalFunc('function Variant.IsNull: Boolean;', @_LapeVariantIsNull); - addGlobalFunc('function Variant.NULL: Variant; static;', @_LapeVariantNULL); - addGlobalFunc('function TByteArray.ToString: String;', @_LapeByteArray_ToString); - addGlobalFunc('procedure TByteArray.FromString(Str: String);', @_LapeByteArray_FromString); - DumpSection := ''; addClass('TBaseClass', 'Pointer'); @@ -804,43 +822,51 @@ procedure ImportBase(Script: TSimbaScript); addGlobalFunc('procedure _WriteLn; override', @_LapeWriteLn); // add native versions for lape to use - addMagic('_ArrayMin', ['TIntegerArray'], [lptNormal], 'Integer', @_LapeArrayMin_IntegerArray); - addMagic('_ArrayMin', ['TSingleArray'], [lptNormal], 'Single', @_LapeArrayMin_SingleArray); - addMagic('_ArrayMin', ['TDoubleArray'], [lptNormal], 'Double', @_LapeArrayMin_DoubleArray); - addMagic('_ArrayMin', ['TSingleMatrix'], [lptNormal], 'Single', @_LapeArrayMin_SingleMatrix); + addMagic('_ArrayMin', ['TIntegerArray'], [lptNormal], 'Integer', @_LapeArrayMin_Int32Array); + addMagic('_ArrayMin', ['TInt64Array'], [lptNormal], 'Int64', @_LapeArrayMin_Int64Array); - addMagic('_ArrayMax', ['TIntegerArray'], [lptNormal], 'Integer', @_LapeArrayMax_IntegerArray); - addMagic('_ArrayMax', ['TSingleArray'], [lptNormal], 'Single', @_LapeArrayMax_SingleArray); - addMagic('_ArrayMax', ['TDoubleArray'], [lptNormal], 'Double', @_LapeArrayMax_DoubleArray); - addMagic('_ArrayMax', ['TSingleMatrix'], [lptNormal], 'Single', @_LapeArrayMax_SingleMatrix); + addMagic('_ArrayMax', ['TIntegerArray'], [lptNormal], 'Integer', @_LapeArrayMax_Int32Array); + addMagic('_ArrayMax', ['TInt64Array'], [lptNormal], 'Int64', @_LapeArrayMax_Int64Array); - addMagic('_ArraySum', ['TIntegerArray'], [lptNormal], 'Int64', @_LapeArraySum_IntegerArray); - addMagic('_ArraySum', ['TSingleArray'], [lptNormal], 'Double', @_LapeArraySum_SingleArray); - addMagic('_ArraySum', ['TDoubleArray'], [lptNormal], 'Double', @_LapeArraySum_DoubleArray); + addMagic('_ArraySum', ['TIntegerArray'], [lptNormal], 'Int64', @_LapeArraySum_Int32Array); + addMagic('_ArraySum', ['TInt64Array'], [lptNormal], 'Int64', @_LapeArraySum_Int64Array); - addMagic('_ArraySort', ['TIntegerArray'], [lptVar], '', @_LapeSort_IntegerArray); + addMagic('_ArraySort', ['TIntegerArray'], [lptVar], '', @_LapeSort_Int32Array); + addMagic('_ArraySort', ['TInt64Array'], [lptVar], '', @_LapeSort_Int64Array); addMagic('_ArraySort', ['TSingleArray'], [lptVar], '', @_LapeSort_SingleArray); addMagic('_ArraySort', ['TDoubleArray'], [lptVar], '', @_LapeSort_DoubleArray); addMagic('_ArraySort', ['TStringArray'], [lptVar], '', @_LapeSort_StringArray); - addMagic('_ArrayUnique', ['TIntegerArray'], [lptNormal], 'TIntegerArray', @_LapeUnique_IntegerArray); + addMagic('_ArrayUnique', ['TIntegerArray'], [lptNormal], 'TIntegerArray', @_LapeUnique_Int32Array); + addMagic('_ArrayUnique', ['TInt64Array'], [lptNormal], 'TInt64Array', @_LapeUnique_Int64Array); addMagic('_ArrayUnique', ['TSingleArray'], [lptNormal], 'TSingleArray', @_LapeUnique_SingleArray); addMagic('_ArrayUnique', ['TDoubleArray'], [lptNormal], 'TDoubleArray', @_LapeUnique_DoubleArray); addMagic('_ArrayUnique', ['TStringArray'], [lptNormal], 'TStringArray', @_LapeUnique_StringArray); addMagic('_ArrayUnique', ['TPointArray'], [lptNormal], 'TPointArray', @_LapeUnique_PointArray); + addMagic('_ArrayUnique', ['TBoxArray'], [lptNormal], 'TBoxArray', @_LapeUnique_BoxArray); + addMagic('_ArrayIndexOf', ['Integer', 'TIntegerArray'], [lptNormal, lptNormal], 'Integer', @_LapeArrayIndexOf_Int32Array); addMagic('_ArrayIndexOf', ['String', 'TStringArray'], [lptNormal, lptNormal], 'Integer', @_LapeArrayIndexOf_StringArray); - addMagic('_ArrayIndicesOf', ['String', 'TStringArray'], [lptNormal, lptNormal], 'TIntegerArray', @_LapeArrayIndicesOf_StringArray); - - addMagic('_ArrayMean', ['TPointArray'], [lptNormal], 'TPoint', @_LapeArrayMean_PointArray); - addMagic('_ArrayMean', ['T2DPointArray'], [lptNormal], 'TPoint', @_LapeArrayMean_2DPointArray); - addMagic('_ArrayMean', ['TSingleMatrix'], [lptNormal], 'Single', @_LapeArrayMean_SingleMatrix); + addMagic('_ArrayIndexOf', ['TPoint', 'TPointArray'], [lptNormal, lptNormal], 'Integer', @_LapeArrayIndexOf_PointArray); - addMagic('_ArrayMedian', ['TPointArray'], [lptNormal], 'TPoint', @_LapeArrayMedian_PointArray); + addMagic('_ArrayIndicesOf', ['Integer', 'TIntegerArray'], [lptNormal, lptNormal], 'TIntegerArray', @_LapeArrayIndicesOf_Int32Array); + addMagic('_ArrayIndicesOf', ['String', 'TStringArray'], [lptNormal, lptNormal], 'TIntegerArray', @_LapeArrayIndicesOf_StringArray); + addMagic('_ArrayIndicesOf', ['TPoint', 'TPointArray'], [lptNormal, lptNormal], 'TIntegerArray', @_LapeArrayIndicesOf_PointArray); + addMagic('_ArrayIntersection', ['TIntegerArray', 'TIntegerArray'], [lptNormal, lptNormal], 'TIntegerArray', @_LapeArrayIntersection_Int32Array); + addMagic('_ArrayIntersection', ['TInt64Array', 'TInt64Array'], [lptNormal, lptNormal], 'TInt64Array', @_LapeArrayIntersection_Int64Array); addMagic('_ArrayIntersection', ['TPointArray', 'TPointArray'], [lptNormal, lptNormal], 'TPointArray', @_LapeArrayIntersection_PointArray); + addMagic('_ArrayIntersection', ['TBoxArray', 'TBoxArray'], [lptNormal, lptNormal], 'TBoxArray', @_LapeArrayIntersection_BoxArray); + + addMagic('_ArrayDifference', ['TIntegerArray', 'TIntegerArray'], [lptNormal, lptNormal], 'TIntegerArray', @_LapeArrayDifference_Int32Array); + addMagic('_ArrayDifference', ['TInt64Array', 'TInt64Array'], [lptNormal, lptNormal], 'TInt64Array', @_LapeArrayDifference_Int64Array); addMagic('_ArrayDifference', ['TPointArray', 'TPointArray'], [lptNormal, lptNormal], 'TPointArray', @_LapeArrayDifference_PointArray); + addMagic('_ArrayDifference', ['TBoxArray', 'TBoxArray'], [lptNormal, lptNormal], 'TBoxArray', @_LapeArrayDifference_BoxArray); + + addMagic('_ArraySymDifference', ['TIntegerArray', 'TIntegerArray'], [lptNormal, lptNormal], 'TIntegerArray', @_LapeArraySymDifference_Int32Array); + addMagic('_ArraySymDifference', ['TInt64Array', 'TInt64Array'], [lptNormal, lptNormal], 'TInt64Array', @_LapeArraySymDifference_Int64Array); addMagic('_ArraySymDifference', ['TPointArray', 'TPointArray'], [lptNormal, lptNormal], 'TPointArray', @_LapeArraySymDifference_PointArray); + addMagic('_ArraySymDifference', ['TBoxArray', 'TBoxArray'], [lptNormal, lptNormal], 'TBoxArray', @_LapeArraySymDifference_BoxArray); end; end; diff --git a/Source/script/imports/simba.import_image.pas b/Source/script/imports/simba.import_image.pas index 0b22a4d21..162c3f825 100644 --- a/Source/script/imports/simba.import_image.pas +++ b/Source/script/imports/simba.import_image.pas @@ -6,7 +6,7 @@ interface uses Classes, SysUtils, - simba.base, simba.script; + simba.base, simba.baseclass, simba.script; procedure ImportSimbaImage(Script: TSimbaScript); @@ -1664,63 +1664,74 @@ procedure _LapeImage_FromLazBitmap(const Params: PParamArray); LAPE_WRAPPER_CALL end; (* -TImage.SaveUnfreedImagesInDir ------------------------------ +TImage.LoadFonts +---------------- ``` -procedure TImage.SaveUnfreedImagesInDir(Directory: String); static; +function TImage.LoadFonts(Dir: String): Boolean; static; ``` -On script terminate if any images have not been freed save them to `Directory` for debugging ease. - -Example: +Loads all ".ttf" fonts in the given directory. +*) +procedure _LapeImage_LoadFonts(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +begin + PBoolean(Result)^ := TSimbaImage.LoadFontsInDir(PString(Params^[0])^); +end; +(* +TImage.Fonts +------------ ``` - TImage.SaveUnfreedImagesInDir('some/directory/'); +function TImage.Fonts: TStringArray; static; ``` + +Returns all the loaded font names. *) -procedure _LapeImage_SaveUnfreedImagesInDir(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV +procedure _LapeImage_Fonts(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - TSimbaImage.SaveUnfreedImages := PString(Params^[0])^; + PStringArray(Result)^ := TSimbaImage.Fonts(); end; (* -TImage.LoadFontsInDir ---------------------- +TImage.FindColor +---------------- ``` -function TImage.LoadFontsInDir(Dir: String): Boolean; static; +function TImage.FindColor(Color: TColor; Tolerance: Single = 0): TPointArray; ``` -Loads all ".ttf" fonts in the given directory. +Returns all the loaded font names. *) -procedure _LapeImage_LoadFontsInDir(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeImage_FindColor(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PBoolean(Result)^ := TSimbaImage.LoadFontsInDir(PString(Params^[0])^); + PPointArray(Result)^ := PSimbaImage(Params^[0])^.FindColor(PColor(Params^[1])^, PSingle(Params^[2])^); end; (* -TImage.Fonts ------------- +TImage.FindImage +---------------- ``` -function TImage.Fonts: TStringArray; static; +function TImage.FindImage(Image: TImage; Tolerance: Single = 0): TPoint; ``` Returns all the loaded font names. *) -procedure _LapeImage_Fonts(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeImage_FindImage(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PStringArray(Result)^ := TSimbaImage.Fonts(); + PPoint(Result)^ := PSimbaImage(Params^[0])^.FindImage(PSimbaImage(Params^[1])^, PSingle(Params^[2])^); end; (* -TImage.Target -------------- +TImage.GetLoadedImages +---------------------- ``` -function TImage.Target: TTarget; +function GetLoadedImages: TImageArray; ``` -Returns a target which is targetted to the image. -Use this to find colors and such on a image. +Returns an array of all the loaded images. *) +procedure _LapeImage_GetLoadedImages(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +begin + PSimbaImageArray(Result)^ := TSimbaImageArray(GetSimbaObjectsOfClass(TSimbaImage)); +end; (* TImage.CreateFromTarget @@ -1773,6 +1784,16 @@ procedure TImage.Show(EnsureVisible: Boolean = True); Show a image on the debug image. *) +(* +TImage.Target +------------- +``` +property TImage.Target: TTarget; +``` + +Returns a target which is targetted to the image. +*) + procedure ImportSimbaImage(Script: TSimbaScript); begin with Script.Compiler do @@ -1935,11 +1956,14 @@ procedure ImportSimbaImage(Script: TSimbaScript); addGlobalFunc('procedure TImage.FromLazBitmap(LazBitmap: TLazBitmap);', @_LapeImage_FromLazBitmap); addGlobalFunc('function TImage.Fonts: TStringArray; static;', @_LapeImage_Fonts); - addGlobalFunc('function TImage.LoadFontsInDir(Dir: String): Boolean; static;', @_LapeImage_LoadFontsInDir); + addGlobalFunc('function TImage.LoadFonts(Dir: String): Boolean; static;', @_LapeImage_LoadFonts); - addGlobalFunc('procedure TImage.SaveUnfreedImagesInDir(Directory: String); static;', @_LapeImage_SaveUnfreedImagesInDir); + addGlobalFunc('function TImage.FindColor(Color: TColor; Tolerance: Single = 0): TPointArray;', @_LapeImage_FindColor); + addGlobalFunc('function TImage.FindImage(Image: TImage; Tolerance: Single = 0): TPoint;', @_LapeImage_FindImage); DumpSection := ''; + + addGlobalFunc('function GetLoadedImages: TImageArray', @_LapeImage_GetLoadedImages); end; end; diff --git a/Source/script/imports/simba.import_matrix.pas b/Source/script/imports/simba.import_matrix.pas index 7c3bd8145..4e70fa21b 100644 --- a/Source/script/imports/simba.import_matrix.pas +++ b/Source/script/imports/simba.import_matrix.pas @@ -274,6 +274,21 @@ procedure _LapeSingleMatrix_Height(const Params: PParamArray; const Result: Poin PInteger(Result)^ := PSingleMatrix(Params^[0])^.Height; end; +procedure _LapeSingleMatrix_Min(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +begin + PSingle(Result)^ := PSingleMatrix(Params^[0])^.Min; +end; + +procedure _LapeSingleMatrix_Max(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +begin + PSingle(Result)^ := PSingleMatrix(Params^[0])^.Max; +end; + +procedure _LapeSingleMatrix_Mean(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +begin + PDouble(Result)^ := PSingleMatrix(Params^[0])^.Mean; +end; + (* TSingleMatrix.SetSize --------------------- @@ -626,6 +641,9 @@ procedure ImportMatrix(Script: TSimbaScript); // single addGlobalFunc('function TSingleMatrix.Width: Integer;', @_LapeSingleMatrix_Width); addGlobalFunc('function TSingleMatrix.Height: Integer;', @_LapeSingleMatrix_Height); + addGlobalFunc('function TSingleMatrix.Min: Single;', @_LapeSingleMatrix_Min); + addGlobalFunc('function TSingleMatrix.Max: Single;', @_LapeSingleMatrix_Max); + addGlobalFunc('function TSingleMatrix.Mean: Double;', @_LapeSingleMatrix_Mean); addGlobalFunc('procedure TSingleMatrix.SetSize(Width, Height: Integer);', @_LapeSingleMatrix_SetSize); addGlobalFunc('function TSingleMatrix.Area: Integer;', @_LapeSingleMatrix_Area); addGlobalFunc('function TSingleMatrix.GetSize(out Width, Height: Integer): Boolean;', @_LapeSingleMatrix_GetSize); diff --git a/Source/script/imports/simba.import_point.pas b/Source/script/imports/simba.import_point.pas index 433095e0e..e4482af91 100644 --- a/Source/script/imports/simba.import_point.pas +++ b/Source/script/imports/simba.import_point.pas @@ -587,6 +587,16 @@ procedure _LapeTPAConnect(const Params: PParamArray; const Result: Pointer); LAP PPointArray(Result)^ := PPointArray(Params^[0])^.Connect(); end; +procedure _LapeTPAMean(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +begin + PPoint(Result)^ := PPointArray(Params^[0])^.Mean; +end; + +procedure _LapeTPAMedian(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +begin + PPoint(Result)^ := PPointArray(Params^[0])^.Median; +end; + (* TPointArray.Extremes -------------------- @@ -1528,6 +1538,11 @@ procedure _LapeATPA_BoundsArray(const Params: PParamArray; const Result: Pointer PBoxArray(Result)^ := P2DPointArray(Params^[0])^.BoundsArray(); end; +procedure _LapeATPA_Mean(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +begin + PPoint(Result)^ := P2DPointArray(Params^[0])^.Mean(); +end; + (* T2DPointArray.Means ------------------- @@ -1636,6 +1651,8 @@ procedure ImportPoint(Script: TSimbaScript); addGlobalFunc('function TPointArray.FloodFill(const StartPoint: TPoint; const EightWay: Boolean): TPointArray;', @_LapeTPAFloodFill); addGlobalFunc('function TPointArray.ShapeFill: TPointArray', @_LapeTPAShapeFill); + addGlobalFunc('function TPointArray.Mean: TPoint', @_LapeTPAMean); + addGlobalFunc('function TPointArray.Median: TPoint', @_LapeTPAMedian); addGlobalFunc('function TPointArray.Extremes: TPointArray', @_LapeTPAExtremes); addGlobalFunc('function TPointArray.Bounds: TBox', @_LapeTPABounds); addGlobalFunc('function TPointArray.MinAreaRect: TQuad', @_LapeTPAMinAreaRect); @@ -1736,6 +1753,7 @@ procedure ImportPoint(Script: TSimbaScript); addGlobalFunc('function T2DPointArray.Bounds: TBox', @_LapeATPA_Bounds); addGlobalFunc('function T2DPointArray.BoundsArray: TBoxArray', @_LapeATPA_BoundsArray); + addGlobalFunc('function T2DPointArray.Mean: TPoint', @_LapeATPA_Mean); addGlobalFunc('function T2DPointArray.Means: TPointArray', @_LapeATPA_Means); addGlobalFunc('function T2DPointArray.Merge: TPointArray;', @_LapeATPA_Merge); addGlobalFunc('function T2DPointArray.Intersection: TPointArray; overload;', @_LapeATPA_Intersection); diff --git a/Source/script/imports/simba.import_pointbuffer.pas b/Source/script/imports/simba.import_pointbuffer.pas deleted file mode 100644 index fb159ba5f..000000000 --- a/Source/script/imports/simba.import_pointbuffer.pas +++ /dev/null @@ -1,131 +0,0 @@ -unit simba.import_pointbuffer; - -{$i simba.inc} - -interface - -uses - Classes, SysUtils, - simba.base, simba.script; - -procedure ImportPointBuffer(Script: TSimbaScript); - -implementation - -uses - Graphics, lptypes, lpvartypes, - simba.containers; - -type - PSimbaPointBuffer = ^TSimbaPointBuffer; - -procedure _LapePointBuffer_Init(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - PSimbaPointBuffer(Params^[0])^.Init(PInteger(Params^[1])^); -end; - -procedure _LapePointBuffer_InitWith(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - PSimbaPointBuffer(Params^[0])^.InitWith(PPointArray(Params^[1])^); -end; - -procedure _LapePointBuffer_Clear(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - PSimbaPointBuffer(Params^[0])^.Clear(); -end; - -procedure _LapePointBuffer_Add1(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - PSimbaPointBuffer(Params^[0])^.Add(PPoint(Params^[1])^); -end; - -procedure _LapePointBuffer_Add2(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - PSimbaPointBuffer(Params^[0])^.Add(PInteger(Params^[1])^, PInteger(Params^[2])^); -end; - -procedure _LapePointBuffer_ToArray(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PPointArray(Result)^ := PSimbaPointBuffer(Params^[0])^.ToArray(PBoolean(Params^[1])^); -end; - -procedure _LapePointBuffer_First(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PPoint(Result)^ := PSimbaPointBuffer(Params^[0])^.First(); -end; - -procedure _LapePointBuffer_Last(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PPoint(Result)^ := PSimbaPointBuffer(Params^[0])^.Last(); -end; - -procedure _LapePointBuffer_Pop(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PPoint(Result)^ := PSimbaPointBuffer(Params^[0])^.Pop(); -end; - -procedure _LapePointBuffer_Clear(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PSimbaPointBuffer(Params^[0])^.Clear(); -end; - -procedure _LapePointBuffer_Size(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PInteger(Result)^ := PSimbaPointBuffer(Params^[0])^.Size; -end; - -procedure _LapePointBuffer_Count(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PInteger(Result)^ := PSimbaPointBuffer(Params^[0])^.Count; -end; - -procedure _LapePointBuffer_Point(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PPoint(Result)^ := PSimbaPointBuffer(Params^[0])^.Item[PInteger(Params^[1])^]; -end; - -procedure ImportPointBuffer(Script: TSimbaScript); -begin - with Script.Compiler do - begin - addGlobalType([ - 'record', - ' {%CODETOOLS OFF}', - ' __Length: Integer;', - ' __Count: Integer;', - ' __Arr: TPointArray;', - ' {%CODETOOLS ON}', - 'end;'], - 'TPointBuffer' - ); - if (getGlobalType('TPointBuffer').Size <> SizeOf(TSimbaPointBuffer)) then - SimbaException('SizeOf(TPointBuffer) is wrong'); - - addDelayedCode([ - 'function ToString(constref PointBuffer: TPointBuffer): String; override;', - 'begin', - ' Result := "TPointBuffer: Size=" + IntToStr(PointBuffer.Size()) + ", Count=" + IntToStr(PointBuffer.Count());', - 'end;' - ]); - - addGlobalFunc('procedure TPointBuffer.Init(const InitialSize: Integer = 1024);', @_LapePointBuffer_Init); - addGlobalFunc('procedure TPointBuffer.InitWith(const Values: TPointArray);', @_LapePointBuffer_InitWith); - - addGlobalFunc('procedure TPointBuffer.Clear;', @_LapePointBuffer_Clear); - - addGlobalFunc('procedure TPointBuffer.Add(Value: TPoint); overload;', @_LapePointBuffer_Add1); - addGlobalFunc('procedure TPointBuffer.Add(X, Y: Integer); overload;', @_LapePointBuffer_Add2); - addGlobalFunc('function TPointBuffer.ToArray(Copy: Boolean = True): TPointArray;', @_LapePointBuffer_ToArray); - - addGlobalFunc('function TPointBuffer.First: TPoint;', @_LapePointBuffer_First); - addGlobalFunc('function TPointBuffer.Last: TPoint;', @_LapePointBuffer_Last); - addGlobalFunc('function TPointBuffer.Pop: TPoint;', @_LapePointBuffer_Pop); - - addGlobalFunc('function TPointBuffer.Size: Integer;', @_LapePointBuffer_Size); - addGlobalFunc('function TPointBuffer.Count: Integer;', @_LapePointBuffer_Count); - addGlobalFunc('function TPointBuffer.Point(Index: Integer): TPoint;', @_LapePointBuffer_Point); - end; -end; - -end. - diff --git a/Source/script/imports/simba.import_string.pas b/Source/script/imports/simba.import_string.pas index 90be53464..be5c74b37 100644 --- a/Source/script/imports/simba.import_string.pas +++ b/Source/script/imports/simba.import_string.pas @@ -13,12 +13,124 @@ procedure ImportString(Script: TSimbaScript); implementation +uses + lpmessages; + (* String ====== String methods *) +(* +String.SetLength +---------------- +``` +procedure String.SetLength(NewLength: Integer); +``` +*) +procedure _LapeString_SetLength(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV +begin + SetLength(PString(Params^[0])^, PInteger(Params^[1])^); +end; + +(* +String.Length +------------- +``` +property String.Length: Integer; +``` +*) +procedure _LapeString_Length(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +begin + PInteger(Result)^ := Length(PString(Params^[0])^); +end; + +(* +String.High +----------- +``` +property String.Low: Integer; +``` +*) +procedure _LapeString_Low(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +begin + PInteger(Result)^ := Low(PString(Params^[0])^); +end; + +(* +String.High +----------- +``` +property String.High: Integer; +``` +*) +procedure _LapeString_High(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +begin + PInteger(Result)^ := High(PString(Params^[0])^); +end; + +(* +String.Pop +---------- +``` +property String.Pop: Char; +``` +*) +procedure _LapeString_Pop(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV + + function _Pop(var Str: lpString): Char; + begin + if Length(Str) < 1 then + LapeExceptionFmt(lpeIndexOutOfRange, [Length(Str), Low(Str), Length(Str)]); + Result := Str[Length(Str)]; + SetLength(Str, Length(Str) - 1); + end; + +begin + PChar(Result)^ := _Pop(PString(Params^[0])^); +end; + +(* +String.First +------------ +``` +property String.First: Char; +``` +*) +procedure _LapeString_First(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV + + function _First(const Str: lpString): Char; + begin + if Length(Str) < 1 then + LapeExceptionFmt(lpeIndexOutOfRange, [Low(Str), Low(Str), Length(Str)]); + Result := Str[Low(Str)]; + end; + +begin + PChar(Result)^ := _First(PString(Params^[0])^); +end; + +(* +String.Last +----------- +``` +property String.Last: Char; +``` +*) +procedure _LapeString_Last(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV + + function _Last(const Str: lpString): Char; + begin + if Length(Str) < 1 then + LapeExceptionFmt(lpeIndexOutOfRange, [High(Str), Low(Str), Length(Str)]); + Result := Str[High(Str)]; + end; + +begin + PChar(Result)^ := _Last(PString(Params^[0])^); +end; + (* String.Before ------------- @@ -47,7 +159,7 @@ procedure _LapeString_After(const Params: PParamArray; const Result: Pointer); L String.StartsWith ----------------- ``` -function String.StartsWith(Value: String; CaseSenstive: Boolean = True): Boolean; +function String.StartsWith(Value: String; CaseSensitive: Boolean = True): Boolean; ``` *) procedure _LapeString_StartsWith(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV @@ -59,24 +171,12 @@ procedure _LapeString_StartsWith(const Params: PParamArray; const Result: Pointe String.Equals ------------- ``` -function String.Equals(Other: String): Boolean; +function String.EqualsIgnoreCase(Other: String; CaseSensitive: Boolean = True): Boolean; ``` *) procedure _LapeString_Equals(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PBoolean(Result)^ := PString(Params^[0])^.Equals(PString(Params^[1])^); -end; - -(* -String.EqualsIgnoreCase ------------------------ -``` -function String.EqualsIgnoreCase(Other: String): Boolean; -``` -*) -procedure _LapeString_EqualsIgnoreCase(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PBoolean(Result)^ := PString(Params^[0])^.EqualsIgnoreCase(PString(Params^[1])^); + PBoolean(Result)^ := PString(Params^[0])^.Equals(PString(Params^[1])^, PBoolean(Params^[2])^); end; (* @@ -119,7 +219,7 @@ procedure _LapeString_Hash(const Params: PParamArray; const Result: Pointer); LA String.EndsWith --------------- ``` -function String.EndsWith(Value: String; CaseSenstive: Boolean = True): Boolean; +function String.EndsWith(Value: String; CaseSensitive: Boolean = True): Boolean; ``` *) procedure _LapeString_EndsWith(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV @@ -131,31 +231,31 @@ procedure _LapeString_EndsWith(const Params: PParamArray; const Result: Pointer) String.IsUpper -------------- ``` -function String.IsUpper(): Boolean; +property String.IsUpper(): Boolean; ``` *) procedure _LapeString_IsUpper(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PBoolean(Result)^ := PString(Params^[0])^.IsUpper(); + PBoolean(Result)^ := PString(Params^[0])^.IsUpper; end; (* String.IsLower -------------- ``` -function String.IsLower(): Boolean; +property String.IsLower: Boolean; ``` *) procedure _LapeString_IsLower(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PBoolean(Result)^ := PString(Params^[0])^.IsLower(); + PBoolean(Result)^ := PString(Params^[0])^.IsLower; end; (* String.ToUpper -------------- ``` -function String.ToUpper(): String; +function String.ToUpper: String; ``` *) procedure _LapeString_ToUpper(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV @@ -167,7 +267,7 @@ procedure _LapeString_ToUpper(const Params: PParamArray; const Result: Pointer); String.ToLower -------------- ``` -function String.ToLower(): String; +function String.ToLower: String; ``` *) procedure _LapeString_ToLower(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV @@ -187,6 +287,18 @@ procedure _LapeString_Capitalize(const Params: PParamArray; const Result: Pointe PString(Result)^ := PString(Params^[0])^.Capitalize(); end; +(* +String.CapitalizeWords +---------------------- +``` +function String.CapitalizeWords: String; +``` +*) +procedure _LapeString_CapitalizeWords(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +begin + PString(Result)^ := PString(Params^[0])^.CapitalizeWords(); +end; + (* String.SwapCase --------------- @@ -260,41 +372,39 @@ procedure _LapeString_PadRight(const Params: PParamArray; const Result: Pointer) end; (* -String.Partition +String.PadCenter ---------------- ``` -function String.Partition(Value: String): TStringArray; +function String.PadCenter(Count: Integer; PaddingChar: Char = #32): String; ``` *) -procedure _LapeString_Partition(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeString_PadCenter(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PStringArray(Result)^ := PString(Params^[0])^.Partition(PString(Params^[1])^); + PString(Result)^ := PString(Params^[0])^.PadCenter(PInteger(Params^[1])^, PChar(Params^[2])^); end; (* -String.Replace --------------- +String.Partition +---------------- ``` -function String.Replace(OldValue: String; NewValue: String): String; +function String.Partition(Value: String): TStringArray; ``` *) -procedure _LapeString_Replace(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeString_Partition(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PString(Result)^ := PString(Params^[0])^.Replace(PString(Params^[1])^, PString(Params^[2])^); + PStringArray(Result)^ := PString(Params^[0])^.Partition(PString(Params^[1])^); end; (* String.Replace -------------- ``` -function String.Replace(OldValue: String; NewValue: String; ReplaceFlags: TReplaceFlags): String; +function String.Replace(OldValue: String; NewValue: String; CaseSensitive: Boolean = True): String; ``` *) -procedure _LapeString_ReplaceEx(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -type - PReplaceFlags = ^TReplaceFlags; +procedure _LapeString_Replace(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PString(Result)^ := PString(Params^[0])^.Replace(PString(Params^[1])^, PString(Params^[2])^, PReplaceFlags(Params^[3])^); + PString(Result)^ := PString(Params^[0])^.Replace(PString(Params^[1])^, PString(Params^[2])^, PBoolean(Params^[3])^); end; (* @@ -423,54 +533,6 @@ procedure _LapeString_RegExprExists(const Params: PParamArray; const Result: Poi PBoolean(Result)^ := PString(Params^[0])^.RegExprExists(PString(Params^[1])^); end; -(* -String.CopyRange ----------------- -``` -function String.CopyRange(StartIndex, EndIndex: Integer): String; -``` -*) -procedure _LapeString_CopyRange(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PString(Result)^ := PString(Params^[0])^.CopyRange(PInteger(Params^[1])^, PInteger(Params^[2])^); -end; - -(* -String.DeleteRange ------------------- -``` -procedure String.DeleteRange(StartIndex, EndIndex: Integer); -``` -*) -procedure _LapeString_DeleteRange(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - PString(Params^[0])^.DeleteRange(PInteger(Params^[1])^, PInteger(Params^[2])^); -end; - -(* -String.Remove -------------- -``` -function String.Remove(Value: String): Boolean; -``` -*) -procedure _LapeString_Remove(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PBoolean(Result)^ := PString(Params^[0])^.Remove(PString(Params^[1])^); -end; - -(* -String.RemoveAll ----------------- -``` -function String.RemoveAll(Value: String): Integer; -``` -*) -procedure _LapeString_RemoveAll(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PInteger(Result)^ := PString(Params^[0])^.RemoveAll(PString(Params^[1])^); -end; - (* String.IndexOf -------------- @@ -568,168 +630,180 @@ procedure _LapeString_BetweenAll(const Params: PParamArray; const Result: Pointe end; (* -String.NumberChars ------------------- +String.Extract +-------------- ``` -function String.NumberChars: String; static; +function String.Extract(Chars: array of Char): String; ``` *) -procedure _LapeString_NumberChars(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeString_Extract(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +type + PCharArray = ^TCharArray; begin - PString(Result)^ := String.NumberChars; + PString(Result)^ := PString(Params^[0])^.Extract(PCharArray(Params^[1])^); end; (* -String.LowerChars ------------------ +String.ExtractInteger +--------------------- ``` -function String.LowerChars: String; static; +function String.ExtractInteger(Default: Int64 = -1): Int64; ``` *) -procedure _LapeString_LowerChars(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeString_ExtractInteger(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PString(Result)^ := String.LowerChars; + PInt64(Result)^ := PString(Params^[0])^.ExtractInteger(PInt64(Params^[1])^); end; (* -String.UpperChars ------------------ +String.ExtractFloat +------------------- ``` -function String.UpperChars: String; static; +function String.ExtractFloat(Default: Double = -1): Double; ``` *) -procedure _LapeString_UpperChars(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeString_ExtractFloat(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PString(Result)^ := String.UpperChars; + PDouble(Result)^ := PString(Params^[0])^.ExtractFloat(PInt64(Params^[1])^); end; (* -String.AlphaChars +String.IsAlpha +-------------- +``` +property String.IsAlpha: Boolean; +``` +*) +procedure _LapeString_IsAlpha(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +begin + PBoolean(Result)^ := PString(Params^[0])^.IsAlpha; +end; + +(* +String.IsAlphaNum ----------------- ``` -function String.AlphaChars: String; static; +property String.IsAlphaNum: Boolean; ``` *) -procedure _LapeString_AlphaChars(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeString_IsAlphaNum(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PString(Result)^ := String.AlphaChars; + PBoolean(Result)^ := PString(Params^[0])^.IsAlphaNum; end; (* -String.AlphaNumChars --------------------- +String.IsNumeric +---------------- ``` -function String.AlphaNumChars: String; static; +property String.IsNumeric: Boolean; ``` *) -procedure _LapeString_AlphaNumChars(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeString_IsNumeric(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PString(Result)^ := String.AlphaNumChars; + PBoolean(Result)^ := PString(Params^[0])^.IsNumeric; end; (* -String.Extract --------------- +String.IsInteger +---------------- ``` -function String.Extract(Chars: array of Char): String; +property String.IsInteger: Boolean; ``` *) -procedure _LapeString_Extract(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -type - PCharArray = ^TCharArray; +procedure _LapeString_IsInteger(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PString(Result)^ := PString(Params^[0])^.Extract(PCharArray(Params^[1])^); + PBoolean(Result)^ := PString(Params^[0])^.IsInteger; end; (* -String.ExtractInteger ---------------------- +String.IsFloat +-------------- ``` -function String.ExtractInteger(Default: Int64 = -1): Int64; +property String.IsFloat: Boolean; ``` *) -procedure _LapeString_ExtractInteger(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeString_IsFloat(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PInt64(Result)^ := PString(Params^[0])^.ExtractInteger(PInt64(Params^[1])^); + PBoolean(Result)^ := PString(Params^[0])^.IsFloat; end; (* -String.ExtractFloat -------------------- +String.Insert +------------- ``` -function String.ExtractFloat(Default: Double = -1): Double; +procedure String.Insert(Value: String; Index: Integer); ``` *) -procedure _LapeString_ExtractFloat(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeString_Insert(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin - PDouble(Result)^ := PString(Params^[0])^.ExtractFloat(PInt64(Params^[1])^); + Insert(PString(Params^[1])^, PString(Params^[0])^, PInteger(Params^[2])^); end; (* -String.IsAlphaNum ------------------ +String.DeleteIndex +------------------ ``` -function String.IsAlphaNum(): Boolean; +function String.DeleteIndex(Index: Integer): Char; ``` *) -procedure _LapeString_IsAlphaNum(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeString_DeleteIndex(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin - PBoolean(Result)^ := PString(Params^[0])^.IsAlphaNum(); + Delete(PString(Params^[0])^, PInteger(Params^[1])^, 1); end; (* -String.IsInteger ----------------- +String.DeleteRange +------------------ ``` -function String.IsInteger(): Boolean; +procedure String.DeleteRange(StartIndex, EndIndex: Integer); ``` *) -procedure _LapeString_IsInteger(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeString_DeleteRange(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin - PBoolean(Result)^ := PString(Params^[0])^.IsInteger(); + Delete(PString(Params^[0])^, PInteger(Params^[1])^, (PInteger(Params^[2])^ - PInteger(Params^[1])^) + 1); end; (* -String.IsFloat --------------- +String.Copy +----------- ``` -function String.IsFloat(): Boolean; +function String.Copy: String; ``` *) -procedure _LapeString_IsFloat(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeString_Copy(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PBoolean(Result)^ := PString(Params^[0])^.IsFloat(); + PString(Result)^ := Copy(PString(Params^[0])^, 1, Length(PString(Params^[0])^)); end; (* -String.Count ------------- +String.CopyRange +---------------- ``` -function String.Count(Value: String): Integer; +function String.CopyRange(StartIndex, EndIndex: Integer): String; ``` *) -procedure _LapeString_Count(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeString_CopyRange(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PInteger(Result)^ := PString(Params^[0])^.Count(PString(Params^[1])^); + PString(Result)^ := Copy(PString(Params^[0])^, PInteger(Params^[1])^, (PInteger(Params^[2])^ - PInteger(Params^[1])^) + 1); end; (* -String.CountAll ---------------- +String.Count +------------ ``` -function String.CountAll(Values: TStringArray): TIntegerArray; +function String.Count(Value: String): Integer; ``` *) -procedure _LapeString_CountAll(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeString_Count(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PIntegerArray(Result)^ := PString(Params^[0])^.CountAll(PStringArray(Params^[1])^); + PInteger(Result)^ := PString(Params^[0])^.Count(PString(Params^[1])^, PBoolean(Params^[2])^); end; (* String.Contains --------------- ``` -function String.Contains(Value: String; CaseSenstive: Boolean = True): Boolean; +function String.Contains(Value: String; CaseSensitive: Boolean): Boolean; ``` *) procedure _LapeString_Contains(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV @@ -741,7 +815,7 @@ procedure _LapeString_Contains(const Params: PParamArray; const Result: Pointer) String.ContainsAny ------------------ ``` -function String.ContainsAny(Values: TStringArray; CaseSenstive: Boolean = True): Boolean; +function String.ContainsAny(Values: TStringArray; CaseSensitive: Boolean = True): Boolean; ``` *) procedure _LapeString_ContainsAny(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV @@ -749,30 +823,6 @@ procedure _LapeString_ContainsAny(const Params: PParamArray; const Result: Point PBoolean(Result)^ := PString(Params^[0])^.ContainsAny(PStringArray(Params^[1])^, PBoolean(Params^[2])^); end; -(* -String.IndexOfAny ------------------ -``` -function String.IndexOfAny(Values: TStringArray): Integer; -``` -*) -procedure _LapeString_IndexOfAny(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PInteger(Result)^ := PString(Params^[0])^.IndexOfAny(PStringArray(Params^[1])^); -end; - -(* -String.IndexOfAny ------------------ -``` -function String.IndexOfAny(Values: TStringArray; Offset: Integer): Integer; -``` -*) -procedure _LapeString_IndexOfAnyEx(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PInteger(Result)^ := PString(Params^[0])^.IndexOfAny(PStringArray(Params^[1])^, PInteger(Params^[2])^); -end; - (* String.Format ------------- @@ -969,75 +1019,71 @@ procedure _LapeString_IN_StringArray(const Params: PParamArray; const Result: Po PBoolean(Result)^ := PString(Params^[0])^ in PStringArray(Params^[1])^; end; - -// -------------------------- -// char methods - (* -Char.IsAlphaNum ---------------- +Char.IsAlpha +------------ ``` -function Char.IsAlphaNum(): Boolean; +property Char.IsAlpha: Boolean; ``` *) -procedure _LapeChar_IsAlphaNum(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeChar_IsAlpha(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PBoolean(Result)^ := PChar(Params^[0])^.IsAlphaNum(); + PBoolean(Result)^ := PChar(Params^[0])^.IsAlpha; end; (* -Char.IsInteger --------------- +Char.IsAlphaNum +--------------- ``` -function Char.IsInteger(): Boolean; +property Char.IsAlphaNum: Boolean; ``` *) -procedure _LapeChar_IsInteger(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeChar_IsAlphaNum(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PBoolean(Result)^ := PChar(Params^[0])^.IsInteger(); + PBoolean(Result)^ := PChar(Params^[0])^.IsAlphaNum; end; (* -Char.IsFloat ------------- +Char.IsNumeric +-------------- ``` -function Char.IsFloat(): Boolean; +property Char.IsNumeric: Boolean; ``` *) -procedure _LapeChar_IsFloat(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeChar_IsNumeric(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PBoolean(Result)^ := PChar(Params^[0])^.IsFloat(); + PBoolean(Result)^ := PChar(Params^[0])^.IsNumeric; end; (* Char.IsUpper ------------ ``` -function Char.IsUpper(): Boolean; +property Char.IsUpper: Boolean; ``` *) procedure _LapeChar_IsUpper(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PBoolean(Result)^ := PChar(Params^[0])^.IsUpper(); + PBoolean(Result)^ := PChar(Params^[0])^.IsUpper; end; (* Char.IsLower ------------ ``` -function Char.IsLower(): Boolean; +property Char.IsLower: Boolean; ``` *) procedure _LapeChar_IsLower(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PBoolean(Result)^ := PChar(Params^[0])^.IsLower(); + PBoolean(Result)^ := PChar(Params^[0])^.IsLower; end; (* Char.ToUpper ------------ ``` -function Char.ToUpper(): String; +function Char.ToUpper: String; ``` *) procedure _LapeChar_ToUpper(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV @@ -1049,7 +1095,7 @@ procedure _LapeChar_ToUpper(const Params: PParamArray; const Result: Pointer); L Char.ToLower ------------ ``` -function Char.ToLower(): String; +function Char.ToLower: String; ``` *) procedure _LapeChar_ToLower(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV @@ -1057,18 +1103,6 @@ procedure _LapeChar_ToLower(const Params: PParamArray; const Result: Pointer); L PString(Result)^ := PChar(Params^[0])^.ToLower(); end; -(* -Char.Capitalize ---------------- -``` -function Char.Capitalize(): String; -``` -*) -procedure _LapeChar_Capitalize(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV -begin - PString(Result)^ := PChar(Params^[0])^.Capitalize(); -end; - (* Char.Join --------- @@ -1117,9 +1151,16 @@ procedure _LapeChar_IN_StringArray(const Params: PParamArray; const Result: Poin PBoolean(Result)^ := PChar(Params^[0])^ in PStringArray(Params^[1])^; end; -procedure _LapeStringArray_ToString(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +(* +TStringArray.Join +----------------- +``` +function TStringArray.Join(Glue: String): String; +``` +*) +procedure _LapeStringArray_Join(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PString(Result)^ := PStringArray(Params^[0])^.ToString(PString(Params^[1])^); + PString(Result)^ := PStringArray(Params^[0])^.Join(PString(Params^[1])^); end; procedure ImportString(Script: TSimbaScript); @@ -1149,25 +1190,38 @@ procedure ImportString(Script: TSimbaScript); ); addGlobalType('array of TRegExprMatch', 'TRegExprMatchArray'); - addGlobalFunc('function String.NumberChars: String; static;', @_LapeString_NumberChars); - addGlobalFunc('function String.AlphaChars: String; static;', @_LapeString_AlphaChars); - addGlobalFunc('function String.LowerChars: String; static;', @_LapeString_LowerChars); - addGlobalFunc('function String.UpperChars: String; static;', @_LapeString_UpperChars); - addGlobalFunc('function String.AlphaNumChars: String; static;', @_LapeString_AlphaNumChars); - - addGlobalFunc('function String.Equals(Other: String): Boolean;', @_LapeString_Equals); - addGlobalFunc('function String.EqualsIgnoreCase(Other: String): Boolean;', @_LapeString_EqualsIgnoreCase); + addGlobalFunc('procedure String.SetLength(NewLen: Int32);', @_LapeString_SetLength); + addGlobalFunc('property String.Length: Int32;', @_LapeString_Length); + addGlobalFunc('property String.Low: Int32;', @_LapeString_Low); + addGlobalFunc('property String.High: Int32;', @_LapeString_High); + addGlobalFunc('property String.Pop: Char;', @_LapeString_Pop); + addGlobalFunc('property String.First: Char;', @_LapeString_First); + addGlobalFunc('property String.Last: Char;', @_LapeString_Last); + + addGlobalFunc('property String.IsUpper: Boolean;', @_LapeString_IsUpper); + addGlobalFunc('property String.IsLower: Boolean;', @_LapeString_IsLower); + addGlobalFunc('property String.IsAlpha: Boolean;', @_LapeString_IsAlpha); + addGlobalFunc('property String.IsAlphaNum: Boolean;', @_LapeString_IsAlphaNum); + addGlobalFunc('property String.IsNumeric: Boolean;', @_LapeString_IsNumeric); + addGlobalFunc('property String.IsInteger: Boolean;', @_LapeString_IsInteger); + addGlobalFunc('property String.IsFloat: Boolean;', @_LapeString_IsFloat); + + addGlobalFunc('procedure String.Insert(Value: String; Index: Int32);', @_LapeString_Insert); + addGlobalFunc('procedure String.DeleteIndex(Index: Integer);', @_LapeString_DeleteIndex); + addGlobalFunc('procedure String.DeleteRange(StartIndex, EndIndex: Int32);', @_LapeString_DeleteRange); + addGlobalFunc('function String.Copy: String', @_LapeString_Copy); + addGlobalFunc('function String.CopyRange(StartIndex, EndIndex: Int32): String', @_LapeString_CopyRange); + + addGlobalFunc('function String.Equals(Other: String; CaseSensitive: Boolean = True): Boolean;', @_LapeString_Equals); addGlobalFunc('function String.Compare(Other: String): Integer;', @_LapeString_Compare); addGlobalFunc('function String.Similarity(Other: String): Double;', @_LapeString_Similarity); addGlobalFunc('function String.Hash(Seed: UInt32 = 0): UInt32;', @_LapeString_Hash); - addGlobalFunc('function String.IsUpper(): Boolean;', @_LapeString_IsUpper); - addGlobalFunc('function String.IsLower(): Boolean;', @_LapeString_IsLower); - - addGlobalFunc('function String.ToUpper(): String;', @_LapeString_ToUpper); - addGlobalFunc('function String.ToLower(): String;', @_LapeString_ToLower); - addGlobalFunc('function String.Capitalize(): String;', @_LapeString_Capitalize); - addGlobalFunc('function String.SwapCase(): String;', @_LapeString_SwapCase); + addGlobalFunc('function String.ToUpper: String;', @_LapeString_ToUpper); + addGlobalFunc('function String.ToLower: String;', @_LapeString_ToLower); + addGlobalFunc('function String.Capitalize: String;', @_LapeString_Capitalize); + addGlobalFunc('function String.CapitalizeWords: String;', @_LapeString_CapitalizeWords); + addGlobalFunc('function String.SwapCase: String;', @_LapeString_SwapCase); addGlobalFunc('function String.Before(Value: String): String;', @_LapeString_Before); addGlobalFunc('function String.After(Value: String): String;', @_LapeString_After); @@ -1180,14 +1234,10 @@ procedure ImportString(Script: TSimbaScript); addGlobalFunc('function String.RegExprFind(Pattern: String): TRegExprMatch;', @_LapeString_RegExprFind); addGlobalFunc('function String.RegExprExists(Pattern: String): Boolean;', @_LapeString_RegExprExists); - addGlobalFunc('function String.IndexOfAny(Values: TStringArray): Integer; overload;', @_LapeString_IndexOfAny); - addGlobalFunc('function String.IndexOfAny(Values: TStringArray; Offset: Integer): Integer; overload;', @_LapeString_IndexOfAnyEx); - addGlobalFunc('function String.IndexOf(Value: String): Integer; overload;', @_LapeString_IndexOf); addGlobalFunc('function String.IndexOf(Value: String; Offset: Integer): Integer; overload;', @_LapeString_IndexOfEx); addGlobalFunc('function String.LastIndexOf(Value: String): Integer; overload;', @_LapeString_LastIndexOf); addGlobalFunc('function String.LastIndexOf(Value: String; Offset: Integer): Integer; overload;', @_LapeString_LastIndexOfEx); - addGlobalFunc('function String.IndicesOf(Value: String): TIntegerArray; overload;', @_LapeString_IndicesOf); addGlobalFunc('function String.IndicesOf(Value: String; Offset: Integer): TIntegerArray; overload;', @_LapeString_IndicesOfEx); @@ -1195,10 +1245,6 @@ procedure ImportString(Script: TSimbaScript); addGlobalFunc('function String.ExtractInteger(Default: Int64 = -1): Int64;', @_LapeString_ExtractInteger); addGlobalFunc('function String.ExtractFloat(Default: Double = -1): Double;', @_LapeString_ExtractFloat); - addGlobalFunc('function String.IsAlphaNum(): Boolean;', @_LapeString_IsAlphaNum); - addGlobalFunc('function String.IsInteger(): Boolean;', @_LapeString_IsInteger); - addGlobalFunc('function String.IsFloat(): Boolean;', @_LapeString_IsFloat); - addGlobalFunc('function String.Trim: String; overload;', @_LapeString_Trim); addGlobalFunc('function String.Trim(TrimChars: array of Char): String; overload;', @_LapeString_TrimEx); @@ -1208,31 +1254,23 @@ procedure ImportString(Script: TSimbaScript); addGlobalFunc('function String.TrimRight: String; overload;', @_LapeString_TrimRight); addGlobalFunc('function String.TrimRight(TrimChars: array of Char): String; overload;', @_LapeString_TrimRightEx); - addGlobalFunc('function String.StartsWith(Value: String; CaseSenstive: Boolean = True): Boolean;', @_LapeString_StartsWith); - addGlobalFunc('function String.EndsWith(Value: String; CaseSenstive: Boolean = True): Boolean;', @_LapeString_EndsWith); + addGlobalFunc('function String.StartsWith(Value: String; CaseSensitive: Boolean = True): Boolean;', @_LapeString_StartsWith); + addGlobalFunc('function String.EndsWith(Value: String; CaseSensitive: Boolean = True): Boolean;', @_LapeString_EndsWith); addGlobalFunc('function String.Partition(Value: String): TStringArray;', @_LapeString_Partition); - addGlobalFunc('function String.Replace(OldValue: String; NewValue: String): String; overload;', @_LapeString_Replace); - addGlobalFunc('function String.Replace(OldValue: String; NewValue: String; ReplaceFlags: TReplaceFlags): String; overload;', @_LapeString_ReplaceEx); - - addGlobalFunc('function String.Contains(Value: String; CaseSenstive: Boolean = True): Boolean;', @_LapeString_Contains); - addGlobalFunc('function String.ContainsAny(Values: TStringArray; CaseSenstive: Boolean = True): Boolean;', @_LapeString_ContainsAny); + addGlobalFunc('function String.Replace(OldValue, NewValue: String; CaseSensitive: Boolean = True): String;', @_LapeString_Replace); - addGlobalFunc('function String.Count(Value: String): Integer;', @_LapeString_Count); - addGlobalFunc('function String.CountAll(Values: TStringArray): TIntegerArray;', @_LapeString_CountAll); + addGlobalFunc('function String.Count(Value: String; CaseSensitive: Boolean = True): Integer;', @_LapeString_Count); + addGlobalFunc('function String.Contains(Value: String; CaseSensitive: Boolean = True): Boolean; overload', @_LapeString_Contains); + addGlobalFunc('function String.ContainsAny(Values: TStringArray; CaseSensitive: Boolean = True): Boolean;', @_LapeString_ContainsAny); addGlobalFunc('function String.Join(Values: TStringArray): String;', @_LapeString_Join); addGlobalFunc('function String.Split(Seperator: String; ExcludeEmpty: Boolean = True): TStringArray;', @_LapeString_Split); addGlobalFunc('function String.SplitLines: TStringArray;', @_LapeString_SplitLines); - addGlobalFunc('function String.CopyRange(StartIndex, EndIndex: Integer): String;', @_LapeString_CopyRange); - addGlobalFunc('procedure String.DeleteRange(StartIndex, EndIndex: Integer);', @_LapeString_DeleteRange); - - addGlobalFunc('function String.Remove(Value: String): Boolean;', @_LapeString_Remove); - addGlobalFunc('function String.RemoveAll(Value: String): Integer;', @_LapeString_RemoveAll); - addGlobalFunc('function String.PadLeft(Count: Integer; PaddingChar: Char = #32): String', @_LapeString_PadLeft); addGlobalFunc('function String.PadRight(Count: Integer; PaddingChar: Char = #32): String', @_LapeString_PadRight); + addGlobalFunc('function String.PadCenter(ACount: Integer; PaddingChar: Char = #32): String', @_LapeString_PadCenter); addGlobalFunc('function String.Format(Args: TVariantArray): String;', @_LapeString_Format); @@ -1249,20 +1287,17 @@ procedure ImportString(Script: TSimbaScript); addGlobalFunc('function String.ToDouble(Default: Double): Double; overload;', @_LapeString_ToDoubleDef); addGlobalFunc('function String.ToDateTime(Fmt: String; Def: TDateTime): TDateTime;', @_LapeString_ToDateTime); - addGlobalFunc('function TStringArray.ToString(Sep: String): String;', @_LapeStringArray_ToString); + addGlobalFunc('function TStringArray.Join(Glue: String): String;', @_LapeStringArray_Join); addGlobalFunc('operator *(Left: String; Right: Integer): String', @_LapeString_MUL_Integer); addGlobalFunc('operator in(Left: String; Right: String): Boolean', @_LapeString_IN_String); addGlobalFunc('operator in(Left: String; Right: TStringArray): Boolean', @_LapeString_IN_StringArray); - addGlobalFunc('function Char.IsUpper(): Boolean;', @_LapeChar_IsUpper); - addGlobalFunc('function Char.IsLower(): Boolean;', @_LapeChar_IsLower); - addGlobalFunc('function Char.ToUpper(): String;', @_LapeChar_ToUpper); - addGlobalFunc('function Char.ToLower(): String;', @_LapeChar_ToLower); - addGlobalFunc('function Char.Capitalize(): String;', @_LapeChar_Capitalize); - addGlobalFunc('function Char.IsAlphaNum(): Boolean;', @_LapeChar_IsAlphaNum); - addGlobalFunc('function Char.IsInteger(): Boolean;', @_LapeChar_IsInteger); - addGlobalFunc('function Char.IsFloat(): Boolean;', @_LapeChar_IsFloat); + addGlobalFunc('property Char.IsUpper: Boolean;', @_LapeChar_IsUpper); + addGlobalFunc('property Char.IsLower: Boolean;', @_LapeChar_IsLower); + addGlobalFunc('property Char.IsAlpha: Boolean;', @_LapeChar_IsAlpha); + addGlobalFunc('property Char.IsAlphaNum: Boolean;', @_LapeChar_IsAlphaNum); + addGlobalFunc('property Char.IsNumeric: Boolean;', @_LapeChar_IsNumeric); addGlobalFunc('function Char.Join(Values: TStringArray): String;', @_LapeChar_Join); addGlobalFunc('operator *(Left: Char; Right: Integer): String', @_LapeChar_MUL_Integer); diff --git a/Source/script/imports/simba.import_target.pas b/Source/script/imports/simba.import_target.pas index 2447d27b9..6a09bffc7 100644 --- a/Source/script/imports/simba.import_target.pas +++ b/Source/script/imports/simba.import_target.pas @@ -1229,9 +1229,9 @@ procedure ImportTarget(Script: TSimbaScript); ' Result.SetImage(Self);', 'end;' ]); - DumpSection := ''; end; end; end. + diff --git a/Source/script/simba.script_compiler.pas b/Source/script/simba.script_compiler.pas index 8706a2b33..765948c7d 100644 --- a/Source/script/simba.script_compiler.pas +++ b/Source/script/simba.script_compiler.pas @@ -60,6 +60,7 @@ TManagedImportClosure = class(TLapeDeclaration) function addGlobalVar(Value: Pointer; AName: lpString): TLapeGlobalVar; override; function addGlobalFunc(Header: lpString; Value: Pointer): TLapeGlobalVar; override; function addGlobalType(Str: lpString; AName: lpString): TLapeType; override; + function addGlobalType(Typ: TLapeType; AName: lpString = ''; ACopy: Boolean = True): TLapeType; override; // Compiler addons procedure pushCode(Code: String); @@ -343,7 +344,7 @@ constructor TScriptCompiler.CreateDump; begin FDump := TSimbaStringPairList.Create(); - // init the dump with things not imported normally + // init the dump with things not imported by normal means for BaseType in ELapeBaseType do if (FBaseTypes[BaseType] <> nil) then DumpCode('Base', 'type %s = %s;'.Format([LapeTypeToString(BaseType), LapeTypeToString(BaseType)])); @@ -384,9 +385,10 @@ constructor TScriptCompiler.CreateDump; DumpCode('Base', 'function GetScriptMethodName(Address: Pointer): String; external;'); DumpCode('Base', 'function DumpCallStack(Start: Integer = 0): String; external;'); - DumpCode('Base', 'function Map(KeyType: T; ValueType: V): Map; external;'); - DumpCode('Base', 'function StringMap(ValueType: V): StringMap; external;'); - DumpCode('Base', 'function Heap(ValueType: V): Heap; external;'); + DumpCode('Base', 'function TMap(KeyType: T; ValueType: V): TMap; external;'); + DumpCode('Base', 'function TStringMap(ValueType: V): TStringMap; external;'); + DumpCode('Base', 'function THeap(ValueType: V): THeap; external;'); + DumpCode('Base', 'function TArrayBuffer(ValueType: V): TArrayBuffer; external;'); inherited Create(TLapeTokenizerString.Create('')); end; @@ -519,6 +521,14 @@ function TScriptCompiler.addGlobalType(Str: lpString; AName: lpString): TLapeTyp DumpType(AName, Str); end; +function TScriptCompiler.addGlobalType(Typ: TLapeType; AName: lpString; ACopy: Boolean): TLapeType; +begin + if (FDump <> nil) and (Typ <> nil) and (Typ.Name <> '') then + DumpType(AName, Typ.Name); + + Result := inherited; +end; + procedure TScriptCompiler.pushCode(Code: String); begin pushTokenizer(TLapeTokenizerString.Create(Code)); diff --git a/Source/script/simba.script_genericarraybuffer.pas b/Source/script/simba.script_genericarraybuffer.pas new file mode 100644 index 000000000..6a97feb77 --- /dev/null +++ b/Source/script/simba.script_genericarraybuffer.pas @@ -0,0 +1,173 @@ +{ + Author: Raymond van Venetië and Merlijn Wajer + Project: Simba (https://github.com/MerlijnWajer/Simba) + License: GNU General Public License (https://www.gnu.org/licenses/gpl-3.0) +} +unit simba.script_genericarraybuffer; + +{$i simba.inc} + +interface + +uses + Classes, SysUtils, + lptypes, lpvartypes, lpvartypes_array, lpvartypes_record, lptree, lpcompiler, lpmessages, + simba.script_genericbase; + +procedure InitializeArrayBuffer(Compiler: TLapeCompiler); + +implementation + +type + TArrayBufferType = class(TLapeType_Record) + protected + FValueType: TLapeType; + FItemArr: TLapeType; + public + //record + // FCount: Int32; + // FItems: array of _T; + //end; + constructor Create(ACompiler: TLapeCompilerBase; AValueType: TLapeType); reintroduce; + end; + +constructor TArrayBufferType.Create(ACompiler: TLapeCompilerBase; AValueType: TLapeType); +begin + inherited Create(ACompiler, nil); + + FValueType := AValueType; + FItemArr := FCompiler.addManagedType(TLapeType_DynArray.Create(FValueType, FCompiler, 'TItemArray')); + + addField(FCompiler.getBaseType(ltInt32), 'Count'); + addField(FItemArr, 'Items'); +end; + +type + TLapeTree_InternalMethod_ArrayBuffer = class(TGenericMethod) + public + function resType: TLapeType; override; + end; + +function TLapeTree_InternalMethod_ArrayBuffer.resType: TLapeType; + + function FindOurType(Typ: TLapeType): TLapeType; + var + Decl: TLapeDeclaration; + begin + for Decl in FCompiler.GlobalDeclarations.GetByClass(TArrayBufferType, bFalse) do + if (TArrayBufferType(Decl).FValueType = Typ) then + Exit(TLapeType(Decl)); + Result := nil; + end; + +var + ValueType: TLapeType; + Builder: TLapeMethodBuilder; +begin + if (FParams.Count <> 1) then + LapeExceptionFmt(lpeWrongNumberParams, [1], DocPos); + + if (FResType = nil) then + begin + ValueType := getParamType(0); + + // Already built? + FResType := FindOurType(ValueType); + if (FResType <> nil) then + begin + Result := inherited; + Exit; + end; + FResType := FCompiler.addGlobalDecl(TArrayBufferType.Create(FCompiler, ValueType)) as TLapeType; + + Builder := TLapeMethodBuilder.Create(FResType); + + Builder.Name := 'First'; + Builder.ResultType := TArrayBufferType(FResType).FValueType; + Builder.Body := [ + 'Result := Items[0];' + ]; + Builder.isProperty := True; + Builder.Build(); + + Builder.Name := 'Last'; + Builder.ResultType := TArrayBufferType(FResType).FValueType; + Builder.Body := [ + 'Result := Items[Count - 1];' + ]; + Builder.isProperty := True; + Builder.Build(); + + Builder.Name := 'Pop'; + Builder.ResultType := TArrayBufferType(FResType).FValueType; + Builder.Body := [ + 'Result := Items[Count - 1];', + 'SetLength(Items, Count - 1);', + 'Dec(Count);' + ]; + Builder.isProperty := True; + Builder.Build(); + + Builder.Name := 'ToArray'; + Builder.ResultType := TArrayBufferType(FResType).FItemArr; + Builder.Body := [ + 'Result := Copy(Items, 0, Count);' + ]; + Builder.Build(); + + Builder.Name := 'Add'; + Builder.addParam('Value', ValueType, lptConstRef); + Builder.Body := [ + 'if (Count >= Length(Items)) then', + ' SetLength(Items, 4 + (Length(Items) * 2));', + '', + 'Items[Count] := Value;', + 'Inc(Count);' + ]; + Builder.isOverload := True; + Builder.Build(); + + Builder.Name := 'Add'; + Builder.addParam('Values', TArrayBufferType(FResType).FItemArr, lptConstRef); + Builder.Body := [ + 'var Len: Int32 := Length(Values);', + 'if (Count + Len >= Length(Items)) then', + ' SetLength(Items, 4 + (Len + (Length(Items) * 2)));', + 'var i: Int32;', + 'for i := 0 to Len - 1 do', + 'begin', + ' Items[Count] := Values[i];', + ' Inc(Count);', + 'end;' + ]; + Builder.isOverload := True; + Builder.Build(); + + Builder.Name := 'Clear'; + Builder.Body := [ + 'Count := 0;' + ]; + Builder.Build(); + + // ToString: String + Builder.Name := 'ToString'; + Builder.ResultType := FCompiler.getBaseType(ltString); + Builder.Body := [ + 'Result := "Count=" + System.ToString(Count) + LINE_SEP + "Items=" + System.ToString(System.Copy(Items, 0, Count));' + ]; + Builder.Build(); + Builder.Free(); + + addToStringOverride(); + end; + + Result := inherited; +end; + +procedure InitializeArrayBuffer(Compiler: TLapeCompiler); +begin + Compiler.InternalMethodMap['TArrayBuffer'] := TLapeTree_InternalMethod_ArrayBuffer; +end; + +end. + diff --git a/Source/script/simba.script_genericbase.pas b/Source/script/simba.script_genericbase.pas index 349799a7e..f2834a484 100644 --- a/Source/script/simba.script_genericbase.pas +++ b/Source/script/simba.script_genericbase.pas @@ -206,6 +206,7 @@ constructor TGenericMethod.Create(ACompiler: TLapeCompilerBase; ADocPos: PDocPos inherited Create(ACompiler, ADocPos); FConstant := bTrue; + FSpecialParam := spType; end; // "inherited FoldConstants()" but dont hide exception if raised diff --git a/Source/script/simba.script_genericheap.pas b/Source/script/simba.script_genericheap.pas index 2f08aec1f..03c5c3b9d 100644 --- a/Source/script/simba.script_genericheap.pas +++ b/Source/script/simba.script_genericheap.pas @@ -230,7 +230,7 @@ function TLapeTree_InternalMethod_Heap.resType: TLapeType; procedure InitializeHeap(Compiler: TLapeCompiler); begin - Compiler.InternalMethodMap['Heap'] := TLapeTree_InternalMethod_Heap; + Compiler.InternalMethodMap['THeap'] := TLapeTree_InternalMethod_Heap; end; end. diff --git a/Source/script/simba.script_genericmap.pas b/Source/script/simba.script_genericmap.pas index 7812ff977..b7181985e 100644 --- a/Source/script/simba.script_genericmap.pas +++ b/Source/script/simba.script_genericmap.pas @@ -338,7 +338,7 @@ function TLapeTree_InternalMethod_Map.resType: TLapeType; procedure InitializeMap(Compiler: TLapeCompiler); begin - Compiler.InternalMethodMap['Map'] := TLapeTree_InternalMethod_Map; + Compiler.InternalMethodMap['TMap'] := TLapeTree_InternalMethod_Map; end; end. diff --git a/Source/script/simba.script_genericstringmap.pas b/Source/script/simba.script_genericstringmap.pas index fadbcf8a3..ab42b0ac2 100644 --- a/Source/script/simba.script_genericstringmap.pas +++ b/Source/script/simba.script_genericstringmap.pas @@ -523,7 +523,7 @@ procedure InitializeStringMap(Compiler: TLapeCompiler); Compiler.addGlobalFunc('function _StringMapIndexOf(Arr: Pointer; ElSize: Int32; Hi: Int32; CaseSens: Boolean; Key: String): Int32', @_LapeStringMapIndexOf); Compiler.addGlobalFunc('function _StringMapHash(Str: String): UInt64', @_LapeStringMapHash); - Compiler.InternalMethodMap['StringMap'] := TLapeTree_InternalMethod_StringMap; + Compiler.InternalMethodMap['TStringMap'] := TLapeTree_InternalMethod_StringMap; end; end. diff --git a/Source/script/simba.script_imports.pas b/Source/script/simba.script_imports.pas index d1537adb1..10feae07a 100644 --- a/Source/script/simba.script_imports.pas +++ b/Source/script/simba.script_imports.pas @@ -26,6 +26,7 @@ implementation simba.script_genericmap, simba.script_genericstringmap, simba.script_genericheap, + simba.script_genericarraybuffer, // Simba simba.import_base, simba.import_colormath,simba.import_matrix, simba.import_windowhandle, @@ -34,7 +35,7 @@ implementation simba.import_encoding, simba.import_file, simba.import_process, simba.import_target, simba.import_math, simba.import_misc, simba.import_slacktree, simba.import_string, simba.import_random, simba.import_debugimage, simba.import_web, simba.import_threading, - simba.import_pointbuffer, simba.import_async, + simba.import_async, // Simba classes simba.import_image, simba.import_externalcanvas, simba.import_dtm, simba.import_matchtemplate, @@ -54,6 +55,7 @@ procedure AddSimbaInternalMethods(Script: TSimbaScript); InitializeMap(Script.Compiler); InitializeStringMap(Script.Compiler); InitializeHeap(Script.Compiler); + InitializeArrayBuffer(Script.Compiler); end; procedure AddSimbaImports(Script: TSimbaScript); @@ -96,7 +98,6 @@ procedure AddSimbaImports(Script: TSimbaScript); ImportMisc(Script); ImportThreading(Script); ImportASync(Script); - ImportPointBuffer(Script); ImportSimbaImageBox(Script); ImportSimbaShapeBox(Script); diff --git a/Source/script/simba.script_pluginloader.pas b/Source/script/simba.script_pluginloader.pas index 8dfa261ab..631af6761 100644 --- a/Source/script/simba.script_pluginloader.pas +++ b/Source/script/simba.script_pluginloader.pas @@ -87,7 +87,7 @@ function FindLoadedPlugin(FileName: String): String; begin Result := ''; for I := 0 to High(LoadedPlugins) do - if (TSimbaPath.PathExtractNameWithoutExt(LoadedPlugins[I].OrginalFileName).EqualsIgnoreCase(TSimbaPath.PathExtractNameWithoutExt(FileName))) then + if (TSimbaPath.PathExtractNameWithoutExt(LoadedPlugins[I].OrginalFileName).Equals(TSimbaPath.PathExtractNameWithoutExt(FileName), False)) then Exit(LoadedPlugins[I].FileName); end; diff --git a/Source/simba.aca.pas b/Source/simba.aca.pas index 0a6ddc238..e458efd94 100644 --- a/Source/simba.aca.pas +++ b/Source/simba.aca.pas @@ -153,8 +153,8 @@ procedure TSimbaACAForm.MenuItemLoadHSLCircleExClick(Sender: TObject); var Value: String; begin - if InputQuery('ACA', 'HSL Circle Radius (Max 2000)', Value) and Value.IsInteger() then - LoadHSLCircle(Min(Value.ToInteger(), 2000)); + if InputQuery('ACA', 'HSL Circle Radius (Max 2000)', Value) and Value.IsNumeric then + LoadHSLCircle(Min(Value.ToInteger, 2000)); end; function TSimbaACAForm.IsShortcut(var Message: TLMKey): Boolean; diff --git a/Source/simba.array_algorithm.pas b/Source/simba.array_algorithm.pas index c40dbb7fd..57c63e717 100644 --- a/Source/simba.array_algorithm.pas +++ b/Source/simba.array_algorithm.pas @@ -29,10 +29,10 @@ generic TArrayRelationship<_T> = class generic TArrayUnique<_T> = class public type TArr = array of _T; - TCompareFunc = function(const L, R: _T): Boolean is nested; + TEqualsFunc = function(const L, R: _T): Boolean is nested; public class function Unique(Arr: TArr): TArr; static; overload; - class function Unique(Arr: TArr; CompareFunc: TCompareFunc): TArr; static; overload; + class function Unique(Arr: TArr; EqualsFunc: TEqualsFunc): TArr; static; overload; end; generic TArraySort<_T> = class @@ -59,48 +59,23 @@ generic TArraySortWeighted<_T, _W> = class end; generic TArrayEquals<_T> = class - public type - TArr = array of _T; - public - class function Equals(A, B: TArr): Boolean; static; reintroduce; - end; - - generic TArrayEqualsFunc<_T> = class public type TArr = array of _T; TEqualFunc = function(const A, B: _T): Boolean is nested; public - class function Equals(A, B: TArr; EqualFunc: TEqualFunc): Boolean; static; reintroduce; + class function Equals(A, B: TArr): Boolean; static; overload; + class function Equals(A, B: TArr; EqualFunc: TEqualFunc): Boolean; static; overload; end; generic TArrayIndexOf<_T> = class - public type - TArr = array of _T; - public - class function IndexOf(Item: _T; Arr: TArr): Integer; static; - end; - - generic TArrayIndexOfFunc<_T> = class public type TArr = array of _T; TEqualFunc = function(const A, B: _T): Boolean is nested; public - class function IndexOf(Item: _T; Arr: TArr; EqualFunc: TEqualFunc): Integer; static; - end; - - generic TArrayIndicesOf<_T> = class - public type - TArr = array of _T; - public - class function IndicesOf(Item: _T; Arr: TArr): TIntegerArray; static; - end; - - generic TArrayIndicesOfFunc<_T> = class - public type - TArr = array of _T; - TEqualFunc = function(const A, B: _T): Boolean is nested; - public - class function IndicesOf(Item: _T; Arr: TArr; EqualFunc: TEqualFunc): TIntegerArray; static; + class function IndexOf(Item: _T; Arr: TArr): Integer; static; overload; + class function IndexOf(Item: _T; Arr: TArr; EqualFunc: TEqualFunc): Integer; static; overload; + class function IndicesOf(Item: _T; Arr: TArr): TIntegerArray; static; overload; + class function IndicesOf(Item: _T; Arr: TArr; EqualFunc: TEqualFunc): TIntegerArray; static; overload; end; implementation @@ -230,7 +205,7 @@ class function TArrayUnique.Unique(Arr: TArr): TArr; dict.Free(); end; -class function TArrayUnique.Unique(Arr: TArr; CompareFunc: TCompareFunc): TArr; +class function TArrayUnique.Unique(Arr: TArr; EqualsFunc: TEqualsFunc): TArr; var I, J, NewLen: Integer; begin @@ -242,7 +217,7 @@ class function TArrayUnique.Unique(Arr: TArr; CompareFunc: TCompareFunc): TArr; J := 0; while (J < NewLen) do begin - if CompareFunc(Result[I], Result[J]) then + if EqualsFunc(Result[I], Result[J]) then Break; Inc(J); end; @@ -407,33 +382,19 @@ class procedure TArraySortWeighted.QuickSort(var Arr: TArr; var Weights: TWeight end; class function TArrayEquals.Equals(A, B: TArr): Boolean; -var - I: Integer; begin - if (Length(A) <> Length(B)) then - Exit(False); - if (Length(A) = 0) and (Length(B) = 0) then - Exit(True); + if IsManagedType(_T) then + SimbaException('Requires EqualsFunc'); - if (not IsManagedType(_T)) then - Result := CompareMem(@A[0], @B[0], Length(A) * SizeOf(_T)) - else - begin - for I := 0 to High(A) do - if (A[I] <> B[I]) then - Exit(False); - Exit(True); - end; + Result := (Length(A) = Length(B)) and ((Length(A) = 0) and (Length(B) = 0)) or CompareMem(@A[0], @B[0], Length(A) * SizeOf(_T)) end; -class function TArrayEqualsFunc.Equals(A, B: TArr; EqualFunc: TEqualFunc): Boolean; +class function TArrayEquals.Equals(A, B: TArr; EqualFunc: TEqualFunc): Boolean; var I: Integer; begin if (Length(A) <> Length(B)) then Exit(False); - if (Length(A) = 0) and (Length(B) = 0) then - Exit(True); for I := 0 to High(A) do if not EqualFunc(A[I], B[I]) then @@ -446,46 +407,38 @@ class function TArrayIndexOf.IndexOf(Item: _T; Arr: TArr): Integer; var I: Integer; begin - Result := -1; - if (Length(Arr) = 0) then - Exit; - - // can use these for better code - if (not IsManagedType(_T)) and ((SizeOf(_T) = 1) or (SizeOf(_T) = 2) or (SizeOf(_T) = 4) or (SizeOf(_T) = 8)) then - begin - case SizeOf(_T) of - 1: Result := IndexByte(Arr[0], Length(Arr), PByte(@Item)^); - 2: Result := IndexWord(Arr[0], Length(Arr), PWord(@Item)^); - 4: Result := IndexDWord(Arr[0], Length(Arr), PDWord(@Item)^); - 8: Result := IndexQWord(Arr[0], Length(Arr), PQWord(@Item)^); - end; - Exit; - end; + if IsManagedType(_T) then + SimbaException('Need EqualsFunc'); for I := 0 to High(Arr) do - if (Arr[I] = Item) then + if CompareMem(@Arr[I], @Item, SizeOf(_T)) then Exit(I); + + Result := -1; end; -class function TArrayIndexOfFunc.IndexOf(Item: _T; Arr: TArr; EqualFunc: TEqualFunc): Integer; +class function TArrayIndexOf.IndexOf(Item: _T; Arr: TArr; EqualFunc: TEqualFunc): Integer; var I: Integer; begin - Result := -1; for I := 0 to High(Arr) do if EqualFunc(Arr[I], Item) then Exit(I); + Result := -1; end; -class function TArrayIndicesOf.IndicesOf(Item: _T; Arr: TArr): TIntegerArray; +class function TArrayIndexOf.IndicesOf(Item: _T; Arr: TArr): TIntegerArray; var I, Count: Integer; begin + if IsManagedType(_T) then + SimbaException('Requires EqualsFunc'); + SetLength(Result, 8); Count := 0; for I := 0 to High(Arr) do - if (Arr[I] = Item) then + if CompareMem(@Arr[I], @Item, SizeOf(_T)) then begin if (Count >= Length(Result)) then SetLength(Result, Length(Result) * 2); @@ -496,7 +449,7 @@ class function TArrayIndicesOf.IndicesOf(Item: _T; Arr: TArr): TIntegerArray; SetLength(Result, Count); end; -class function TArrayIndicesOfFunc.IndicesOf(Item: _T; Arr: TArr; EqualFunc: TEqualFunc): TIntegerArray; +class function TArrayIndexOf.IndicesOf(Item: _T; Arr: TArr; EqualFunc: TEqualFunc): TIntegerArray; var I, Count: Integer; begin diff --git a/Source/simba.baseclass.pas b/Source/simba.baseclass.pas index 4871e7a5d..acdc2e0e1 100644 --- a/Source/simba.baseclass.pas +++ b/Source/simba.baseclass.pas @@ -14,6 +14,7 @@ interface simba.base, simba.containers, simba.threading; type + TSimbaBaseClass = class protected FName: String; @@ -32,6 +33,8 @@ TSimbaBaseClass = class property Name: String read GetName write SetName; property FreeOnTerminate: Boolean read FFreeOnTerminate write FFreeOnTerminate; end; + TSimbaBaseClassType = class of TSimbaBaseClass; + TSimbaBaseClassArray = array of TSimbaBaseClass; TSimbaBaseThread = class(TThread) protected @@ -49,6 +52,8 @@ TSimbaBaseThread = class(TThread) procedure PrintUnfinishedThreads; procedure PrintUnfreedThreads; + function GetSimbaObjectsOfClass(ClassType: TSimbaBaseClassType): TSimbaBaseClassArray; + implementation type @@ -131,6 +136,22 @@ procedure PrintUnfreedThreads; end; end; +function GetSimbaObjectsOfClass(ClassType: TSimbaBaseClassType): TSimbaBaseClassArray; +var + I: Integer; +begin + Result := []; + + TrackedObjects.Lock(); + try + for I := 0 to TrackedObjects.Count - 1 do + if (TrackedObjects[I] is ClassType) then + Result := Result + [TrackedObjects[I]]; + finally + TrackedObjects.UnLock(); + end; +end; + procedure TSimbaBaseClass.NotifyUnfreed; begin DebugLn([EDebugLn.YELLOW], ' ' + ClassName + ' (' + HexStr(Self) + ')' + IfThen(Name <> '', ' "' + Name + '"', '')); @@ -197,4 +218,3 @@ finalization TrackedObjects.First.Free(); end. - diff --git a/Source/simba.containers.pas b/Source/simba.containers.pas index 74813d3a7..a4aec6d08 100644 --- a/Source/simba.containers.pas +++ b/Source/simba.containers.pas @@ -4,14 +4,13 @@ License: GNU General Public License (https://www.gnu.org/licenses/gpl-3.0) Very simple containers: - - List + - Lists - Stack - ArrayBuffer - StringBuilder } unit simba.containers; -{$DEFINE SIMBA_MAX_OPTIMIZATION} {$i simba.inc} interface diff --git a/Source/script/imports/simba.externalcanvas.pas b/Source/simba.externalcanvas.pas similarity index 100% rename from Source/script/imports/simba.externalcanvas.pas rename to Source/simba.externalcanvas.pas diff --git a/Source/simba.image.pas b/Source/simba.image.pas index 11e32c600..687fb7ce2 100644 --- a/Source/simba.image.pas +++ b/Source/simba.image.pas @@ -57,7 +57,6 @@ TSimbaImage = class(TSimbaBaseClass) procedure DrawDataAlpha(TheData: PColorBGRA; DataW, DataH: Integer; P: TPoint; Alpha: Byte); procedure RaiseOutOfImageException(X, Y: Integer); - procedure NotifyUnfreed; override; function GetPixel(const X, Y: Integer): TColor; function GetAlpha(const X, Y: Integer): Byte; @@ -77,7 +76,6 @@ TSimbaImage = class(TSimbaBaseClass) procedure SetFontBold(Value: Boolean); procedure SetFontItalic(Value: Boolean); public - class var SaveUnfreedImages: ShortString; class function LoadFontsInDir(Dir: String): Boolean; class function Fonts: TStringArray; public @@ -247,20 +245,21 @@ TSimbaImage = class(TSimbaBaseClass) function Save(FileName: String; OverwriteIfExists: Boolean = False): Boolean; function SaveToString: String; - // Difference - function Equals(Other: TObject): Boolean; override; - function Equals(Other: TSimbaImage): Boolean; overload; - + // Compare/Difference + function Equals(Other: TSimbaImage): Boolean; reintroduce; function Compare(Other: TSimbaImage): Single; - function PixelDifference(Other: TSimbaImage): Integer; overload; function PixelDifference(Other: TSimbaImage; Tolerance: Single): Integer; overload; - function PixelDifferenceTPA(Other: TSimbaImage): TPointArray; overload; + function PixelDifferenceTPA(Other: TSimbaImage): TPointArray; overload; function PixelDifferenceTPA(Other: TSimbaImage; Tolerance: Single): TPointArray; overload; // Laz bridge function ToLazBitmap: TBitmap; procedure FromLazBitmap(LazBitmap: TBitmap); + + // Basic finders, use Target.SetTarget(img) for all + function FindColor(Color: TColor; Tolerance: Single): TPointArray; + function FindImage(Image: TSimbaImage; Tolerance: Single): TPoint; end; PSimbaImage = ^TSimbaImage; @@ -611,14 +610,6 @@ function TSimbaImage.SaveToString: String; Result := SimbaImage_ToString(Self); end; -function TSimbaImage.Equals(Other: TObject): Boolean; -begin - if (Other is TSimbaImage) then - Result := Equals(TSimbaImage(Other)) - else - Result := inherited Equals(Other); -end; - // Compare without alpha function TSimbaImage.Equals(Other: TSimbaImage): Boolean; var @@ -845,6 +836,22 @@ procedure TSimbaImage.FromLazBitmap(LazBitmap: TBitmap); TempBitmap.Free(); end; +function TSimbaImage.FindColor(Color: TColor; Tolerance: Single): TPointArray; +var + Target: TSimbaTarget; +begin + Target.SetImage(Self); + Result := Target.FindColor(Color, Tolerance, Target.Bounds); +end; + +function TSimbaImage.FindImage(Image: TSimbaImage; Tolerance: Single): TPoint; +var + Target: TSimbaTarget; +begin + Target.SetImage(Self); + Result := Target.FindImage(Image, Tolerance, Target.Bounds); +end; + procedure TSimbaImage.DrawTPA(TPA: TPointArray); begin if (FDrawAlpha = ALPHA_OPAQUE) then @@ -1885,19 +1892,6 @@ procedure TSimbaImage.RaiseOutOfImageException(X, Y: Integer); SimbaException('%d,%d is outside the image bounds (0,0,%d,%d)', [X, Y, FWidth-1, FHeight-1]); end; -procedure TSimbaImage.NotifyUnfreed; -begin - inherited NotifyUnfreed(); - - if (SaveUnfreedImages <> '') then - try - Save(IncludeTrailingPathDelimiter(SetDirSeparators(SaveUnfreedImages)) + IntToStr(PtrUInt(Self)) + '.bmp'); - except - on E: Exception do - DebugLn(E.ToString); - end; -end; - function TSimbaImage.GetPixel(const X, Y: Integer): TColor; begin if (X < 0) or (Y < 0) or (X >= FWidth) or (Y >= FHeight) then @@ -2048,3 +2042,4 @@ destructor TSimbaImage.Destroy; end. + diff --git a/Source/simba.target.pas b/Source/simba.target.pas index d56d079ab..52f01a126 100644 --- a/Source/simba.target.pas +++ b/Source/simba.target.pas @@ -1166,8 +1166,7 @@ function TSimbaTarget.ToString: String; class operator TSimbaTarget.Initialize(var Self: TSimbaTarget); begin - Self := Default(TSimbaTarget); + FillByte(Self, SizeOf(TSimbaTarget), 0); end; end. - diff --git a/Source/simba.vartype_box.pas b/Source/simba.vartype_box.pas index c976fe272..7baa22f71 100644 --- a/Source/simba.vartype_box.pas +++ b/Source/simba.vartype_box.pas @@ -75,7 +75,7 @@ TBoxHelper = record helper for TBox function Difference(Other: TBoxArray): TBoxArray; function SymmetricDifference(Other: TBoxArray): TBoxArray; function Intersection(Other: TBoxArray): TBoxArray; - + function Unique: TBoxArray; function Pack: TBoxArray; function Sort(Weights: TIntegerArray; LowToHigh: Boolean = True): TBoxArray; overload; @@ -424,6 +424,11 @@ function TBoxArrayHelper.Intersection(Other: TBoxArray): TBoxArray; Result := specialize TArrayRelationship.Intersection(Self, Other); end; +function TBoxArrayHelper.Unique: TBoxArray; +begin + Result := specialize TArrayUnique.Unique(Self) +end; + function TBoxArrayHelper.SortFrom(From: TPoint): TBoxArray; var Weights: TDoubleArray; diff --git a/Source/simba.vartype_ordarray.pas b/Source/simba.vartype_ordarray.pas index 1bd80a3a5..ed7614023 100644 --- a/Source/simba.vartype_ordarray.pas +++ b/Source/simba.vartype_ordarray.pas @@ -18,7 +18,6 @@ interface function ToString: String; procedure FromString(Value: String); end; - TIntegerArrayHelper = type helper for TIntegerArray function Equals(Other: TIntegerArray): Boolean; function IndexOf(Value: Integer): Integer; @@ -38,12 +37,14 @@ interface function Difference(Other: TInt64Array): TInt64Array; function SymmetricDifference(Other: TInt64Array): TInt64Array; function Intersection(Other: TInt64Array): TInt64Array; + function Min: Int64; + function Max: Int64; + function Sum: Int64; + function Unique: TInt64Array; + procedure Sort; end; TSingleArrayHelper = type helper for TSingleArray - function Equals(Other: TSingleArray): Boolean; - function IndexOf(Value: Single): Integer; - function IndicesOf(Value: Single): TIntegerArray; function Min: Single; function Max: Single; function Sum: Double; @@ -52,9 +53,6 @@ interface end; TDoubleArrayHelper = type helper for TDoubleArray - function Equals(Other: TDoubleArray): Boolean; - function IndexOf(Value: Double): Integer; - function IndicesOf(Value: Double): TIntegerArray; function Min: Double; function Max: Double; function Sum: Double; @@ -81,7 +79,6 @@ procedure TByteArrayHelper.FromString(Value: String); if (Length(Self) > 0) then Move(Value[1], Self[0], Length(Value)); end; - function TIntegerArrayHelper.Equals(Other: TIntegerArray): Boolean; begin Result := specialize TArrayEquals.Equals(Self, Other); @@ -94,7 +91,7 @@ function TIntegerArrayHelper.IndexOf(Value: Integer): Integer; function TIntegerArrayHelper.IndicesOf(Value: Integer): TIntegerArray; begin - Result := specialize TArrayIndicesOf.IndicesOf(Value, Self); + Result := specialize TArrayIndexOf.IndicesOf(Value, Self); end; function TIntegerArrayHelper.Min: Integer; @@ -144,7 +141,7 @@ function TInt64ArrayHelper.Difference(Other: TInt64Array): TInt64Array; function TInt64ArrayHelper.SymmetricDifference(Other: TInt64Array): TInt64Array; begin - Result := specialize TArrayRelationship.SymmetricDifference(Self, Other); + Result := specialize TArrayRelationship.SymmetricDifference(Self, Other); end; function TInt64ArrayHelper.Intersection(Other: TInt64Array): TInt64Array; @@ -152,37 +149,29 @@ function TInt64ArrayHelper.Intersection(Other: TInt64Array): TInt64Array; Result := specialize TArrayRelationship.Intersection(Self, Other); end; -function TSingleArrayHelper.Equals(Other: TSingleArray): Boolean; - - function Same(const L, R: Single): Boolean; - begin - Result := SameValue(L, R); - end; - +function TInt64ArrayHelper.Min: Int64; begin - Result := specialize TArrayEqualsFunc.Equals(Self, Other, @Same); + Result := specialize MinA(Self); end; -function TSingleArrayHelper.IndexOf(Value: Single): Integer; - - function Same(const L, R: Single): Boolean; - begin - Result := SameValue(L, R); - end; - +function TInt64ArrayHelper.Max: Int64; begin - Result := specialize TArrayIndexOfFunc.IndexOf(Value, Self, @Same); + Result := specialize MaxA(Self); end; -function TSingleArrayHelper.IndicesOf(Value: Single): TIntegerArray; +function TInt64ArrayHelper.Sum: Int64; +begin + Result := specialize Sum(Self); +end; - function Same(const L, R: Single): Boolean; - begin - Result := SameValue(L, R); - end; +function TInt64ArrayHelper.Unique: TInt64Array; +begin + Result := specialize TArrayUnique.Unique(Self); +end; +procedure TInt64ArrayHelper.Sort; begin - Result := specialize TArrayIndicesOfFunc.IndicesOf(Value, Self, @Same); + specialize TArraySort.QuickSort(Self, Low(Self), High(Self)); end; function TSingleArrayHelper.Min: Single; @@ -216,39 +205,6 @@ procedure TSingleArrayHelper.Sort; specialize TArraySort.QuickSort(Self, Low(Self), High(Self)); end; -function TDoubleArrayHelper.Equals(Other: TDoubleArray): Boolean; - - function Same(const L, R: Double): Boolean; - begin - Result := SameValue(L, R); - end; - -begin - Result := specialize TArrayEqualsFunc.Equals(Self, Other, @Same); -end; - -function TDoubleArrayHelper.IndexOf(Value: Double): Integer; - - function Same(const L, R: Double): Boolean; - begin - Result := SameValue(L, R); - end; - -begin - Result := specialize TArrayIndexOfFunc.IndexOf(Value, Self, @Same); -end; - -function TDoubleArrayHelper.IndicesOf(Value: Double): TIntegerArray; - - function Same(const L, R: Double): Boolean; - begin - Result := SameValue(L, R); - end; - -begin - Result := specialize TArrayIndicesOfFunc.IndicesOf(Value, Self, @Same); -end; - function TDoubleArrayHelper.Min: Double; begin Result := specialize MinA(Self); diff --git a/Source/simba.vartype_pointarray.pas b/Source/simba.vartype_pointarray.pas index 91894ef3d..8849da492 100644 --- a/Source/simba.vartype_pointarray.pas +++ b/Source/simba.vartype_pointarray.pas @@ -80,6 +80,7 @@ interface function ConvexHull: TPointArray; function Mean: TPoint; + function Median: TPoint; function MinAreaRect: TQuad; function MinAreaCircle: TCircle; function Bounds: TBox; @@ -159,7 +160,7 @@ interface function ConvexityDefects(Epsilon: Single; Mode: EConvexityDefects = EConvexityDefects.NONE): TPointArray; procedure ToAxes(out X, Y: TIntegerArray); - function Median: TPoint; + end; T2DPointArrayHelper = type helper for T2DPointArray @@ -513,7 +514,7 @@ function TPointArrayHelper.IndexOf(P: TPoint): Integer; function TPointArrayHelper.IndicesOf(P: TPoint): TIntegerArray; begin - Result := specialize TArrayIndicesOf.IndicesOf(P, Self); + Result := specialize TArrayIndexOf.IndicesOf(P, Self); end; function TPointArrayHelper.Equals(Other: TPointArray): Boolean; diff --git a/Source/simba.vartype_string.pas b/Source/simba.vartype_string.pas index 5602d5fdd..c6f2add8f 100644 --- a/Source/simba.vartype_string.pas +++ b/Source/simba.vartype_string.pas @@ -7,7 +7,7 @@ { avk959 - https://github.com/avk959/LGenerics - - SimRatio (used in String.Similarity) + - SimRatio (used for String.Similarity) } unit simba.vartype_string; @@ -42,45 +42,55 @@ TRegExprMatch = record TRegExprMatchArray = array of TRegExprMatch; TSimbaCharHelper = type helper for Char + private + function GetIsUpper: Boolean; + function GetIsLower: Boolean; + function GetIsAlpha: Boolean; + function GetIsAlphaNum: Boolean; + function GetIsNumeric: Boolean; public - function IsUpper(): Boolean; - function IsLower(): Boolean; - function IsAlphaNum(): Boolean; - function IsInteger(): Boolean; - function IsFloat(): Boolean; + function ToUpper: Char; + function ToLower: Char; - function ToUpper(): Char; - function ToLower(): Char; - function Capitalize(): Char; + property IsUpper: Boolean read GetIsUpper; + property IsLower: Boolean read GetIsLower; + property IsAlpha: Boolean read GetIsAlpha; + property IsAlphaNum: Boolean read GetIsAlphaNum; + property IsNumeric: Boolean read GetIsNumeric; function Join(const Values: TStringArray): String; end; TSimbaStringHelper = type helper for String - public const - NumberChars = '0123456789'; - LowerChars = 'abcdefghijklmnopqrstuvwxyz'; - UpperChars = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'; - AlphaChars = LowerChars + UpperChars; - AlphaNumChars = AlphaChars + NumberChars; + private + function IsInSet(Chars: TSysCharSet): Boolean; + + function GetIsAlpha: Boolean; + function GetIsAlphaNum: Boolean; + function GetIsFloat: Boolean; + function GetIsInteger: Boolean; + function GetIsLower: Boolean; + function GetIsNumeric: Boolean; + function GetIsUpper: Boolean; public - function Equals(Other: String): Boolean; - function EqualsIgnoreCase(Other: String): Boolean; + function Equals(Other: String; CaseSensitive: Boolean = True): Boolean; function Compare(Other: String): Integer; function Similarity(Other: String): Double; function Hash(Seed: UInt32 = 0): UInt32; - function IsUpper(): Boolean; - function IsLower(): Boolean; - function IsAlphaNum(): Boolean; - function IsInteger(): Boolean; - function IsFloat(): Boolean; + property IsUpper: Boolean read GetIsUpper; + property IsLower: Boolean read GetIsLower; + property IsAlpha: Boolean read GetIsAlpha; + property IsAlphaNum: Boolean read GetIsAlphaNum; + property IsNumeric: Boolean read GetIsNumeric; + property IsFloat: Boolean read GetIsFloat; + property IsInteger: Boolean read GetIsInteger; - function ToUpper(): String; - function ToLower(): String; - function Capitalize(): String; - function CapitalizeWords(): String; - function SwapCase(): String; + function ToUpper: String; + function ToLower: String; + function SwapCase: String; + function Capitalize: String; + function CapitalizeWords: String; function Before(const Value: String): String; function After(const Value: String): String; @@ -93,9 +103,6 @@ TRegExprMatch = record function RegExprFind(const Pattern: String): TRegExprMatch; function RegExprExists(const Pattern: String): Boolean; - function IndexOfAny(const Values: TStringArray): Integer; overload; - function IndexOfAny(const Values: TStringArray; Offset: Integer): Integer; overload; - function IndexOf(const Value: String): Integer; overload; function IndexOf(const Value: String; Offset: Integer): Integer; overload; function LastIndexOf(const Value: String): Integer; overload; @@ -104,9 +111,11 @@ TRegExprMatch = record function IndicesOf(const Value: String): TIntegerArray; overload; function IndicesOf(const Value: String; Offset: Integer): TIntegerArray; overload; + function Count(const Value: String; CaseSensitive: Boolean = True): Integer; + function Extract(const Chars: array of Char): String; function ExtractInteger(Default: Int64 = -1): Int64; - function ExtractFloat(Default: Extended = -1): Extended; + function ExtractFloat(Default: Double = -1): Double; function Trim: String; overload; function Trim(const TrimChars: array of Char): String; overload; @@ -117,18 +126,14 @@ TRegExprMatch = record function TrimRight: String; overload; function TrimRight(const TrimChars: array of Char): String; overload; - function StartsWith(const Value: String; CaseSenstive: Boolean = True): Boolean; - function EndsWith(const Value: String; CaseSenstive: Boolean = True): Boolean; - - function Partition(const Value: String; CaseSenstive: Boolean = True): TStringArray; - function Replace(const OldValue: String; const NewValue: String): String; overload; - function Replace(const OldValue: String; const NewValue: String; ReplaceFlags: TReplaceFlags): String; overload; + function StartsWith(const Value: String; CaseSensitive: Boolean = True): Boolean; + function EndsWith(const Value: String; CaseSensitive: Boolean = True): Boolean; - function Contains(const Value: String; CaseSenstive: Boolean = True): Boolean; - function ContainsAny(const Values: TStringArray; CaseSenstive: Boolean = True): Boolean; + function Partition(const Value: String; CaseSensitive: Boolean = True): TStringArray; + function Replace(const OldValue: String; const NewValue: String; CaseSensitive: Boolean = True): String; - function Count(const Value: String): Integer; - function CountAll(const Values: TStringArray): TIntegerArray; + function Contains(const Value: String; CaseSensitive: Boolean = True): Boolean; + function ContainsAny(const Values: TStringArray; CaseSensitive: Boolean = True): Boolean; function Join(const Values: TStringArray): String; function Split(const Seperator: String; ExcludeEmpty: Boolean = True): TStringArray; @@ -139,19 +144,12 @@ TRegExprMatch = record procedure DeleteRange(StartIndex, EndIndex: Integer); procedure Insert(const Value: String; Index: Integer); - procedure Extend(Value: String); - procedure Append(Value: Char); - - function Remove(Value: String): Boolean; - function RemoveAll(Value: String): Integer; - function PadLeft(ACount: Integer; PaddingChar: Char = #32): String; function PadRight(ACount: Integer; PaddingChar: Char = #32): String; function PadCenter(ACount: Integer; PaddingChar: Char = #32): String; function Format(Args: array of const): String; - function ToBytes: TByteArray; function ToBoolean: Boolean; overload; function ToBoolean(Default: Boolean): Boolean; overload; function ToInteger: Integer; overload; @@ -162,21 +160,19 @@ TRegExprMatch = record function ToSingle(Default: Single): Single; overload; function ToDouble: Double; overload; function ToDouble(Default: Double): Double; overload; - function ToExtended: Extended; overload; - function ToExtended(Default: Extended): Extended; overload; function ToDateTime(Fmt: String; Def: TDateTime): TDateTime; + function ToBytes: TByteArray; function ParseJSON: TJSONData; end; TStringArrayHelper = type helper for TStringArray - function Equals(Other: TStringArray): Boolean; function IndexOf(Value: String): Integer; function IndicesOf(Value: String): TIntegerArray; function Unique: TStringArray; procedure Sort; - function ToString(Sep: String): String; + function Join(Glue: String): String; end; operator * (const Left: String; Right: Int32): String; @@ -189,61 +185,52 @@ implementation RegExpr, StrUtils, DateUtils, simba.containers, simba.hash, simba.array_algorithm; -function TSimbaCharHelper.IsUpper(): Boolean; +function TSimbaCharHelper.GetIsUpper: Boolean; begin - Result := (Byte(Self) >= Byte('A')) and (Byte(Self) <= Byte('Z')); + Result := Self in ['A'..'Z']; end; -function TSimbaCharHelper.IsLower(): Boolean; +function TSimbaCharHelper.GetIsLower: Boolean; begin - Result := (Byte(Self) >= Byte('a')) and (Byte(Self) <= Byte('z')); + Result := Self in ['a'..'z']; end; -function TSimbaCharHelper.IsAlphaNum(): Boolean; +function TSimbaCharHelper.GetIsAlpha: Boolean; begin - Result := Self in ['0'..'9', 'a'..'z', 'A'..'Z']; + Result := Self in ['a'..'z', 'A'..'Z']; end; -function TSimbaCharHelper.IsInteger(): Boolean; +function TSimbaCharHelper.GetIsAlphaNum: Boolean; begin - Result := Self in ['0'..'9']; + Result := Self in ['0'..'9', 'a'..'z', 'A'..'Z']; end; -// same as is integer for chars, here for convinience -function TSimbaCharHelper.IsFloat(): Boolean; +function TSimbaCharHelper.GetIsNumeric: Boolean; begin Result := Self in ['0'..'9']; end; -function TSimbaCharHelper.ToUpper(): Char; +function TSimbaCharHelper.ToUpper: Char; begin Result := UpCase(Self); end; -function TSimbaCharHelper.ToLower(): Char; +function TSimbaCharHelper.ToLower: Char; begin Result := LowerCase(Self); end; -function TSimbaCharHelper.Capitalize(): Char; -begin - Result := UpCase(Self); -end; - function TSimbaCharHelper.Join(const Values: TStringArray): String; begin Result := String(Self).Join(Values); end; - -(* ---- String helpers ---- *) - function TSimbaStringHelper.Before(const Value: String): String; var P: Integer; begin P := Pos(Value, Self); - if (P = 0) then + if (P < 1) then Result := '' else Result := System.Copy(Self, 1, P - 1); @@ -254,7 +241,7 @@ function TSimbaStringHelper.After(const Value: String): String; P: Integer; begin P := Pos(Value, Self); - if (P = 0) then + if (P < 1) then Result := '' else Result := System.Copy(Self, P + System.Length(Value), (System.Length(Self) - System.Length(Value)) + 1); @@ -415,25 +402,6 @@ function TSimbaStringHelper.RegExprFindAll(const Pattern: String): TRegExprMatch end; end; -function TSimbaStringHelper.IndexOfAny(const Values: TStringArray): Integer; -begin - Result := IndexOfAny(Values, 1); -end; - -function TSimbaStringHelper.IndexOfAny(const Values: TStringArray; Offset: Integer): Integer; -var - I: Integer; -begin - Result := 0; - - for I := 0 to High(Values) do - begin - Result := Self.IndexOf(Values[I], Offset); - if (Result > 0) then - Exit; - end; -end; - function TSimbaStringHelper.IndexOf(const Value: String): Integer; begin Result := Pos(Value, Self); @@ -451,7 +419,7 @@ function TSimbaStringHelper.LastIndexOf(const Value: String): Integer; function TSimbaStringHelper.LastIndexOf(const Value: String; Offset: Integer): Integer; begin - Result := RPosEx(Value, Self, Offset); + Result := RPosEx(Value, Self, Length(Self)); end; function TSimbaStringHelper.IndicesOf(const Value: String): TIntegerArray; @@ -464,7 +432,7 @@ function TSimbaStringHelper.IndicesOf(const Value: String): TIntegerArray; if (Self = '') then Exit; - if Length(Value) = 1 then + if (Length(Value) = 1) then begin Buffer.Init(32); @@ -514,14 +482,70 @@ function TSimbaStringHelper.IndicesOf(const Value: String; Offset: Integer): TIn end; end; -function TSimbaStringHelper.Equals(Other: String): Boolean; +function TSimbaStringHelper.Count(const Value: String; CaseSensitive: Boolean): Integer; begin - Result := Self = Other; + if CaseSensitive then + Result := Length(IndicesOf(Value)) + else + Result := Length(ToLower().IndicesOf(Value.ToLower())); end; -function TSimbaStringHelper.EqualsIgnoreCase(Other: String): Boolean; +function TSimbaStringHelper.IsInSet(Chars: TSysCharSet): Boolean; +var + I: Integer; begin - Result := SameText(Self, Other); + for I := 1 to Length(Self) do + if not (Self[I] in Chars) then + Exit(False); + + Result := Self <> '' +end; + +function TSimbaStringHelper.GetIsAlpha: Boolean; +begin + Result := IsInSet(['a'..'z', 'A'..'Z']); +end; + +function TSimbaStringHelper.GetIsAlphaNum: Boolean; +begin + Result := IsInSet(['0'..'9', 'a'..'z', 'A'..'Z']); +end; + +function TSimbaStringHelper.GetIsFloat: Boolean; +var + _: Double; +begin + Result := TryStrToFloat(Self, _); +end; + +function TSimbaStringHelper.GetIsInteger: Boolean; +var + _: Int64; +begin + Result := TryStrToInt64(Self, _) or TryStrToUInt64(Self, UInt64(_)); +end; + +function TSimbaStringHelper.GetIsLower: Boolean; +begin + Result := IsInSet(['a'..'z']); +end; + +function TSimbaStringHelper.GetIsNumeric: Boolean; +begin + Result := IsInSet(['0'..'9']); +end; + +function TSimbaStringHelper.GetIsUpper: Boolean; +begin + Result := IsInSet(['A'..'Z']); +end; + +function TSimbaStringHelper.Equals(Other: String; CaseSensitive: Boolean): Boolean; +begin + if CaseSensitive then + Result := SameStr(Self, Other) + else + Result := SameText(Self, Other); end; function TSimbaStringHelper.Compare(Other: String): Integer; @@ -579,7 +603,8 @@ function TSimbaStringHelper.Similarity(Other: String): Double; if aLenR < MAX_STATIC then Dist := @StBuf[0] - else begin + else + begin System.SetLength(Buf, Succ(aLenR)); Dist := Pointer(Buf); end; @@ -633,48 +658,42 @@ function TSimbaStringHelper.Hash(Seed: UInt32 = 0): UInt32; Result := Hash32(Self, Seed); end; -function TSimbaStringHelper.IsUpper(): Boolean; -var i: Int32; +function TSimbaStringHelper.ToUpper: String; begin - for i:=1 to Length(self) do - if not self[i].IsUpper() then - Exit(False); - Result := True; -end; - -function TSimbaStringHelper.IsLower(): Boolean; -var i: Int32; -begin - for i:=1 to Length(self) do - if not self[i].IsLower() then - Exit(False); - Result := True; + Result := UpperCase(Self); end; -function TSimbaStringHelper.ToUpper(): String; +function TSimbaStringHelper.ToLower: String; begin - Result := UpperCase(Self); + Result := LowerCase(Self); end; -function TSimbaStringHelper.ToLower(): String; +function TSimbaStringHelper.SwapCase: String; +var + i: Integer; begin - Result := LowerCase(Self); + Result := Self.Copy(); + for i := 1 to Length(Result) do + if (Result[i] in ['a'..'z']) then + Result[i] := UpCase(Result[i]) + else if (Result[i] in ['A'..'Z']) then + Result[i] := LowerCase(Result[i]); end; -function TSimbaStringHelper.Capitalize(): String; +function TSimbaStringHelper.Capitalize: String; var I: Integer; begin SetLength(Result, Length(Self)); - - for I := 1 to Length(Self) do - if (I = 1) then - Result[I] := UpCase(Self[I]) - else + if (Length(Result) > 0) then + begin + Result[1] := UpCase(Self[1]); + for I := 2 to Length(Self) do Result[I] := LowerCase(Self[I]); + end; end; -function TSimbaStringHelper.CapitalizeWords(): String; +function TSimbaStringHelper.CapitalizeWords: String; var Temp: TStringArray; I: Integer; @@ -685,21 +704,6 @@ function TSimbaStringHelper.CapitalizeWords(): String; Result := ' '.Join(Temp); end; -function TSimbaStringHelper.SwapCase(): String; -var - i: Integer; -begin - SetLength(Result, Length(Self)); - - for i:=1 to Length(self) do - if Self[i].IsUpper() then - Result[i] := Self[i].ToLower() - else if Self[i].IsLower() then - Result[i] := Self[i].ToUpper() - else - Result[i] := Self[i]; -end; - function TSimbaStringHelper.Extract(const Chars: array of Char): String; type TCharMap = array[Char] of Boolean; @@ -734,68 +738,11 @@ function TSimbaStringHelper.ExtractInteger(Default: Int64): Int64; Result := StrToInt64Def(Self.Extract(['-','0','1','2','3','4','5','6','7','8','9']), Default); end; -function TSimbaStringHelper.ExtractFloat(Default: Extended): Extended; +function TSimbaStringHelper.ExtractFloat(Default: Double): Double; begin Result := StrToFloatDef(Self.Extract(['.','-','0','1','2','3','4','5','6','7','8','9']), Default); end; -function TSimbaStringHelper.IsAlphaNum: Boolean; -var - I: Integer; -begin - if (Self = '') then - Exit(False); - - Result := True; - - for I := 1 to Length(Self) do - if not (Self[I] in ['0'..'9','a'..'z','A'..'Z']) then - begin - Result := False; - Exit; - end; -end; - -function TSimbaStringHelper.IsInteger: Boolean; -var - I: Integer; -begin - if (Self = '') then - Exit(False); - - for I := 1 to Length(Self) do - if (not (Self[I] in ['0'..'9'])) then - begin - if (I = 1) and (Self[I] = '-') then - Continue; - - Result := False; - Exit; - end; - - Result := True; -end; - -function TSimbaStringHelper.IsFloat: Boolean; -var - I: Integer; -begin - if (Self = '') then - Exit(False); - - for I := 1 to Length(Self) do - if (not (Self[I] in ['0'..'9', '.'])) then - begin - if (I = 1) and (Self[I] = '-') then - Continue; - - Result := False; - Exit; - end; - - Result := True; -end; - function TSimbaStringHelper.Trim: String; begin Result := SysUtils.Trim(Self); @@ -872,29 +819,29 @@ function TSimbaStringHelper.TrimRight(const TrimChars: array of Char): String; Result := System.Copy(Self, 1, I); end; -function TSimbaStringHelper.StartsWith(const Value: String; CaseSenstive: Boolean): Boolean; +function TSimbaStringHelper.StartsWith(const Value: String; CaseSensitive: Boolean): Boolean; begin - case CaseSenstive of + case CaseSensitive of False: Result := (Length(Value) > 0) and SameText(System.Copy(Self, 1, Length(Value)), Value); True: Result := (Length(Value) > 0) and (System.Copy(Self, 1, Length(Value)) = Value); end; end; -function TSimbaStringHelper.EndsWith(const Value: String; CaseSenstive: Boolean): Boolean; +function TSimbaStringHelper.EndsWith(const Value: String; CaseSensitive: Boolean): Boolean; begin - case CaseSenstive of + case CaseSensitive of False: Result := (Length(Value) > 0) and SameText(System.Copy(Self, Length(Self) - Length(Value) + 1), Value); True: Result := (Length(Value) > 0) and (System.Copy(Self, Length(Self) - Length(Value) + 1) = Value); end; end; -function TSimbaStringHelper.Partition(const Value: String; CaseSenstive: Boolean): TStringArray; +function TSimbaStringHelper.Partition(const Value: String; CaseSensitive: Boolean): TStringArray; var I: Integer; begin Result := ['', '', '']; - if CaseSenstive then + if CaseSensitive then I := Self.IndexOf(Value) else I := Self.ToUpper().IndexOf(Value.ToUpper()); @@ -907,26 +854,24 @@ function TSimbaStringHelper.Partition(const Value: String; CaseSenstive: Boolean end; end; -function TSimbaStringHelper.Replace(const OldValue: String; const NewValue: String): String; +function TSimbaStringHelper.Replace(const OldValue: String; const NewValue: String; CaseSensitive: Boolean): String; begin - Result := StringReplace(Self, OldValue, NewValue, [rfReplaceAll]); -end; - -function TSimbaStringHelper.Replace(const OldValue: String; const NewValue: String; ReplaceFlags: TReplaceFlags): String; -begin - Result := StringReplace(Self, OldValue, NewValue, ReplaceFlags); + if CaseSensitive then + Result := StringReplace(Self, OldValue, NewValue, [rfReplaceAll]) + else + Result := StringReplace(Self, OldValue, NewValue, [rfReplaceAll, rfIgnoreCase]); end; -function TSimbaStringHelper.Contains(const Value: String; CaseSenstive: Boolean): Boolean; +function TSimbaStringHelper.Contains(const Value: String; CaseSensitive: Boolean): Boolean; begin - Result := ContainsAny([Value], CaseSenstive); + Result := ContainsAny([Value], CaseSensitive); end; -function TSimbaStringHelper.ContainsAny(const Values: TStringArray; CaseSenstive: Boolean): Boolean; +function TSimbaStringHelper.ContainsAny(const Values: TStringArray; CaseSensitive: Boolean): Boolean; var I: Integer; begin - case CaseSenstive of + case CaseSensitive of True: for I := 0 to High(Values) do if Self.IndexOf(Values[I]) > 0 then @@ -941,20 +886,6 @@ function TSimbaStringHelper.ContainsAny(const Values: TStringArray; CaseSenstive Result := False; end; -function TSimbaStringHelper.Count(const Value: String): Integer; -begin - Result := Length(Self.IndicesOf(Value)); -end; - -function TSimbaStringHelper.CountAll(const Values: TStringArray): TIntegerArray; -var - I: Integer; -begin - SetLength(Result, Length(Values)); - for I := 0 to High(Values) do - Result[I] := Length(Self.IndicesOf(Values[I])); -end; - function TSimbaStringHelper.Join(const Values: TStringArray): String; var I, Current, Total: Integer; @@ -1148,30 +1079,6 @@ procedure TSimbaStringHelper.Insert(const Value: String; Index: Integer); System.Insert(Value, Self, Index); end; -procedure TSimbaStringHelper.Extend(Value: String); -begin - Self := Self + Value; -end; - -procedure TSimbaStringHelper.Append(Value: Char); -begin - Self := Self + Value; -end; - -function TSimbaStringHelper.Remove(Value: String): Boolean; -var - ReplaceCount: Integer; -begin - Self := StringReplace(Self, Value, '', [], ReplaceCount); - - Result := ReplaceCount > 0; -end; - -function TSimbaStringHelper.RemoveAll(Value: String): Integer; -begin - Self := StringReplace(Self, Value, '', [rfReplaceAll], Result); -end; - function TSimbaStringHelper.PadLeft(ACount: Integer; PaddingChar: Char): String; begin ACount := ACount - Length(Self); @@ -1265,16 +1172,6 @@ function TSimbaStringHelper.ToDouble(Default: Double): Double; Result := StrToFloatDef(Self, Default); end; -function TSimbaStringHelper.ToExtended: Extended; -begin - Result := StrToFloat(Self); -end; - -function TSimbaStringHelper.ToExtended(Default: Extended): Extended; -begin - Result := StrToFloatDef(Self, Default); -end; - function TSimbaStringHelper.ToDateTime(Fmt: String; Def: TDateTime): TDateTime; begin Result := Def; @@ -1287,7 +1184,7 @@ function TSimbaStringHelper.ToDateTime(Fmt: String; Def: TDateTime): TDateTime; 'iso8601': TryISO8601ToDate(Self, Result); 'unix': - if Self.IsInteger() then + if Self.IsNumeric then Result := UnixToDateTime(Self.ToInt64()); else SimbaException('String.ToDateTime: Fmt "%s" not recognized', [Fmt]); @@ -1311,19 +1208,26 @@ function TSimbaStringHelper.ParseJSON: TJSONData; end; end; -function TStringArrayHelper.Equals(Other: TStringArray): Boolean; -begin - Result := specialize TArrayEquals.Equals(Self, Other); -end; - function TStringArrayHelper.IndexOf(Value: String): Integer; + + function Equals(const L, R: String): Boolean; + begin + Result := (L = R); + end; + begin - Result := specialize TArrayIndexOf.IndexOf(Value, Self); + Result := specialize TArrayIndexOf.IndexOf(Value, Self, @Equals); end; function TStringArrayHelper.IndicesOf(Value: String): TIntegerArray; + + function Equals(const L, R: String): Boolean; + begin + Result := (L = R); + end; + begin - Result := specialize TArrayIndicesOf.IndicesOf(Value, Self); + Result := specialize TArrayIndexOf.IndicesOf(Value, Self, @Equals); end; function TStringArrayHelper.Unique: TStringArray; @@ -1342,9 +1246,9 @@ procedure TStringArrayHelper.Sort; specialize TArraySortFunc.QuickSort(Self, Low(Self), High(Self), @Compare); end; -function TStringArrayHelper.ToString(Sep: String): String; +function TStringArrayHelper.Join(Glue: String): String; begin - Result := Sep.Join(Self); + Result := Glue.Join(Self); end; operator *(const Left: String; Right: Int32): String; diff --git a/Tests/array_equals.simba b/Tests/array_equals.simba deleted file mode 100644 index bce96f231..000000000 --- a/Tests/array_equals.simba +++ /dev/null @@ -1,94 +0,0 @@ -{$assertions on} - -procedure TestIntegerArray; -var - a,b: TIntegerArray; -begin - a := []; - b := []; - Assert(a.Equals(b)); - - a := [1]; - b := []; - Assert(not a.Equals(b)); - - a := [1]; - b := [1]; - Assert(a.Equals(b)); - - a := [1]; - b := [-1]; - Assert(not a.Equals(b)); - - a := [3,2,1]; - b := [3,2,1]; - Assert(a.Equals(b)); - - a := [3,2,1]; - b := [2,3,1]; - Assert(not a.Equals(b)); -end; - -procedure TestSingleArray; -var - a,b: TSingleArray; -begin - a := []; - b := []; - Assert(a.Equals(b)); - - a := [1]; - b := []; - Assert(not a.Equals(b)); - - a := [1.34]; - b := [1.34]; - Assert(a.Equals(b)); - - a := [1.01]; - b := [-1.01]; - Assert(not a.Equals(b)); - - a := [3.09,2.2,1]; - b := [3.09,2.2,1]; - Assert(a.Equals(b)); - - a := [2,3.1,1]; - b := [2,3,1]; - Assert(not a.Equals(b)); -end; - -procedure TestPointArray; -var - a,b: TPointArray; -begin - a := []; - b := []; - Assert(a.Equals(b)); - - a := [[0,0]]; - b := []; - Assert(not a.Equals(b)); - - a := [[1,2]]; - b := [[1,2]]; - Assert(a.Equals(b)); - - a := [[1,2]]; - b := [[-1,-2]]; - Assert(not a.Equals(b)); - - a := [[3,3],[3,3],[1,1]]; - b := [[3,3],[3,3],[1,1]]; - Assert(a.Equals(b)); - - a := [[3,3],[3,3],[0,0]]; - b := [[3,3],[3,3],[3,0]]; - Assert(not a.Equals(b)); -end; - -begin - TestIntegerArray(); - TestSingleArray(); - TestPointArray(); -end; diff --git a/Tests/array_indexof.simba b/Tests/array_indexof.simba index e63876848..15ad26649 100644 --- a/Tests/array_indexof.simba +++ b/Tests/array_indexof.simba @@ -1,35 +1,33 @@ {$assertions on} -procedure TestIntegerArray; +// Test our native overrides + +procedure TestStringArray; var - Arr: TIntegerArray; + Arr: TStringArray; begin - Assert(Arr.IndexOf(0)=-1); - Arr := [0]; - Assert(Arr.IndexOf(0)=0); - Arr := [1,0]; - Assert(Arr.IndexOf(0)=1); - Arr := [3,-1,0,1,0,-123]; - Assert(Arr.IndexOf(1)=3); - - Arr := [3,-1,0,1,0,-123]; - Assert(ToString(Arr.IndicesOf(0)) = '[2, 4]'); + Assert(Arr.IndexOf('abc')=-1); + Arr := ['abc']; + Assert(Arr.IndexOf('abc')=0); + Arr := ['abc','xyz']; + Assert(Arr.IndexOf('xyz')=1); + Arr := ['abc', 'xyz', '123', 'hello', 'world', 'xyz', 'hello']; + Assert(Arr.IndexOf('hello')=3); + Assert(Arr.IndicesOf('hello').Equals([3,6])); end; -procedure TestSingleArray; +procedure TestIntegerArray; var - Arr: TSingleArray; + Arr: TIntegerArray; begin Assert(Arr.IndexOf(0)=-1); Arr := [0]; Assert(Arr.IndexOf(0)=0); Arr := [1,0]; Assert(Arr.IndexOf(0)=1); - Arr := [3,-1,0,1.2,0,-123]; - Assert(Arr.IndexOf(1.2)=3); - - Arr := [3,-1,0.5,1,0.5,-123]; - Assert(ToString(Arr.IndicesOf(0.5)) = '[2, 4]'); + Arr := [3,-1,0,1,0,-123]; + Assert(Arr.IndexOf(1)=3); + Assert(Arr.IndicesOf(0).Equals([2,4])); end; procedure TestPointArray; @@ -43,13 +41,12 @@ begin Assert(Arr.IndexOf([0,0])=1); Arr := [[-1,-1],[0,0],[123,123],[123,123]]; Assert(Arr.IndexOf([123,123])=2); - Arr := [[1,2],[3,4],[5,6],[1,2]]; - Assert(ToString(Arr.IndicesOf([1,2])) = '[0, 3]'); + Assert(Arr.IndicesOf([1,2]).Equals([0,3])); end; begin + TestStringArray(); TestIntegerArray(); - TestSingleArray(); TestPointArray(); end; diff --git a/Tests/array_minmax.simba b/Tests/array_minmax.simba new file mode 100644 index 000000000..884d05498 --- /dev/null +++ b/Tests/array_minmax.simba @@ -0,0 +1,15 @@ +{$assertions on} + +// Test our native overrides + +var + ints: TIntegerArray = [1,2,0,Low(Int32),High(Int32)]; + int64s: TInt64Array = [1,2,0,Low(Int64),High(Int64)]; + +begin + Assert(ints.Min = Low(Int32)); + Assert(ints.Max = High(Int32)); + + Assert(int64s.Min = Low(Int64)); + Assert(int64s.Max = High(Int64)); +end. diff --git a/Tests/array_relationship.simba b/Tests/array_relationship.simba index 43edf7c66..ddd75bf99 100644 --- a/Tests/array_relationship.simba +++ b/Tests/array_relationship.simba @@ -1,5 +1,7 @@ {$assertions on} +// Test our native overrides + procedure TestIntegerArray; function Success(a,b: TIntegerArray): Boolean; @@ -29,21 +31,34 @@ begin Assert(Success(a.Intersection(b), [3, 4])); end; + procedure TestInt64Array; + + function Success(a,b: TInt64Array): Boolean; + var i: Int32; + begin + if (Length(a) <> Length(b)) then + Exit(False); + for i:=0 to High(a) do + if not Contains(a[i], b) then + Exit(False); + Result := True; + end; + var a,b: TInt64Array; begin - //a := [1,2,3]; - //b := [3,2,1]; - //Assert(ToString(a.Difference(b)) = '[]'); - //Assert(ToString(a.SymDifference(b)) = '[]'); - //Assert(ToString(a.Intersection(b)) = '[3, 2, 1]'); - // - //a := [1,2,3,4]; - //b := [5,4,3]; - //Assert(ToString(a.Difference(b)) = '[1, 2]'); - //Assert(ToString(a.SymDifference(b)) = '[1, 2, 5]'); - //Assert(ToString(a.Intersection(b)) = '[3, 4]'); + a := [1,2,3,High(Int64),Low(Int64)]; + b := [High(Int64),Low(Int64),3,2,1]; + Assert(Success(a.Difference(b), [])); + Assert(Success(a.SymDifference(b), [])); + Assert(Success(a.Intersection(b), [High(Int64),Low(Int64),3,2,1])); + + a := [1,2,3,4]; + b := [5,4,3]; + Assert(Success(a.Difference(b), [1, 2])); + Assert(Success(a.SymDifference(b), [1, 2, 5])); + Assert(Success(a.Intersection(b), [3, 4])); end; procedure TestPointArray; diff --git a/Tests/array_sort.simba b/Tests/array_sort.simba index 9bf017870..1fc025668 100644 --- a/Tests/array_sort.simba +++ b/Tests/array_sort.simba @@ -1,5 +1,6 @@ {$assertions on} +// Test our native overrides procedure TestInt; var @@ -8,7 +9,17 @@ begin a := [-1000, 1000, 0, 0, 1, 2, -1, 3]; a.Sort(); - Assert(ToStr(a) = '[-1000, -1, 0, 0, 1, 2, 3, 1000]'); + Assert(a.Equals([-1000, -1, 0, 0, 1, 2, 3, 1000])); +end; + +procedure TestInt64; +var + a: TInt64Array; +begin + a := [Low(Int64), High(Int64), 0, 0, 1, 2, -1, 3]; + a.Sort(); + + Assert(a.Equals([-9223372036854775808, -1, 0, 0, 1, 2, 3, 9223372036854775807])); end; procedure TestSingle; @@ -45,11 +56,13 @@ var begin a := ['xyz', 'abc', '1', 'a', 'b', 'c', 'abc1', '0', 'xyz0']; a.Sort(); - Assert(ToStr(a) = '[0, 1, a, abc, abc1, b, c, xyz, xyz0]'); + + Assert(a.Equals(['0', '1', 'a', 'abc', 'abc1', 'b', 'c', 'xyz', 'xyz0'])); end; begin TestInt(); + TestInt64(); TestSingle(); TestDouble(); TestString(); diff --git a/Tests/array_sum.simba b/Tests/array_sum.simba new file mode 100644 index 000000000..e33f0a5b1 --- /dev/null +++ b/Tests/array_sum.simba @@ -0,0 +1,12 @@ +{$assertions on} + +// Test our native overrides + +var + ints: TIntegerArray = [0, -1, 1, 2, 3, Low(Int32),High(Int32)]; + int64s: TInt64Array = [0, -1, 1, 2, 3, Low(Int64),High(Int64)]; + +begin + Assert(ints.Sum = 4); + Assert(int64s.Sum = 4); +end. diff --git a/Tests/array_unique.simba b/Tests/array_unique.simba index e69ffe0fc..a5bfe645d 100644 --- a/Tests/array_unique.simba +++ b/Tests/array_unique.simba @@ -1,33 +1,25 @@ {$assertions on} -// Unique is a lape method but Simba provides some (faster) ones for some types -// So test thoese. +// Test our native overrides var Singles: TSingleArray = [1,2,3,3,2,1,0]; Doubles: TDoubleArray = [1,2,3,3,2,1,0]; - Ints: TIntegerArray = [1,2,3,3,2,1,0]; Int64s: TInt64Array = [1,2,3,3,2,1,0]; - Strings: TStringArray = ['1','2','3','3','2','1','0','abc','abc']; - - Points: TPointArray := TPointArray.CreateFromBox([200,200,299,299], True) + - TPointArray.CreateFromBox([200,290,399,399], True); - + Points: TPointArray = [[-5,-5],[0,0],[2,2],[5,5],[0,0],[5,5],[2,2],[2,2]]; + Boxes: TBoxArray = [[0,0,0,0],[1,1,1,1],[2,2,2,2],[0,0,0,0],[2,2,2,2]]; Cols: TColorArray = [1,2,3,3,2,1,0,High(TColor),Low(TColor)]; begin + Assert(Unique(Points).Equals([[-5,-5],[0,0],[2,2],[5,5]])); + Assert(Unique(Boxes).Equals([[0,0,0,0], [1,1,1,1], [2,2,2,2]])); Assert(ToString(Unique(Singles)) = '[1, 2, 3, 0]'); Assert(ToString(Unique(Doubles)) = '[1, 2, 3, 0]'); - Assert(ToString(Unique(Ints)) = '[1, 2, 3, 0]'); Assert(ToString(Unique(Int64s)) = '[1, 2, 3, 0]'); - Assert(ToString(Unique(Int64s)) = '[1, 2, 3, 0]'); Assert(ToString(Unique(Strings)) = '[1, 2, 3, 0, abc]'); - - Assert(Points.Unique.Length = 31000); - Assert(ToString(Unique(Cols)) = '[1, 2, 3, 0, 2147483647, -2147483648]'); end. diff --git a/Tests/externalcanvas.simba b/Tests/externalcanvas.simba index 0826f36eb..161c38856 100644 --- a/Tests/externalcanvas.simba +++ b/Tests/externalcanvas.simba @@ -22,9 +22,10 @@ begin ExternalCanvas.EndUpdate(); - Assert(Img.Target.FindColor($FFFFFF, 0).Bounds() = [10,10,90,90]); - Assert(Img.Target.FindColor($7F7F7F, 0).Bounds() = [5,5,95,95]); + Assert(Img.FindColor($FFFFFF, 0).Bounds() = [10,10,90,90]); + Assert(Img.FindColor($7F7F7F, 0).Bounds() = [5,5,95,95]); ExternalCanvas.Free(); Img.Free(); end; + diff --git a/Tests/generic_arraybuffer.simba b/Tests/generic_arraybuffer.simba new file mode 100644 index 000000000..8b8587187 --- /dev/null +++ b/Tests/generic_arraybuffer.simba @@ -0,0 +1,28 @@ +{$assertions on} + +type + TPointBuffer = TArrayBuffer; + +var + Buffer: TPointBuffer; + I: Integer; +begin + Buffer.Add([100,100]); + Buffer.Add([[200,200],[300,300]]); + Assert(Buffer.Count = 3); + Assert(Buffer.First = [100,100]); + Assert(Buffer.Last = [300,300]); + + Assert(Buffer.Pop = [300,300]); + Buffer.Clear; + Assert(Buffer.Count = 0); + + // test growth and overallocation + for I := 1 to 1000 do + Buffer.Add([I,I]); + + Assert(Buffer.Count = 1000); + Assert(Buffer.Items.Length > 1500); + + Assert(Length(Buffer.ToArray) = 1000); +end. diff --git a/Tests/generic_heap.simba b/Tests/generic_heap.simba index d866e76e6..c73fe1c8a 100644 --- a/Tests/generic_heap.simba +++ b/Tests/generic_heap.simba @@ -3,7 +3,7 @@ function MaxValues(Mat: TIntegerMatrix; count: Integer): TPointArray; var X,Y,I: Integer; - Heap: Heap(Single); + Heap: THeap; Errored: Boolean; begin for Y := 0 to Mat.Height - 1 do diff --git a/Tests/generic_map.simba b/Tests/generic_map.simba index 8f512e15f..618ff3956 100644 --- a/Tests/generic_map.simba +++ b/Tests/generic_map.simba @@ -1,7 +1,7 @@ {$assertions on} var - Map: Map(Int32,String); + Map: TMap; begin Map.Value[123] := '123'; Map.Value[456] := '456'; diff --git a/Tests/generic_stringmap.simba b/Tests/generic_stringmap.simba index 5fb2e97b9..ea2440476 100644 --- a/Tests/generic_stringmap.simba +++ b/Tests/generic_stringmap.simba @@ -1,7 +1,7 @@ {$assertions on} type - TStringIntMap = StringMap(Int32); + TStringIntMap = TStringMap; procedure Test_CaseSens; var @@ -65,7 +65,7 @@ end; procedure Test_Arr; var - Map: StringMap(TIntegerArray); + Map: TStringMap(TIntegerArray); begin Map.Value['a'] := [1,2,3]; Map.Value['b'] := [100,101,102]; diff --git a/Tests/image.simba b/Tests/image.simba index ca1c4cd61..6864c2533 100644 --- a/Tests/image.simba +++ b/Tests/image.simba @@ -55,7 +55,7 @@ var begin img.Fill(Colors.WHITE); - Assert(Length(img.Target.FindColor($FFFFFF, 0)) = 100*100); + Assert(Length(img.FindColor($FFFFFF, 0)) = 100*100); img.Pixel[img.Center.X, img.Center.Y] := 0; Assert(Length(img.GetColors().Unique()) = 2); Assert(img.GetColors().Unique()[0] = 16777215); @@ -64,7 +64,7 @@ begin img.DrawColor := 0; img.DrawBoxFilled([1,1,img.Width-2,img.Height-2]); - TPA := img.Target.FindColor(Colors.WHITE,0); + TPA := img.FindColor(Colors.WHITE,0); Assert(TPA.Bounds = [0,0,img.Width-1,img.Height-1]); Assert(TPA.Length = 396); end; @@ -152,3 +152,4 @@ begin img.Free(); end. + diff --git a/Tests/string.simba b/Tests/string.simba index 07843ad08..306fef097 100644 --- a/Tests/string.simba +++ b/Tests/string.simba @@ -1,71 +1,128 @@ {$assertions on} -var - TestString: String; +procedure TestStringIs; begin - TestString := 'abcHelloxyz'; - Assert(ToString(TestString.Partition('Hello')) = '[abc, Hello, xyz]'); + Assert('123'.IsNumeric); + Assert(not 'abc123'.IsNumeric); + + Assert('123'.IsInteger); + Assert(not 'abc123'.IsNumeric); + + Assert('123'.IsFloat); + Assert('123.456'.IsFloat); + Assert(not 'abc123'.IsFloat); - TestString := 'HelloRemoveWorld'; - Assert(TestString.Remove('Remove') = True); - Assert(TestString = 'HelloWorld'); + Assert('123'.IsAlphaNum); + Assert('abc123'.IsAlphaNum); + Assert(not '-123'.IsAlphaNum); + Assert(not '#abc'.IsAlphaNum); - TestString := 'HelloRemoveRemoveWorld'; - Assert(TestString.RemoveAll('Remove') = 2); - Assert(TestString = 'HelloWorld'); + Assert('abc'.IsAlpha); + Assert(not 'abc123'.IsAlpha); - TestString := '1.23'; - Assert(TestString.IsInteger = False); - Assert(TestString.IsFloat = True); - Assert(ToString(TestString.ExtractFloat) = '1.23'); + Assert('abc'.IsLower); + Assert(not 'Abc'.IsLower); + + Assert('ABC'.IsUpper); + Assert(not 'Abc'.IsUpper); +end; - TestString := '-9000'; - Assert(TestString.IsFloat = True); - Assert(TestString.IsInteger = True); - Assert(ToString(TestString.ExtractInteger) = '-9000'); - Assert(ToString(TestString.ExtractFloat) = '-9000'); +procedure TestStringCopyDeleteInsert; +var + Str: String; +begin + Str := 'HoiHola'; + Str.Insert('Hello', 4); + Assert(Str = 'HoiHelloHola'); - TestString := 'Hello World 1,2,3'; - Assert(ToString(TestString.Split(' ')) = '[Hello, World, 1,2,3]'); + Str := 'xyz'; + Str.DeleteIndex(2); + Assert(Str = 'xz'); - TestString := '|1||2|3|'; - Assert(ToString(TestString.Split('|')) = '[1, 2, 3]'); + Str := 'abc123xyz'; + Str.DeleteRange(4,6); + Assert(Str = 'abcxyz'); - TestString := 'WorldHelloWorldHelloWorldWorld'; - Assert(ToString(TestString.Split('World')) = '[Hello, Hello]'); + Str := 'abc123xyz'; + Assert(Str.Copy() = 'abc123xyz'); + Assert(Str.CopyRange(4,6) = '123'); +end; - TestString := '@ @@@@@@'; - Assert(ToString(TestString.Split('@@@@@')) = '[@ , @]'); +procedure TestStringExtract; +var + Str: String; +begin + Str := '1.23'; + Assert(ToString(Str.ExtractInteger()) = '123'); + Assert(ToString(Str.ExtractFloat()) = '1.23'); + Str := '123abcxyz'; + Assert(Str.Extract(['a','b','c']) = 'abc'); + Str := '123'; + Assert(Str.Extract(['a','b','c']) = ''); + Str := 'hello123world.456'; + Assert(ToString(Str.ExtractFloat) = '123.456'); + Str := '-hello123world.456'; + Assert(ToString(Str.ExtractFloat) = '-123.456'); +end; - TestString := 'abcdef'; - Assert(ToString(TestString.Split('nothin')) = '[abcdef]'); +procedure TestStringToXXX; +var + Str: String; +begin + Str := '123'; + Assert(Str.ToInteger() = 123); + Assert(Str.ToInt64() = 123); + Str := '1.23'; + Assert(Str.ToSingle() = Single(1.23)); + Assert(Str.ToDouble() = Double(1.23)); + + Str := 'True'; + Assert(Str.ToBoolean = True); + Str := 'False'; + Assert(Str.ToBoolean = False); + Str := '1'; + Assert(Str.ToBoolean = True); + Str := '0'; + Assert(Str.ToBoolean = False); + + Str := 'abc XYZ'; + Assert(Str.ToLower = 'abc xyz'); + Assert(Str.ToUpper = 'ABC XYZ'); + Assert(Str.SwapCase = 'ABC xyz'); + Assert(Str.Capitalize = 'Abc xyz'); + Assert(Str.CapitalizeWords = 'Abc Xyz'); + + Str := 'abc'; + Assert(Str.ToBytes.Equals([97,98,99])); +end; - TestString := 'abcdef'; - Assert(ToString(TestString.Split('f')) = '[abcde]'); +procedure TestStringSplitJoin; +var + Str: String; +begin + Str := 'beforemiddleafter'; + Assert(Str.Partition('middle').Equals(['before', 'middle', 'after'])); - TestString := 'Hello'+#13#10+'World'+#13#10+'1'+#10+'2'+#13#10+#13#10; - Assert(ToString(TestString.SplitLines()) = '[Hello, World, 1, 2, ]'); + Str := 'Hello World 1,2,3'; + Assert(ToString(Str.Split(' ')) = '[Hello, World, 1,2,3]'); - TestString := 'abc abc xyz xyz'; - Assert(TestString.Extract(['x', 'y', 'z']) = 'xyzxyz'); + Str := '|1||2|3|'; + Assert(ToString(Str.Split('|')) = '[1, 2, 3]'); - TestString := 'hello123world456'; - Assert(ToString(TestString.ExtractInteger) = '123456'); - TestString := '-hello123world456'; - Assert(ToString(TestString.ExtractInteger) = '-123456'); + Str := 'WorldHelloWorldHelloWorldWorld'; + Assert(ToString(Str.Split('World')) = '[Hello, Hello]'); - TestString := 'hello123world.456'; - Assert(ToString(TestString.ExtractFloat) = '123.456'); - TestString := '-hello123world.456'; - Assert(ToString(TestString.ExtractFloat) = '-123.456'); + Str := '@ @@@@@@'; + Assert(ToString(Str.Split('@@@@@')) = '[@ , @]'); - Assert(String.UpperChars.IsUpper() = True); - Assert(String.UpperChars.IsLower() = False); + Str := 'abcdef'; + Assert(ToString(Str.Split('nothin')) = '[abcdef]'); - Assert(String.LowerChars.IsLower() = True); - Assert(String.LowerChars.IsUpper() = False); + Str := 'abcdef'; + Assert(ToString(Str.Split('f')) = '[abcde]'); - Assert(String.AlphaChars.IsAlphaNum() = True); + Str := 'Hello'+#13#10+'World'+#13#10+'1'+#10+'2'+#13#10+#13#10; + Assert(ToString(Str.SplitLines()) = '[Hello, World, 1, 2, ]'); Assert(#32.Join(['a']) = 'a'); Assert(#32.Join(['a','b']) = 'a b'); @@ -79,3 +136,32 @@ begin Assert(String(' ').Join(['aaa', '', 'bb', '', 'c']) = 'aaa bb c'); Assert(String(' ').Join(['aaa', '', 'bb', '', 'c', '']) = 'aaa bb c '); end; + +var + Str: String; +begin + Str := 'abc1'; + Assert(Str.Pop = '1'); + Assert(Str.First = 'a'); + Assert(Str.Last = 'c'); + + Assert(Str.Low = 1); + Assert(Str.High = 3); + Assert(Str.Length = 3); + + Str.SetLength(10); + Assert(Str.Length = 10); + Str.SetLength(0); + Assert(Str.Length = 0); + + Assert('abcxyz'.Equals('abcxyz')); + Assert(not 'abcxyz'.Equals('Abcxyz')); + Assert('abcxyz'.Equals('Abcxyz', False)); + Assert(not 'abcxyz123'.Equals('abcxyz', False)); + + TestStringIs(); + TestStringCopyDeleteInsert(); + TestStringExtract(); + TestStringToXXX(); + TestStringSplitJoin(); +end; diff --git a/Third-Party/lape b/Third-Party/lape index 0a0cf1258..7f9742af5 160000 --- a/Third-Party/lape +++ b/Third-Party/lape @@ -1 +1 @@ -Subproject commit 0a0cf125803d207f03e3d35c21979055b9066ff3 +Subproject commit 7f9742af569aab77f5c139ff050cb0d935f813e1