Fixed #170, fixed bug in debug image popping up everytime you call DisplayDebugImgWindow, updated rev number added 2 new functions to the OCR (GetTextATPA and GetTextAtEx). Added a new way of determing the max height/width of a font-set.

Projects/SAMufasaGUI/debugimage.pas

@@ -89,14 +89,11 @@ end;
 
 procedure TDebugImgForm.DrawBitmap;
 var
-  rawImage : TRawImage;
   Bitmap : Graphics.TBitmap;
 begin
   if ToDrawBmp = nil then
     raise Exception.Create('ERROR in TDebugImgForm.DrawBitmap: ToDrawBmp = nil');
-  ArrDataToRawImage(ToDrawBmp.FData,Point(ToDrawBmp.width,ToDrawBmp.height),RawImage);
+  Bitmap := ToDrawBmp.ToTBitmap;
-  Bitmap := Graphics.TBitmap.Create;
-  Bitmap.LoadFromRawImage(Rawimage,false);
   DrawImage.Canvas.Draw(0,0,Bitmap);
   DrawImage.Repaint;
   Bitmap.Free;
@@ -109,7 +106,8 @@ end;
 
 procedure TDebugImgForm.ShowDebugImgForm;
 begin
-  Show;
+  if not Visible then
+    show;
   if (DispSize.x <> Width) or (DispSize.y  <> height) then
   begin;
     Width := DispSize.x;

Projects/SAMufasaGUI/framescript.pas

@@ -168,6 +168,7 @@ var
   ms: TMemoryStream;
   d: TDeclaration;
   sp, ep: Integer;
+  s : string;
 begin
   mp := TCodeInsight.Create;
   mp.FileName := ScriptFile;
@@ -179,7 +180,11 @@ begin
 
   try
     SynEdit.GetWordBoundsAtRowCol(SynEdit.CaretXY, sp, ep);
-    mp.Run(ms);
+    s := SynEdit.Lines[SynEdit.Carety-1];
+    if ep > length(s) then //We are outside the real text, go back to the last char
+      mp.Run(ms, nil, Synedit.SelStart - ep + length(s),false)
+    else
+      mp.Run(ms, nil, Synedit.SelStart + (ep - Synedit.CaretX) - 1,false);
     mp.Position := SynEdit.SelStart + (ep - SynEdit.CaretX) - 1;
 
     d := mp.FindVarBase(mp.GetExpressionAtPos);

Projects/SAMufasaGUI/testunit.pas

@@ -46,7 +46,7 @@ uses
   CastaliaSimplePasPar, v_AutoCompleteForm, PSDump;
 
 const
-  SimbaVersion = 633;
+  SimbaVersion = 635;
 
 type
 
@@ -457,6 +457,7 @@ uses
    syncobjs, // for the critical sections
    debugimage,
    files,
+   InterfaceBase,
    extensionmanagergui,
    colourhistory,
    math;
@@ -2314,7 +2315,7 @@ begin
   if Self.Visible = false then
     MenuItemShowClick(sender)
   else
-    Self.hide;
+    Self.Hide;
 end;
 
 procedure TForm1.MenuItemReportBugClick(Sender: TObject);

Units/MMLAddon/PSInc/Wrappers/ocr.inc

@@ -31,12 +31,23 @@ begin
   Result := CurrThread.Client.MOCR.TextToFontTPA(text, font, w, h);
 end;
 
+function ps_GetTextATPA(const ATPA : T2DPointArray; const maxvspacing : integer; const font : string): string; extdecl;
+begin
+  result := CurrThread.Client.MOCR.GetTextATPA(ATPA,maxvspacing,font);
+end;
+
 function ps_GetTextAt(const atX, atY, minvspacing, maxvspacing, hspacing,
                    color, tol, len: integer;const font: string): string; extdecl;
 begin
   result := CurrThread.Client.MOCR.GetTextAt(atx,aty,minvspacing,maxvspacing,hspacing,color,tol,len,font);
 end;
 
