RSCR Text development #7

const
  BUFFER = 1; // 1-3!
  TEXT_LENGTH = 700; // Maximum length to use for GetText..
  SCAN_SHADOW = True; // Look for shadow pixels in GetText matching?

type
  TCharset = record
    chars: array[32..126] of record
      shape: record
        pixels: TPointArray;
        size, width, height: Integer;
        bounds: TBox;
      end;
      shadow: record
        pixels: TPointArray;
        size: Integer;
      end;
      width, height: Integer;
    end;
    max_width, max_height: Integer;
    offset: TPoint;
    loaded: TIntegerArray;
  end;

procedure InsertTIA(var arr: TIntegerArray; index: Integer; item: Integer);
var
  i, l, j, k: Integer;
begin
  l := (Length(arr) - 1);
  SetLength(arr, (l + 2));
  j := index;
  k := (l + 1);
  if (j < 0) then
    j := 0
  else
    if (j > k) then
      j := k;
  if (k > j) then
  for i := l downto j do
    arr[(i + 1)] := arr[i];
  arr[j] := item;
end;

procedure AppendTIA(var arr: TIntegerArray; item: Integer);
var
  l: Integer;
begin
  l := (Length(arr) + 1);
  SetLength(arr, l);
  arr[(l - 1)] := item;
end;

function LoadCharset(path: string): TCharset;
var
  h, i, j, k, g, v, l, w, s, p: Integer;
  b: TStringArray;
  n: string;
  d: Integer;
begin
  b := GetFiles(path, 'bmp');
  h := High(b);
  l := 0;
  Result.max_width := 0;
  Result.max_height := 0;
  Result.offset := Point(0, 0);
  SetLength(Result.loaded, 0);
  for i := 0 to h do
  begin
    n := Copy(b[i], 1, (Length(b[i]) - 4));
    if (n = ExtractFromStr(b[i], Numbers)) then
    begin
      v := StrToInt(n);
      if InRange(v, 32, 126) then
      begin
        d := LoadBitmap(path + b[i]);
        GetBitmapSize(d, Result.chars[v].width, Result.chars[v].height);
        if (Result.chars[v].width > Result.max_width) then
          Result.max_width := Result.chars[v].width;
        if (Result.chars[v].height > Result.max_height) then
          Result.max_height := Result.chars[v].height;
        if (v <> 32) then
        begin
          FindColorsBitmap(d, Result.chars[v].shape.pixels, 16777215);
          FindColorsBitmap(d, Result.chars[v].shadow.pixels, 255);
          Result.chars[v].shape.bounds := GetTPABounds(Result.chars[v].shape.pixels);
          if (Result.chars[v].shape.bounds.X1 > Result.offset.X) then
            Result.offset.X := Result.chars[v].shape.bounds.X1;
          if (Result.chars[v].shape.bounds.Y1 > Result.offset.Y) then
            Result.offset.Y := Result.chars[v].shape.bounds.Y1;
          Result.chars[v].shape.width := ((Result.chars[v].shape.bounds.X2 - Result.chars[v].shape.bounds.X1) + 1);
          Result.chars[v].shape.height := ((Result.chars[v].shape.bounds.Y2 - Result.chars[v].shape.bounds.Y1) + 1);
          Result.chars[v].shape.size := Length(Result.chars[v].shape.pixels);
          Result.chars[v].shadow.size := Length(Result.chars[v].shadow.pixels);
          w := Result.chars[v].shape.width;
          s := Result.chars[v].shape.size;
          p := -1;
          k := (l - 1);
          for j := 0 to k do
          begin
            g := Result.loaded[j];
            if ((w > Result.chars[g].shape.width) or ((w = Result.chars[g].shape.width) and (s > Result.chars[g].shape.size))) then
            begin
              p := j;
              Break;
            end;
          end;
          if (p = -1) then
            AppendTIA(Result.loaded, v)
          else
            InsertTIA(Result.loaded, p, v);
        end else
        begin
          Result.chars[v].shape.size := 0;
          AppendTIA(Result.loaded, v);
        end;
        l := (l + 1);
        FreeBitmap(d);
      end;
    end;
  end;
  SetLength(b, 0);
