tesseract.simba

(*
Tesseract
=========

Tesseract is an open source text recognition (OCR) Engine.
https://github.com/tesseract-ocr/tesseract

Tesseract attempts to read virtually any text providing the image is processed enough.
*)

{$loadlib libtesseract}

type
  TTesseractMatch = record
    Text: String;
    Bounds: TBox;
    Confidence: Single;
  end;
  TTesseractMatchArray = array of TTesseractMatch;

  TTesseractOCR = record
    const CHARS_UPPERCASE  = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
    const CHARS_LOWERCASE  = 'abcdefghijklmnopqrstuvwxyz';
    const CHARS_DIGITS     = '0123456789';
    const CHARS_NUMBER     = '0123456789,.';
    const CHARS_LETTERS    = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
    const CHARS_SYMBOLS    = '.,-<>?+=()/\*@![]#~';
    const CHARS_WHITESPACE = #10+#13+#32;

    ResizeMultiplier: Single;
    MinMatch: Single;
    Instance: Pointer;
    Area: TBox;
    Image: TImage;
  end;

procedure TTesseractOCR.SetWhitelist(Value: String);
begin
  if (Value = '') then
    Value := #0;

  Tesseract_SetVariable(Self.Instance, PTessChar('tessedit_char_whitelist'), PTessChar(Value));
end;

procedure TTesseractOCR.SetBlacklist(Value: String);
begin
  if (Value = '') then
    Value := #0;

  Tesseract_SetVariable(Self.Instance, PTessChar('tessedit_char_blacklist'), PTessChar(Value));
end;

procedure TTesseractOCR.SetMinMatch(Value: Single);
begin
  Self.MinMatch := Value;
end;

procedure TTesseractOCR.ClearWhitelist;
begin
  Self.SetWhitelist('');
end;

procedure TTesseractOCR.ClearBlacklist;
begin
  Self.SetBlacklist('');
end;

function TTesseractOCR.GetTextEx(MinMatch: Single): String;
var
  Match: TTesseractMatch;
begin
  for Match in Self.GetCharacterMatches() do
    if (Match.Confidence > MinMatch) then
      Result := Result + Match.Text;
end;

function TTesseractOCR.GetText: String;
var
  Text: PTessChar;
  TextLength: Integer;