+function ps_GetTextAtEx(const xs,ys,xe,ye, minvspacing, maxvspacing, hspacing,
+                   color, tol: integer;const font: string): string; extdecl;
+begin
+  result := CurrThread.Client.MOCR.GetTextAt(xs,ys,xe,ye,minvspacing,maxvspacing,hspacing,color,tol,font);
+end;
+
 function ps_LoadSystemFont(const SysFont : TFont; const FontName : string) : boolean;extdecl;
 begin
   result := CurrThread.Client.MOCR.Fonts.LoadSystemFont(SysFont,FontName);

Units/MMLAddon/PSInc/psexportedmethods.inc

@@ -244,6 +244,9 @@ AddFunction(@ps_TPAFromText, 'function TPAFromText(const text, font: String;var
 AddFunction(@ps_TPAFromTextWrap,'procedure TPAFromTextWrap(const text, font: String;var w,h : integer;var TPA : TPointArray);');
 AddFunction(@ps_MaskFromText, 'function MaskFromText(const text, font: String): TMask;');
 AddFunction(@ps_GetTextAt,'function GetTextAt(const atX, atY, minvspacing, maxvspacing, hspacing,color, tol, len: integer;const font: string): string;');
+AddFunction(@ps_getTextAtEx,'function GetTextAtEx(const xs,ys,xe,ye, minvspacing, maxvspacing, hspacing,color, tol: integer;const font: string): string;');
+AddFunction(@ps_GetTextAtEx,'function GetTextAtExWrap(const xs,ys,xe,ye, minvspacing, maxvspacing, hspacing,color, tol: integer;const font: string): string;');
+AddFunction(@ps_gettextATPA,'function GetTextATPA(const ATPA : T2DPointArray; const maxvspacing : integer; const font : string): string;');
 AddFunction(@ps_LoadSystemFont,'function LoadSystemFont(const SysFont : TFont; const FontName : string) : boolean;');
 
 {Bitmaps}

Units/MMLCore/finder.pas

@@ -52,11 +52,11 @@ type
     CTS: Integer;
 
     Procedure UpdateCachedValues(NewWidth,NewHeight : integer);
-    procedure DefaultOperations(var xs,ys,xe,ye : integer);
     //Loads the Spiral into ClientTPA (Will not cause problems)
     procedure LoadSpiralPath(startX, startY, x1, y1, x2, y2: Integer);
   public
     WarnOnly : boolean;
+    procedure DefaultOperations(var xs,ys,xe,ye : integer);
     function FindColorsToleranceOptimised(out Points: TPointArray; Color,xs, ys, xe, ye, Tol: Integer): Boolean;
     function FindColorToleranceOptimised(out x, y: Integer; Color, xs, ys,xe, ye, tol: Integer): Boolean;
     function CountColorTolerance(Color, xs, ys, xe, ye, Tolerance: Integer): Integer;

Units/MMLCore/ocr.pas

@@ -61,7 +61,10 @@ type
     procedure FilterCharsBitmap(bmp: TMufasaBitmap);
 
     function GetTextAt(atX, atY, minvspacing, maxvspacing, hspacing,
-                    color, tol, len: integer; font: string): string;
+                    color, tol, len: integer; font: string): string;overload;
+    function GetTextAt(xs, ys, xe, ye, minvspacing, maxvspacing, hspacing,
+      color, tol: integer; font: string): string;overload;
+    function GetTextATPA(const ATPA: T2DPointArray; const maxvspacing: integer; font: string): string;
     function TextToFontTPA(Text, font: String; out w, h: integer): TPointArray;
     function TextToFontBitmap(Text, font: String): TMufasaBitmap;
     function TextToMask(Text, font: String): TMask;
@@ -697,9 +700,7 @@ begin
     result := GetUpTextAtEx(atX, atY, false);
 end;
 
-function TMOCR.GetTextAt(atX, atY, minvspacing, maxvspacing, hspacing,
+function TMOCR.GetTextATPA(const ATPA : T2DPointArray;const maxvspacing : integer; font: string): string;
-                               color, tol, len: integer; font: string): string;
-
 var
   b, lb: TBox;
   i, j, w, h: Integer;
@@ -707,78 +708,19 @@ var
   n: TNormArray;
   fD: TocrData;
   TPA: TPointArray;
-   STPA: T2DPointArray;
 
 begin
   Result := '';
   fD := FFonts.GetFont(font);