end;

function Percentage(percent, source: Extended): Extended;
begin
  case (percent = 0) of
    False: Result := ((percent / 100.0) * source);
    True: Result := 0.0;
  end;
end;

function FindColorEx(var TPA: TPointArray; colors: TIntegerArray; XS, YS, XE, YE: Integer): Boolean;
var
  c: TIntegerArray;
  t: TPointArray;
  h, i, j, l, r: Integer;
begin
  h := High(colors);
  if not (h = 0) then
  begin
    r := 0;
    if (h > -1) then
    begin
      t := TPAFromBox(IntToBox(XS, YS, XE, YE));
      l := (Length(t) - 1);
      if (l > -1) then
      begin
        c := GetColors(t);
        SetLength(TPA, (l + 1));
        for i := 0 to l do
          for j := 0 to h do
            if (c[i] = colors[j]) then
            begin
              TPA[r] := t[i];
              r := (r + 1);
              Break;
            end;
      end;
    end;
    SetLength(TPA, r);
    Result := (r > 0);
  end else
    Result := FindColors(TPA, colors[0], XS, YS, XE, YE);
end;

{==============================================================================]
  Returns position of item or value that is closest to item in TIA.
  As this method is Binary Searching algorithm, it ONLY works with sorted arrays!
  0 method finds position of either item OR value that is smaller than item.
  1 method finds position of either item OR value that is bigger than item.
[==============================================================================}
function TIABinaryLocateEx(TIA: TIntegerArray; item: Integer; method: Integer): Integer;
var
  i, l, r: Integer;
begin
  Result := High(TIA);
  if (Result > -1) then
  begin
    l := -1;
    while ((Result - l) > 1) do
    begin
      i := ((Result + l) div 2);
      if (item <= TIA[i]) then
        Result := i
      else
        l := i;
    end;
    if not (TIA[Result] = item) then
      if not (method = 1) then
      begin
        r := Result;
        if (TIA[Result] > item) then
        while (Result > -1) do
          if (TIA[Result] > item) then
            Result := (Result - 1)
          else
            Break;
        if not (method = 0) then
          if (Result = -1) then
            Result := r
          else
            if (Abs(TIA[Result] - item) > Abs(TIA[r] - item)) then
              Result := r;
      end else
        if (Result > -1) then
          if (TIA[Result] < item) then
            Result := -1;
  end;
end;

function GetTextTPA(pixels, shadow: TPointArray; len: Integer; buffer: Integer; charset: TCharset): string;
  function MatrixMatches(matrix: array of TBoolArray; TPA: TPointArray; offset: TPoint; needed: Integer): Boolean;
  var
    i, l, r: Integer;
  begin
    l := (Length(TPA) - 1);
    r := 0;
    for i := 0 to l do
      if matrix[(TPA[i].X + offset.X)][(TPA[i].Y + offset.Y)] then
      begin
        r := (r + 1);
        if (r >= needed) then
          Break;
      end;
    Result := (r >= needed);
  end;
  function MatrixMatch(matrix: array of TBoolArray; TPA: TPointArray; offset: TPoint): Boolean;
  var
    i, l: Integer;
  begin
    l := (Length(TPA) - 1);
    for i := 0 to l do
      if not matrix[(TPA[i].X + offset.X)][(TPA[i].Y + offset.Y)] then
        Exit(False);
    Result := True;
  end;
var
  b, o, g, q, m, j, d, e, f, t, s, w, h, i, l, k, x, z: Integer;
  matrix: array[0..1] of array of TBoolArray;
  required, columns: TIntegerArray;
  scan, found: Boolean;
  offset: TPoint;
  bounds: TBox;
  listed: TBoolArray;
