From 0b503f8c58c67d4f0848a0ec4cc197e99786ff17 Mon Sep 17 00:00:00 2001 From: Raymond Date: Sun, 6 Feb 2011 19:54:29 +0100 Subject: [PATCH] Added few Gaussian related functions and ConvoluteMatrix for bitmaps :-). --- Projects/Simba/simbaunit.lfm | 23 +++++++++- Units/MMLAddon/PSInc/Wrappers/bitmap.inc | 8 ++++ Units/MMLAddon/PSInc/Wrappers/math.inc | 20 ++++++++ Units/MMLAddon/PSInc/psexportedmethods.inc | 5 ++ Units/MMLAddon/mmlpsthread.pas | 2 +- Units/MMLCore/bitmaps.pas | 51 +++++++++++++++++++++ Units/MMLCore/finder.pas | 10 +--- Units/MMLCore/mmath.pas | 53 +++++++++++++++++++++- Units/MMLCore/mufasatypes.pas | 1 + 9 files changed, 161 insertions(+), 12 deletions(-) diff --git a/Projects/Simba/simbaunit.lfm b/Projects/Simba/simbaunit.lfm index ad8a14e..51853ed 100644 --- a/Projects/Simba/simbaunit.lfm +++ b/Projects/Simba/simbaunit.lfm @@ -305,7 +305,6 @@ object SimbaForm: TSimbaForm Height = 19 Top = 7 Width = 16 - Color = clBtnFace Flat = True Glyph.Data = { 36090000424D3609000000000000360000002800000018000000180000000100 @@ -3324,10 +3323,21 @@ object SimbaForm: TSimbaForm end object SCARHighlighter: TSynPasSyn Enabled = False + AsmAttri.FrameEdges = sfeAround CommentAttri.Foreground = clGreen + CommentAttri.FrameEdges = sfeAround CommentAttri.Style = [] + IDEDirectiveAttri.FrameEdges = sfeAround + IdentifierAttri.FrameEdges = sfeAround + KeyAttri.FrameEdges = sfeAround NumberAttri.Foreground = clNavy + NumberAttri.FrameEdges = sfeAround + SpaceAttri.FrameEdges = sfeAround StringAttri.Foreground = clFuchsia + StringAttri.FrameEdges = sfeAround + SymbolAttri.FrameEdges = sfeAround + CaseLabelAttri.FrameEdges = sfeAround + DirectiveAttri.FrameEdges = sfeAround CompilerMode = pcmObjFPC NestedComments = False left = 568 @@ -3335,14 +3345,25 @@ object SimbaForm: TSimbaForm end object LazHighlighter: TSynPasSyn Enabled = False + AsmAttri.FrameEdges = sfeAround CommentAttri.Foreground = clBlue + CommentAttri.FrameEdges = sfeAround CommentAttri.Style = [fsBold] + IDEDirectiveAttri.FrameEdges = sfeAround IdentifierAttri.Foreground = clDefault + IdentifierAttri.FrameEdges = sfeAround + KeyAttri.FrameEdges = sfeAround NumberAttri.Foreground = clNavy + NumberAttri.FrameEdges = sfeAround + SpaceAttri.FrameEdges = sfeAround StringAttri.Foreground = clBlue + StringAttri.FrameEdges = sfeAround SymbolAttri.Foreground = clRed + SymbolAttri.FrameEdges = sfeAround + CaseLabelAttri.FrameEdges = sfeAround CaseLabelAttri.Style = [fsItalic] DirectiveAttri.Foreground = clRed + DirectiveAttri.FrameEdges = sfeAround DirectiveAttri.Style = [fsBold] CompilerMode = pcmObjFPC NestedComments = False diff --git a/Units/MMLAddon/PSInc/Wrappers/bitmap.inc b/Units/MMLAddon/PSInc/Wrappers/bitmap.inc index 6ee58b5..b6b568c 100644 --- a/Units/MMLAddon/PSInc/Wrappers/bitmap.inc +++ b/Units/MMLAddon/PSInc/Wrappers/bitmap.inc @@ -305,6 +305,14 @@ begin CurrThread.Client.MBitmaps[bitmap].FloodFill(startPoint,searchcol,replacecol); end; +function ps_ConvoluteBitmap(bitmap : integer; matrix : T2DExtendedArray) : integer; extdecl; +begin + with CurrThread.Client.MBitmaps do + begin + result := CreateBMP(0,0); + Bmp[bitmap].Convolute(Bmp[Result],matrix); + end; +end; function ps_CalculatePixelShift(Bmp1,Bmp2 : Integer; CompareBox : TBox) : integer;extdecl; begin with CurrThread.Client.MBitmaps do diff --git a/Units/MMLAddon/PSInc/Wrappers/math.inc b/Units/MMLAddon/PSInc/Wrappers/math.inc index b45a95e..07dc6c7 100644 --- a/Units/MMLAddon/PSInc/Wrappers/math.inc +++ b/Units/MMLAddon/PSInc/Wrappers/math.inc @@ -43,6 +43,26 @@ begin result := power(base,exponent); end; +function ps_RiemannGauss(Xstart,StepSize,Sigma : extended; AmountSteps : integer) : extended; extdecl; +begin + result := RiemannGauss(Xstart,StepSize,Sigma,AmountSteps); +end; + +function ps_DiscreteGauss(Xstart,Xend : integer; sigma : extended) : TExtendedArray; extdecl; +begin + result := DiscreteGauss(Xstart,Xend,Sigma); +end; + +function ps_GaussMatrix(N : integer; sigma : extended) : T2DExtendedArray; extdecl; +begin + result := GaussMatrix(N,sigma); +end; + +function ps_exp(exponent : extended) : extended; extdecl; +begin + result := exp(exponent); +end; + function ps_Max(a,b : integer) : integer; extdecl; begin result := max(a,b); diff --git a/Units/MMLAddon/PSInc/psexportedmethods.inc b/Units/MMLAddon/PSInc/psexportedmethods.inc index 123d759..59b2e19 100644 --- a/Units/MMLAddon/PSInc/psexportedmethods.inc +++ b/Units/MMLAddon/PSInc/psexportedmethods.inc @@ -57,6 +57,10 @@ AddFunction(@ps_round,'function Round(e:extended) : integer'); AddFunction(@ps_ceil,'function ceil(e : extended) : integer'); AddFunction(@ps_floor,'function floor(e : extended) : integer'); AddFunction(@ps_pow,'function pow(base,exponent : extended) : extended'); +AddFunction(@ps_exp,'function exp(exponent : extended) : extended'); +AddFunction(@ps_RiemannGauss,'function RiemannGauss(Xstart,StepSize,Sigma : extended; AmountSteps : integer) : extended;'); +AddFunction(@ps_DiscreteGauss,'function DiscreteGauss(Xstart,Xend : integer; sigma : extended) : TExtendedArray;'); +AddFunction(@ps_GaussMatrix,'function GaussMatrix(N : integer; sigma : extended) : T2DExtendedArray;'); AddFunction(@ps_max,'function Max(a, b: Integer): Integer;'); AddFunction(@ps_min,'function Min(a, b: Integer): Integer;'); AddFunction(@ps_minE,'function MinE(a, b: extended): Extended;'); @@ -416,6 +420,7 @@ AddFunction(@ps_DrawATPABitmapEx,'procedure DrawATPABitmapEx(bitmap: integer; AT AddFunction(@ps_DrawBitmap,'procedure DrawBitmap(Bmp: Integer; Dest: TCanvas; x, y: Integer);'); AddFunction(@ps_RectangleBitmap,'procedure RectangleBitmap(bitmap : integer; const box : TBox; Color : TColor);'); AddFunction(@ps_FloodfillBitmap,'procedure FloodFillBitmap(bitmap : integer; const StartPoint : TPoint; const SearchCol,ReplaceCol : TColor);'); +AddFunction(@ps_ConvoluteBitmap,'function ConvoluteBitmap(bitmap : integer; matrix : T2DExtendedArray) : integer;'); AddFunction(@ps_CalculatePixelShift,'function CalculatePixelShift(Bmp1,Bmp2 : Integer; CompareBox : TBox) : integer;'); AddFunction(@ps_CalculatePixelTolerance,'function CalculatePixelTolerance(Bmp1,Bmp2 : Integer; CompareBox : TBox; CTS : integer) : extended;'); {$ENDIF} diff --git a/Units/MMLAddon/mmlpsthread.pas b/Units/MMLAddon/mmlpsthread.pas index 2910763..6b9ecee 100644 --- a/Units/MMLAddon/mmlpsthread.pas +++ b/Units/MMLAddon/mmlpsthread.pas @@ -24,7 +24,7 @@ unit mmlpsthread; {$Define PS_USESSUPPORT} - +{$define USE_RUTIS} {$mode objfpc}{$H+} interface diff --git a/Units/MMLCore/bitmaps.pas b/Units/MMLCore/bitmaps.pas index 5a02ae4..335550f 100644 --- a/Units/MMLCore/bitmaps.pas +++ b/Units/MMLCore/bitmaps.pas @@ -82,10 +82,12 @@ type procedure Invert;overload; procedure Posterize(TargetBitmap : TMufasaBitmap; Po : integer);overload; procedure Posterize(Po : integer);overload; + procedure Convolute(TargetBitmap : TMufasaBitmap; Matrix : T2DExtendedArray); function Copy(const xs,ys,xe,ye : integer) : TMufasaBitmap; overload; function Copy: TMufasaBitmap;overload; function ToTBitmap: TBitmap; function ToString : string; + function RowPtrs : TPRGB32Array; procedure LoadFromTBitmap(bmp: TBitmap); procedure LoadFromRawImage(RawImage: TRawImage); function CreateTMask : TMask; @@ -640,6 +642,15 @@ begin end; end; +function TMufasaBitmap.RowPtrs: TPRGB32Array; +var + I : integer; +begin; + setlength(result,h); + for i := 0 to h - 1 do + result[i] := FData + w * i; +end; + procedure TMufasaBitmap.LoadFromRawImage(RawImage: TRawImage); var @@ -1276,6 +1287,46 @@ begin end; end; +procedure TMufasaBitmap.Convolute(TargetBitmap : TMufasaBitmap; Matrix: T2DExtendedArray); +var + x,y,xx,yy : integer; + mw,mh : integer; //Matrix-Width/Matrix-height; + Row,RowT : TPRGB32Array; + R,G,B : extended; + midX,midY : integer; + xmax,ymax : integer; +begin + mw := Length(Matrix); + mh := Length(Matrix[0]); + if ((mw mod 2) = 0) or ((mh mod 2) = 0) then + exit; + TargetBitmap.SetSize(w,h); + Row := RowPtrs; + RowT := TargetBitmap.RowPtrs; //Target + midX := mw div 2; + midY := mh div 2; + xmax := w-1-midX; + ymax := h-1-midY; + dec(mw); dec(mh); //Faster in loop. + for x := midx to xmax do + for y := midy to ymax do + begin + R := 0; + G := 0; + B := 0; + for xx := mw downto 0 do // for xx := x - midx to x + midx do + for yy := mh downto 0 do + begin + r := r + Row[y+yy-midy][x+xx-midx].r * Matrix[xx][yy]; + g := g + Row[y+yy-midy][x+xx-midx].g * Matrix[xx][yy]; + b := b + Row[y+yy-midy][x+xx-midx].b * Matrix[xx][yy]; + end; + RowT[y][x].r := round(r); + RowT[y][x].g := round(g); + RowT[y][x].b := round(b); + end; +end; + function TMufasaBitmap.CreateTMask: TMask; var x,y : integer; diff --git a/Units/MMLCore/finder.pas b/Units/MMLCore/finder.pas index 7de3bad..9dcefbf 100644 --- a/Units/MMLCore/finder.pas +++ b/Units/MMLCore/finder.pas @@ -108,8 +108,6 @@ uses tpa, //TPABounds dtmutil ; -type - TPRGB32Array = array of PRGB32; procedure TMFinder.LoadSpiralPath(startX, startY, x1, y1, x2, y2: Integer); var @@ -175,12 +173,8 @@ begin; end; function CalculateRowPtrs(Bitmap : TMufasaBitmap) : TPRGB32Array;overload; -var - I : integer; -begin; - setlength(result,Bitmap.Height); - for i := 0 to Bitmap.Height - 1 do - result[i] := Bitmap.FData + Bitmap.Width * i; +begin + Result := Bitmap.RowPtrs; end; //SkipCoords[y][x] = False/True; True means its "transparent" and therefore not needed to be checked. procedure CalculateBitmapSkipCoords(Bitmap : TMufasaBitmap; out SkipCoords : T2DBoolArray); diff --git a/Units/MMLCore/mmath.pas b/Units/MMLCore/mmath.pas index f29fa46..4a89f74 100644 --- a/Units/MMLCore/mmath.pas +++ b/Units/MMLCore/mmath.pas @@ -35,10 +35,60 @@ function RotatePoints(const P: TPointArray;const A, cx, cy: Extended): TPointArr function RotatePoint(const p: TPoint;const angle, mx, my: Extended): TPoint; function ChangeDistPT(const PT : TPoint; mx,my : integer; newdist : extended) : TPoint; function ChangeDistTPA(var TPA : TPointArray; mx,my : integer; newdist : extended) : boolean; - +function RiemannGauss(Xstart,StepSize,Sigma : extended; AmountSteps : integer) : extended; +function DiscreteGauss(Xstart,Xend : integer; sigma : extended) : TExtendedArray; +function GaussMatrix(N : integer; sigma : extended) : T2DExtendedArray; implementation uses math; +{/\ + Returns a GaussianMatrix with size of X*X, where X is Nth odd-number. +/\} +function GaussMatrix(N : integer; sigma : extended) : T2DExtendedArray; +var + x,y,mid : integer; + Val : TExtendedArray; +begin + N := N * 2- 1; + SetLength(Result,N); + for x := 0 to n-1 do + Setlength(result[x],N); + mid := n div 2; + Val := DiscreteGauss(-mid,mid,sigma); + for x := 0 to n-1 do + for y := 0 to n-1 do + Result[x][y] := Val[x] * Val[y]; +end; + +{/\ + Returns the discrete Gaussian values, uses RiemanGauss with 100 steps. +/\} +function DiscreteGauss(Xstart,Xend : integer; sigma : extended) : TExtendedArray; +var + i : integer; +begin + setlength(Result,Xend-xstart+1); + for i := xstart to xend do + result[i-xstart] := RiemannGauss(i-0.5,0.01,Sigma,100); +end; + +{/\ + RiemannGauss integrates the Gaussian function using the Riemann method. +/\} +function RiemannGauss(Xstart,StepSize,Sigma : extended; AmountSteps : integer) : extended; +var + i : integer; + x : extended; +begin + result := 0; + x := xstart - 0.5 * stepsize; + for i := 1 to AmountSteps do + begin + x := x + stepsize; //Get the middle value + result := Result + exp(-x*x/(2*sigma*sigma)); //Better accuracy to do the sig^2 here? + end; + result := result * stepsize * 1 / (Sqrt(2 * pi) * sigma); +end; {/\ Rotates the given points (P) by A (in radians) around the point defined by cx, cy. @@ -98,7 +148,6 @@ begin except result := false; end; - end; end. diff --git a/Units/MMLCore/mufasatypes.pas b/Units/MMLCore/mufasatypes.pas index 7580d0b..ef1adea 100644 --- a/Units/MMLCore/mufasatypes.pas +++ b/Units/MMLCore/mufasatypes.pas @@ -58,6 +58,7 @@ type end; PRGB32 = ^TRGB32; TRGB32Array = array of TRGB32; + TPRGB32Array = array of PRGB32; //Array of Pointers TRetData = record Ptr : PRGB32;