-  {writeln(format('W, H: %d, %d', [fD.max_width, fd.max_height]));}
-
-  TClient(Client).IOManager.GetDimensions(w, h);
- { writeln('Dimensions: (' + inttostr(w) + ', ' + inttostr(h) + ')');    }
-
-  { Get the text points }
-  SetLength(TPA, 0);
-  if (atY + fD.max_height -1) >= h then
-    raise exception.createFMT('You are trying to get text that is out of is origin y-coordinate: %d',[aty]);
-
-  TClient(Client).MFinder.FindColorsTolerance(TPA, color, atX, atY,
-                                     min(atX + fD.max_width * len, w - 1),
-                                     atY + fD.max_height - 1, tol);
-{  b := GetTPABounds(TPA);
-  bmp := TMufasaBitmap.Create;
-  bmp.SetSize(b.x2+1,b.y2+1);
-  bmp.DrawTPA(TPA, clRed);
-  bmp.SaveToFile('c:\found.bmp');}
-
-  { Split the text points into something usable. }
-  { +1 because splittpa will not split well if we use 0 space ;) }
-  STPA := SplitTPAEx(TPA, minvspacing+1, hspacing+1);
-
-{  bmp.DrawATPA(STPA);
-  bmp.SaveToFile('c:\found2.bmp');
-  bmp.Free;
-
-  for i := 0 to high(STPA) do
-  begin
-    b := GetTPABounds(STPA[i]);
-    bmp := TMufasaBitmap.Create;
-    bmp.SetSize(b.x2+1,b.y2+1);
-    bmp.DrawTPA(STPA[i], clRed);
-    bmp.SaveToFile('c:\t_' + inttostr(i) + '.bmp');
-    bmp.Free;
-  end;    }
-
-  SortATPAFrom(STPA, Point(0, atY));
-  SortATPAFromFirstPoint(STPA, Point(0, atY));
-
-{  for i := 0 to high(STPA) do
-  begin
-    b := GetTPABounds(STPA[i]);
-    bmp := TMufasaBitmap.Create;
-    bmp.SetSize(b.x2-b.x1 + 2,b.y2-b.y1 + 2);
-    for j := 0 to high(STPA[i]) do
-      bmp.FastSetPixel(stpa[i][j].x-b.x1,stpa[i][j].y-b.y1,clred);
-    bmp.SaveToFile('c:\s_' + inttostr(i) + '.bmp');
-    bmp.Free;
-  end;  }
-
-  { We no longer need the points in TPA }
-  SetLength(TPA, 0);
-
-  fillchar(b, sizeof(tbox), 0);
-  fillchar(lb, sizeof(tbox), 0);
 
   lbset := false;
   SetLength(Result, 0);
   SetLength(n, (fd.width + 1) * (fd.height + 1));
-  for i := 0 to high(STPA) do
+  for i := 0 to high(ATPA) do
   begin
-    if length(result) >= len then
-      exit;
     for j := 0 to high(n) do
       n[j] := 0;
-    TPA := STPA[i];
+    TPA := ATPA[i];
     b := GetTPABounds(TPA);
     if not lbset then
     begin
@@ -817,6 +759,48 @@ begin
   end;
 end;
 
+function TMOCR.GetTextAt(xs, ys, xe,ye, minvspacing, maxvspacing, hspacing,
+                               color, tol: integer; font: string): string;
+var
+  TPA : TPointArray;
+  STPA : T2DPointArray;
+  B : TBox;
+begin;
+  SetLength(TPA, 0);
+  TClient(Client).MFinder.FindColorsTolerance(TPA, color, xs,ys,xe,ye,tol);
+  b := GetTPABounds(TPA);
+
+  { Split the text points into something usable. }
+  { +1 because splittpa will not split well if we use 0 space ;) }
+  STPA := SplitTPAEx(TPA, minvspacing+1, hspacing+1);
+
+  SortATPAFrom(STPA, Point(0, ys));
+  SortATPAFromFirstPoint(STPA, Point(0, ys));
+  result := gettextatpa(STPA,maxvspacing,font);
+end;
+
+function TMOCR.GetTextAt(atX, atY, minvspacing, maxvspacing, hspacing,
+                               color, tol, len: integer; font: string): string;
+var
+  w,h : integer;
+  fD: TocrData;
+
+begin
+  Result := '';
+  fD := FFonts.GetFont(font);
+  TClient(Client).IOManager.GetDimensions(w, h);
+ { writeln('Dimensions: (' + inttostr(w) + ', ' + inttostr(h) + ')');    }
+
+  { Get the text points }
+  if (atY + fD.height -1) >= h then
+    raise exception.createFMT('You are trying to get text that is out of is origin y-coordinate: %d',[aty]);
+  result := GetTextAt(atX, atY,min(atX + fD.max_width * len, w - 1),
+            atY + fD.max_height - 1, minvspacing,maxvspacing,hspacing,color,tol,font);
+  if length(result) > len then
+    setlength(result,len);
+
+end;
+
 function TMOCR.TextToFontTPA(Text, font: String; out w, h: integer): TPointArray;
 
 var