begin
  Result := '';
  if (High(pixels) > -1) then
  begin
    bounds := GetTPABounds(pixels);
    d := charset.chars[32].width;
    w := (((bounds.X2 + charset.max_width) + 3));
    h := (charset.max_height + 1);
    SetLength(matrix[0], w, h);
    SetLength(listed, w);
    l := (Length(pixels) - 1);
    for i := 0 to l do
    begin
      matrix[0][pixels[i].X][pixels[i].Y] := True;
      listed[pixels[i].X] := True;
    end;
    l := (w - 1);
    z := 0;
    SetLength(columns, w);
    for i := 0 to l do
      if listed[i] then
      begin
        columns[z] := i;
        z := (z + 1);
      end;
    SetLength(listed, 0);
    SetLength(columns, z);
    l := (Length(shadow) - 1);
    scan := (l > -1);
    z := (w - 1);
    s := (Length(charset.loaded) - 1);
    q := 0;
    o := 0;
    b := Max((buffer - 1), 0);
    if scan then
    begin
      SetLength(matrix[1], w, h);
      for i := 0 to l do
        if ((shadow[i].X < w) and (shadow[i].Y < h)) then
          matrix[1][shadow[i].X][shadow[i].Y] := True;
      SetLength(required, (s + 1));
      for i := 0 to s do
      begin
        g := charset.loaded[i];
        required[i] := Round(Percentage(75.0, charset.chars[g].shadow.size));
      end;
    end;
    x := 0;
    while (x < z) do
    begin
      o := x;
      t := -1;
      f := -1;
      j := s;
      for e := 0 to b do
      begin
        i := -1;
        if ((f > -1) or (e = 0)) then
        while (i < j) do
        begin
          i := (i + 1);
          g := charset.loaded[i];
          q := (x + e);
          if not ((q + charset.chars[g].width) > w) then
          begin
            offset := Point(q, 0);
            found := not scan;
            if not found then
              found := MatrixMatches(matrix[1], charset.chars[g].shadow.pixels, offset, required[i]);
            if found then
              if MatrixMatch(matrix[0], charset.chars[g].shape.pixels, offset) then
              begin
                f := e;
                t := g;
                j := i;
                Break;
              end;
          end;
        end;
      end;
      if (t > -1) then
      begin
        q := (((x + f) - o) + 1);
        if (q > d) then
          Result := (Result + StringOfChar(' ', (q div d)));
        x := ((x + f) + charset.chars[g].width);
        Result := (Result + Chr(t));
        if (Length(Result) >= len) then
        begin
          SetLength(Result, len);
          Exit;
        end;
      end else
        x := (x + 1);
      q := TIABinaryLocateEx(columns, x, 1);
      if (q < 0) then
        Exit;
      x := Max((q - charset.offset.X), x);
    end;
  end;
end;

var
  chars: TCharset;
  new, old: string;
  pixels, shadow: TPointArray;
  found: Boolean;

function PickTextTPA(var TPA: TPointArray; position: TPoint; colors: TIntegerArray; charset: TCharset): Boolean;
var
  a: TBox;
  w, h: Integer;
begin
  SetLength(TPA, 0);
  Result := False;
  GetClientDimensions(w, h);
  if PointInBox(position, IntToBox(0, 0, (w - 1), (h - 1))) then
  begin
    a := IntToBox(position.X, position.Y, (w - 1), (position.Y + charset.max_height));
    if (a.Y2 < h) then
      Result := FindColorEx(TPA, colors, a.X1, a.Y1, a.X2, a.Y2);
  end;
  if Result then
    OffsetTPA(TPA, Point(-position.X, -position.Y));
end;

var
  t, m: Integer;

begin
  chars := LoadCharset(ScriptPath + 'RSCR_Main\');
  ActivateClient;
  Wait(1000);
  SetLength(shadow, 0);
  repeat
    found := not SCAN_SHADOW;
    if not found then
      found := PickTextTPA(shadow, Point(6, 5), [0], chars);
    if found then
    begin
      t := GetSystemTime;
      if PickTextTPA(pixels, Point(6, 5), [65535, 16777215, 16776960, 4231423, 255], chars) then
      begin
        m := (GetSystemTime - t);
        new := GetTextTPA(pixels, shadow, TEXT_LENGTH, BUFFER, chars);
        if (new <> '') then
          if (new <> old) then
          begin
            ClearDebug;
            WriteLn(new + ' [' + IntToStr(m) + ' ms.]');
            old := new;
          end;
      end;
    end;
  until IsKeyDown(VK_F12);
end.