moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2025-01-30 23:00:18 -05:00
Code Issues Releases Wiki Activity

Minor changes + added todo list.

Browse Source
This commit is contained in:
Raymond 2010-04-05 01:36:21 +02:00
parent 72539efffd
commit 2141e1d016
4 changed files with 268 additions and 319 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
Units/MMLCore/fontloader.pas
View File

@ -49,10 +49,12 @@ type
TMFonts = class(TObject) TMFonts = class(TObject)
private private
Fonts: TList; Fonts: TList;
Path: String; FPath: String;
Client : TObject; Client : TObject;
function GetFontIndex(const Name: String): Integer; function GetFontIndex(const Name: String): Integer;
function GetFontByIndex(Index : integer): TMfont; function GetFontByIndex(Index : integer): TMfont;
procedure SetPath(const aPath: String);
function GetPath: String;
public public
constructor Create(Owner : TObject); constructor Create(Owner : TObject);
destructor Destroy; override; destructor Destroy; override;
@ -60,10 +62,9 @@ type
function FreeFont(const Name: String): Boolean; function FreeFont(const Name: String): Boolean;
function LoadFont(const Name: String; Shadow: Boolean): boolean; function LoadFont(const Name: String; Shadow: Boolean): boolean;
function LoadSystemFont(const SysFont : TFont; const FontName : string) : boolean; function LoadSystemFont(const SysFont : TFont; const FontName : string) : boolean;
procedure SetPath(const aPath: String);
function GetPath: String;
function Copy(Owner : TObject): TMFonts; function Copy(Owner : TObject): TMFonts;
function Count : integer; function Count : integer;
property Path : string read GetPath write SetPath;
property Font[Index : integer]: TMfont read GetFontByIndex; default; property Font[Index : integer]: TMfont read GetFontByIndex; default;
end; end;
@ -155,12 +156,12 @@ end;
procedure TMFonts.SetPath(const aPath: String); procedure TMFonts.SetPath(const aPath: String);
begin begin
Path := aPath; FPath := aPath;
end; end;
function TMFonts.GetPath: String; function TMFonts.GetPath: String;
begin begin
Exit(Path); Exit(FPath);
end; end;
function TMFonts.GetFontIndex(const Name: String): Integer; function TMFonts.GetFontIndex(const Name: String): Integer;
@ -201,9 +202,9 @@ function TMFonts.LoadFont(const Name: String; Shadow: Boolean): boolean;
var var
f: TMFont; f: TMFont;
begin begin
if not DirectoryExists(Path + Name) then if not DirectoryExists(FPath + Name) then
begin begin
raise Exception.Create('LoadFont: Directory ' + Path + Name + ' does not exists.'); raise Exception.Create('LoadFont: Directory ' + FPath + Name + ' does not exists.');
Exit(False); Exit(False);
end; end;
@ -211,7 +212,7 @@ begin
f.Name := Name; f.Name := Name;
if Shadow then if Shadow then
F.Name := F.Name + '_s'; F.Name := F.Name + '_s';
f.Data := InitOCR( LoadGlyphMasks(Path + Name + DS, Shadow)); f.Data := InitOCR( LoadGlyphMasks(FPath + Name + DS, Shadow));
Fonts.Add(f); Fonts.Add(f);
{$IFDEF FONTDEBUG} {$IFDEF FONTDEBUG}
TClient(Client).Writeln('Loaded Font ' + f.Name); TClient(Client).Writeln('Loaded Font ' + f.Name);
@ -270,7 +271,7 @@ var
i:integer; i:integer;
begin begin
Result := TMFonts.Create(Owner); Result := TMFonts.Create(Owner);
Result.Path := Self.GetPath(); Result.Path := FPath;
for i := 0 to Self.Fonts.Count -1 do for i := 0 to Self.Fonts.Count -1 do
Result.Fonts.Add(TMFont(Self.Fonts.Items[i]).Copy()); Result.Fonts.Add(TMFont(Self.Fonts.Items[i]).Copy());
end; end;

6
Units/MMLCore/ocr.pas
View File