begin
  Text := Tesseract_GetUTF8Text(Self.Instance, TextLength);
  if (Self.MinMatch > 0) then
    Result := Self.GetTextEx(Self.MinMatch)
  else
  begin
    SetLength(Result, TextLength);
    if (TextLength > 0) then
      Move(Text^, Result[1], TextLength);
    Result := Trim(StringReplace(Result, #10, LINE_SEP, [rfReplaceAll]));
  end;

  Tesseract_FreeUTF8Text(Text);
end;

function TTesseractOCR.Recognize(Area: TBox): String; overload;
var
  img1, img2: TImage;
begin
  if (Self.Image <> nil) then
  begin
    Self.Image.Free();
    Self.Image := nil;
  end;

  Self.Area := Area;
  Self.Image := TImage.CreateFromTarget(Self.Area);

  // Assume smallest font is is 8px
  // Tesseract wants something like ~25px. 8*3.5 = 28
  img1 := Self.Image.Resize(EImageResizeAlgo.BILINEAR, Self.ResizeMultiplier);
  img2 := img1.Threshold(True);
  Result := Self.Recognize(img2);

  img1.Free();

  Self.Image.Free();
  Self.Image := img2;
end;

function TTesseractOCR.Recognize(Bitmap: TImage): String; overload;
begin
  Tesseract_SetImage(Self.Instance, Bitmap.Data, Bitmap.Width, Bitmap.Height, 4, Bitmap.Width * 4);

  Result := Self.GetText();
end;

function TTesseractOCR.GetMatches(GetMatchFunc, GetCountFunc: Pointer): TTesseractMatchArray;
type
  TGetMatchCount = function(Tesseract: Pointer): Integer;
  TGetMatch = procedure(Tesseract: Pointer; Index: Integer; var Text: Pointer; var Len: Integer; var Confidence: Single; var X1, Y1, X2, Y2: Integer);
var
  I, TextLen: Integer;
  Text: PTessChar;
  B: TBox;
  Confidence: Single;
begin
  SetLength(Result, TGetMatchCount(GetCountFunc)(Self.Instance));
  for I := 0 to High(Result) do
  begin
    TGetMatch(GetMatchFunc)(Self.Instance, I, Text, TextLen, Confidence, B.X1, B.Y1, B.X2, B.Y2);

    B.X1 := Self.Area.X1 + Round(B.X1 / Self.ResizeMultiplier);
    B.Y1 := Self.Area.Y1 + Round(B.Y1 / Self.ResizeMultiplier);
    B.X2 := Self.Area.X1 + Round(B.X2 / Self.ResizeMultiplier);
    B.Y2 := Self.Area.Y1 + Round(B.Y2 / Self.ResizeMultiplier);

    Result[I].Confidence := Confidence;
    Result[I].Bounds := B;

    SetLength(Result[I].Text, TextLen);
    if (TextLen > 0) then
      Move(Text^, Result[I].Text[1], TextLen);

    Tesseract_FreeUTF8Text(Text);
  end;
end;

function TTesseractOCR.GetCharacterMatches: TTesseractMatchArray;
begin
  Result := Self.GetMatches(@Tesseract_GetCharacterMatch, @Tesseract_GetCharacterCount);
end;

function TTesseractOCR.GetWordMatches: TTesseractMatchArray;
begin
  Result := Self.GetMatches(@Tesseract_GetWordMatch, @Tesseract_GetWordCount);
end;

function TTesseractOCR.GetLineMatches: TTesseractMatchArray;
begin
  Result := Self.GetMatches(@Tesseract_GetLineMatch, @Tesseract_GetLineCount);
end;

function TTesseractOCR.GetBlockMatches: TTesseractMatchArray;
begin
  Result := Self.GetMatches(@Tesseract_GetBlockMatch, @Tesseract_GetBlockCount);
end;

function TTesseractOCR.GetTextBounds: TBox;
var
  Matches: TTesseractMatchArray;
begin
  Matches := Self.GetBlockMatches();
  if Length(Matches) > 0 then
    Result := Matches[0].Bounds;
end;

procedure TTesseractOCR.Debug;
var
  Match: TTesseractMatch;
  Matches: TSingleArray;
begin
  WriteLn('--------------------------------------------------');
  WriteLn('TEXT:');
  Write(' ');
  WriteLn('"%s"'.Format([Self.GetText()]));

  WriteLn('MATCHES:');
  Write(' ');
  for Match in Self.GetCharacterMatches() do
    Write('"%s" %f, '.Format([Match.Text, Match.Confidence]));
  WriteLn();

  WriteLn('AVERAGE:');
  Write(' ');
  for Match in Self.GetCharacterMatches() do
    Matches += Match.Confidence;
  WriteLn('%f'.Format([Matches.Mean()]));
  WriteLn('--------------------------------------------------');

  Self.Image.Show();
end;

procedure TTesseractOCR.Free;
begin
  if (Self.Image <> nil) then
  begin
    Self.Image.Free();
    Self.Image := nil;
  end;

  if (Self.Instance <> nil) then
  begin
    Tesseract_End(Self.Instance);
    Tesseract_Delete(Self.Instance);

    Self.Instance := nil;
  end;
end;

procedure TTesseractOCR.Setup;
begin
  Self.Instance := Tesseract_Create();
  Self.ResizeMultiplier := 3.5;

  Tesseract_Init(Self.Instance, PTessChar({$MACRO DIR} + '/tessdata'), PTessChar('eng'));
  Tesseract_SetVariable(Self.Instance, PTessChar('user_defined_dpi'), PTessChar('70'));

  AddOnTerminate(@Self.Free);
end;

var
  TesseractOCR: TTesseractOCR;

begin
  TesseractOCR.Setup();
end;