From dd3d202b44e9560cc609d8bdbabf7cce55b5a4b4 Mon Sep 17 00:00:00 2001 From: Raymond Date: Tue, 20 Oct 2009 19:48:18 +0000 Subject: [PATCH] Bitmap masks added. Little mistake in the RowCalcs, fixed it. RetData now also has a RowLen property. Added Paths (ScriptPath / AppPath); git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@143 3f818213-9676-44b0-a9b4-5e4c4e03d09d --- Projects/SAMufasaGUI/testunit.lrs | 2 + Projects/SAMufasaGUI/testunit.pas | 43 +++++----- Tests/PS/BmpTest.mufa | 77 ++++++++++++++++++ Tests/PS/MaskTest.mufa | 22 ++++++ Tests/PS/PathTest.mufa | 5 ++ Units/MMLAddon/PSInc/Wrappers/bitmap.inc | 16 ++++ Units/MMLAddon/PSInc/pscompile.inc | 6 ++ Units/MMLAddon/mmlpsthread.pas | 9 +++ Units/MMLCore/bitmaps.pas | 39 +++++++++- Units/MMLCore/finder.pas | 99 ++++++++++++++++++++++-- Units/MMLCore/mufasatypes.pas | 10 ++- Units/MMLCore/window.pas | 5 ++ 12 files changed, 302 insertions(+), 31 deletions(-) create mode 100644 Tests/PS/BmpTest.mufa create mode 100644 Tests/PS/MaskTest.mufa create mode 100644 Tests/PS/PathTest.mufa diff --git a/Projects/SAMufasaGUI/testunit.lrs b/Projects/SAMufasaGUI/testunit.lrs index 3c9f50c..551608d 100644 --- a/Projects/SAMufasaGUI/testunit.lrs +++ b/Projects/SAMufasaGUI/testunit.lrs @@ -1,3 +1,5 @@ +{ This is an automatically generated lazarus resource file } + LazarusResources.Add('TForm1','FORMDATA',[ 'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#207#0#6'Height'#3')'#2#3'Top'#3#196#0#5'W' +'idth'#3#211#2#13'ActiveControl'#7#8'SynEdit1'#7'Caption'#6#9'Mufasa v2'#12 diff --git a/Projects/SAMufasaGUI/testunit.pas b/Projects/SAMufasaGUI/testunit.pas index 422c6d8..3e95706 100644 --- a/Projects/SAMufasaGUI/testunit.pas +++ b/Projects/SAMufasaGUI/testunit.pas @@ -23,7 +23,7 @@ unit TestUnit; -{$Undefine ProcessMessages} //Define this for processmessages in ThreadSafeCall +{$Undef ProcessMessages} //Define this for processmessages in ThreadSafeCall {$mode objfpc}{$H+} interface @@ -100,7 +100,7 @@ type procedure ToTray(Sender: TObject); procedure Undo(Sender: TObject); private - ScriptPath : string;//The path to the saved/opened file currently in the SynEdit + ScriptFile : string;//The path to the saved/opened file currently in the SynEdit StartText : string;//The text synedit holds upon start/open/save ScriptName : string;//The name of the currently opened/saved file. ScriptDefault : string;//The default script e.g. program new; begin end. @@ -115,11 +115,13 @@ type function SaveCurrentScriptAs : boolean; function CanExitOrOpen : boolean; function ClearScript : boolean; + procedure run; end; const WindowTitle = 'Mufasa v2 - %s';//Title, where %s = the place of the filename. var Form1: TForm1; + MainDir : string; CurrentSyncInfo : TSyncInfo;//We need this for SafeCallThread implementation @@ -128,20 +130,23 @@ uses -{ TForm1 } -procedure Run; +procedure TForm1.Run; Var MMLPSThread : TMMLPSThread; begin - CurrentSyncInfo.SyncMethod:= @Form1.SafeCallThread; + CurrentSyncInfo.SyncMethod:= @Self.SafeCallThread; MMLPSThread := TMMLPSThread.Create(True,@CurrentSyncInfo); - MMLPSThread.SetPSScript(Form1.SynEdit1.Lines.Text); - MMLPSThread.SetDebug(Form1.Memo1); + MMLPSThread.SetPSScript(Self.SynEdit1.Lines.Text); + MMLPSThread.SetDebug(Self.Memo1); + if ScriptFile <> '' then + MMLPSThread.SetPaths( ExtractFileDir(ScriptFile) + DS,MainDir +DS) + else + MMLPSThread.SetPaths('',MainDir + DS); // This doesn't actually set the Client's MWindow to the passed window, it // only copies the current set window handle. - MMLPSThread.Client.MWindow.SetWindow(Form1.Window); + MMLPSThread.Client.MWindow.SetWindow(Self.Window); MMLPSThread.Resume; @@ -330,9 +335,9 @@ begin; StartText := SynEdit1.Lines.text; ScriptName:= ExtractFileNameOnly(FileName); WriteLn('Script name will be: ' + ScriptName); - ScriptPath:= FileName; + ScriptFile:= FileName; StatusBar.Panels[0].Text:= ScriptName; - StatusBar.Panels[1].text:= ScriptPath; + StatusBar.Panels[1].text:= FileName; Self.Caption:= Format(WindowTitle,[ScriptName]); ScriptChanged := false; Result := True; @@ -344,11 +349,11 @@ end; function TForm1.SaveCurrentScript: boolean; begin - Result := (ScriptPath <> ''); + Result := (ScriptFile <> ''); if Result then begin; ScriptChanged := false; - SynEdit1.Lines.SaveToFile(ScriptPath); + SynEdit1.Lines.SaveToFile(ScriptFile); StartText:= SynEdit1.Lines.Text; end else @@ -365,13 +370,13 @@ begin begin; if ExtractFileExt(FileName) = '' then begin; - ScriptPath := FileName + '.mufa'; + ScriptFile := FileName + '.mufa'; end else - ScriptPath := FileName; - SynEdit1.Lines.SaveToFile(ScriptPath); - ScriptName:= ExtractFileNameOnly(ScriptPath); + ScriptFile := FileName; + SynEdit1.Lines.SaveToFile(ScriptFile); + ScriptName:= ExtractFileNameOnly(ScriptFile); StatusBar.Panels[0].Text:= ScriptName; - StatusBar.Panels[1].text := ScriptPath; + StatusBar.Panels[1].text := ScriptFile; Self.Caption:= Format(WindowTitle,[ScriptName]); WriteLn('Script name will be: ' + ScriptName); Result := True; @@ -381,7 +386,7 @@ begin end; if result then begin; - Writeln('Succesfully saved: ' + ScriptPath); + Writeln('Succesfully saved: ' + ScriptFile); StartText:= SynEdit1.Lines.Text; SynEdit1.MarkTextAsSaved; ScriptChanged := false; @@ -405,7 +410,7 @@ function TForm1.ClearScript: boolean; begin if CanExitOrOpen then begin; - ScriptPath:= ''; + ScriptFile:= ''; ScriptName:= 'Untitled'; StartText:= ScriptDefault; SynEdit1.Lines.Text:= ScriptDefault; diff --git a/Tests/PS/BmpTest.mufa b/Tests/PS/BmpTest.mufa new file mode 100644 index 0000000..e68871f --- /dev/null +++ b/Tests/PS/BmpTest.mufa @@ -0,0 +1,77 @@ +program new; +//http://www.hawaiisunshine.org/wp-content/uploads/2008/12/sunshine1.jpg +var + Bmp : integer; + x,y : integer; + w,h : integer; +begin + Bmp := BitmapFromString(37, 32, 'beNqFl3lwVuUVxp93veu3f1' + + 'lI+EKCLCkIAuI6oIBl0ylWweJerSm2atAaUJYgZCMLBAKyTSAh+w4' + + 'ERKnUpWoXERSBjtailDVACLS17Tj+13NvpB3tTHvnzOTOzb3vL+c5' + + 'azIGaIDMYMwQ3BBSkSkD4J4xCa4gNKQBZTClTS5tMBNQgAAY6C3mG' + + 'cN/zP/Wf0o3373oK0mfM8/E1UMMAa0YmZKQ4pvz6DUHzAJM3wwmpH' + + '/6t1j/D3f1He/Xyj/HFQgzhIEQEAHiQDIwAEjzbrjrQX2c7yNJwDn' + + '/5vh+Tb5l/3Vx77mhdFDLEEMMSPdtMDAGmMAwXWOWxWfb4s6APT4a' + + 'S5iBCDgRLT8KnjhcEJEJIgvP/ieOccPgZpDrsO/FIGAUcI8TeMwJP' + + 'heOLI/FVkZj5YFAuWEscANTw8lDnEgcMgQeBDd9hQXjQggu6ack+z' + + 'b0u5enHpAEZADXA3MDwSWZgwtSB5aG4+VmoBxGOfgqYC2wVNrjIaJ' + + 'gQV/nKBdh7rnpMPKUecnGhCI044xdzZ9+5tV40ZXMPenIo/ujumRk' + + '5oahA1cHCIEqsCqINZCV3Fpjhsp08CnDHe5RVAw86oeVLOoHN8W/T' + + '+YywpWnMPfj2h/d/iTm3xBHAHcHUDT2mi3jrqmISgJVK2yXvFbqjd' + + 'ysYGah4S5xQ08b1t1CDZMi4COygKHANcBYYHbmwEUzpg33JUoSgiB' + + 'aCWFKP+P75ca/U3j9iOH7pk2pHpRaAmwSaHJ0NbCRnkuxynFXhEN5' + + 'SbHHosGpEsN9FzJtjBYYDcwCirPSm267pWbSLQuGDxrXn7rKO57O5' + + 'dqyAuGrGeuB/CrjHZmZG6TYANQL3qpEE9g2YJvQa4ReBPYT4IfAFD' + + '+sQ/34kl93Glg1etBrk8Z1j8hYb2MpkGfh8RCboL1kiynpWK6fuRa' + + 'D5lDcq2mvfMnaQnaj4g0AWSPQDNYIVSusddJ+ial5wA+AicANPnEa' + + 'R/61SR3Tx+y+dXBnltGditfT+asJ/Up2rOumYQsTkZFAKqmtXC8Bj' + + 'TiDzWFyD6p9KN8C1ADthuwyDWI1gDfB2OQJa20IRMqD4YWWkcNxP/' + + 'AghfW6RNvYAV3XxbqGGjvT8Uoy9sWxN4LuKHYPjuy8YcSiRNpNnqr' + + 'U+Dwih61AUfRwXt9iYksImy1slqiVvNV0W5TTCN0s3QZt15r2Jq2r' + + 'tFxrmRuToo2J+GuDgntTsSMV3ZnYl403RuLd7+H9bH1omLsngpaYU' + + '2xbpMa1XgkrB5YFbVLieKnqFyNnm4LYFlI1rrFV6Rqu67nRLO1WaT' + + 'UKUcdQyyiOaHB4V2rwjczIwSzzyBB5cKTxu9HGW9epX13L9w/Bmxn' + + 'YH8EuEw0C9LctCUTvZeYQIAFGNRL2mx6lK/PTZZuFelc32FY1RL2y' + + 'Opxwo9KtpqwXaLVRw9EewtvZgXdGhI7cmPLJGPvoSHZsvHtonLsvC' + + '3sHYV9CdATRotDAUc1QpTg5+LwVeFhY06GvB0v4zSrsdzxK0AaFRi' + + 'VJxiZltxgu3Wynhxo7Y6gWaIvi9+OtD28N/mFy0rHbQ0dvlp9OtA6' + + 'M5m8Nwfujo+9lx7tjssNlDRLbODYxrBMoN8VyQy+Uep7QD7uhmZY9' + + '0bFH2TrKvBpp9Ux0SqddOp6MhtFgojMJNQ5aUnFkWuCTWeHDM8zj9' + + 'yV/MFUemi4/nGq9c714e4T1wai0NwdGWzij2qlnbCvDyxxrBCoUVi' + + 'oUKpGv9S9Md54TfiASnRx0MihNgU6OLq7aBaWlbhSq3VWdcTTFURv' + + 'FRzPNM48nfzLH/GyudXS2PnAXfjMDb07EgcmhwxPS96W7LZwKR20H' + + 'q4PaygTh1nKUMawkAwo5WwDkcvNR05miJI0Y6khdFu+0dLMWJGmTJ' + + 'ZuDaI5jWxgfTTMv5Aw4di+OPyRPPeES6+hs/s4d+O33xcczUt8dG2' + + '20vApqFW4DrBrwanAqnyoGaoPFQBFQwHg+RJ60HxHqNmpHAPX2Nhf' + + '0IQnYEjCagtgeQEMc799u9s7LOPlj5/ij7OQT+sgckB27j308S5x8' + + 'MHHwtkhzCHUSrVJR1dTB2NLf95gn5iqGUoYSqEKmXxLmAsP9Edh4v' + + 'yPRHGlwsN0CgVqisi6E1nT8+mbz77mje3KSTzyuLueFT+Sww3Pw5x' + + 'zj0wdkz2MpX8yKv56FOk5+oY1zcrAabCPlJEeFRKn0WKXQpbCL4OZ' + + 'B/cy0ZgLZ/tRwOSMcsTpSjLYUTvF6fRy/kjvy/FNpPU8Hr7wY+/xJ' + + 'fJaDSy+ETj9jnvpp4G9PZu8fhjqNLgcdCnXUacFqhNoo2RrKEIEij' + + 'kJPTFkCawXsZxnPsa07GM/yaoFpqbrjRnOAt8RY5yDszMb5nw+8mB' + + 'c785w+MR+nntdfzBe9S8PHn8YXubi8IOXAJLc7Dc022ilvJSNWLcR' + + 'mkhFYTU5xFAsUS1GidLEw86V+VuMhjQngaV7NKSizM8DbQ6otiXVk' + + '4eN73MsvppxZyE++gLP54vM8nF8WOLlAnV9sn1moz82PvzoCHTFeb' + + '6DZZNR2SMmtEFvA14Othp+T3MNRFazgaonk8w08aOAmyBRv/hg0ll' + + 'ps7Egy25LRORSXnx98eVmkn9Vb5J5cLC4VBk7koe+l0KUl8cNzDKr' + + 'EtoifWtRGpIcj1zYzsY68A8o5SgVKhCgSvAByMeO5ms3VfIw/8Q1O' + + 'iyQ6w+hON5oHYP8t+HJZRu8yeXY5egr1uQLrQoF9Zom8sFReWGRfX' + + 'pixewwaY9gRl5TMdQJ1Smxl7GVgAxhtMpUMFQJlHpEVgxeCLwbLVf' + + 'JeybP9BSAgJE3nPenoTAMp+dmjQfLiYhEuluNsiTqzwuwpNM/ms8s' + + 'rjCuLw6dz0uoHoD2GPclWm8Opl24nnCAZaavBGsJxD0fmVwEv8nCC' + + 'Vo47ucjqX6X8WtiTgdYB+OWN5FriUqE6vxI9FThVzM6V2KeXo6/Yu' + + 'LLc+Ud+4uA0pykZXXHsDMtmE9sYtgpsFp6MhFvrV1ylj6sA4TwHl8' + + 'J4yg5OBhvo40hPGr67MrF3FP74kPPP0uS+Mpwtw6lSnC7DuTJ1vlh' + + 'cKjC+XB7tm5+2ezi6UrArKjqoSA1s12yTn5DrOa/irNLvlmSruYcr' + + 'BSuDXMasHCdyo19xUX9VnsSwKxsf3IWvChJ/WWn0VXqgUyTmKpwpw' + + 'V8rndML8XXB4D/NjdRT1JJVd1S3GWixZKOjN/gaVknRD1pLpSf8CF' + + 'KKghMuXwYecbx1gja0VO6tOvcZ4r0p6FuQ9HVFvHel59qFtR7rdDn' + + '61grKmUtLA725CYpsawy7U+2dAfKO1SlUc6//V/lOkWs05ip9SdcJ' + + 'bwf2cMxcZATuD8dp3qULkJ60vD0TC/XkZnxVmtJbiIskYDlOFuN8J' + + 'etZjd5V6FmGvkVJh+6ym1PQSgtJ3Njh0mTktcIbbV6G+E4Ra4Pma/' + + 'xNm4T1vGOqVNp5ZnCashLeWPf+47gnwIv/BWSck+g='); + GetClientDimensions(w,h); + if FindBitmapToleranceIn(bmp,x,y,0,0,w-1,h-1,25) then + MoveMouse(x,y); +end. diff --git a/Tests/PS/MaskTest.mufa b/Tests/PS/MaskTest.mufa new file mode 100644 index 0000000..79db52e --- /dev/null +++ b/Tests/PS/MaskTest.mufa @@ -0,0 +1,22 @@ +program new; +//http://nl.wikipedia.org/wiki/Lily_Allen + +var + Bmp : integer; + Mask : TMask; + x,y : integer; + i, ii : integer; + w,h : integer; +begin + Bmp := BitmapFromString(107, 19, 'beNrtVkEOgCAM8/+fxoOJUYG' + + 'uWwZKbE9KtmYrHbBtgiAIgpCOckFiopdtZr/j2HhynBjYjmntJxaW' + + '6BwJWC8eH6QU15gz0Zx9vFgX0Iwhs0CASRUW8CFmioB1JFisA5qRI' + + 'KvJQNKa5mEcyAhoauI6N8ymAlkxWpdtwgL2bhPXCJc7+E7JLNJsgG' + + 'qQgL1jhHwX4VJdBsNZMbN5D//m/ob5XzwDp40wfg/jW9g024hbuPd' + + 'ritabVqaAj7zYVyxg9fol4M8FFG7YAfIG00k='); + Mask := CreateBitmapMask(Bmp); + GetClientDimensions(w,h); +// if FindBitmapMaskTolerance(Bmp,x,y,0, 0,w-1, h-1,1,5) then + if FindMaskTolerance(Mask,x,y,0, 0,w-1, h-1,1,5) then + MoveMouse(x,y); +end. diff --git a/Tests/PS/PathTest.mufa b/Tests/PS/PathTest.mufa new file mode 100644 index 0000000..415b1b3 --- /dev/null +++ b/Tests/PS/PathTest.mufa @@ -0,0 +1,5 @@ +program new; +begin + Writeln(AppPath); + Writeln(ScriptPath); +end. diff --git a/Units/MMLAddon/PSInc/Wrappers/bitmap.inc b/Units/MMLAddon/PSInc/Wrappers/bitmap.inc index bd20e64..9638f92 100644 --- a/Units/MMLAddon/PSInc/Wrappers/bitmap.inc +++ b/Units/MMLAddon/PSInc/Wrappers/bitmap.inc @@ -231,3 +231,19 @@ begin; Bmp[bitmap].Posterize(Bmp[result],po); end; end; +function CreateBitmapMask(Bitmap : integer) : TMask; +begin; + result := CurrThread.Client.MBitmaps.Bmp[Bitmap].CreateTMask; +end; + +function FindMaskTolerance(mask: TMask; var x, y: Integer; xs,ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean; +begin; + result := CurrThread.Client.MFinder.FindBitmapMaskTolerance(Mask,x,y,xs,ys,xe,ye,tolerance,contourtolerance); +end; +function FindBitmapMaskTolerance(mask: Integer; var x, y: Integer; xs, ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean; +begin; + Writeln('Better be using FindMaskTolerance in combination with CreateBitmapMask, more efficient.'); + with CurrThread.Client do + result := MFinder.FindBitmapMaskTolerance(MBitmaps.bmp[mask].CreateTMask,x,y,xs,ys,xe,ye,tolerance,contourtolerance); +end; + diff --git a/Units/MMLAddon/PSInc/pscompile.inc b/Units/MMLAddon/PSInc/pscompile.inc index 5c53d3b..ddfed00 100644 --- a/Units/MMLAddon/PSInc/pscompile.inc +++ b/Units/MMLAddon/PSInc/pscompile.inc @@ -21,9 +21,12 @@ PSCompile.inc for the Mufasa Macro Library } +Sender.Comp.AddConstantN('AppPath','string').SetString(CurrThread.AppPath); +Sender.Comp.AddConstantN('ScriptPath','string').SetString(CurrThread.ScriptPath); Sender.Comp.AddTypeS('TIntegerArray', 'Array of integer'); Sender.Comp.AddTypeS('TPointArray','Array of TPoint'); Sender.Comp.AddTypeS('TBmpMirrorStyle','(MirrorWidth,MirrorHeight,MirrorLine)'); +Sender.Comp.AddTypeS('TMask','record White, Black : TPointArray; WhiteHi,BlackHi : integer; W,H : integer;end;'); Sender.Comp.AddTypes('TDTMPointDef', 'record x, y, Color, Tolerance, AreaSize, AreaShape: integer; end;'); @@ -127,3 +130,6 @@ Sender.AddFunction(@GreyScaleBitmap,'function GreyScaleBitmap(bitmap : integer) Sender.AddFunction(@BrightnessBitmap,'function BrightnessBitmap(Bitmap,br : integer) : integer;'); Sender.AddFunction(@ContrastBitmap,'function ContrastBitmap(bitmap : integer; co : extended) : integer;'); Sender.AddFunction(@PosterizeBitmap,'function PosterizeBitmap(Bitmap : integer; po : integer) : integer;'); +Sender.AddFunction(@CreateBitmapMask,'function CreateBitmapMask(Bitmap : integer) : TMask;'); +Sender.AddFunction(@FindMaskTolerance,'function FindMaskTolerance(mask: TMask; var x, y: Integer; xs,ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;'); +Sender.AddFunction(@FindBitmapMaskTolerance,'function FindBitmapMaskTolerance(mask: Integer; var x, y: Integer; xs, ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean;'); diff --git a/Units/MMLAddon/mmlpsthread.pas b/Units/MMLAddon/mmlpsthread.pas index b99b3a0..e90da05 100644 --- a/Units/MMLAddon/mmlpsthread.pas +++ b/Units/MMLAddon/mmlpsthread.pas @@ -47,6 +47,8 @@ type procedure PSScriptProcessUnknowDirective(Sender: TPSPreProcessor; Parser: TPSPascalPreProcessorParser; const Active: Boolean; const DirectiveName, DirectiveParam: string; var Continue: Boolean); + private + ScriptPath, AppPath : string; protected DebugTo : TMemo; PluginsToload : Array of integer; @@ -65,6 +67,7 @@ type SyncInfo : PSyncInfo; //We need this for callthreadsafe procedure SetPSScript(Script : string); procedure SetDebug( Strings : TMemo ); + procedure SetPaths(ScriptP,AppP : string); constructor Create(CreateSuspended: Boolean; TheSyncInfo : PSyncInfo); destructor Destroy; override; end; @@ -315,6 +318,12 @@ begin DebugTo := Strings; end; +procedure TMMLPSThread.SetPaths(ScriptP, AppP: string); +begin + AppPath:= AppP; + ScriptPath:= ScriptP; +end; + { Include stuff here? } diff --git a/Units/MMLCore/bitmaps.pas b/Units/MMLCore/bitmaps.pas index be9a6ad..5e37176 100644 --- a/Units/MMLCore/bitmaps.pas +++ b/Units/MMLCore/bitmaps.pas @@ -71,6 +71,7 @@ type procedure Invert; procedure Posterize(TargetBitmap : TMufasaBitmap; Po : integer);overload; procedure Posterize(Po : integer);overload; + function CreateTMask : TMask; constructor Create; destructor Destroy;override; end; @@ -475,10 +476,8 @@ var PtrRet : TRetData; Rows : integer; begin - Self.ValidatePoint(xs,ys); - Self.ValidatePoint(xe,ye); - wi := xe-xs + 1; - hi := ye-ys + 1; + wi := Min(xe-xs + 1,Self.w); + hi := Min(ye-ys + 1,Self.h); PtrRet := TMWindow(MWindow).ReturnData(xs,ys,wi,hi); for y := 0 to (hi-1) do Move(PtrRet.Ptr[y * (wi + PtrRet.IncPtrWith)], FData[y * self.w],wi * SizeOf(TRGB32)); @@ -754,6 +753,38 @@ begin end; end; +function TMufasaBitmap.CreateTMask: TMask; +var + x,y : integer; + dX,dY : integer; +begin + Result.BlackHi:= -1; + Result.WhiteHi:= -1; + Result.W := Self.Width; + Result.H := Self.Height; + SetLength(result.Black,w*h); + SetLength(result.White,w*h); + dX := w-1; + dY := h-1; + //Search it like | | | | | instead of horizontal -> for X loop first. + for x := 0 to dX do + for y := 0 to dY do + //Check for non-white/black pixels? Not for now atleast. + if FData[y*w+x].r = 255 then + begin; + inc(Result.WhiteHi); + Result.White[Result.WhiteHi].x := x; + Result.White[Result.WhiteHi].y := y; + end else + begin; + inc(Result.BlackHi); + Result.Black[Result.BlackHi].x := x; + Result.Black[Result.BlackHi].y := y; + end; + SetLength(result.Black,Result.BlackHi+1); + SetLength(result.White,Result.WhiteHi+1); +end; + constructor TMBitmaps.Create(Owner: TObject); diff --git a/Units/MMLCore/finder.pas b/Units/MMLCore/finder.pas index 7c2fd30..089f798 100644 --- a/Units/MMLCore/finder.pas +++ b/Units/MMLCore/finder.pas @@ -27,6 +27,7 @@ unit finder; interface +{$define CheckAllBackground}//Undefine this to only check the first white point against the background (in masks). uses Classes, SysUtils,bitmaps, MufasaTypes; // Types @@ -59,6 +60,9 @@ type function FindColorsTolerance(var Points: TPointArray; Color, xs, ys, xe, ye, Tol: Integer): Boolean; function FindColorsSpiralTolerance(x, y: Integer; var Points: TPointArray; color, xs, ys, xe, ye: Integer; Tolerance: Integer) : boolean; function FindColors(var TPA: TPointArray; Color, xs, ys, xe, ye: Integer): Boolean; + //Mask + function FindBitmapMaskTolerance(mask: TMask; var x, y: Integer; xs, ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean; + procedure CheckMask(Mask : TMask); //Bitmap functions function FindBitmap(bitmap: TMufasaBitmap; var x, y: Integer): Boolean; function FindBitmapIn(bitmap: TMufasaBitmap; var x, y: Integer; xs, ys, xe, ye: Integer): Boolean; @@ -142,11 +146,8 @@ var I : integer; begin; setlength(result,RowCount); - for i := 0 to RowCount - 1do - begin; - result[i] := ReturnData.Ptr; - inc(ReturnData.Ptr,ReturnData.IncPtrWith); - end; + for i := 0 to RowCount - 1 do + result[i] := ReturnData.Ptr + ReturnData.RowLen * i; end; function CalculateRowPtrs(Bitmap : TMufasaBitmap) : TPRGB32Array;overload; @@ -155,7 +156,7 @@ var begin; setlength(result,Bitmap.Height); for i := 0 to Bitmap.Height - 1 do - result[i] := Bitmap.FData + Bitmap.Width; + result[i] := Bitmap.FData + Bitmap.Width * i; end; constructor TMFinder.Create(aClient: TObject); @@ -671,6 +672,92 @@ begin TClient(Client).MWindow.FreeReturnData; end; +//Only works with CTS 1 for now.. Since Colorsame doesn't return a boolean :-( +//We do not check whether every white pixel is in tol range with every other white pixel.. + +function TMFinder.FindBitmapMaskTolerance(mask: TMask; var x, y: Integer; xs, + ys, xe, ye: Integer; Tolerance, ContourTolerance: Integer): Boolean; +var + MainRowdata : TPRGB32Array; + PtrData : TRetData; + MaskW,MaskH : integer; + CheckerWhite,CheckerBlack,CurrWhite,CurrBlack: TRGB32; + i,ii : integer; + dX, dY, xx, yy: Integer; +label NotFoundMask; + //Don't know if the compiler has any speed-troubles with goto jumping in nested for loops. + +begin + Result := false; + // checks for valid xs,ys,xe,ye? (may involve GetDimensions) + DefaultOperations(xs,ys,xe,ye); + //Check the mask. + CheckMask(Mask); + // calculate delta x and y + dX := xe - xs; + dY := ye - ys; + + PtrData := TClient(Client).MWindow.ReturnData(xs, ys, dX + 1, dY + 1); + //Caculate the row ptrs + MainRowdata:= CalculateRowPtrs(PtrData,dy+1); + + //Get the 'fixed' mask size + MaskW := Mask.W; + MaskH := Mask.H; + //Heck our mask cannot be outside the search area + dX := dX - MaskW; + dY := dY - MaskH; + for yy := 0 to dY do + for xx := 0 to dX do + begin; + CheckerWhite := MainRowdata[yy + mask.White[0].y][xx + mask.white[0].x]; + CheckerBlack := MainRowdata[yy + mask.Black[0].y][xx + mask.Black[0].x]; + //Just check two 'random' points against eachother, might be a time saver in some circumstances. + if (Sqrt(sqr(CheckerWhite.r-CheckerBlack.r) + sqr(CheckerWhite.G-CheckerBlack.G) + sqr(CheckerWhite.b-CheckerBlack.B)) + <= ContourTolerance) then //The Tol between the white and black is lower than the minimum difference, so continue with looking! + continue; + for i := 0 to mask.WhiteHi do + begin; + CurrWhite := MainRowdata[yy + mask.White[i].y][xx + mask.white[i].x]; + if (Sqrt(sqr(CheckerWhite.r-CurrWhite.r) + sqr(CheckerWhite.G-CurrWhite.G) + sqr(CheckerWhite.b-CurrWhite.B)) + > Tolerance) then //The white checkpoint n' this point aren't in the same tol range -> goto nomatch; + goto NotFoundMask; + {$ifdef CheckAllBackground} + for ii := 0 to mask.BlackHi do + begin + CurrBlack := MainRowdata[yy + mask.Black[ii].y][xx + mask.Black[ii].x]; + if (Sqrt(sqr(CurrWhite.r-CurrBlack.r) + sqr(CurrWhite.G-CurrBlack.G) + sqr(CurrWhite.b-CurrBlack.B)) + <= ContourTolerance) then //The Tol between the white and black is lower than the minimum difference -> goto nomatch; + goto NotFoundMask; + end; + {$endif} + end; + {$ifndef CheckAllBackground} + for ii := 0 to mask.BlackHi do + begin + CurrBlack := MainRowdata[yy + mask.Black[ii].y][xx + mask.Black[ii].x]; + if (Sqrt(sqr(CheckerWhite.r-CurrBlack.r) + sqr(CheckerWhite.G-CurrBlack.G) + sqr(CheckerWhite.b-CurrBlack.B)) + <= ContourTolerance) then //The Tol between the white and black is lower than the minimum difference -> goto nomatch; + goto NotFoundMask; + end; + {$endif} + //We have found the mask appearntly, otherwise we would have jumped! Gna Gna. + x := xx + xs; + y := yy + ys; + TClient(Client).MWindow.FreeReturnData; + Exit(true); + //Bah not found the mask, lets do nothing and continue! + NotFoundMask: + end; + TClient(Client).MWindow.FreeReturnData; +end; + +procedure TMFinder.CheckMask(Mask: TMask); +begin + if (Mask.W < 1) or (Mask.H < 1) or (Mask.WhiteHi < 0) or (Mask.BlackHi < 0) then + raise exception.CreateFMT('Mask is invalid. Width/Height: (%d,%d). WhiteHi/BlackHi: (%d,%d)',[Mask.W,Mask.H,Mask.WhiteHi,Mask.BlackHi]); +end; + function TMFinder.FindBitmap(bitmap: TMufasaBitmap; var x, y: Integer): Boolean; var w,h : integer; diff --git a/Units/MMLCore/mufasatypes.pas b/Units/MMLCore/mufasatypes.pas index 3d9c02d..922d5b8 100644 --- a/Units/MMLCore/mufasatypes.pas +++ b/Units/MMLCore/mufasatypes.pas @@ -32,8 +32,7 @@ uses Classes, SysUtils,plugins; const DS = DirectorySeparator; -var - MainDir : string; + type TRGB32 = packed record B, G, R, A: Byte; @@ -43,6 +42,7 @@ type TRetData = record Ptr : PRGB32; IncPtrWith : integer; + RowLen : integer; end; TBmpMirrorStyle = (MirrorWidth,MirrorHeight,MirrorLine); //LineMirror is in line x=y; TTargetWindowMode = (w_BMP, w_Window, w_HDC, w_ArrayPtr, w_XWindow); @@ -54,6 +54,12 @@ type TExtendedArray = Array of Extended; T2DExtendedArray = Array of Array of Extended; + { Mask Types } + TMask = record + White, Black : TPointArray; + WhiteHi,BlackHi : integer; + W,H : integer; + end; { DTM Types } { diff --git a/Units/MMLCore/window.pas b/Units/MMLCore/window.pas index 31a8599..90a608c 100644 --- a/Units/MMLCore/window.pas +++ b/Units/MMLCore/window.pas @@ -282,6 +282,7 @@ begin Inc(TmpData, ys * width + xs); Result.Ptr:= tmpData; Result.IncPtrWith:= Self.FrozenSize.x - width; + Result.RowLen:= Self.FrozenSize.x; end else case Self.TargetMode of w_BMP : @@ -294,6 +295,7 @@ begin Inc(TmpData, ys * width + xs); Result.Ptr := TmpData; Result.IncPtrWith:= TargetBitmap.Width - width; + Result.RowLen:= TargetBitmap.Width; end; w_Window: begin @@ -301,6 +303,7 @@ begin BitBlt(Self.DrawBitmap.Canvas.Handle,0,0, width, height, Self.TargetDC, xs,ys, SRCCOPY); Result.Ptr:= Self.DrawBmpDataPtr; Result.IncPtrWith:= DrawBmpW - Width; + Result.RowLen:= DrawBmpW; {$ENDIF} end; w_XWindow: @@ -324,6 +327,7 @@ begin //WriteLn(IntToStr(Self.XWindowImage^.width) + ', ' + IntToStr(Self.XWindowImage^.height)); Result.Ptr := PRGB32(Self.XWindowImage^.data); Result.IncPtrWith := 0; + Result.RowLen := width; Self.XImageFreed:=False; XSetErrorHandler(Old_Handler); @@ -342,6 +346,7 @@ begin Inc(TmpData, ys * width + xs); Result.Ptr := TmpData; Result.IncPtrWith:= Self.ArraySize.x - width; + Result.RowLen:= Self.ArraySize.x; end; end;