RSCR Text development #5

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

function LoadCharset(path: string): TCharset;
var
  h, i, v, l: 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;
  SetLength(Result.loaded, ((126 - 32) + 2));
  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].pixels, 16777215);
          FindColorsBitmap(d, Result.chars[v].shadow, 255);
          Result.chars[v].size := Length(Result.chars[v].pixels);
          Result.chars[v].s_size := Length(Result.chars[v].shadow);
        end else
          Result.chars[v].size := 0;
        Result.loaded[l] := v;
        l := (l + 1);
        FreeBitmap(d);
      end;
    end;
  end;
  SetLength(Result.loaded, l);
  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;

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, d, e, f, t, s, w, h, i, l, k, x, z: Integer;
  matrix: array[0..1] of array of TBoolArray;
  required: TIntegerArray;
  scan, found: Boolean;
  offset: TPoint;
  bounds: TBox;
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);
    l := (Length(pixels) - 1);
    for i := 0 to l do
      matrix[0][pixels[i].X][pixels[i].Y] := True;
    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].s_size));
      end;
    end;
    for x := 0 to z do
    begin
      t := -1;
      m := 0;
      f := -1;
      for e := 0 to b do
        if ((f > -1) or (e = 0)) then
        for i := 0 to s do
        begin
          g := charset.loaded[i];
          k := charset.chars[g].size;
          if (k > m) then
            if not ((q + (x + e) + charset.chars[g].width) > w) then
            begin
              offset := Point(((x + e) + q), 0);
              found := not scan;
              if not found then
                found := MatrixMatches(matrix[1], charset.chars[g].shadow, offset, required[i]);
              if found then
                if MatrixMatch(matrix[0], charset.chars[g].pixels, offset) then
                begin
                  f := e;
                  t := g;
                  m := k;
                end;
            end;
        end;
      if (t > -1) then
      begin
        if (((((x + f) + q) - o) + 1) > d) then
          Result := (Result + StringOfChar(' ', (((((x + f) + q) - o) + 1) div d)));
        q := ((q + charset.chars[t].width) - 1);
        o := ((x + f) + q);
        Result := (Result + Chr(t));
        if (Length(Result) >= len) then
        begin
          SetLength(Result, len);
          Exit;
        end;
      end;
    end;
  end;
end;

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

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;

begin
  chars := LoadCharset(ScriptPath + 'RSCR_Main2\');
  ActivateClient;
  Wait(1000);
  SetLength(shadow, 0);
  repeat
    if PickTextTPA(shadow, Point(6, 5), [0], chars) then
      if PickTextTPA(pixels, Point(6, 5), [65535, 16777215, 16776960, 4231423], chars) then
      begin
        new := GetTextTPA(pixels, shadow, 50, 2, chars);
        if (new <> '') then
          if (new <> old) then
          begin
            ClearDebug;
            WriteLn(new);
            old := new;
          end;
      end;
  until IsKeyDown(VK_F12);
end.