@ -45,7 +45,7 @@ type
debugbmp: TMufasaBitmap; debugbmp: TMufasaBitmap;
{$ENDIF} {$ENDIF}
function GetFonts:TMFonts; function GetFonts:TMFonts;
procedure SetFonts(NewFonts: TMFonts); procedure SetFonts(const NewFonts: TMFonts);
public public
constructor Create(Owner: TObject); constructor Create(Owner: TObject);
destructor Destroy; override; destructor Destroy; override;
@ -139,7 +139,7 @@ var
i: longint; i: longint;
begin begin
// We're going to load all fonts now // We're going to load all fonts now
FFonts.SetPath(path); FFonts.Path := path;
dirs := GetDirectories(path); dirs := GetDirectories(path);
Result := false; Result := false;
for i := 0 to high(dirs) do for i := 0 to high(dirs) do
@ -158,7 +158,7 @@ begin
end; end;
{ Set new Fonts. We set it to a Copy of NewFonts } { Set new Fonts. We set it to a Copy of NewFonts }
procedure TMOCR.SetFonts(NewFonts: TMFonts); procedure TMOCR.SetFonts(const NewFonts: TMFonts);
begin begin
Self.FFonts := NewFonts.Copy(Self.Client); Self.FFonts := NewFonts.Copy(Self.Client);
end; end;

552
Units/MMLCore/ocrutil.pas
View File

