From 41d05f62bb9bdabc88e3ceb30f6dc241bb2012fb Mon Sep 17 00:00:00 2001 From: Olly Date: Tue, 27 Jun 2023 02:25:20 +0100 Subject: [PATCH] Implement finder multithreading --- Source/colormath/simba.colormath.pas | 28 +- .../simba.colormath_distance_unrolled.pas | 4 + Source/finders/simba.finder_color.pas | 382 ++++++++++++------ .../simba.matchtemplate_ccoeff.pas | 14 +- .../simba.matchtemplate_ccorr.pas | 14 +- .../simba.matchtemplate_helpers.pas | 10 +- .../simba.matchtemplate_sqdiff.pas | 14 +- .../imports/simba/simba.import_finder.pas | 6 +- Source/simba.finder.pas | 73 +--- Source/simba.threadpool.pas | 236 +++++------ 10 files changed, 416 insertions(+), 365 deletions(-) diff --git a/Source/colormath/simba.colormath.pas b/Source/colormath/simba.colormath.pas index b9cf77b01..655c976f8 100644 --- a/Source/colormath/simba.colormath.pas +++ b/Source/colormath/simba.colormath.pas @@ -20,7 +20,17 @@ interface simba.mufasatypes; type - TColorHelper = type Helper for TColor + {$PUSH} + {$SCOPEDENUMS ON} + EColorSpace = (RGB, HSV, HSL, XYZ, LAB, LCH, DELTAE); + PColorSpace = ^EColorSpace; + {$POP} + + EColorSpaceHelper = type helper for EColorSpace + function AsString: String; + end; + + TColorHelper = type helper for TColor function ToBGRA: TColorBGRA; function ToRGB: TColorRGB; function ToXYZ: TColorXYZ; @@ -41,8 +51,8 @@ TColorRGB_Helper = record helper for TColorRGB end; TColorBGRA_Helper = record helper for TColorBGRA - function Equals(const Other: TColorBGRA): Boolean; - function EqualsIgnoreAlpha(const Other: TColorBGRA): Boolean; + function Equals(const Other: TColorBGRA): Boolean; inline; + function EqualsIgnoreAlpha(const Other: TColorBGRA): Boolean; inline; function ToRGB: TColorRGB; function ToXYZ: TColorXYZ; @@ -79,12 +89,6 @@ TColorLCH_Helper = record helper for TColorLCH function ToColor: TColor; end; - {$PUSH} - {$SCOPEDENUMS ON} - EColorSpace = (RGB, HSV, HSL, XYZ, LAB, LCH, DELTAE); - PColorSpace = ^EColorSpace; - {$POP} - function ColorIntensity(const Color: TColor): Byte; function ColorToGray(const Color: TColor): Byte; function ColorToRGB(const Color: TColor): TColorRGB; @@ -98,8 +102,14 @@ function ColorToLCH(const Color: TColor): TColorLCH; implementation uses + TypInfo, simba.colormath_conversion; +function EColorSpaceHelper.AsString: String; +begin + Result := GetEnumName(TypeInfo(Self), Ord(Self)); +end; + function ColorToRGB(const Color: TColor): TColorRGB; begin Result := TSimbaColorConversion.ColorToRGB(Color); diff --git a/Source/colormath/simba.colormath_distance_unrolled.pas b/Source/colormath/simba.colormath_distance_unrolled.pas index 27f64ccb8..fe5006630 100644 --- a/Source/colormath/simba.colormath_distance_unrolled.pas +++ b/Source/colormath/simba.colormath_distance_unrolled.pas @@ -19,6 +19,9 @@ interface Classes, SysUtils, Math, simba.mufasatypes, simba.colormath_distance; +type + TColorDistanceFunc = function(const Color1: Pointer; const Color2: TColorBGRA; const mul: TChannelMultipliers): Single; + function DistanceRGB_UnRolled(const C1: PColorRGB; const C2: TColorBGRA; const mul: TChannelMultipliers): Single; function DistanceHSL_UnRolled(const C1: PColorHSL; const C2: TColorBGRA; const mul: TChannelMultipliers): Single; function DistanceHSV_UnRolled(const C1: PColorHSV; const C2: TColorBGRA; const mul: TChannelMultipliers): Single; @@ -320,3 +323,4 @@ function DistanceDeltaE_UnRolled(const C1: PColorLAB; const C2: TColorBGRA; cons end. + diff --git a/Source/finders/simba.finder_color.pas b/Source/finders/simba.finder_color.pas index 4fc20ef4b..2d743f724 100644 --- a/Source/finders/simba.finder_color.pas +++ b/Source/finders/simba.finder_color.pas @@ -12,208 +12,346 @@ {$DEFINE SIMBA_MAX_OPTIMIZATION} {$i simba.inc} +{.$DEFINE SIMBA_BUFFERCHECKS} +{.$DEFINE SIMBA_BENCHMARKS} + interface uses Classes, SysUtils, Math, Graphics, - simba.mufasatypes, simba.colormath, simba.colormath_distance; - -type - TColorFinder = record - private - type - TCompareColorFunc = function(const Color1: Pointer; const Color2: TColorBGRA; const mul: TChannelMultipliers): Single; - private - FCompareFunc: TCompareColorFunc; - FColorContainer: array[0..2] of Single; - FColor: Pointer; - FTolerance: Single; - FMultipliers: TChannelMultipliers; - FMaxDistance: Single; - public - procedure Setup(Formula: EColorSpace; Color: TColor; Tolerance: Single; Multiplier: TChannelMultipliers); - - function Count(Buffer: PColorBGRA; BufferWidth: Integer; SearchWidth, SearchHeight: Integer; MaxToFind: Integer = -1): Integer; - function Find(Buffer: PColorBGRA; BufferWidth: Integer; SearchWidth, SearchHeight: Integer; Offset: TPoint; MaxToFind: Integer = -1): TPointArray; - function Match(Buffer: PColorBGRA; BufferWidth: Integer; SearchWidth, SearchHeight: Integer): TSingleMatrix; - - class operator Initialize(var Self: TColorFinder); - end; + simba.mufasatypes, simba.colormath, simba.colormath_distance, simba.target; + +function FindColorsOnTarget(Target: TSimbaTarget; Bounds: TBox; + Formula: EColorSpace; Color: TColor; Tolerance: Single; Multipliers: TChannelMultipliers): TPointArray; + +function FindColorsOnBuffer(Formula: EColorSpace; Color: TColor; Tolerance: Single; Multipliers: TChannelMultipliers; + Buffer: PColorBGRA; BufferWidth: Integer; SearchWidth, SearchHeight: Integer; OffsetX, OffsetY: Integer {$IFDEF SIMBA_BUFFERCHECKS}; BufferLo, BufferHi: PColorBGRA{$ENDIF}): TPointArray; + +function CountColorsOnTarget(Target: TSimbaTarget; Bounds: TBox; + Formula: EColorSpace; Color: TColor; Tolerance: Single; Multipliers: TChannelMultipliers): Integer; + +function CountColorsOnBuffer(Formula: EColorSpace; Color: TColor; Tolerance: Single; Multipliers: TChannelMultipliers; + Buffer: PColorBGRA; BufferWidth: Integer; SearchWidth, SearchHeight: Integer {$IFDEF SIMBA_BUFFERCHECKS}; BufferLo, BufferHi: PColorBGRA{$ENDIF}): Integer; + +function MatchColorsOnBuffer(Formula: EColorSpace; Color: TColor; Multipliers: TChannelMultipliers; + Buffer: PColorBGRA; BufferWidth: Integer; SearchWidth, SearchHeight: Integer {$IFDEF SIMBA_BUFFERCHECKS}; BufferLo, BufferHi: PColorBGRA{$ENDIF}): TSingleMatrix; + +function MatchColorsOnTarget(Target: TSimbaTarget; Bounds: TBox; + Formula: EColorSpace; Color: TColor; Multipliers: TChannelMultipliers): TSingleMatrix; + +var + ColorFinderMT_Enabled: Boolean = True; + ColorFinderMT_SliceHeight: Integer = 150; + ColorFinderMT_SliceWidth: Integer = 300; implementation uses - simba.overallocatearray, simba.colormath_distance_unrolled; + simba.overallocatearray, simba.colormath_distance_unrolled, simba.threadpool, simba.atpa, simba.datetime; -procedure TColorFinder.Setup(Formula: EColorSpace; Color: TColor; Tolerance: Single; Multiplier: TChannelMultipliers); +// How much to "Slice" (vertically) the image up for multithreading. +function CalculateSlices(SearchWidth, SearchHeight: Integer): Integer; +var + I: Integer; begin - FColor := @FColorContainer[0]; + Result := 1; + + if ColorFinderMT_Enabled and (SearchWidth >= ColorFinderMT_SliceWidth) and (SearchHeight >= (ColorFinderMT_SliceHeight * 2)) then // not worth + begin + for I := SimbaThreadPool.ThreadCount - 1 downto 2 do + if (SearchHeight div I) > ColorFinderMT_SliceHeight then // Each slice is at leastColorFinderMT_SliceHeight` pixels + Exit(I); + end; + + // not possible to slice into at least `ColorFinderMT_SliceHeight` pixels +end; + +{$DEFINE MACRO_FINDCOLORS := +var + TargetColorContainer: array[0..2] of Single; + TargetColor: Pointer; - FTolerance := Tolerance; - FMultipliers := Multiplier; + CompareFunc: TColorDistanceFunc; + MaxDistance: Single; + X, Y: Integer; + RowPtr, Ptr: PColorBGRA; + + Cache: record + Color: TColorBGRA; + Dist: Single; + end; + +begin + MACRO_FINDCOLORS_BEGIN + + TargetColor := @TargetColorContainer; case Formula of EColorSpace.RGB: begin - FCompareFunc := TCompareColorFunc(@DistanceRGB_UnRolled); - FMaxDistance := DistanceRGB_Max(Multiplier); - PColorRGB(FColor)^ := Color.ToRGB(); + CompareFunc := TColorDistanceFunc(@DistanceRGB_UnRolled); + MaxDistance := DistanceRGB_Max(Multipliers); + PColorRGB(TargetColor)^ := Color.ToRGB(); end; EColorSpace.HSV: begin - FCompareFunc := TCompareColorFunc(@DistanceHSV_UnRolled); - FMaxDistance := DistanceHSV_Max(Multiplier); - PColorHSV(FColor)^ := Color.ToHSV(); + CompareFunc := TColorDistanceFunc(@DistanceHSV_UnRolled); + MaxDistance := DistanceHSV_Max(Multipliers); + PColorHSV(TargetColor)^ := Color.ToHSV(); end; EColorSpace.HSL: begin - FCompareFunc := TCompareColorFunc(@DistanceHSL_Unrolled); - FMaxDistance := DistanceHSL_Max(Multiplier); - PColorHSL(FColor)^ := Color.ToHSL(); + CompareFunc := TColorDistanceFunc(@DistanceHSL_Unrolled); + MaxDistance := DistanceHSL_Max(Multipliers); + PColorHSL(TargetColor)^ := Color.ToHSL(); end; EColorSpace.XYZ: begin - FCompareFunc := TCompareColorFunc(@DistanceXYZ_UnRolled); - FMaxDistance := DistanceXYZ_Max(Multiplier); - PColorXYZ(FColor)^ := Color.ToXYZ(); + CompareFunc := TColorDistanceFunc(@DistanceXYZ_UnRolled); + MaxDistance := DistanceXYZ_Max(Multipliers); + PColorXYZ(TargetColor)^ := Color.ToXYZ(); end; EColorSpace.LAB: begin - FCompareFunc := TCompareColorFunc(@DistanceLAB_UnRolled); - FMaxDistance := DistanceLAB_Max(Multiplier); - PColorLAB(FColor)^ := Color.ToLAB(); + CompareFunc := TColorDistanceFunc(@DistanceLAB_UnRolled); + MaxDistance := DistanceLAB_Max(Multipliers); + PColorLAB(TargetColor)^ := Color.ToLAB(); end; EColorSpace.LCH: begin - FCompareFunc := TCompareColorFunc(@DistanceLCH_UnRolled); - FMaxDistance := DistanceLCH_Max(Multiplier); - PColorLCH(FColor)^ := Color.ToLCH(); + CompareFunc := TColorDistanceFunc(@DistanceLCH_UnRolled); + MaxDistance := DistanceLCH_Max(Multipliers); + PColorLCH(TargetColor)^ := Color.ToLCH(); end; EColorSpace.DeltaE: begin - FCompareFunc := TCompareColorFunc(@DistanceDeltaE_UnRolled); - FMaxDistance := DistanceDeltaE_Max(Multiplier); - PColorLAB(FColor)^ := Color.ToLAB(); + CompareFunc := TColorDistanceFunc(@DistanceDeltaE_UnRolled); + MaxDistance := DistanceDeltaE_Max(Multipliers); + PColorLAB(TargetColor)^ := Color.ToLAB(); end; + + else + SimbaException('MACRO_FINDCOLORS: Formula invalid!'); end; -end; -function TColorFinder.Count(Buffer: PColorBGRA; BufferWidth: Integer; SearchWidth, SearchHeight: Integer; MaxToFind: Integer): Integer; -var - X, Y, RowSize: Integer; - RowPtr, Ptr: PByte; -begin - Result := 0; - if IsZero(FMaxDistance) or (SearchWidth <= 0) or (SearchHeight <= 0) or (Buffer = nil) or (BufferWidth <= 0) then + if IsZero(MaxDistance{%H-}) or (SearchWidth <= 0) or (SearchHeight <= 0) or (Buffer = nil) or (BufferWidth <= 0) then Exit; - RowSize := BufferWidth * SizeOf(TColorBGRA); - RowPtr := PByte(Buffer); + RowPtr := Buffer; Dec(SearchHeight); Dec(SearchWidth); + + Cache.Color := RowPtr^; + Cache.Dist := {%H-}CompareFunc(TargetColor, Cache.Color, Multipliers) / MaxDistance * 100; + for Y := 0 to SearchHeight do begin Ptr := RowPtr; for X := 0 to SearchWidth do begin - if (Self.FCompareFunc(FColor, PColorBGRA(Ptr)^, FMultipliers) / FMaxDistance * 100 <= FTolerance) then + {$IFDEF SIMBA_BUFFERCHECKS} + if (Ptr < BufferLo) or (Ptr > BufferHi) then begin - Inc(Result); - if (Result = MaxToFind) then - Exit; + DebugLn('Outside of buffer: %d, (Lo: %d, Hi: %d)', [PtrUInt(Ptr), PtrUInt(BufferLo), PtrUInt(BufferHi)]); + Halt; end; + {$ENDIF} - Inc(Ptr, SizeOf(TColorBGRA)); - end; + if not Cache.Color.EqualsIgnoreAlpha(Ptr^) then + begin + Cache.Color := Ptr^; + Cache.Dist := CompareFunc(TargetColor, Cache.Color, Multipliers) / MaxDistance * 100; + end; - Inc(RowPtr, RowSize); + MACRO_FINDCOLORS_COMPARE + + Inc(Ptr); + end; + Inc(RowPtr, BufferWidth); end; + + MACRO_FINDCOLORS_END end; +} -function TColorFinder.Find(Buffer: PColorBGRA; BufferWidth: Integer; SearchWidth, SearchHeight: Integer; Offset: TPoint; MaxToFind: Integer): TPointArray; +function FindColorsOnBuffer(Formula: EColorSpace; Color: TColor; Tolerance: Single; Multipliers: TChannelMultipliers; + Buffer: PColorBGRA; BufferWidth: Integer; SearchWidth, SearchHeight: Integer; OffsetX, OffsetY: Integer {$IFDEF SIMBA_BUFFERCHECKS}; BufferLo, BufferHi: PColorBGRA{$ENDIF}): TPointArray; var - X, Y, RowSize: Integer; - RowPtr, Ptr: PByte; PointBuffer: TSimbaPointBuffer; -label - Finished; -begin - Result := nil; - if IsZero(FMaxDistance) or (SearchWidth <= 0) or (SearchHeight <= 0) or (Buffer = nil) or (BufferWidth <= 0) then - Exit; - PointBuffer.Init(65536); + {$DEFINE MACRO_FINDCOLORS_BEGIN := + Result := []; + PointBuffer.Init(16*1024); + } + {$DEFINE MACRO_FINDCOLORS_COMPARE := + if (Cache.Dist <= Tolerance) then + PointBuffer.Add(X + OffsetX, Y + OffsetY); + } + {$DEFINE MACRO_FINDCOLORS_END := + Result := PointBuffer.Trim(); + } + MACRO_FINDCOLORS + +function CountColorsOnBuffer(Formula: EColorSpace; Color: TColor; Tolerance: Single; Multipliers: TChannelMultipliers; + Buffer: PColorBGRA; BufferWidth: Integer; SearchWidth, SearchHeight: Integer {$IFDEF SIMBA_BUFFERCHECKS}; BufferLo, BufferHi: PColorBGRA{$ENDIF}): Integer; + + {$DEFINE MACRO_FINDCOLORS_BEGIN := + Result := 0; + } + {$DEFINE MACRO_FINDCOLORS_COMPARE := + if (Cache.Dist <= Tolerance) then + Inc(Result); + } + {$DEFINE MACRO_FINDCOLORS_END := } + MACRO_FINDCOLORS + +function FindColorsOnTarget(Target: TSimbaTarget; Bounds: TBox; + Formula: EColorSpace; Color: TColor; Tolerance: Single; Multipliers: TChannelMultipliers): TPointArray; +var + Buffer: PColorBGRA; + BufferWidth: Integer; - RowSize := BufferWidth * SizeOf(TColorBGRA); - RowPtr := PByte(Buffer); + SliceResults: T2DPointArray; - Dec(SearchHeight); - Dec(SearchWidth); - for Y := 0 to SearchHeight do + procedure Execute(const Index, Lo, Hi: Integer); begin - Ptr := RowPtr; - for X := 0 to SearchWidth do - begin - if (Self.FCompareFunc(FColor, PColorBGRA(Ptr)^, FMultipliers) / FMaxDistance * 100 <= FTolerance) then - begin - PointBuffer.Add(X + Offset.X, Y + Offset.Y); - if (PointBuffer.Count = MaxToFind) then - goto Finished; - end; - - Inc(Ptr, SizeOf(TColorBGRA)); - end; - - Inc(RowPtr, RowSize); + SliceResults[Index] := FindColorsOnBuffer( + Formula, Color, Tolerance, Multipliers, + @Buffer[Lo * BufferWidth], BufferWidth, Bounds.Width, (Hi - Lo) + 1, Bounds.X1, Bounds.Y1 + Lo + {$IFDEF SIMBA_BUFFERCHECKS}, Buffer, Buffer + (MemSize(Buffer) div SizeOf(TColorBGRA)) {$ENDIF} + ); end; - Finished: - Result := PointBuffer.Trim(); -end; - -function TColorFinder.Match(Buffer: PColorBGRA; BufferWidth: Integer; SearchWidth, SearchHeight: Integer): TSingleMatrix; var - X, Y, RowSize: Integer; - RowPtr, Ptr: PByte; + ThreadsUsed: Integer; + T: Double; begin - Result := nil; - if IsZero(FMaxDistance) then - Exit; - if (SearchWidth <= 0) or (SearchHeight <= 0) or (Buffer = nil) or (BufferWidth <= 0) then - Exit; + Result := []; + + if Target.GetImageData(Bounds, Buffer, BufferWidth) then + try + {$IFDEF SIMBA_BENCHMARKS} + T := HighResolutionTime(); + {$ENDIF} + + SetLength(SliceResults, CalculateSlices(Bounds.Width, Bounds.Height)); // Cannot exceed this + ThreadsUsed := SimbaThreadPool.RunParallel(Length(SliceResults), 0, Bounds.Height - 1, @Execute); + Result := SliceResults.Merge(); + + {$IFDEF SIMBA_BENCHMARKS} + DebugLn('FindColors: ColorSpace=%s Width=%d Height=%d ThreadsUsed=%d Time=%f', [Formula.AsString(), Bounds.Width, Bounds.Height, ThreadsUsed, HighResolutionTime() - T]); + {$ENDIF} + finally + Target.FreeImageData(Buffer); + end; +end; - Result.SetSize(SearchWidth, SearchHeight); +function CountColorsOnTarget(Target: TSimbaTarget; Bounds: TBox; Formula: EColorSpace; Color: TColor; Tolerance: Single; Multipliers: TChannelMultipliers): Integer; +var + Buffer: PColorBGRA; + BufferWidth: Integer; - RowSize := BufferWidth * SizeOf(TColorBGRA); - RowPtr := PByte(Buffer); + SliceResults: TIntegerArray; - Dec(SearchHeight); - Dec(SearchWidth); - for Y := 0 to SearchHeight do + procedure Execute(const Index, Lo, Hi: Integer); begin - Ptr := RowPtr; - for X := 0 to SearchWidth do - begin - Result[Y, X] := 1 - (FCompareFunc(FColor, PColorBGRA(Ptr)^, FMultipliers) / FMaxDistance); + SliceResults[Index] := CountColorsOnBuffer( + Formula, Color, Tolerance, Multipliers, + @Buffer[Lo * BufferWidth], BufferWidth, Bounds.Width, (Hi - Lo) + 1 + {$IFDEF SIMBA_BUFFERCHECKS}, Buffer, Buffer + (MemSize(Buffer) div SizeOf(TColorBGRA)) {$ENDIF} + ); + end; - Inc(Ptr, SizeOf(TColorBGRA)); - end; +var + ThreadsUsed: Integer; + T: Double; + I: Integer; +begin + Result := 0; - Inc(RowPtr, RowSize); + if Target.GetImageData(Bounds, Buffer, BufferWidth) then + try + {$IFDEF SIMBA_BENCHMARKS} + T := HighResolutionTime(); + {$ENDIF} + + SetLength(SliceResults, CalculateSlices(Bounds.Width, Bounds.Height)); // Cannot exceed this + ThreadsUsed := SimbaThreadPool.RunParallel(Length(SliceResults), 0, Bounds.Height - 1, @Execute); + for I := 0 to High(SliceResults) do + Result += SliceResults[I]; + + {$IFDEF SIMBA_BENCHMARKS} + DebugLn('CountColors: ColorSpace=%s Width=%d Height=%d ThreadsUsed=%d Time=%f', [Formula.AsString(), Bounds.Width, Bounds.Height, ThreadsUsed, HighResolutionTime() - T]); + {$ENDIF} + finally + Target.FreeImageData(Buffer); end; end; -class operator TColorFinder.Initialize(var Self: TColorFinder); +function MatchColorsOnBuffer(Formula: EColorSpace; Color: TColor; Multipliers: TChannelMultipliers; + Buffer: PColorBGRA; BufferWidth: Integer; SearchWidth, SearchHeight: Integer {$IFDEF SIMBA_BUFFERCHECKS}; BufferLo, BufferHi: PColorBGRA{$ENDIF}): TSingleMatrix; + + {$DEFINE MACRO_FINDCOLORS_BEGIN := + Result.SetSize(SearchWidth, SearchHeight); + } + {$DEFINE MACRO_FINDCOLORS_COMPARE := + Result[Y, X] := 1 - Cache.Dist; + } + {$DEFINE MACRO_FINDCOLORS_END := + // Nothing + } + MACRO_FINDCOLORS + +function MatchColorsOnTarget(Target: TSimbaTarget; Bounds: TBox; + Formula: EColorSpace; Color: TColor; Multipliers: TChannelMultipliers): TSingleMatrix; +var + Buffer: PColorBGRA; + BufferWidth: Integer; + + SliceResults: array of TSingleMatrix; + + procedure Execute(const Index, Lo, Hi: Integer); + begin + SliceResults[Index] := MatchColorsOnBuffer( + Formula, Color, Multipliers, + @Buffer[Lo * BufferWidth], BufferWidth, Bounds.Width, (Hi - Lo) + 1 + {$IFDEF SIMBA_BUFFERCHECKS}, Buffer, Buffer + (MemSize(Buffer) div SizeOf(TColorBGRA)) {$ENDIF} + ); + end; + +var + ThreadsUsed: Integer; + T: Double; + I: Integer; begin - Self := Default(TColorFinder); + Result := []; + + if Target.GetImageData(Bounds, Buffer, BufferWidth) then + try + {$IFDEF SIMBA_BENCHMARKS} + T := HighResolutionTime(); + {$ENDIF} + + SetLength(SliceResults, CalculateSlices(Bounds.Width, Bounds.Height)); // Cannot exceed this + ThreadsUsed := SimbaThreadPool.RunParallel(Length(SliceResults), 0, Bounds.Height - 1, @Execute); + for I := 0 to High(SliceResults) do + Result += SliceResults[I]; + + {$IFDEF SIMBA_BENCHMARKS} + DebugLn('MatchColors: ColorSpace=%s Width=%d Height=%d ThreadsUsed=%d Time=%f', [Formula.AsString(), Bounds.Width, Bounds.Height, ThreadsUsed, HighResolutionTime() - T]); + {$ENDIF} + finally + Target.FreeImageData(Buffer); + end; end; end. + diff --git a/Source/matchtemplate/simba.matchtemplate_ccoeff.pas b/Source/matchtemplate/simba.matchtemplate_ccoeff.pas index 6100ef1e5..2facad7c7 100644 --- a/Source/matchtemplate/simba.matchtemplate_ccoeff.pas +++ b/Source/matchtemplate/simba.matchtemplate_ccoeff.pas @@ -167,9 +167,9 @@ function MatchTemplateMask_CCOEFF_Cache(ACache: TMatchTemplateCacheBase; Templat Move(Mat[Y, 0], Result[SliceOffset + Y, 0], RowSize); end; -var - Tasks: TSimbaThreadPoolTasks; - I: Integer; +//var + //Tasks: TSimbaThreadPoolTasks; + //I: Integer; begin if (not (ACache is TMatchTemplateCache_CCOEFF)) then raise Exception.Create('[MatchTemplateMask_CCOEFF]: Invalid cache'); @@ -182,11 +182,11 @@ function MatchTemplateMask_CCOEFF_Cache(ACache: TMatchTemplateCacheBase; Templat if Length(Cache.Slices) > 1 then begin - SetLength(Tasks, Length(Cache.Slices)); - for I := 0 to High(Tasks) do - Tasks[I] := TSimbaThreadPoolTask.Create(@DoMatchTemplate); + //SetLength(Tasks, Length(Cache.Slices)); + //for I := 0 to High(Tasks) do + // Tasks[I] := TSimbaThreadPoolTask.Create(@DoMatchTemplate); - SimbaThreadPool.RunParallel(Tasks); + //SimbaThreadPool.RunParallel(Tasks); end else DoMatchTemplate(0); diff --git a/Source/matchtemplate/simba.matchtemplate_ccorr.pas b/Source/matchtemplate/simba.matchtemplate_ccorr.pas index e7b7735be..2ae8495fd 100644 --- a/Source/matchtemplate/simba.matchtemplate_ccorr.pas +++ b/Source/matchtemplate/simba.matchtemplate_ccorr.pas @@ -153,9 +153,9 @@ function MatchTemplateMask_CCORR_Cache(ACache: TMatchTemplateCacheBase; Template Move(Mat[Y, 0], Result[SliceOffset + Y, 0], RowSize); end; -var - Tasks: TSimbaThreadPoolTasks; - I: Integer; +//var + //Tasks: TSimbaThreadPoolTasks; + //I: Integer; begin if (not (ACache is TMatchTemplateCache_CCORR)) then raise Exception.Create('[MatchTemplateMask_CCORR]: Invalid cache'); @@ -168,11 +168,11 @@ function MatchTemplateMask_CCORR_Cache(ACache: TMatchTemplateCacheBase; Template if Length(Cache.Slices) > 1 then begin - SetLength(Tasks, Length(Cache.Slices)); - for I := 0 to High(Tasks) do - Tasks[I] := TSimbaThreadPoolTask.Create(@DoMatchTemplate); + //SetLength(Tasks, Length(Cache.Slices)); + //for I := 0 to High(Tasks) do + // Tasks[I] := TSimbaThreadPoolTask.Create(@DoMatchTemplate); - SimbaThreadPool.RunParallel(Tasks); + //SimbaThreadPool.RunParallel(Tasks); end else DoMatchTemplate(0); diff --git a/Source/matchtemplate/simba.matchtemplate_helpers.pas b/Source/matchtemplate/simba.matchtemplate_helpers.pas index 600b42b69..4b9694cee 100644 --- a/Source/matchtemplate/simba.matchtemplate_helpers.pas +++ b/Source/matchtemplate/simba.matchtemplate_helpers.pas @@ -144,7 +144,7 @@ function CalculateSlices(ImageW, ImageH, TemplW, TemplH: Integer): Integer; if (ImageW - TemplW > 200) and (ImageH - TemplH > 250) then // not worth begin - for I := Min(TThread.ProcessorCount, 4) downto 2 do // more than 4 threads loses effectiveness very quickly + for I := SimbaThreadPool.ThreadCount - 1 downto 2 do // more than 4 threads loses effectiveness very quickly if ((ImageH div I) + TemplH) > 200 then Exit(I); end; @@ -187,7 +187,7 @@ function Multithread(Image, Templ: TIntegerMatrix; MatchTemplate: TMatchTemplate ImageSlices: TImageSlices; RowSize: Integer; - procedure DoMatchTemplate(SliceIndex: Integer); + procedure DoMatchTemplate(const SliceIndex: Integer); var SliceOffset, Y: Integer; Mat: TSingleMatrix; @@ -200,7 +200,7 @@ function Multithread(Image, Templ: TIntegerMatrix; MatchTemplate: TMatchTemplate end; var - Tasks: TSimbaThreadPoolTasks; + //Tasks: TSimbaThreadPoolTaskArray; I: Integer; begin if CalculateSlices(Image.Width, Image.Height, Templ.Width, Templ.Height) > 1 then @@ -212,11 +212,13 @@ function Multithread(Image, Templ: TIntegerMatrix; MatchTemplate: TMatchTemplate RowSize := Result.Width * SizeOf(Single); ImageSlices := SliceImage(Image, Templ); + { SetLength(Tasks, Length(ImageSlices)); for I := 0 to High(Tasks) do - Tasks[I] := TSimbaThreadPoolTask.Create(@DoMatchTemplate); + Tasks[I] := TSimbaThreadPoolTask_NestedMethod.Create(@DoMatchTemplate); SimbaThreadPool.RunParallel(Tasks); + } end else Result := MatchTemplate(Image, Templ, Normed); end; diff --git a/Source/matchtemplate/simba.matchtemplate_sqdiff.pas b/Source/matchtemplate/simba.matchtemplate_sqdiff.pas index 3711de1ad..54f3f9bcf 100644 --- a/Source/matchtemplate/simba.matchtemplate_sqdiff.pas +++ b/Source/matchtemplate/simba.matchtemplate_sqdiff.pas @@ -106,9 +106,9 @@ function MatchTemplateMask_SQDIFF_Cache(ACache: TMatchTemplateCacheBase; Templat Move(Mat[Y, 0], Result[SliceOffset + Y, 0], RowSize); end; -var - Tasks: TSimbaThreadPoolTasks; - I: Integer; +//var + //Tasks: TSimbaThreadPoolTasks; + //I: Integer; begin if (not (ACache is TMatchTemplateCache_SQDIFF)) then raise Exception.Create('[MatchTemplateMask_SQDIFF]: Invalid cache'); @@ -121,11 +121,11 @@ function MatchTemplateMask_SQDIFF_Cache(ACache: TMatchTemplateCacheBase; Templat if Length(Cache.Slices) > 1 then begin - SetLength(Tasks, Length(Cache.Slices)); - for I := 0 to High(Tasks) do - Tasks[I] := TSimbaThreadPoolTask.Create(@DoMatchTemplate); + //SetLength(Tasks, Length(Cache.Slices)); + //for I := 0 to High(Tasks) do + // Tasks[I] := TSimbaThreadPoolTask.Create(@DoMatchTemplate); - SimbaThreadPool.RunParallel(Tasks); + //SimbaThreadPool.RunParallel(Tasks); end else DoMatchTemplate(0); diff --git a/Source/script/imports/simba/simba.import_finder.pas b/Source/script/imports/simba/simba.import_finder.pas index 86ae105db..9474d2818 100644 --- a/Source/script/imports/simba/simba.import_finder.pas +++ b/Source/script/imports/simba/simba.import_finder.pas @@ -19,7 +19,7 @@ implementation uses lptypes, lpvartypes, simba.script_compiler, simba.mufasatypes, simba.finder, simba.bitmap, simba.dtm, - simba.colormath, simba.colormath_distance, simba.bitmap_finders, simba.target; + simba.colormath, simba.colormath_distance, simba.bitmap_finders, simba.target, simba.finder_color; (* Finder @@ -305,6 +305,10 @@ procedure ImportFinder(Compiler: TSimbaScript_Compiler); begin ImportingSection := 'Finder'; + addGlobalVar(ltBoolean, @ColorFinderMT_Enabled, 'ColorFinderMT_Enabled'); + addGlobalVar(ltInt32, @ColorFinderMT_SliceHeight, 'ColorFinderMT_SliceHeight'); + addGlobalVar(ltInt32, @ColorFinderMT_SliceWidth, 'ColorFinderMT_SliceWidth'); + addGlobalType([ 'record', ' Color: TColor;', diff --git a/Source/simba.finder.pas b/Source/simba.finder.pas index 88348a824..8366c8905 100644 --- a/Source/simba.finder.pas +++ b/Source/simba.finder.pas @@ -29,7 +29,6 @@ TColorTolerance = record TSimbaFinder = packed record private FTarget: TSimbaTarget; - FColorFinder: TColorFinder; FBitmapFinder: TBitmapFinder; FDTMFinder: TDTMFinder; @@ -37,9 +36,6 @@ TColorTolerance = record function DoFindDTMRotated(DTM: TDTM; StartDegrees, EndDegrees: Double; Step: Double; out FoundDegrees: TDoubleArray; Bounds: TBox; MaxToFind: Integer): TPointArray; function DoFindBitmap(Bitmap: TMufasaBitmap; Bounds: TBox; MaxToFind: Integer): TPointArray; - function DoFindColor(Bounds: TBox): TPointArray; - function DoCountColor(Bounds: TBox): Integer; - function GetDataAsBitmap(var Bounds: TBox; out Bitmap: TMufasaBitmap): Boolean; public function FindDTM(DTM: TDTM; MaxToFind: Integer; Bounds: TBox): TPointArray; @@ -130,36 +126,6 @@ function TSimbaFinder.DoFindBitmap(Bitmap: TMufasaBitmap; Bounds: TBox; MaxToFin end; end; -function TSimbaFinder.DoFindColor(Bounds: TBox): TPointArray; -var - Data: PColorBGRA; - DataWidth: Integer; -begin - Result := nil; - - if FTarget.GetImageData(Bounds, Data, DataWidth) then - try - Result := FColorFinder.Find(Data, DataWidth, Bounds.Width, Bounds.Height, Bounds.TopLeft); - finally - FTarget.FreeImageData(Data); - end; -end; - -function TSimbaFinder.DoCountColor(Bounds: TBox): Integer; -var - Data: PColorBGRA; - DataWidth: Integer; -begin - Result := 0; - - if FTarget.GetImageData(Bounds, Data, DataWidth) then - try - Result := FColorFinder.Count(Data, DataWidth, Bounds.Width, Bounds.Height); - finally - FTarget.FreeImageData(Data); - end; -end; - function TSimbaFinder.GetDataAsBitmap(var Bounds: TBox; out Bitmap: TMufasaBitmap): Boolean; var Data: PColorBGRA = nil; @@ -202,62 +168,38 @@ function TSimbaFinder.FindBitmap(Bitmap: TMufasaBitmap; Tolerance: Single; Color end; function TSimbaFinder.MatchColor(Color: TColor; ColorSpace: EColorSpace; Multipliers: TChannelMultipliers; Bounds: TBox): TSingleMatrix; -var - Data: PColorBGRA; - DataWidth: Integer; begin - Result := nil; - - if FTarget.GetImageData(Bounds, Data, DataWidth) then - try - FColorFinder.Setup(ColorSpace, Color, 0, Multipliers); - - Result := FColorFinder.Match(Data, DataWidth, Bounds.Width, Bounds.Height); - finally - FTarget.FreeImageData(Data); - end; + Result := MatchColorsOnTarget(FTarget, Bounds, ColorSpace, Color, DefaultMultipliers); end; function TSimbaFinder.FindColor(Color: TColor; Tolerance: Single; Bounds: TBox): TPointArray; begin - FColorFinder.Setup(EColorSpace.RGB, Color, Tolerance, DefaultMultipliers); - - Result := DoFindColor(Bounds); + Result := FindColorsOnTarget(FTarget, Bounds, EColorSpace.RGB, Color, Tolerance, DefaultMultipliers); end; function TSimbaFinder.FindColor(Color: TColor; Tolerance: Single; ColorSpace: EColorSpace; Multipliers: TChannelMultipliers; Bounds: TBox): TPointArray; begin - FColorFinder.Setup(ColorSpace, Color, Tolerance, Multipliers); - - Result := DoFindColor(Bounds); + Result := FindColorsOnTarget(FTarget, Bounds, ColorSpace, Color, Tolerance, Multipliers); end; function TSimbaFinder.FindColor(Color: TColorTolerance; Bounds: TBox): TPointArray; begin - FColorFinder.Setup(Color.ColorSpace, Color.Color, Color.Tolerance, Color.Multipliers); - - Result := DoFindColor(Bounds); + Result := FindColorsOnTarget(FTarget, Bounds, Color.ColorSpace, Color.Color, Color.Tolerance, Color.Multipliers); end; function TSimbaFinder.CountColor(Color: TColor; Tolerance: Single; Bounds: TBox): Integer; begin - FColorFinder.Setup(EColorSpace.RGB, Color, Tolerance, DefaultMultipliers); - - Result := DoCountColor(Bounds); + Result := CountColorsOnTarget(FTarget, Bounds, EColorSpace.RGB, Color, Tolerance, DefaultMultipliers); end; function TSimbaFinder.CountColor(Color: TColor; Tolerance: Single; ColorSpace: EColorSpace; Multipliers: TChannelMultipliers; Bounds: TBox): Integer; begin - FColorFinder.Setup(ColorSpace, Color, Tolerance, Multipliers); - - Result := DoCountColor(Bounds); + Result := CountColorsOnTarget(FTarget, Bounds, ColorSpace, Color, Tolerance, Multipliers); end; function TSimbaFinder.CountColor(Color: TColorTolerance; Bounds: TBox): Integer; begin - FColorFinder.Setup(Color.ColorSpace, Color.Color, Color.Tolerance, Color.Multipliers); - - Result := DoCountColor(Bounds); + Result := CountColorsOnTarget(FTarget, Bounds, Color.ColorSpace, Color.Color, Color.Tolerance, Color.Multipliers); end; function TSimbaFinder.GetColor(X, Y: Integer): TColor; @@ -536,3 +478,4 @@ function TSimbaFinder.FindTemplate(Templ: TMufasaBitmap; MinMatch: Single; Bound end. + diff --git a/Source/simba.threadpool.pas b/Source/simba.threadpool.pas index d1864583e..b0fab9635 100644 --- a/Source/simba.threadpool.pas +++ b/Source/simba.threadpool.pas @@ -10,46 +10,27 @@ interface uses - classes, sysutils, syncobjs; + classes, sysutils, + simba.baseclass, simba.mufasatypes, simba.simplelock; type - PParamArray = ^TParamArray; - TParamArray = array[Word] of Pointer; - - TSimbaThreadPoolNestedMethod = procedure(Index: Integer) is nested; - TSimbaThreadPoolMethod = procedure(const Params: PParamArray; const Result: Pointer); - TSimbaThreadPoolTask = record - Method: TSimbaThreadPoolMethod; - NestedMethod: TSimbaThreadPoolNestedMethod; - Params: TParamArray; - Result: Pointer; - - procedure Execute(Index: Integer); - - class function Create(AMethod: TSimbaThreadPoolNestedMethod): TSimbaThreadPoolTask; static; overload; - class function Create(AMethod: TSimbaThreadPoolMethod; AParams: array of Pointer; AResult: Pointer = nil): TSimbaThreadPoolTask; static; overload; - end; - TSimbaThreadPoolTasks = array of TSimbaThreadPoolTask; + TSimbaThreadPoolMethod_Nested = procedure(const Index, Lo, Hi: Integer) is nested; TSimbaThreadPool_Thread = class(TThread) protected - FEvent: TSimpleEvent; - FIdleEvent: TSimpleEvent; - FTask: TSimbaThreadPoolTask; - FTaskIndex: Integer; - procedure Execute; override; - - procedure SetIdle(Value: Boolean); - function GetIdle: Boolean; public - constructor Create; reintroduce; - destructor Destroy; override; + IdleLock: TSimpleWaitableLock; // Locked = Thread is being used right now. + MethodLock: TSimpleWaitableLock; // Locked = Waiting for a method to call + + Index: Integer; + Lo: Integer; + Hi: Integer; - procedure Run(Task: TSimbaThreadPoolTask; TaskIndex: Integer); - procedure WaitForIdle; + Method: TSimbaThreadPoolMethod_Nested; - property Idle: Boolean read GetIdle write SetIdle; + constructor Create; reintroduce; + destructor Destroy; override; end; TSimbaThreadPool = class @@ -57,15 +38,18 @@ TSimbaThreadPool = class type TThreadArray = array of TSimbaThreadPool_Thread; protected + FThreadCount: Integer; FThreads: TThreadArray; - FLock: TCriticalSection; + FLock: TSimpleEnterableLock; - function GetIdleThreads(Count: Integer; out IdleThreads: TThreadArray): Boolean; + function GetIdleThreads(MaxThreads: Integer): TThreadArray; public - procedure RunParallel(Tasks: TSimbaThreadPoolTasks); - - constructor Create(ThreadCount: Int32); + constructor Create(AThreadCount: Integer); destructor Destroy; override; + + property ThreadCount: Integer read FThreadCount; + + function RunParallel(MaxThreads: Integer; Lo, Hi: Integer; Method: TSimbaThreadPoolMethod_Nested): Integer; end; var @@ -73,88 +57,40 @@ TSimbaThreadPool = class implementation -uses - LazLoggerBase; - -procedure TSimbaThreadPoolTask.Execute(Index: Integer); -begin - if Assigned(Method) then Method(@Params, Result); - if Assigned(NestedMethod) then NestedMethod(Index); -end; - -class function TSimbaThreadPoolTask.Create(AMethod: TSimbaThreadPoolNestedMethod): TSimbaThreadPoolTask; -begin - Result := Default(TSimbaThreadPoolTask); - Result.NestedMethod := AMethod; -end; - -class function TSimbaThreadPoolTask.Create(AMethod: TSimbaThreadPoolMethod; AParams: array of Pointer; AResult: Pointer): TSimbaThreadPoolTask; -begin - Result := Default(TSimbaThreadPoolTask); - Result.Method := AMethod; - Result.Params := AParams; - Result.Result := AResult; -end; - procedure TSimbaThreadPool_Thread.Execute; begin while True do begin - FEvent.WaitFor(INFINITE); + MethodLock.WaitLocked(); if Terminated then - Exit; - - FTask.Execute(FTaskIndex); - - FEvent.ResetEvent(); - FIdleEvent.SetEvent(); + Break; + + if Assigned(Method) then + try + Method(Index, Lo, Hi); + except + on E: Exception do + DebugLn('Exception whilst invoking method in thread pool: ' + E.Message); + end; + + Method := nil; + MethodLock.Lock(); + IdleLock.Unlock(); end; end; -procedure TSimbaThreadPool_Thread.Run(Task: TSimbaThreadPoolTask; TaskIndex: Integer); -begin - FTask := Task; - FTaskIndex := TaskIndex; - - FEvent.SetEvent(); // begin execution -end; - -procedure TSimbaThreadPool_Thread.WaitForIdle; -begin - FIdleEvent.WaitFor(INFINITE); -end; - -function TSimbaThreadPool_Thread.GetIdle: Boolean; -begin - Result := FIdleEvent.WaitFor(0) = wrSignaled; -end; - -procedure TSimbaThreadPool_Thread.SetIdle(Value: Boolean); -begin - if Suspended then - Start(); - - if Value then - FIdleEvent.SetEvent() - else - FIdleEvent.ResetEvent(); -end; - constructor TSimbaThreadPool_Thread.Create; begin inherited Create(True, 512 * 512); // default = 4MiB, we set 256KiB + // also start suspended until we need it. - FreeOnTerminate := False; - - FEvent := TSimpleEvent.Create(); - - FIdleEvent := TSimpleEvent.Create(); - FIdleEvent.SetEvent(); + MethodLock.Lock(); end; destructor TSimbaThreadPool_Thread.Destroy; begin - FEvent.SetEvent(); // call event so execute loop can execute. + IdleLock.WaitLocked(); // Wait if running something + MethodLock.Unlock(); // Wake `Execute` loop if not running if (not Suspended) then begin @@ -162,49 +98,45 @@ destructor TSimbaThreadPool_Thread.Destroy; WaitFor(); end; - FEvent.Free(); - FIdleEvent.Free(); - inherited Destroy(); end; -function TSimbaThreadPool.GetIdleThreads(Count: Integer; out IdleThreads: TThreadArray): Boolean; +function TSimbaThreadPool.GetIdleThreads(MaxThreads: Integer): TThreadArray; var - I, J: Integer; + I, Count: Integer; begin - FLock.Enter(); + SetLength(Result, MaxThreads); + Count := 0; + FLock.Enter(); try for I := 0 to High(FThreads) do - if FThreads[i].Idle then - begin - IdleThreads := IdleThreads + [FThreads[I]]; + begin + if FThreads[I].IdleLock.IsLocked() then + Continue; - if (Length(IdleThreads) = Count) then - begin - for J := 0 to High(IdleThreads) do - IdleThreads[J].Idle := False; + Result[Count] := FThreads[I]; + Result[Count].IdleLock.Lock(); + Inc(Count); - Result := True; - Exit; - end; - end; + if (Count = MaxThreads) then + Break; + end; finally FLock.Leave(); end; - Result := False; + SetLength(Result, Count); end; -constructor TSimbaThreadPool.Create(ThreadCount: Int32); +constructor TSimbaThreadPool.Create(AThreadCount: Integer); var I: Integer; begin inherited Create(); - FLock := TCriticalSection.Create(); - - SetLength(FThreads, ThreadCount); + FThreadCount := AThreadCount; + SetLength(FThreads, FThreadCount); for I := 0 to High(FThreads) do FThreads[I] := TSimbaThreadPool_Thread.Create(); end; @@ -217,38 +149,56 @@ destructor TSimbaThreadPool.Destroy; FThreads[I].Free(); FThreads := nil; - if (FLock <> nil) then - FreeAndNil(FLock); - inherited Destroy(); end; -procedure TSimbaThreadPool.RunParallel(Tasks: TSimbaThreadPoolTasks); +function TSimbaThreadPool.RunParallel(MaxThreads: Integer; Lo, Hi: Integer; Method: TSimbaThreadPoolMethod_Nested): Integer; var Threads: TThreadArray; - I: Integer; + I, Size: Integer; begin - if GetIdleThreads(Length(Tasks), Threads) then + if (MaxThreads > 1) then + Threads := GetIdleThreads(Min(FThreadCount, MaxThreads)) + else + Threads := []; + + Result := Max(1, Length(Threads)); + + if (Length(Threads) > 1) then begin - // DebugLn('Running %d tasks', [Length(Tasks)]); + Size := ((Hi - Lo) + 1) div Result; + + for I := 0 to High(Threads) do + begin + Threads[I].Index := I; + Threads[I].Method := Method; + + if (I = 0) then + begin + Threads[I].Lo := 0; + Threads[I].Hi := Size; + end else + begin + Threads[I].Lo := Threads[I-1].Hi + 1; + Threads[I].Hi := Threads[I-1].Hi + Size; + end; + + if (I = High(Threads)) then + Threads[I].Hi := Hi; + + Threads[I].MethodLock.Unlock(); + if Threads[I].Suspended then + Threads[I].Start(); + end; - for I := 0 to High(Tasks) do - Threads[I].Run(Tasks[I], I); for I := 0 to High(Threads) do - Threads[I].WaitForIdle(); + Threads[I].IdleLock.WaitLocked(); end else - begin - // Not enough threads - no multithreading. - for I := 0 to High(Tasks) do - Tasks[I].Execute(I); - end; + Method(0, Lo, Hi); end; initialization - if (TThread.ProcessorCount >= 4) then - SimbaThreadPool := TSimbaThreadPool.Create(4) - else - SimbaThreadPool := TSimbaThreadPool.Create(TThread.ProcessorCount); + SimbaThreadPool := TSimbaThreadPool.Create(TThread.ProcessorCount); finalization if (SimbaThreadPool <> nil) then