moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2024-08-13 16:53:59 -04:00
Code Issues Releases Wiki Activity

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.

Browse Source
This commit is contained in:
Raymond 2010-04-21 17:10:40 +02:00
parent 544294fbe6
commit e1a11367f4
8 changed files with 101 additions and 87 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
Projects/SAMufasaGUI/debugimage.pas
View File

@ -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 := Graphics.TBitmap.Create;
Bitmap.LoadFromRawImage(Rawimage,false);
Bitmap := ToDrawBmp.ToTBitmap;
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;

7
Projects/SAMufasaGUI/framescript.pas
View File

@ -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);

5
Projects/SAMufasaGUI/testunit.pas
View File

@ -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);

11
Units/MMLAddon/PSInc/Wrappers/ocr.inc
View File

@ -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);

3
Units/MMLAddon/PSInc/psexportedmethods.inc
View File

@ -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}

2
Units/MMLCore/finder.pas
View File

@ -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;

126
Units/MMLCore/ocr.pas
View File

@ -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,88 +700,27 @@ begin
result := GetUpTextAtEx(atX, atY, false);
end;
function TMOCR.GetTextAt(atX, atY, minvspacing, maxvspacing, hspacing,
color, tol, len: integer; font: string): string;
function TMOCR.GetTextATPA(const ATPA : T2DPointArray;const maxvspacing : integer; font: string): string;
var
b, lb: TBox;
i, j, w, h: Integer;
lbset: boolean;
n: TNormArray;
fD: TocrData;
TPA: TPointArray;
STPA: T2DPointArray;
b, lb: TBox;
i, j, w, h: Integer;
lbset: boolean;
n: TNormArray;
fD: TocrData;
TPA: TPointArray;
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

26
Units/MMLCore/ocrutil.pas
View File

@ -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_height:=0;
result.max_width := maxw;
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;