From 4bd86d0959180c508c2e7d7000a0b9be066eb1a3 Mon Sep 17 00:00:00 2001 From: Olly Date: Tue, 19 Sep 2023 17:11:30 +0100 Subject: [PATCH] use TCircle for TSimbaImage.DrawCircle --- .../imports/simba/simba.import_circle.pas | 1 + .../imports/simba/simba.import_debugimage.pas | 75 +++++++++++++++++-- .../simbaclasses/simba.import_class_image.pas | 20 ++--- .../simba.import_externalimage.pas | 10 +-- Source/simba.circle.pas | 2 + Source/simba.externalimage.pas | 27 +++---- Source/simba.image.pas | 54 ++++++------- Source/simba.inc | 2 +- 8 files changed, 132 insertions(+), 59 deletions(-) diff --git a/Source/script/imports/simba/simba.import_circle.pas b/Source/script/imports/simba/simba.import_circle.pas index 9ba73c7b3..f5a8f43af 100644 --- a/Source/script/imports/simba/simba.import_circle.pas +++ b/Source/script/imports/simba/simba.import_circle.pas @@ -200,6 +200,7 @@ procedure ImportCircle(Compiler: TSimbaScript_Compiler); ImportingSection := 'TCircle'; addGlobalType('record Center: TPoint; Radius: Integer; end;', 'TCircle'); + addGlobalType('array of TCircle;', 'TCircleArray'); addGlobalFunc('function TCircle.Create(ACenter: TPoint; ARadius: Integer): TCircle; static; overload', @_LapeCircle_Create); addGlobalFunc('function TCircle.CreateFromPoints(Points: TPointArray): TCircle; static; overload', @_LapeCircle_CreateFromPoints); diff --git a/Source/script/imports/simba/simba.import_debugimage.pas b/Source/script/imports/simba/simba.import_debugimage.pas index e2a16873e..da4faa562 100644 --- a/Source/script/imports/simba/simba.import_debugimage.pas +++ b/Source/script/imports/simba/simba.import_debugimage.pas @@ -58,6 +58,18 @@ implementation > procedure Show(Quad: TQuad; Filled: Boolean = False); *) +(* +Show +~~~~ +> procedure Show(Circles: TCircleArray; Filled: Boolean = False); +*) + +(* +Show +~~~~ +> procedure Show(Circle: TCircle; Filled: Boolean = False); +*) + (* Show ~~~~ @@ -97,19 +109,25 @@ implementation (* ShowOnClient ~~~~~~~~~~~~ -> procedure ShowOnClient(TPA: TPointArray; Color: Integer = $0000FF); +> procedure ShowOnClient(Circles: TCircleArray; Filled: Boolean = False); *) (* ShowOnClient ~~~~~~~~~~~~ -> procedure ShowOnClient(ATPA: T2DPointArray); +> procedure ShowOnClient(Circle: TCircle; Filled: Boolean = False); *) (* -Show -~~~~ -> procedure Show(Bitmap: TSimbaImage; EnsureVisible: Boolean = True); +ShowOnClient +~~~~~~~~~~~~ +> procedure ShowOnClient(TPA: TPointArray; Color: Integer = $0000FF); +*) + +(* +ShowOnClient +~~~~~~~~~~~~ +> procedure ShowOnClient(ATPA: T2DPointArray); *) (* @@ -309,6 +327,33 @@ procedure ImportDebugImage(Compiler: TSimbaScript_Compiler); 'end;' ]); + addGlobalFunc( + 'procedure Show(Circles: TCircleArray; Filled: Boolean = False); overload;', [ + 'var', + ' Boxes: TBoxArray;', + ' Circle: TCircle;', + 'begin', + ' for Circle in Circles do', + ' Boxes += Circle.Bounds();', + '', + ' with Boxes.Merge() do', + ' with TImage.Create(X1+X2+1, Y1+Y2+1) do', + ' try', + ' DrawCircleArray(Circles, Filled);', + ' Show();', + ' finally', + ' Free();', + ' end;', + 'end;' + ]); + + addGlobalFunc( + 'procedure Show(Circle: TCircle; Filled: Boolean = False); overload;', [ + 'begin', + ' Show(TCircleArray([Circle]), Filled);', + 'end;' + ]); + addGlobalFunc( 'procedure ShowOnClient(Quads: TQuadArray; Filled: Boolean = False); overload;', [ 'begin', @@ -349,6 +394,26 @@ procedure ImportDebugImage(Compiler: TSimbaScript_Compiler); 'end;' ]); + addGlobalFunc( + 'procedure ShowOnClient(Circles: TCircleArray; Filled: Boolean = False); overload;', [ + 'begin', + ' with TImage.CreateFromTarget() do', + ' try', + ' DrawCircleArray(Circles, Filled);', + ' Show();', + ' finally', + ' Free();', + ' end;', + 'end;' + ]); + + addGlobalFunc( + 'procedure ShowOnClient(Circle: TCircle; Filled: Boolean = False); overload;', [ + 'begin', + ' ShowOnClient(TCircleArray([Circle]), Filled);', + 'end;' + ]); + addGlobalFunc( 'procedure ShowOnClient(TPA: TPointArray; Color: Integer = $0000FF); overload;', [ 'begin', diff --git a/Source/script/imports/simbaclasses/simba.import_class_image.pas b/Source/script/imports/simbaclasses/simba.import_class_image.pas index 887daf86b..21a15475c 100644 --- a/Source/script/imports/simbaclasses/simba.import_class_image.pas +++ b/Source/script/imports/simbaclasses/simba.import_class_image.pas @@ -15,7 +15,7 @@ implementation uses Graphics, lptypes, - simba.image; + simba.image, simba.circle; type PBitmap = ^TBitmap; @@ -612,31 +612,31 @@ procedure _LapeImage_DrawPolygonInverted(const Params: PParamArray); LAPE_WRAPPE (* TImage.DrawCircle ~~~~~~~~~~~~~~~~~ -> procedure TImage.DrawCircle(ACenter: TPoint; Radius: Integer; Color: TColor); +> procedure TImage.DrawCircle(Circle: TCircle; Color: TColor); *) procedure _LapeImage_DrawCircle(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin - PSimbaImage(Params^[0])^.DrawCircle(PPoint(Params^[1])^, PInteger(Params^[2])^, PColor(Params^[3])^); + PSimbaImage(Params^[0])^.DrawCircle(PCircle(Params^[1])^, PColor(Params^[2])^); end; (* TImage.DrawCircleFilled ~~~~~~~~~~~~~~~~~~~~~~~ -> procedure TImage.DrawCircleFilled(ACenter: TPoint; Radius: Integer; Color: TColor); +> procedure TImage.DrawCircleFilled(Circle: TCircle; Color: TColor); *) procedure _LapeImage_DrawCircleFilled(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin - PSimbaImage(Params^[0])^.DrawCircleFilled(PPoint(Params^[1])^, PInteger(Params^[2])^, PColor(Params^[3])^); + PSimbaImage(Params^[0])^.DrawCircleFilled(PCircle(Params^[1])^, PColor(Params^[2])^); end; (* TImage.DrawCircleInverted ~~~~~~~~~~~~~~~~~~~~~~~~~ -> procedure TImage.DrawCircleInverted(ACenter: TPoint; Radius: Integer; Color: TColor); +> procedure TImage.DrawCircleInverted(Circle: TCircle; Color: TColor); *) procedure _LapeImage_DrawCircleInverted(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin - PSimbaImage(Params^[0])^.DrawCircleInverted(PPoint(Params^[1])^, PInteger(Params^[2])^, PColor(Params^[3])^); + PSimbaImage(Params^[0])^.DrawCircleInverted(PCircle(Params^[1])^, PColor(Params^[2])^); end; (* @@ -732,11 +732,11 @@ procedure _LapeImage_DrawPolygonArray(const Params: PParamArray); LAPE_WRAPPER_C (* TImage.DrawCircleArray ~~~~~~~~~~~~~~~~~~~~~~ -> procedure TImage.DrawCircleArray(Points: TPointArray; Radius: Integer; Filled: Boolean; Color: TColor = -1); +> procedure TImage.DrawCircleArray(Circles: TCircleArray; Filled: Boolean; Color: TColor = -1); *) procedure _LapeImage_DrawCircleArray(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin - PSimbaImage(Params^[0])^.DrawCircleArray(PPointArray(Params^[1])^, PInteger(Params^[2])^, PBoolean(Params^[3])^, PColor(Params^[4])^); + PSimbaImage(Params^[0])^.DrawCircleArray(PCircleArray(Params^[1])^, PBoolean(Params^[2])^, PColor(Params^[3])^); end; (* @@ -1341,7 +1341,7 @@ procedure ImportSimbaImage(Compiler: TSimbaScript_Compiler); addGlobalFunc('procedure TImage.DrawQuadArray(Quads: TQuadArray; Filled: Boolean; Color: TColor = -1);', @_LapeImage_DrawQuadArray); addGlobalFunc('procedure TImage.DrawBoxArray(Boxes: TBoxArray; Filled: Boolean; Color: TColor = -1);', @_LapeImage_DrawBoxArray); addGlobalFunc('procedure TImage.DrawPolygonArray(Polygons: T2DPointArray; Filled: Boolean; Color: TColor = -1);', @_LapeImage_DrawPolygonArray); - addGlobalFunc('procedure TImage.DrawCircleArray(Points: TPointArray; Radius: Integer; Filled: Boolean; Color: TColor = -1);', @_LapeImage_DrawCircleArray); + addGlobalFunc('procedure TImage.DrawCircleArray(Circles: TCircleArray; Filled: Boolean; Color: TColor = -1);', @_LapeImage_DrawCircleArray); addGlobalFunc('procedure TImage.DrawCrossArray(Points: TPointArray; Radius: Integer; Thickness: Integer; Color: TColor = -1);', @_LapeImage_DrawCrossArray); addGlobalFunc('procedure TImage.DrawHSLCircle(ACenter: TPoint; Radius: Integer)', @_LapeImage_DrawHSLCircle); diff --git a/Source/script/imports/simbaclasses/simba.import_externalimage.pas b/Source/script/imports/simbaclasses/simba.import_externalimage.pas index d1f6df513..19da025cf 100644 --- a/Source/script/imports/simbaclasses/simba.import_externalimage.pas +++ b/Source/script/imports/simbaclasses/simba.import_externalimage.pas @@ -14,7 +14,7 @@ implementation uses lptypes, - simba.image, simba.externalimage; + simba.image, simba.externalimage, simba.circle; procedure _LapeExternalImage_Create(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin @@ -303,7 +303,7 @@ procedure _LapeExternalImage_DrawPolygonInverted(const Params: PParamArray); LAP *) procedure _LapeExternalImage_DrawCircle(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin - PSimbaExternalImage(Params^[0])^.DrawCircle(PPoint(Params^[1])^, PInteger(Params^[2])^, PColor(Params^[3])^); + PSimbaExternalImage(Params^[0])^.DrawCircle(PCircle(Params^[1])^, PColor(Params^[2])^); end; (* @@ -313,7 +313,7 @@ procedure _LapeExternalImage_DrawCircle(const Params: PParamArray); LAPE_WRAPPER *) procedure _LapeExternalImage_DrawCircleFilled(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin - PSimbaExternalImage(Params^[0])^.DrawCircleFilled(PPoint(Params^[1])^, PInteger(Params^[2])^, PColor(Params^[3])^); + PSimbaExternalImage(Params^[0])^.DrawCircleFilled(PCircle(Params^[1])^, PColor(Params^[2])^); end; (* @@ -323,7 +323,7 @@ procedure _LapeExternalImage_DrawCircleFilled(const Params: PParamArray); LAPE_W *) procedure _LapeExternalImage_DrawCircleInverted(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin - PSimbaExternalImage(Params^[0])^.DrawCircleInverted(PPoint(Params^[1])^, PInteger(Params^[2])^, PColor(Params^[3])^); + PSimbaExternalImage(Params^[0])^.DrawCircleInverted(PCircle(Params^[1])^, PColor(Params^[2])^); end; (* @@ -423,7 +423,7 @@ procedure _LapeExternalImage_DrawPolygonArray(const Params: PParamArray); LAPE_W *) procedure _LapeExternalImage_DrawCircleArray(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV begin - PSimbaExternalImage(Params^[0])^.DrawCircleArray(PPointArray(Params^[1])^, PInteger(Params^[2])^, PBoolean(Params^[3])^, PColor(Params^[4])^); + PSimbaExternalImage(Params^[0])^.DrawCircleArray(PCircleArray(Params^[1])^, PBoolean(Params^[2])^, PColor(Params^[3])^); end; (* diff --git a/Source/simba.circle.pas b/Source/simba.circle.pas index 9bfe7cdd4..de28abd7c 100644 --- a/Source/simba.circle.pas +++ b/Source/simba.circle.pas @@ -19,6 +19,8 @@ TCircle = record Center: TPoint; Radius: Integer; end; + PCircleArray = ^TCircleArray; + TCircleArray = array of TCircle; TCircleHelper = type helper for TCircle public const diff --git a/Source/simba.externalimage.pas b/Source/simba.externalimage.pas index 9c0c995be..aa86a1181 100644 --- a/Source/simba.externalimage.pas +++ b/Source/simba.externalimage.pas @@ -6,7 +6,8 @@ interface uses Classes, SysUtils, Graphics, - simba.mufasatypes, simba.baseclass, simba.image, simba.simplelock; + simba.mufasatypes, simba.baseclass, simba.image, simba.simplelock, + simba.circle; type TSimbaExternalImageCallback = procedure(Image: Pointer); cdecl; @@ -83,9 +84,9 @@ TSimbaExternalImage = class(TSimbaBaseClass) procedure DrawPolygonFilled(Points: TPointArray; Color: TColor); procedure DrawPolygonInverted(Points: TPointArray; Color: TColor); - procedure DrawCircle(ACenter: TPoint; Radius: Integer; Color: TColor); - procedure DrawCircleFilled(ACenter: TPoint; Radius: Integer; Color: TColor); - procedure DrawCircleInverted(ACenter: TPoint; Radius: Integer; Color: TColor); + procedure DrawCircle(Circle: TCircle; Color: TColor); + procedure DrawCircleFilled(Circle: TCircle; Color: TColor); + procedure DrawCircleInverted(Circle: TCircle; Color: TColor); procedure DrawBox(B: TBox; Color: TColor); procedure DrawBoxFilled(B: TBox; Color: TColor); @@ -98,7 +99,7 @@ TSimbaExternalImage = class(TSimbaBaseClass) procedure DrawQuadArray(Quads: TQuadArray; Filled: Boolean; Color: TColor = -1); procedure DrawBoxArray(Boxes: TBoxArray; Filled: Boolean; Color: TColor = -1); procedure DrawPolygonArray(Polygons: T2DPointArray; Filled: Boolean; Color: TColor = -1); - procedure DrawCircleArray(Points: TPointArray; Radius: Integer; Filled: Boolean; Color: TColor = -1); + procedure DrawCircleArray(Circles: TCircleArray; Filled: Boolean; Color: TColor = -1); procedure DrawCrossArray(Points: TPointArray; Radius: Integer; Color: TColor = -1); end; @@ -477,31 +478,31 @@ procedure TSimbaExternalImage.DrawPolygonInverted(Points: TPointArray; Color: TC end; end; -procedure TSimbaExternalImage.DrawCircle(ACenter: TPoint; Radius: Integer; Color: TColor); +procedure TSimbaExternalImage.DrawCircle(Circle: TCircle; Color: TColor); begin Lock(); try - FImage.DrawCircle(ACenter, Radius, Color); + FImage.DrawCircle(Circle, Color); finally Unlock(); end; end; -procedure TSimbaExternalImage.DrawCircleFilled(ACenter: TPoint; Radius: Integer; Color: TColor); +procedure TSimbaExternalImage.DrawCircleFilled(Circle: TCircle; Color: TColor); begin Lock(); try - FImage.DrawCircleFilled(ACenter, Radius, Color); + FImage.DrawCircleFilled(Circle, Color); finally Unlock(); end; end; -procedure TSimbaExternalImage.DrawCircleInverted(ACenter: TPoint; Radius: Integer; Color: TColor); +procedure TSimbaExternalImage.DrawCircleInverted(Circle: TCircle; Color: TColor); begin Lock(); try - FImage.DrawCircleInverted(ACenter, Radius, Color); + FImage.DrawCircleInverted(Circle, Color); finally Unlock(); end; @@ -597,11 +598,11 @@ procedure TSimbaExternalImage.DrawPolygonArray(Polygons: T2DPointArray; Filled: end; end; -procedure TSimbaExternalImage.DrawCircleArray(Points: TPointArray; Radius: Integer; Filled: Boolean; Color: TColor); +procedure TSimbaExternalImage.DrawCircleArray(Circles: TCircleArray; Filled: Boolean; Color: TColor); begin Lock(); try - FImage.DrawCircleArray(Points, Radius, Filled, Color); + FImage.DrawCircleArray(Circles, Filled, Color); finally Unlock(); end; diff --git a/Source/simba.image.pas b/Source/simba.image.pas index 518b0f5ed..66a36182a 100644 --- a/Source/simba.image.pas +++ b/Source/simba.image.pas @@ -13,7 +13,8 @@ interface uses Classes, SysUtils, Graphics, simba.baseclass, simba.mufasatypes, simba.image_textdrawer, - simba.colormath, simba.colormath_distance, simba.matchtemplate; + simba.colormath, simba.colormath_distance, simba.matchtemplate, + simba.circle; type {$PUSH} @@ -129,9 +130,9 @@ TSimbaImage = class(TSimbaBaseClass) procedure DrawPolygonFilled(Points: TPointArray; Color: TColor); procedure DrawPolygonInverted(Points: TPointArray; Color: TColor); - procedure DrawCircle(ACenter: TPoint; Radius: Integer; Color: TColor); - procedure DrawCircleFilled(ACenter: TPoint; Radius: Integer; Color: TColor); - procedure DrawCircleInverted(ACenter: TPoint; Radius: Integer; Color: TColor); + procedure DrawCircle(Circle: TCircle; Color: TColor); + procedure DrawCircleFilled(Circle: TCircle; Color: TColor); + procedure DrawCircleInverted(Circle: TCircle; Color: TColor); procedure DrawBox(B: TBox; Color: TColor); procedure DrawBoxFilled(B: TBox; Color: TColor); @@ -144,7 +145,7 @@ TSimbaImage = class(TSimbaBaseClass) procedure DrawQuadArray(Quads: TQuadArray; Filled: Boolean; Color: TColor = -1); procedure DrawBoxArray(Boxes: TBoxArray; Filled: Boolean; Color: TColor = -1); procedure DrawPolygonArray(Polygons: T2DPointArray; Filled: Boolean; Color: TColor = -1); - procedure DrawCircleArray(Points: TPointArray; Radius: Integer; Filled: Boolean; Color: TColor = -1); + procedure DrawCircleArray(Circles: TCircleArray; Filled: Boolean; Color: TColor = -1); procedure DrawCrossArray(Points: TPointArray; Radius: Integer; Color: TColor = -1); procedure DrawHSLCircle(ACenter: TPoint; Radius: Integer); @@ -947,40 +948,43 @@ procedure TSimbaImage.DrawPolygonInverted(Points: TPointArray; Color: TColor); FData[Y*FWidth+X] := RGB; end; -procedure TSimbaImage.DrawCircle(ACenter: TPoint; Radius: Integer; Color: TColor); +procedure TSimbaImage.DrawCircle(Circle: TCircle; Color: TColor); begin - if (Radius < 1) then + if (Circle.Radius < 1) then Exit; - DrawTPA(TPointArray.CreateFromCircle(ACenter, Radius, False), Color); + DrawTPA(TPointArray.CreateFromCircle(Circle.Center, Circle.Radius, False), Color); end; -procedure TSimbaImage.DrawCircleFilled(ACenter: TPoint; Radius: Integer; Color: TColor); +procedure TSimbaImage.DrawCircleFilled(Circle: TCircle; Color: TColor); begin - if (Radius < 1) then + if (Circle.Radius < 1) then Exit; - DrawTPA(TPointArray.CreateFromCircle(ACenter, Radius, True), Color); + DrawTPA(TPointArray.CreateFromCircle(Circle.Center, Circle.Radius, True), Color); end; -procedure TSimbaImage.DrawCircleInverted(ACenter: TPoint; Radius: Integer; Color: TColor); +procedure TSimbaImage.DrawCircleInverted(Circle: TCircle; Color: TColor); var X, Y: Integer; - Bounds: TBox; + B: TBox; RGB: TColorBGRA; begin RGB := ColorToBGRA(Color); - Bounds.X1 := Max(ACenter.X-Radius, 0); - Bounds.Y1 := Max(ACenter.Y-Radius, 0); - Bounds.X2 := Min(ACenter.X+Radius, FWidth-1); - Bounds.Y2 := Min(ACenter.Y+Radius, FHeight-1); + with Circle do + begin + B.X1 := Max(Center.X-Radius, 0); + B.Y1 := Max(Center.Y-Radius, 0); + B.X2 := Min(Center.X+Radius, FWidth-1); + B.Y2 := Min(Center.Y+Radius, FHeight-1); + end; - Self.DrawBoxInverted(Bounds, Color); + Self.DrawBoxInverted(B, Color); - for X := Bounds.X1 to Bounds.X2 do - for Y := Bounds.Y1 to Bounds.Y2 do - if not TSimbaGeometry.PointInCircle(Point(X, Y), ACenter, Radius) then + for X := B.X1 to B.X2 do + for Y := B.Y1 to B.Y2 do + if not Circle.Contains(TPoint.Create(X, Y)) then FData[Y*FWidth+X] := RGB; end; @@ -1091,15 +1095,15 @@ procedure TSimbaImage.DrawPolygonArray(Polygons: T2DPointArray; Filled: Boolean; DrawPolygon(Polygons[I], GetDistinctColor(Color, I)); end; -procedure TSimbaImage.DrawCircleArray(Points: TPointArray; Radius: Integer; Filled: Boolean; Color: TColor); +procedure TSimbaImage.DrawCircleArray(Circles: TCircleArray; Filled: Boolean; Color: TColor); var I: Integer; begin - for I := 0 to High(Points) do + for I := 0 to High(Circles) do if Filled then - DrawCircleFilled(Points[I], Radius, GetDistinctColor(Color, I)) + DrawCircleFilled(Circles[I], GetDistinctColor(Color, I)) else - DrawCircle(Points[I], Radius, GetDistinctColor(Color, I)); + DrawCircle(Circles[I], GetDistinctColor(Color, I)); end; procedure TSimbaImage.DrawCrossArray(Points: TPointArray; Radius: Integer; Color: TColor); diff --git a/Source/simba.inc b/Source/simba.inc index 0585358ce..96b49107b 100644 --- a/Source/simba.inc +++ b/Source/simba.inc @@ -9,7 +9,7 @@ {$DEFINE SIMBA_HAS_DEBUGINFO} {$ELSE} {$IFDEF SIMBA_MAX_OPTIMIZATION} // O4 can do "unsafe" optimizations so this is not globally enabled. - {.$OPTIMIZATION LEVEL4} + {$OPTIMIZATION LEVEL4} {$ENDIF} {$ENDIF}