Units/MMLCore/ocrutil.pas

@@ -38,7 +38,7 @@ type
     L,a,b: real;
   end;
 
-  procedure findBounds(glyphs: TocrGlyphMaskArray; out width,height: integer);
+  procedure findBounds(glyphs: TocrGlyphMaskArray; out width,height,maxwidth,maxheight: integer);
   function LoadGlyphMask(const bmp : TMufasaBitmap; shadow: boolean; const ascii : char): TocrGlyphMask;
   function LoadGlyphMasks(const path: string; shadow: boolean): TocrGlyphMaskArray;
   function InitOCR(const Masks : TocrGlyphMaskArray): TocrData;
@@ -56,14 +56,21 @@ uses
   {End To-Remove unit}
 
 {initalizes the remaining fields from a TocrGlyphMask and finds the global bounds}
-procedure findBounds(glyphs: TocrGlyphMaskArray; out width,height: integer);
+procedure findBounds(glyphs: TocrGlyphMaskArray; out width,height,maxwidth,maxheight: integer);
 var
   i,x,y,c,w,h: integer;
+  minx,miny,maxx,maxy : integer;
   l,r,t,b: integer;
   dat: TNormArray;
 begin
   width:= 0;
   height:= 0;
+  MaxWidth := 0;
+  MaxHeight := 0;
+  minx := 9000;
+  miny := 9000;
+  maxx := 0;
+  maxy := 0;
   for c:= 0 to length(glyphs) - 1 do
   begin
     dat:= glyphs[c].mask;
@@ -79,8 +86,12 @@ begin
       begin
         x:= i mod w;
         y:= i div w;
+        if x > maxx then maxx := x;
+        if x < minx then minx := x;
         if x > r then r:= x;
         if x < l then l:= x;
+        if y > maxy then maxy := y;
+        if y < miny then miny := y;
         if y > b then b:= y;
         if y < t then t:= y;
       end;
@@ -94,6 +105,8 @@ begin
     if (r - l + 1) > width then width:= r - l + 1;
     if (b - t + 1) > height then height:= b - t + 1;
   end;
+  maxwidth:= (maxx-minx) + 1;
+  maxheight := (maxy - miny) + 1;
 end;
 
 {Use whatever you want if you don't like this}
@@ -166,18 +179,19 @@ function InitOCR(const masks : TocrGlyphMaskArray): TocrData;
 var
   t,b,l,r,w,h,mw: integer;
   x,y: integer;
+  maxw,maxh : integer;
   c,i,len,size: integer;
   pos: integer;
   ascii: char;
 begin
   w:= 0;
   h:= 0;
-  findBounds(masks,w,h);
+  findBounds(masks,w,h,maxw,maxh);
   len:= Length(masks);
   result.width:= w;
   result.height:= h;
-  result.max_width:=0;
+  result.max_width := maxw;
-  result.max_height:=0;
+  result.max_height := maxh;
   size:= w * h;
   SetLength(result.pos,len,size);
   SetLength(result.pos_adj,len);
@@ -216,8 +230,6 @@ begin
     result.ascii[ord(ascii)].yoff:= masks[i].t;
     result.ascii[ord(ascii)].width:= masks[i].width;
     result.ascii[ord(ascii)].height:= masks[i].height;
-    result.max_width := max(result.max_width, masks[i].width);
-    result.max_height := max(result.max_height, masks[i].height);
   end;
   result.inputs:= size;
   result.outputs:= len;