@ -8,54 +8,45 @@ uses
Classes, SysUtils, MufasaTypes,bitmaps; Classes, SysUtils, MufasaTypes,bitmaps;
type type
TNormArray = array of integer; TNormArray = array of integer;
TocrGlyphMask = record TocrGlyphMask = record
ascii: char; ascii: char;
width,height: integer; width,height: integer;
l,r,t,b: integer; l,r,t,b: integer;
mask: TNormArray; mask: TNormArray;
end; end;
TocrGlyphMaskArray = array of TocrGlyphMask; TocrGlyphMaskArray = array of TocrGlyphMask;
TocrGlyphMetric = record TocrGlyphMetric = record
xoff,yoff: integer; xoff,yoff: integer;
width,height: integer; width,height: integer;
index: integer; //stores the internal TocrData index for this char index: integer; //stores the internal TocrData index for this char
end; end;
TocrData = record TocrData = record
ascii: array[0..255] of TocrGlyphMetric; ascii: array[0..255] of TocrGlyphMetric;
pos: array of array of integer; pos: array of array of integer;
pos_adj: array of real; pos_adj: array of real;
neg: array of array of integer; neg: array of array of integer;
neg_adj: array of real; neg_adj: array of real;
map: array of char; map: array of char;
width,height, max_width, max_height: integer; width,height, max_width, max_height: integer;
inputs,outputs: integer; inputs,outputs: integer;
end; end;
TocrDataArray = array of TocrData; TocrDataArray = array of TocrData;
{Begin To be removed} tLab = record
Tbmp = record L,a,b: real;
data: array of TRGB32; end;
width,height: integer;
end;
{End To be removed}
procedure findBounds(glyphs: TocrGlyphMaskArray; out width,height: integer);
tLab = record function LoadGlyphMask(const bmp : TMufasaBitmap; shadow: boolean; const ascii : char): TocrGlyphMask;
L,a,b: real; function LoadGlyphMasks(const path: string; shadow: boolean): TocrGlyphMaskArray;
end; function InitOCR(const Masks : TocrGlyphMaskArray): TocrData;
function GuessGlyph(glyph: TNormArray; ocrdata: TocrData): char;
procedure findBounds(glyphs: TocrGlyphMaskArray; out width,height: integer); function PointsToNorm(points: TpointArray; out w,h: integer): TNormArray;
function LoadGlyphMask(const bmp : TMufasaBitmap; shadow: boolean; const ascii : char): TocrGlyphMask; function ImageToNorm(src: TRGB32Array; w,h: integer): TNormArray;
function LoadGlyphMasks(const path: string; shadow: boolean): TocrGlyphMaskArray; function ocrDetect(txt: TNormArray; w,h: integer; var ocrdata: TocrData): string;
function InitOCR(const Masks : TocrGlyphMaskArray): TocrData; function ExtractText(colors: PRGB32;{colors: tRGBArray;} w,h: integer): TNormArray;
function GuessGlyph(glyph: TNormArray; ocrdata: TocrData): char;
function PointsToNorm(points: TpointArray; out w,h: integer): TNormArray;
function ImageToNorm(src: TRGB32Array; w,h: integer): TNormArray;
function ocrDetect(txt: TNormArray; w,h: integer; var ocrdata: TocrData): string;
function ExtractText(colors: PRGB32;{colors: tRGBArray;} w,h: integer): TNormArray;
function MakeTPAString(str: string): TpointArray;
implementation implementation
uses uses
@ -64,86 +55,63 @@ uses
graphtype, intfgraphics,graphics; graphtype, intfgraphics,graphics;
{End To-Remove unit} {End To-Remove unit}
function ReadBMP(path: string): Tbmp;
var
LazIntf : TLazIntfImage;
RawImageDesc : TRawImageDescription;
begin
if FileExists(path) then
begin;
LazIntf := TLazIntfImage.Create(0,0);
RawImageDesc.Init_BPP32_B8G8R8_BIO_TTB(LazIntf.Width,LazIntf.Height);
LazIntf.DataDescription := RawImageDesc;
LazIntf.LoadFromFile(path);
Result.width := LazIntf.Width;
Result.height := LazIntf.Height;
SetLength(result.data,LazIntf.Width*LazIntf.Height);
Move(LazIntf.PixelData[0],result.data[0],LazIntf.Width*LazIntf.Height*sizeOf(TRGB32));
LazIntf.Free;
end;
end;
{initalizes the remaining fields from a TocrGlyphMask and finds the global bounds} {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: integer);
var var
i,x,y,c,w,h: integer; i,x,y,c,w,h: integer;
l,r,t,b: integer; l,r,t,b: integer;
dat: TNormArray; dat: TNormArray;
begin begin
width:= 0; width:= 0;
height:= 0; height:= 0;
for c:= 0 to length(glyphs) - 1 do for c:= 0 to length(glyphs) - 1 do
begin
dat:= glyphs[c].mask;
w:= glyphs[c].width;
h:= glyphs[c].height;
l:= w;
r:= 0;
t:= h;
b:= 0;
for i:= 0 to w*h-1 do
begin begin
dat:= glyphs[c].mask; if dat[i] = 1 then
w:= glyphs[c].width; begin
h:= glyphs[c].height; x:= i mod w;
l:= w; y:= i div w;
r:= 0; if x > r then r:= x;
t:= h; if x < l then l:= x;
b:= 0; if y > b then b:= y;
for i:= 0 to w*h-1 do if y < t then t:= y;
begin end;
if dat[i] = 1 then
begin
x:= i mod w;
y:= i div w;
if x > r then r:= x;
if x < l then l:= x;
if y > b then b:= y;
if y < t then t:= y;
end;
end;
if l = w then l:= 0;
if t = h then t:= 0;
glyphs[c].r:= r;
glyphs[c].l:= l;
glyphs[c].b:= b;
glyphs[c].t:= t;
if (r - l + 1) > width then width:= r - l + 1;
if (b - t + 1) > height then height:= b - t + 1;
end; end;
if l = w then l:= 0;
if t = h then t:= 0;
glyphs[c].r:= r;
glyphs[c].l:= l;
glyphs[c].b:= b;
glyphs[c].t:= t;
if (r - l + 1) > width then width:= r - l + 1;
if (b - t + 1) > height then height:= b - t + 1;
end;
end; end;
{Use whatever you want if you don't like this} {Use whatever you want if you don't like this}
function GetFiles(Path, Ext: string): TstringArray; function GetFiles(Path, Ext: string): TstringArray;
var var
SearchRec : TSearchRec; SearchRec : TSearchRec;
c : integer; c : integer;
begin begin
c := 0; c := 0;
if FindFirst(Path + '*.' + ext, faAnyFile, SearchRec) = 0 then if FindFirst(Path + '*.' + ext, faAnyFile, SearchRec) = 0 then
begin begin
repeat repeat
inc(c); inc(c);
SetLength(Result,c); SetLength(Result,c);
Result[c-1] := SearchRec.Name; Result[c-1] := SearchRec.Name;
until FindNext(SearchRec) <> 0; until FindNext(SearchRec) <> 0;
SysUtils.FindClose(SearchRec); SysUtils.FindClose(SearchRec);
end; end;
end; end;
function LoadGlyphMask(const bmp: TMufasaBitmap; shadow: boolean; const ascii : char): TocrGlyphMask; function LoadGlyphMask(const bmp: TMufasaBitmap; shadow: boolean; const ascii : char): TocrGlyphMask;
@ -258,218 +226,215 @@ end;
{guesses a glyph stored in glyph (which is an 1-0 image of the size specified by width and height in ocrdata} {guesses a glyph stored in glyph (which is an 1-0 image of the size specified by width and height in ocrdata}
function GuessGlyph(glyph: TNormArray; ocrdata: TocrData): char; function GuessGlyph(glyph: TNormArray; ocrdata: TocrData): char;
var var
i,c,inputs,outputs,val: integer; i,c,inputs,outputs,val: integer;
pos_weights: array of real; pos_weights: array of real;
neg_weights: array of real; neg_weights: array of real;
max, weight: real; max, weight: real;
begin begin
SetLength(pos_weights,ocrdata.outputs); SetLength(pos_weights,ocrdata.outputs);
SetLength(neg_weights,ocrdata.outputs); SetLength(neg_weights,ocrdata.outputs);
inputs:= ocrdata.inputs - 1; inputs:= ocrdata.inputs - 1;
outputs:= ocrdata.outputs - 1; outputs:= ocrdata.outputs - 1;
for i:= 0 to inputs do for i:= 0 to inputs do
begin
val:= glyph[i];
for c:= 0 to outputs do
begin begin
val:= glyph[i]; pos_weights[c]:= pos_weights[c] + ocrdata.pos[c][i] * val;
for c:= 0 to outputs do neg_weights[c]:= neg_weights[c] + ocrdata.neg[c][i] * val;
begin end
pos_weights[c]:= pos_weights[c] + ocrdata.pos[c][i] * val; end;
neg_weights[c]:= neg_weights[c] + ocrdata.neg[c][i] * val; max:= 0;
end for i:= 0 to outputs do
end; begin
max:= 0; weight:= pos_weights[i] * ocrdata.pos_adj[i] - neg_weights[i] * ocrdata.neg_adj[i];
for i:= 0 to outputs do if (weight > max) then
begin begin
weight:= pos_weights[i] * ocrdata.pos_adj[i] - neg_weights[i] * ocrdata.neg_adj[i]; max:= weight;
if (weight > max) then result:= ocrdata.map[i];
begin
max:= weight;
result:= ocrdata.map[i];
end;
end; end;
end;
end; end;
{converts a TPA into a 1-0 image of the smallest possible size} {converts a TPA into a 1-0 image of the smallest possible size}
function PointsToNorm(points: TpointArray; out w,h: integer): TNormArray; function PointsToNorm(points: TpointArray; out w,h: integer): TNormArray;
var var
l,r,t,b: integer; l,r,t,b: integer;
i,len,size: integer; i,len,size: integer;
norm: TNormArray; norm: TNormArray;
begin begin
len:= length(points); len:= length(points);
l:= points[0].x; l:= points[0].x;
r:= points[0].x; r:= points[0].x;
t:= points[0].y; t:= points[0].y;
b:= points[0].y; b:= points[0].y;
for i:= 1 to len-1 do for i:= 1 to len-1 do
begin begin
if points[i].x < l then l:= points[i].x; if points[i].x < l then l:= points[i].x;
if points[i].x > r then r:= points[i].x; if points[i].x > r then r:= points[i].x;
if points[i].y < t then t:= points[i].y; if points[i].y < t then t:= points[i].y;
if points[i].y > b then b:= points[i].y; if points[i].y > b then b:= points[i].y;
end; end;
w:= r - l + 1; w:= r - l + 1;
h:= b - t + 1; h:= b - t + 1;
size:= w * h; size:= w * h;
SetLength(norm,size); SetLength(norm,size);
for i:= 0 to len-1 do for i:= 0 to len-1 do
norm[(points[i].x - l) + (points[i].y - t) * w]:= 1; norm[(points[i].x - l) + (points[i].y - t) * w]:= 1;
result:= norm; result:= norm;
end; end;
function ImageToNorm(src: TRGB32Array; w,h: integer): TNormArray; function ImageToNorm(src: TRGB32Array; w,h: integer): TNormArray;
var var
norm: TNormArray; norm: TNormArray;
i: integer; i: integer;
begin begin
SetLength(norm,w*h); SetLength(norm,w*h);
for i:= 0 to w*h-1 do for i:= 0 to w*h-1 do
if (src[i].r = 255) and (src[i].g = 255) and (src[i].b = 255) then if (src[i].r = 255) and (src[i].g = 255) and (src[i].b = 255) then
norm[i]:= 1 else norm[i]:= 0; norm[i]:= 1 else norm[i]:= 0;
result:= norm; result:= norm;
end; end;
{takes a mask of only one line of text, a TocrData, and returns the string in it} {takes a mask of only one line of text, a TocrData, and returns the string in it}
function ocrDetect(txt: TNormArray; w,h: integer; var ocrdata: TocrData): string; function ocrDetect(txt: TNormArray; w,h: integer; var ocrdata: TocrData): string;
var var
l,r,t,b,x,y,xx,yy: integer; l,r,t,b,x,y,xx,yy: integer;
upper,left,last,spaces: integer; upper,left,last,spaces: integer;
glyph: TNormArray; glyph: TNormArray;
empty: boolean; empty: boolean;
ascii: char; ascii: char;
begin begin
result:= ''; result:= '';
l:= -1; l:= -1;
r:= -1; r:= -1;
upper:= -9001; //large negative upper:= -9001; //large negative
left:= -9001; //large negative left:= -9001; //large negative
x:= 0; x:= 0;
while x < w do while x < w do
begin
empty:= true;
for y:= 0 to h-1 do
begin begin
empty:= true; if txt[x+y*w] = 1 then
for y:= 0 to h-1 do begin
begin empty:= false;
if txt[x+y*w] = 1 then break;
begin end;
empty:= false;
break;
end;
end;
if (l = -1) and (not empty) then
begin
l:= x
end else if (l <> -1) then
begin
if empty then
r:= x - 1
else if x = w-1 then
r:= x;
end;
if (r <> -1) and (l <> -1) then
begin
t:= -1;
b:= -1;
SetLength(glyph,0);
SetLength(glyph,ocrdata.width*ocrdata.height);
for yy:= 0 to h-1 do
begin
for xx:= l to r do
if txt[xx+yy*w] = 1 then begin t:= yy; break; end;
if t <> -1 then break;
end;
for yy:= h-1 downto 0 do
begin
for xx:= l to r do
if txt[xx+yy*w] = 1 then begin b:= yy; break; end;
if b <> -1 then break;
end;
if b - t + 1 > ocrdata.height then b:= b - (b-t+1-ocrdata.height);
if r - l + 1 > ocrdata.width then r:= r - (r-l+1-ocrdata.width);
for yy:= t to b do
for xx:= l to r do
glyph[(xx-l) + (yy-t)*ocrdata.width]:= txt[xx+yy*w];
ascii:= GuessGlyph(glyph,ocrdata);
if (upper = -9001) or (left = -9001) then
begin
upper:= t - ocrdata.ascii[ord(ascii)].yoff;
left:= l - ocrdata.ascii[ord(ascii)].xoff + ocrdata.ascii[ord(ascii)].width;
x:= left;
end else
begin
last:= left;
left:= l - ocrdata.ascii[ord(ascii)].xoff;
if last <> left then
begin
for spaces:= 1 to (left - last) div ocrdata.ascii[32].width do
result:= result + ' ';
end;
left:= left + ocrdata.ascii[ord(ascii)].width;
x:= left;
end;
result:= result + ascii;
l:= -1;
r:= -1;
end;
inc(x);
end; end;
if (l = -1) and (not empty) then
begin
l:= x
end else if (l <> -1) then
begin
if empty then
r:= x - 1
else if x = w-1 then
r:= x;
end;
if (r <> -1) and (l <> -1) then
begin
t:= -1;
b:= -1;
SetLength(glyph,0);
SetLength(glyph,ocrdata.width*ocrdata.height);
for yy:= 0 to h-1 do
begin
for xx:= l to r do
if txt[xx+yy*w] = 1 then begin t:= yy; break; end;
if t <> -1 then break;
end;
for yy:= h-1 downto 0 do
begin
for xx:= l to r do
if txt[xx+yy*w] = 1 then begin b:= yy; break; end;
if b <> -1 then break;
end;
if b - t + 1 > ocrdata.height then b:= b - (b-t+1-ocrdata.height);
if r - l + 1 > ocrdata.width then r:= r - (r-l+1-ocrdata.width);
for yy:= t to b do
for xx:= l to r do
glyph[(xx-l) + (yy-t)*ocrdata.width]:= txt[xx+yy*w];
ascii:= GuessGlyph(glyph,ocrdata);
if (upper = -9001) or (left = -9001) then
begin
upper:= t - ocrdata.ascii[ord(ascii)].yoff;
left:= l - ocrdata.ascii[ord(ascii)].xoff + ocrdata.ascii[ord(ascii)].width;
x:= left;
end else
begin
last:= left;
left:= l - ocrdata.ascii[ord(ascii)].xoff;
if last <> left then
begin
for spaces:= 1 to (left - last) div ocrdata.ascii[32].width do
result:= result + ' ';
end;
left:= left + ocrdata.ascii[ord(ascii)].width;
x:= left;
end;
result:= result + ascii;
l:= -1;
r:= -1;
end;
inc(x);
end;
end; end;
function AvgColors(color1:TRGB32; weight1: integer; color2: TRGB32; weight2: integer): TRGB32; function AvgColors(color1:TRGB32; weight1: integer; color2: TRGB32; weight2: integer): TRGB32;
begin begin
result.r:= (color1.r * weight1 + color2.r * weight2) div (weight1 + weight2); result.r:= (color1.r * weight1 + color2.r * weight2) div (weight1 + weight2);
result.g:= (color1.g * weight1 + color2.g * weight2) div (weight1 + weight2); result.g:= (color1.g * weight1 + color2.g * weight2) div (weight1 + weight2);
result.b:= (color1.b * weight1 + color2.b * weight2) div (weight1 + weight2); result.b:= (color1.b * weight1 + color2.b * weight2) div (weight1 + weight2);
end; end;
procedure RGBtoXYZ(color: TRGB32; out X, Y, Z: real); inline; procedure RGBtoXYZ(color: TRGB32; out X, Y, Z: real); inline;
var var
nr,ng,nb: real; nr,ng,nb: real;
begin begin
nr:= color.r / 255.0; nr:= color.r / 255.0;
ng:= color.g / 255.0; ng:= color.g / 255.0;
nb:= color.b / 255.0; nb:= color.b / 255.0;
if nr <= 0.04045 then nr:= nr / 12.92 else nr:= power((nr + 0.055)/1.055,2.4); if nr <= 0.04045 then nr:= nr / 12.92 else nr:= power((nr + 0.055)/1.055,2.4);
if ng <= 0.04045 then ng:= ng / 12.92 else ng:= power((ng + 0.055)/1.055,2.4); if ng <= 0.04045 then ng:= ng / 12.92 else ng:= power((ng + 0.055)/1.055,2.4);
if nb <= 0.04045 then nr:= nb / 12.92 else nb:= power((nb + 0.055)/1.055,2.4); if nb <= 0.04045 then nr:= nb / 12.92 else nb:= power((nb + 0.055)/1.055,2.4);
X:= 0.4124*nr + 0.3576*ng + 0.1805*nb; X:= 0.4124*nr + 0.3576*ng + 0.1805*nb;
Y:= 0.2126*nr + 0.7152*ng + 0.0722*nb; Y:= 0.2126*nr + 0.7152*ng + 0.0722*nb;
Z:= 0.0193*nr + 0.1192*ng + 0.9505*nb; Z:= 0.0193*nr + 0.1192*ng + 0.9505*nb;
end; end;
function labmod(i: real): real; inline; function labmod(i: real): real; inline;
begin begin
if i > power(0.206896552,3) then if i > power(0.206896552,3) then
result:= power(i,0.333333333) result:= power(i,0.333333333)
else else
result:= 7.787037037*i + 0.137931034; result:= 7.787037037*i + 0.137931034;
end; end;
function ColortoLab(c: TRGB32): tLab; inline; function ColortoLab(c: TRGB32): tLab; inline;
var var
X,Y,Z,sum,Xn,Yn,Zn: real; X,Y,Z,sum,Xn,Yn,Zn: real;
begin begin
RGBtoXYZ(c,X,Y,Z); RGBtoXYZ(c,X,Y,Z);
sum:= X + Y + Z; sum:= X + Y + Z;
if(sum = 0) then if(sum = 0) then
begin begin
result.l := 0.0; result.l := 0.0;
result.a := 0.0; result.a := 0.0;
result.b := 0.0; result.b := 0.0;
end; end;
Xn:= X / sum; Xn:= X / sum;
Yn:= Y / sum; Yn:= Y / sum;
Zn:= Z / sum; Zn:= Z / sum;
result.L:= 116.0*labmod(y/yn) - 16.0; result.L:= 116.0*labmod(y/yn) - 16.0;
result.a:= 500.0*(labmod(x/xn)-labmod(y/yn)); result.a:= 500.0*(labmod(x/xn)-labmod(y/yn));
result.b:= 500.0*(labmod(y/yn)-labmod(z/zn)); result.b:= 500.0*(labmod(y/yn)-labmod(z/zn));
end; end;
function colorDistSqr(a,b:TRGB32): integer; inline; function colorDistSqr(a,b:TRGB32): integer; inline;
begin begin
result:= (a.r-b.r)*(a.r-b.r)+(a.b-b.b)*(a.b-b.b)+(a.g-b.g)*(a.g-b.g); result:= (a.r-b.r)*(a.r-b.r)+(a.b-b.b)*(a.b-b.b)+(a.g-b.g)*(a.g-b.g);
end; end;
function ExtractText(colors: PRGB32;{colors: tRGBArray;} w,h: integer): TNormArray; function ExtractText(colors: PRGB32;{colors: tRGBArray;} w,h: integer): TNormArray;
@ -595,32 +560,5 @@ begin
result:= norm; result:= norm;
end; end;
function MakeTPAString(str: string): TpointArray;
var
i,j,c,off: integer;
bmp: array of Tbmp;
begin
raise Exception.Create('MakeTPAString sucks ass, don''t use it.');
c:= 0;
off:= 0;
SetLength(bmp,length(str));
for i:= 0 to length(str)-1 do
begin
bmp[i]:= ReadBmp('/home/merlijn/Programs/mufasa/Fonts/StatChars/' + inttostr(ord(str[i+1])) + '.bmp');
SetLength(result,c+bmp[i].width*bmp[i].height);
for j:= 0 to bmp[i].width*bmp[i].height - 1 do
begin
if bmp[i].data[j].g = 255 then
begin
result[c].x:= j mod bmp[i].width + off;
result[c].y:= j div bmp[i].width;
inc(c);
end;
end;
off:= off + bmp[i].width;
SetLength(result,c);
end;
end;
end. end.

10
todo.txt Normal file
View File

@ -0,0 +1,10 @@
- DTM Editor
- BMP Editor
- DTM Features
- SRL Installer
- Extra GUI icons
- Installer
- Test scripts
- DWS
- OCR exceptions + proper implementation of len
- Documentation + wiki