diff --git a/Source/image/clearpixelaa.inc b/Source/image/clearpixelalpha.inc similarity index 58% rename from Source/image/clearpixelaa.inc rename to Source/image/clearpixelalpha.inc index 979ab1e01..915e40171 100644 --- a/Source/image/clearpixelaa.inc +++ b/Source/image/clearpixelalpha.inc @@ -1,4 +1,4 @@ -procedure _ClearPixelA(const X, Y: Integer; const Alpha: Byte); inline; +procedure _SetPixelAntialias(const X, Y: Integer; const Alpha: Byte); inline; begin if (X >= 0) and (Y >= 0) and (X < FWidth) and (Y < FHeight) then FData[Y*FWidth+X].A := 0; diff --git a/Source/image/drawellipseaa.inc b/Source/image/ellipseantialias.inc similarity index 72% rename from Source/image/drawellipseaa.inc rename to Source/image/ellipseantialias.inc index e623a290c..a113a93ba 100644 --- a/Source/image/drawellipseaa.inc +++ b/Source/image/ellipseantialias.inc @@ -1,6 +1,7 @@ // https://zingl.github.io/bresenham.js +// Requires _SetPixelAntialias(const X, Y: Integer; const Alpha: Byte); -procedure _DrawEllipseAA(x0, y0, x1, y1: Integer; Thickness: Single); +procedure _EllipseAntialias(x0, y0, x1, y1: Integer; Thickness: Single); var a,b,b1: Integer; a2,b2: Single; @@ -76,10 +77,10 @@ begin i := 255*err/ed; Alpha := Byte(Round(i)); - _SetPixelA(x0,y0, Alpha); - _SetPixelA(x0,y1, Alpha); - _SetPixelA(x1,y0, Alpha); - _SetPixelA(x1,y1, Alpha); + _SetPixelAntialias(x0,y0, Alpha); + _SetPixelAntialias(x0,y1, Alpha); + _SetPixelAntialias(x1,y0, Alpha); + _SetPixelAntialias(x1,y1, Alpha); if (err+dy+a < dx) then begin @@ -95,10 +96,10 @@ begin while (i < Thickness) and (2*i <= x0+x1) do begin - _SetPixelA(Round(i), y0, 0); - _SetPixelA(Round(x0+x1-i), y0, 0); - _SetPixelA(Round(i), y1, 0); - _SetPixelA(Round(x0+x1-i), y1, 0); + _SetPixelAntialias(Round(i), y0, 0); + _SetPixelAntialias(Round(x0+x1-i), y0, 0); + _SetPixelAntialias(Round(i), y1, 0); + _SetPixelAntialias(Round(x0+x1-i), y1, 0); i += 1.0; end; @@ -114,10 +115,10 @@ begin ed += 2*ed*i*i/(4*ed*ed+i*i); Alpha := Byte(Round(255-255*e2/ed)); - _SetPixelA(Round(Thickness), y0, Alpha); - _SetPixelA(Round(x0+x1-Thickness), y0, Alpha); - _SetPixelA(Round(Thickness), y1, Alpha); - _SetPixelA(Round(x0+x1-Thickness), y1, Alpha); + _SetPixelAntialias(Round(Thickness), y0, Alpha); + _SetPixelAntialias(Round(x0+x1-Thickness), y0, Alpha); + _SetPixelAntialias(Round(Thickness), y1, Alpha); + _SetPixelAntialias(Round(x0+x1-Thickness), y1, Alpha); if (e2+dy2+a2 < dx2) then Break; @@ -139,13 +140,13 @@ begin begin Alpha := Byte(Round(255*4*err/b1)); - _SetPixelA(x0, y0, Alpha); - _SetPixelA(x1, y0, Alpha); + _SetPixelAntialias(x0, y0, Alpha); + _SetPixelAntialias(x1, y0, Alpha); y0 += 1; - _SetPixelA(x0, y1, Alpha); - _SetPixelA(x1, y1, Alpha); + _SetPixelAntialias(x0, y1, Alpha); + _SetPixelAntialias(x1, y1, Alpha); y1 -= 1; dy += a; diff --git a/Source/image/drawlineaa.inc b/Source/image/lineantialias.inc similarity index 72% rename from Source/image/drawlineaa.inc rename to Source/image/lineantialias.inc index 5ea836d89..eeadfb508 100644 --- a/Source/image/drawlineaa.inc +++ b/Source/image/lineantialias.inc @@ -1,6 +1,7 @@ // https://zingl.github.io/bresenham.js +// Requires _SetPixelAntialias(const X, Y: Integer; const Alpha: Byte); -procedure _DrawLineAA(x0, y0, x1, y1: Integer; Thickness: Single); +procedure _LineAntialias(x0, y0, x1, y1: Integer; Thickness: Single); var dx, dy, err: Integer; e2, x2, y2: Integer; @@ -22,7 +23,7 @@ begin Thickness := (Thickness + 1) / 2; while True do begin - _SetPixelA(x0, y0, Round(Max(0, 255 * (Abs(err-dx+dy)/ed-Thickness+1)))); + _SetPixelAntialias(x0, y0, Round(Max(0, 255 * (Abs(err-dx+dy)/ed-Thickness+1)))); e2 := err; x2 := x0; @@ -33,7 +34,7 @@ begin while (e2 < ed*Thickness) and ((y1 <> y2) or (dx > dy)) do begin y2 += sy; - _SetPixelA(x0, y2, Round(Max(0, 255 * (Abs(e2)/ed-Thickness+1)))); + _SetPixelAntialias(x0, y2, Round(Max(0, 255 * (Abs(e2)/ed-Thickness+1)))); e2 += dx; end; if (x0 = x1) then @@ -50,7 +51,7 @@ begin while (e2 < ed*Thickness) and ((x1 <> x2) or (dx < dy)) do begin x2 += sx; - _SetPixelA(x2, y0, Round(Max(0, 255 * (Abs(e2)/ed-Thickness+1)))); + _SetPixelAntialias(x2, y0, Round(Max(0, 255 * (Abs(e2)/ed-Thickness+1)))); e2 += dy; end; if (y0 = y1) then diff --git a/Source/image/setpixel.inc b/Source/image/setpixel.inc deleted file mode 100644 index f777492b8..000000000 --- a/Source/image/setpixel.inc +++ /dev/null @@ -1,6 +0,0 @@ -procedure _SetPixel(const X, Y: Integer); inline; -begin - if (X >= 0) and (Y >= 0) and (X < FWidth) and (Y < FHeight) then - FData[Y*FWidth+X] := BGRA; -end; - diff --git a/Source/image/drawpixelaa.inc b/Source/image/setpixelantialias.inc similarity index 88% rename from Source/image/drawpixelaa.inc rename to Source/image/setpixelantialias.inc index fcf6740f4..e3d147244 100644 --- a/Source/image/drawpixelaa.inc +++ b/Source/image/setpixelantialias.inc @@ -1,4 +1,4 @@ -procedure _SetPixelA(const X, Y: Integer; const Alpha: Byte); inline; +procedure _SetPixelAntialias(const X, Y: Integer; const Alpha: Byte); inline; var Pixel: PColorBGRA; APlus1, APlus1Inv: UInt32; diff --git a/Source/image/simba.image.pas b/Source/image/simba.image.pas index 223786554..ce01c8d0a 100644 --- a/Source/image/simba.image.pas +++ b/Source/image/simba.image.pas @@ -99,7 +99,6 @@ TSimbaImage = class(TSimbaBaseClass) property FontItalic: Boolean read GetFontItalic write SetFontItalic; function InImage(const X, Y: Integer): Boolean; overload; - procedure EnsureInImage(var X, Y: Integer); overload; procedure AssertInImage(const Method: String; const X, Y: Integer); function Equals(Other: TObject): Boolean; override; @@ -130,16 +129,27 @@ TSimbaImage = class(TSimbaBaseClass) procedure DrawATPA(ATPA: T2DPointArray; Color: TColor = -1); procedure DrawTPA(Points: TPointArray; Color: TColor); + // Line procedure DrawCrosshairs(ACenter: TPoint; Size: Integer; Color: TColor); procedure DrawCross(ACenter: TPoint; Radius: Integer; Color: TColor); + procedure DrawLine(Start, Stop: TPoint; Color: TColor); - procedure DrawLine(Start, Stop: TPoint; Color: TColor); overload; - procedure DrawLine(Start, Stop: TPoint; Thickness: Integer; Color: TColor); overload; + // Box + procedure DrawBox(B: TBox; Color: TColor); + procedure DrawBoxFilled(Box: TBox; Color: TColor; Alpha: Byte = 0); + procedure DrawBoxInverted(B: TBox; Color: TColor); + // Poly procedure DrawPolygon(Points: TPointArray; Color: TColor); procedure DrawPolygonFilled(Points: TPointArray; Color: TColor; Alpha: Byte = 0); procedure DrawPolygonInverted(Points: TPointArray; Color: TColor); + // Quad + procedure DrawQuad(Quad: TQuad; Color: TColor); + procedure DrawQuadFilled(Quad: TQuad; Color: TColor; Alpha: Byte = 0); + procedure DrawQuadInverted(Quad: TQuad; Color: TColor); + + // Circle procedure DrawCircle(ACenter: TPoint; Radius: Integer; Color: TColor); procedure DrawCircleInverted(ACenter: TPoint; Radius: Integer; Color: TColor); procedure DrawCircleFilled(ACenter: TPoint; Radius: Integer; Color: TColor; Alpha: Byte = 0); @@ -149,13 +159,10 @@ TSimbaImage = class(TSimbaBaseClass) procedure DrawCircleFilled(Circle: TCircle; Color: TColor; Alpha: Byte = 0); overload; procedure DrawCircleInverted(Circle: TCircle; Color: TColor); overload; - procedure DrawBox(B: TBox; Color: TColor); - procedure DrawBoxFilled(Box: TBox; Color: TColor; Alpha: Byte = 0); - procedure DrawBoxInverted(B: TBox; Color: TColor); - - procedure DrawQuad(Quad: TQuad; Color: TColor); - procedure DrawQuadFilled(Quad: TQuad; Color: TColor; Alpha: Byte = 0); - procedure DrawQuadInverted(Quad: TQuad; Color: TColor); + // Antialiased + procedure DrawLineAA(Start, Stop: TPoint; Color: TColor; Thickness: Single = 1.5); + procedure DrawEllipseAA(ACenter: TPoint; XRadius, YRadius: Integer; Color: TColor; Thickness: Single = 1.5); + procedure DrawCircleAA(ACenter: TPoint; Radius: Integer; Color: TColor; Thickness: Single = 1.5); procedure DrawQuadArray(Quads: TQuadArray; Filled: Boolean; Color: TColor = -1); procedure DrawBoxArray(Boxes: TBoxArray; Filled: Boolean; Color: TColor = -1); @@ -230,10 +237,6 @@ TSimbaImage = class(TSimbaBaseClass) function MatchTemplate(Template: TSimbaImage; Formula: ETMFormula): TSingleMatrix; function MatchTemplateMask(Template: TSimbaImage; Formula: ETMFormula): TSingleMatrix; - - procedure DrawLineAA(Start, Stop: TPoint; Color: TColor; Thickness: Single = 1.5); - procedure DrawEllipseAA(ACenter: TPoint; XRadius, YRadius: Integer; Color: TColor; Thickness: Single = 1.5); - procedure DrawCircleAA(ACenter: TPoint; Radius: Integer; Color: TColor; Thickness: Single = 1.5); end; TSimbaImageArray = array of TSimbaImage; @@ -246,7 +249,7 @@ implementation simba.encoding, simba.compress, simba.nativeinterface, simba.singlematrix, simba.image_lazbridge, simba.image_integral, simba.image_gaussblur, - simba.image_bitmaparealoader; + simba.image_bitmaparealoader, simba.image_utils; function GetDistinctColor(const Color, Index: Integer): Integer; inline; const @@ -847,74 +850,6 @@ procedure TSimbaImage.DrawLine(Start, Stop: TPoint; Color: TColor); end; end; -procedure TSimbaImage.DrawLine(Start, Stop: TPoint; Thickness: Integer; Color: TColor); -var - BGR: TColorBGRA; - Templ: TPointArray; - H: Integer; - - procedure PutPixel(const X, Y: Single); inline; - var - XX, YY: Integer; - I: Integer; - P: TPoint; - begin - XX := Round(X); - YY := Round(Y); - - for I := 0 to H do - begin - P.X := XX + Templ[I].X; - P.Y := YY + Templ[I].Y; - if (P.X >= 0) and (P.Y >= 0) and (P.X < FWidth) and (P.Y < FHeight) then - FData[P.Y * FWidth + P.X] := BGR; - end; - end; - -var - DX, DY, Step, I: Integer; - RX, RY, X, Y: Single; -begin - if (Thickness <= 1) then - begin - DrawLine(Start, Stop, Color); - Exit; - end; - - BGR := ColorToBGRA(Color); - - Templ := TPointArray.CreateFromCircle(TPoint.Create(0,0), Thickness, True); - H := High(Templ); - - DX := (Stop.X - Start.X); - DY := (Stop.Y - Start.Y); - if (Abs(DX) > Abs(DY)) then - Step := Abs(DX) - else - Step := Abs(DY); - - if (Step = 0) then - begin - RX := DX; - RY := DY; - end else - begin - RX := DX / Step; - RY := DY / Step; - end; - X := Start.X; - Y := Start.Y; - - PutPixel(X, Y); - for I := 1 to Step do - begin - X := X + RX; - Y := Y + RY; - - PutPixel(X, Y); - end; -end; - procedure TSimbaImage.DrawPolygon(Points: TPointArray; Color: TColor); begin Self.DrawTPA(Points.Connect(), Color); @@ -1164,7 +1099,7 @@ procedure TSimbaImage.DrawHSLCircle(ACenter: TPoint; Radius: Integer); procedure TSimbaImage.Fill(Color: TColor); begin - FillDWord(FData[0], FWidth * FHeight, Color.ToBGRA().AsInteger); + FillData(@FData[0], FWidth * FHeight, Color.ToBGRA()); end; procedure TSimbaImage.Clear; @@ -1679,10 +1614,8 @@ function TSimbaImage.Convolute(Matrix: TDoubleMatrix): TSimbaImage; for YY := 0 to MatHeight do for XX := 0 to MatWidth do begin - CX := X+XX-MidX; - CY := Y+YY-MidY; - - EnsureInImage(CX, CY); + CX := EnsureRange(X+XX-MidX, 0, FWidth-1); + CY := EnsureRange(Y+YY-MidY, 0, FHeight-1); NewR += (Matrix[YY, XX] * SrcRows[CY, CX].R); NewG += (Matrix[YY, XX] * SrcRows[CY, CX].G); @@ -2001,24 +1934,27 @@ procedure TSimbaImage.DrawTextLines(Text: TStringArray; Position: TPoint; Color: procedure TSimbaImage.SetSize(NewWidth, NewHeight: Integer); var NewData: PColorBGRA; - i,minw,minh: Integer; + I, MinW, MinH: Integer; + Size: SizeInt; begin if (not FDataOwner) then SimbaException('TSimbaImage.SetSize: Cannot resize a image with external memory'); if (NewWidth <> FWidth) or (NewHeight <> FHeight) then begin - if NewWidth*NewHeight <> 0 then + if (NewWidth * NewHeight <> 0) then NewData := AllocMem(NewWidth * NewHeight * SizeOf(TColorBGRA)) else NewData := nil; - if Assigned(FData) and Assigned(NewData) and (FWidth*FHeight <> 0) then + if Assigned(FData) and Assigned(NewData) and (FWidth * FHeight <> 0) then begin - minw := Min(NewWidth,FWidth); - minh := Min(NewHeight,FHeight); - for i := 0 to minh - 1 do - Move(FData[i*FWidth],Newdata[i*NewWidth],minw * SizeOf(TColorBGRA)); + MinW := Min(NewWidth, FWidth); + MinH := Min(NewHeight, FHeight); + + Size := MinW * SizeOf(TColorBGRA); + for I := 0 to MinH - 1 do + Move(FData[I * FWidth], NewData[I * NewWidth], Size); end; if Assigned(FData) then FreeMem(FData); @@ -2309,26 +2245,27 @@ procedure TSimbaImage.Pad(Amount: Integer); Move(FData[Y * FWidth], FData[(Y + Amount) * FWidth + Amount], OldWidth * SizeOf(TColorBGRA)); // clear old pixels - if Y < Amount then - FillByte(FData[Y * FWidth], OldWidth * SizeOf(TColorBGRA), 0) + if (Y < Amount) then + FillData(@FData[Y * FWidth], OldWidth * SizeOf(TColorBGRA), TransparentRGB) else - FillByte(FData[Y * FWidth], Amount * SizeOf(TColorBGRA), 0); + FillData(@FData[Y * FWidth], Amount * SizeOf(TColorBGRA), TransparentRGB); end; end; procedure TSimbaImage._DrawBoxFilled(Box: TBox; Color: TColor); var + BGRA: TColorBGRA; Size: Integer; procedure _Row(const Y: Integer; X1, X2: Integer); inline; begin - FillDWord(FData[Y * FWidth + X1], Size, Color); + FillData(@FData[Y * FWidth + X1], Size, BGRA); end; {$i boxfilled.inc} begin - Color := Color.ToBGRA().AsInteger; // rgb to bgra + BGRA := Color.ToBGRA(); Size := (Box.X2 - Box.X1) + 1; _BoxFilled(Box); @@ -2415,6 +2352,8 @@ procedure TSimbaImage._DrawCircleFilledAlpha(ACenter: TPoint; Radius: Integer; C end; procedure TSimbaImage._DrawCircleFilled(ACenter: TPoint; Radius: Integer; Color: TColor); +var + BGRA: TColorBGRA; procedure _Row(const Y: Integer; X1, X2: Integer); inline; begin @@ -2423,14 +2362,14 @@ procedure TSimbaImage._DrawCircleFilled(ACenter: TPoint; Radius: Integer; Color: X1 := EnsureRange(X1, 0, FWidth - 1); X2 := EnsureRange(X2, 0, FWidth - 1); if ((X2 - X1) + 1 > 0) then - FillDWord(FData[Y * FWidth + X1], (X2 - X1) + 1, Color); + FillData(@FData[Y * FWidth + X1], (X2 - X1) + 1, BGRA); end; end; {$i circlefilled.inc} begin - Color := Color.ToBGRA().AsInteger; // rgb to bgra + BGRA := Color.ToBGRA(); // rgb to bgra _CircleFilled(ACenter.X, ACenter.Y, Radius); end; @@ -2444,25 +2383,23 @@ procedure TSimbaImage._DrawPolygonFilledAlpha(Points: TPointArray; Color: TColor Ptr: PColorBGRA; Upper: PtrUInt; begin - if (Y >= 0) and (Y < FHeight) then + // Y is already clipped in _PolygonFilled + X1 := EnsureRange(X1, 0, FWidth - 1); + X2 := EnsureRange(X2, 0, FWidth - 1); + + if ((X2 - X1) + 1 > 0) then begin - X1 := EnsureRange(X1, 0, FWidth - 1); - X2 := EnsureRange(X2, 0, FWidth - 1); + Ptr := @FData[Y * FWidth + X1]; + Upper := PtrUInt(Ptr) + ((X2 - X1) * SizeOf(TColorBGRA)); - if ((X2 - X1) + 1 > 0) then + while PtrUInt(Ptr) <= Upper do begin - Ptr := @FData[Y * FWidth + X1]; - Upper := PtrUInt(Ptr) + ((X2 - X1) * SizeOf(TColorBGRA)); + Ptr^.R := R + Ptr^.R * A shr 8; + Ptr^.G := G + Ptr^.G * A shr 8; + Ptr^.B := B + Ptr^.B * A shr 8; + Ptr^.A := Alpha; - while PtrUInt(Ptr) <= Upper do - begin - Ptr^.R := R + Ptr^.R * A shr 8; - Ptr^.G := G + Ptr^.G * A shr 8; - Ptr^.B := B + Ptr^.B * A shr 8; - Ptr^.A := Alpha; - - Inc(Ptr); - end; + Inc(Ptr); end; end; end; @@ -2479,22 +2416,23 @@ procedure TSimbaImage._DrawPolygonFilledAlpha(Points: TPointArray; Color: TColor end; procedure TSimbaImage._DrawPolygonFilled(Points: TPointArray; Color: TColor); +var + BGRA: TColorBGRA; procedure _Row(const Y: Integer; X1, X2: Integer); inline; begin - if (Y >= 0) and (Y < FHeight) then - begin - X1 := EnsureRange(X1, 0, FWidth - 1); - X2 := EnsureRange(X2, 0, FWidth - 1); - if ((X2 - X1) + 1 > 0) then - FillDWord(FData[Y * FWidth + X1], (X2 - X1) + 1, Color); - end; + // Y is already clipped in _PolygonFilled + X1 := EnsureRange(X1, 0, FWidth - 1); + X2 := EnsureRange(X2, 0, FWidth - 1); + + if ((X2 - X1) + 1 > 0) then + FillData(@FData[Y * FWidth + X1], (X2 - X1) + 1, BGRA); end; {$i polygonfilled.inc} begin - Color := Color.ToBGRA().AsInteger; // rgb to bgra + BGRA := Color.ToBGRA(); _PolygonFilled(Points, TRect.Create(0,0,FWidth-1,FHeight-1)); end; @@ -2537,15 +2475,6 @@ function TSimbaImage.InImage(const X, Y: Integer): Boolean; Result := (X >= 0) and (Y >= 0) and (X < FWidth) and (Y < FHeight); end; -procedure TSimbaImage.EnsureInImage(var X, Y: Integer); -begin - if (X < 0) then X := 0 - else if (X >= FWidth) then X := FWidth - 1; - - if (Y < 0) then Y := 0 - else if (Y >= FHeight) then Y := FHeight - 1; -end; - procedure TSimbaImage.AssertInImage(const Method: String; const X, Y: Integer); begin if (X < 0) or (Y < 0) or (X >= FWidth) or (Y >= FHeight) then @@ -2565,12 +2494,10 @@ function TSimbaImage.MatchTemplateMask(Template: TSimbaImage; Formula: ETMFormul procedure TSimbaImage.DrawLineAA(Start, Stop: TPoint; Color: TColor; Thickness: Single); procedure DoClearAlpha; - {$i clearpixelaa.inc} - {$DEFINE _SetPixelA := _ClearPixelA} - {$i drawlineaa.inc} - {$UNDEF _SetPixelA} + {$i clearpixelalpha.inc} + {$i lineantialias.inc} begin - _DrawLineAA( + _LineAntialias( Start.X, Start.Y, Stop.X, Stop.Y, Thickness @@ -2581,12 +2508,12 @@ procedure TSimbaImage.DrawLineAA(Start, Stop: TPoint; Color: TColor; Thickness: var BGRA: TColorBGRA; - {$i drawpixelaa.inc} - {$i drawlineaa.inc} + {$i setpixelantialias.inc} + {$i lineantialias.inc} begin BGRA := Color.ToBGRA(); - _DrawLineAA( + _LineAntialias( Start.X, Start.Y, Stop.X, Stop.Y, Thickness @@ -2601,12 +2528,10 @@ procedure TSimbaImage.DrawLineAA(Start, Stop: TPoint; Color: TColor; Thickness: procedure TSimbaImage.DrawEllipseAA(ACenter: TPoint; XRadius, YRadius: Integer; Color: TColor; Thickness: Single); procedure DoClearAlpha; - {$i clearpixelaa.inc} - {$DEFINE _SetPixelA := _ClearPixelA} - {$i drawellipseaa.inc} - {$UNDEF _SetPixelA} + {$i clearpixelalpha.inc} + {$i ellipseantialias.inc} begin - _DrawEllipseAA( + _EllipseAntialias( ACenter.X - XRadius, ACenter.Y - YRadius, ACenter.X + XRadius, ACenter.Y + YRadius, Thickness @@ -2617,12 +2542,12 @@ procedure TSimbaImage.DrawEllipseAA(ACenter: TPoint; XRadius, YRadius: Integer; var BGRA: TColorBGRA; - {$i drawpixelaa.inc} - {$i drawellipseaa.inc} + {$i setpixelantialias.inc} + {$i ellipseantialias.inc} begin BGRA := Color.ToBGRA(); - _DrawEllipseAA( + _EllipseAntialias( ACenter.X - XRadius, ACenter.Y - YRadius, ACenter.X + XRadius, ACenter.Y + YRadius, Thickness diff --git a/Source/image/simba.image_utils.pas b/Source/image/simba.image_utils.pas new file mode 100644 index 000000000..c3bce91bb --- /dev/null +++ b/Source/image/simba.image_utils.pas @@ -0,0 +1,145 @@ +unit simba.image_utils; + +{$i simba.inc} + +interface + +uses + Classes, SysUtils, + simba.mufasatypes; + +procedure FillData(Data: PColorBGRA; count: SizeInt; value: TColorBGRA); + +implementation + +// in FPC trunk +{$IFDEF CPUX86_64} +procedure FillXxxx_MoreThanTwoXmms; assembler; nostackframe; +{ Input: + rcx = 'x' + rdx = byte count + xmm0 = pattern for unaligned writes + xmm1 = pattern for aligned writes } +asm + { x can start and end misaligned on the vector boundary: + + x = ~~][H1][H2][...][T2][T1]~ + [UH] [UT] + + UH (“unaligned head”) potentially overlaps with H1 and is already written with 'movdqu' by the caller. + At least 1 of its bytes is exclusive to it, i.e. if x is already aligned, H1 starts at byte 16. + + H1 and so on are called “aligned heads” or just “heads”. + T1 and so on are called “aligned tails” or just “tails”. + + UT (“unaligned tail”) is written with another 'movdqu' after the loop. + At least 1 of its bytes is exclusive to it as well, that’s why 65 is subtracted below instead of 64. } + + lea -65(%rcx,%rdx), %r8 { r8 = end of x - 65, to get the loop bound and to write UT later (why not write it right away though...). } + and $-16, %rcx { align rcx to the LEFT (so needs to be offset by an additional +16 for a while). } + movdqa %xmm1, 16(%rcx) { Write H1. } + mov %r8, %rax + and $-16, %rax { rax = “T4” (possibly fictive) = aligned r8 = loop bound. } + cmp $49, %rdx { 33~49 bytes might contain 1~2 heads+tails; write as H1 and T1. } + jle .LOneAlignedTailWrite + movdqa %xmm1, 32(%rcx) { Write H2. } + cmp $81, %rdx { 50~81 bytes might contain 2~4 heads+tails; write as H1–2 and T2–1. } + jle .LTwoAlignedTailWrites + cmp $113, %rdx { 82~113 bytes might contain 4~6 heads+tails; write as H1–2 and T4–1. } + jle .LFourAlignedTailWrites + + add $48, %rcx + cmp $0x80000, %rdx + jae .L64xNT_Body + +.balign 16 +.L64x_Body: + movdqa %xmm1, (%rcx) + movdqa %xmm1, 16(%rcx) + movdqa %xmm1, 32(%rcx) + movdqa %xmm1, 48(%rcx) + add $64, %rcx + cmp %rax, %rcx + jb .L64x_Body + +.LFourAlignedTailWrites: + movdqa %xmm1, (%rax) { T4 } + movdqa %xmm1, 16(%rax) { T3 } +.LTwoAlignedTailWrites: + movdqa %xmm1, 32(%rax) { T2 } +.LOneAlignedTailWrite: + movdqa %xmm1, 48(%rax) { T1 } + movdqu %xmm0, 49(%r8) { UT } + ret + +.balign 16 +.L64xNT_Body: + movntdq %xmm1, (%rcx) + movntdq %xmm1, 16(%rcx) + movntdq %xmm1, 32(%rcx) + movntdq %xmm1, 48(%rcx) + add $64, %rcx + cmp %rax, %rcx + jb .L64xNT_Body + mfence + jmp .LFourAlignedTailWrites +end; + +procedure FillDWord(var x;count:SizeInt;value:DWord);assembler;nostackframe; +asm +{$ifdef win64} + mov %r8d, %eax +{$else} + mov %edx, %eax + mov %rsi, %rdx + mov %rdi, %rcx +{$endif win64} + + cmp $3, %rdx + jle .L3OrLess + cmp $8, %rdx + jle .L4to8 + + movd %eax, %xmm0 + pshufd $0, %xmm0, %xmm0 { xmm0 = pattern for unaligned writes } + movdqu %xmm0, (%rcx) + + shl $2, %rdx { rdx = byte count } + mov %rcx, %r8 + shl $3, %ecx + rol %cl, %eax { misalign the pattern by the misalignment of x } + mov %r8, %rcx + movd %eax, %xmm1 + pshufd $0, %xmm1, %xmm1 { xmm1 = pattern for aligned writes } + jmp FillXxxx_MoreThanTwoXmms + +.L4to8: +{$ifndef win64} { on win64, eax = r8d already. } + mov %eax, %r8d +{$endif} + shl $32, %r8 + or %r8, %rax + mov %rax, (%rcx) + mov %rax, 8(%rcx) + mov %rax, -16(%rcx,%rdx,4) + mov %rax, -8(%rcx,%rdx,4) + ret + +.L3OrLess: + test %rdx, %rdx + jle .LQuit + mov %eax, (%rcx) + mov %eax, -4(%rcx,%rdx,4) + shr $1, %edx + mov %eax, (%rcx,%rdx,4) +.LQuit: +end; +{$ENDIF} + +procedure FillData(Data: PColorBGRA; count: SizeInt; value: TColorBGRA); +begin + FillDWord(Data^, Count, DWord(Value)); +end; + +end. + diff --git a/Source/script/imports/simbaclasses/simba.import_class_image.pas b/Source/script/imports/simbaclasses/simba.import_class_image.pas index b35f5c0b3..d8f93ddc0 100644 --- a/Source/script/imports/simbaclasses/simba.import_class_image.pas +++ b/Source/script/imports/simbaclasses/simba.import_class_image.pas @@ -39,16 +39,6 @@ procedure _LapeImage_InImage(const Params: PParamArray; const Result: Pointer); PBoolean(Result)^ := PSimbaImage(Params^[0])^.InImage(PInteger(Params^[1])^, PInteger(Params^[2])^); end; -(* -TImage.EnsureInImage -~~~~~~~~~~~~~~~~~~~~ -> function TImage.EnsureInImage(var X, Y: Integer): Boolean; -*) -procedure _LapeImage_EnsureInImage(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - PSimbaImage(Params^[0])^.EnsureInImage(PInteger(Params^[1])^, PInteger(Params^[2])^); -end; - (* TImage.GetData ~~~~~~~~~~~~~~ @@ -584,16 +574,6 @@ procedure _LapeImage_DrawLine(const Params: PParamArray); LAPE_WRAPPER_CALLING_C PSimbaImage(Params^[0])^.DrawLine(PPoint(Params^[1])^, PPoint(Params^[2])^, PColor(Params^[3])^); end; -(* -TImage.DrawLine -~~~~~~~~~~~~~~~ -> procedure TImage.DrawLine(Start, Stop: TPoint; Thickness: Integer; Color: TColor); -*) -procedure _LapeImage_DrawLineEx(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV -begin - PSimbaImage(Params^[0])^.DrawLine(PPoint(Params^[1])^, PPoint(Params^[2])^, PInteger(Params^[3])^, PColor(Params^[4])^); -end; - (* TImage.DrawPolygon ~~~~~~~~~~~~~~~~~~ @@ -1355,7 +1335,6 @@ procedure ImportSimbaImage(Compiler: TSimbaScript_Compiler); addGlobalFunc('function TImage.LoadFonts(Dir: String): Boolean; static;', @_LapeImage_LoadFonts); addGlobalFunc('function TImage.InImage(X, Y: Integer): Boolean', @_LapeImage_InImage); - addGlobalFunc('procedure TImage.EnsureInImage(var X, Y: Integer)', @_LapeImage_EnsureInImage); addGlobalFunc('function TImage.Create: TImage; static; overload', @_LapeImage_Create); addGlobalFunc('function TImage.Create(Width, Height: Integer): TImage; static; overload', @_LapeImage_CreateEx); @@ -1389,8 +1368,7 @@ procedure ImportSimbaImage(Compiler: TSimbaScript_Compiler); addGlobalFunc('procedure TImage.DrawCrosshairs(ACenter: TPoint; Size: Integer; Color: TColor);', @_LapeImage_DrawCrosshairs); addGlobalFunc('procedure TImage.DrawCross(ACenter: TPoint; Radius: Integer; Color: TColor);', @_LapeImage_DrawCross); - addGlobalFunc('procedure TImage.DrawLine(Start, Stop: TPoint; Color: TColor); overload', @_LapeImage_DrawLine); - addGlobalFunc('procedure TImage.DrawLine(Start, Stop: TPoint; Thickness: Integer; Color: TColor); overload', @_LapeImage_DrawLineEx); + addGlobalFunc('procedure TImage.DrawLine(Start, Stop: TPoint; Color: TColor)', @_LapeImage_DrawLine); addGlobalFunc('procedure TImage.DrawPolygon(Points: TPointArray; Color: TColor);', @_LapeImage_DrawPolygon); addGlobalFunc('procedure TImage.DrawPolygonFilled(Points: TPointArray; Color: TColor; Alpha: Byte = 0);', @_LapeImage_DrawPolygonFilled);