RSCR Text development #2

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

function GetTextEx(position: TPoint; colors: TIntegerArray; len: Integer; buffer: Integer; charset: TCharset): string;
var
  area, bounds: TBox;
  b, o, g, q, d, m, e, f, t, s, r, w, h, i, l, j, k, x, y, z: Integer;
  p, c: TPoint;
  a, v: TPointArray;
  image: Integer;
  matrix: array of TBoolArray;
  u: TIntegerArray;
begin
  Result := '';
  if (High(colors) > -1) then
  begin
    GetClientDimensions(w, h);
    if PointInBox(position, IntToBox(0, 0, (w - 1), (h - 1))) then
    begin
      area := IntToBox(position.X, position.Y, (w - 1), (position.Y + charset.max_height));
      if (area.Y2 < h) then
        if FindColorEx(a, colors, area.X1, area.Y1, area.X2, area.Y2) then
        begin
          l := (Length(a) - 1);
          OffsetTPA(a, Point(-position.X, -position.Y));
          bounds := GetTPABounds(a);
          d := charset.chars[32].width;
          w := ((((bounds.X2 - 0) + charset.max_width) + 3));
          h := ((area.Y2 - area.Y1) + 1);
          SetLength(matrix, w, h);
          for i := 0 to l do
            matrix[a[i].X][a[i].Y] := True;
          z := (w - 1);
          s := (Length(charset.loaded) - 1);
          q := 0;
          o := 0;
          b := Max((buffer - 1), 0);
          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];
                if (charset.chars[g].size > 0) then
                  if not ((q + (x + e) + charset.chars[g].width) > w) then
                  begin
                    k := (Length(charset.chars[g].pixels) - 1);
                    r := 0;
                    for j := 0 to k do
                    begin
                      c.X := ((charset.chars[g].pixels[j].X + (x + e)) + q);
                      c.Y := charset.chars[g].pixels[j].Y;
                      if not matrix[c.X][c.Y] then
                        Break
                      else
                        r := (r + 1);
                    end;
                    if (r > k) then
                      if (r > m) then
                      begin
                        f := e;
                        t := g;
                        m := r;
                      end;
                  end;
              end;
            if (t > -1) then
            begin
              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);
                SetLength(matrix, 0);
                Exit;
              end;
            end;
          end;
          SetLength(matrix, 0);
        end;
    end;
  end;
end;

function GetText(position: TPoint; colors: TIntegerArray; len: Integer; buffer: Integer; charset: TCharset): string;
  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
  area, bounds: TBox;
  b, o, g, q, d, m, e, f, t, s, r, w, h, i, l, j, k, x, y, z: Integer;
  p, c, offset: TPoint;
  a, v: TPointArray;
  image: Integer;
  matrix: array of TBoolArray;
  u: TIntegerArray;
begin
  Result := '';
  if (High(colors) > -1) then
  begin
    GetClientDimensions(w, h);
    if PointInBox(position, IntToBox(0, 0, (w - 1), (h - 1))) then
    begin
      area := IntToBox(position.X, position.Y, (w - 1), (position.Y + charset.max_height));
      if (area.Y2 < h) then
        if FindColorEx(a, colors, area.X1, area.Y1, area.X2, area.Y2) then
        begin
          l := (Length(a) - 1);
          OffsetTPA(a, Point(-position.X, -position.Y));
          bounds := GetTPABounds(a);
          d := charset.chars[32].width;
          w := ((((bounds.X2 - bounds.X1) + charset.max_width) + 3));
          h := ((area.Y2 - area.Y1) + 1);
          SetLength(matrix, w, h);
          for i := 0 to l do
            matrix[a[i].X][a[i].Y] := True;
          z := (w - 1);
          s := (Length(charset.loaded) - 1);
          q := 0;
          o := 0;
          b := Max((buffer - 1), 0);
          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);
                    if MatrixMatch(matrix, charset.chars[g].pixels, offset) then
                    begin
                      f := e;
                      t := g;
                      m := k;
                    end;
                  end;
              end;
            if (t > -1) then
            begin
              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);
                SetLength(matrix, 0);
                Exit;
              end;
            end;
          end;
          SetLength(matrix, 0);
        end;
    end;
  end;
end;

function GetTextEx2(position: TPoint; colors: TIntegerArray; shadow, 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
  area, bounds: TBox;
  sk, sr, sm, b, o, g, q, d, m, e, f, t, s, r, w, h, i, l, j, k, x, y, z: Integer;
  p, c, offset: TPoint;
  sa, a, v: TPointArray;
  matrix: array[0..1] of array of TBoolArray;
  required: TIntegerArray;
  u: TIntegerArray;
  found: Boolean;
begin
  Result := '';
  if (High(colors) > -1) then
  begin
    GetClientDimensions(w, h);
    if PointInBox(position, IntToBox(0, 0, (w - 1), (h - 1))) then
    begin
      area := IntToBox(position.X, position.Y, (w - 1), (position.Y + charset.max_height));
      if (area.Y2 < h) then
        if FindColors(sa, shadow, area.X1, area.Y1, area.X2, area.Y2) then
          if FindColorEx(a, colors, area.X1, area.Y1, area.X2, area.Y2) then
          begin
            l := (Length(a) - 1);
            OffsetTPA(a, Point(-position.X, -position.Y));
            OffsetTPA(sa, Point(-position.X, -position.Y));
            bounds := GetTPABounds(a);
            d := charset.chars[32].width;
            w := ((((bounds.X2 - bounds.X1) + charset.max_width) + 3));
            h := ((area.Y2 - area.Y1) + 1);
            SetLength(matrix[0], w, h);
            for i := 0 to l do
              matrix[0][a[i].X][a[i].Y] := True;
            l := (Length(sa) - 1);
            SetLength(matrix[1], w, h);
            for i := 0 to l do
              if ((sa[i].X < w) and (sa[i].Y < h)) then
                matrix[1][sa[i].X][sa[i].Y] := True;
            z := (w - 1);
            s := (Length(charset.loaded) - 1);
            q := 0;
            o := 0;
            b := Max((buffer - 1), 0);
            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;
            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);
                      if MatrixMatches(matrix[1], charset.chars[g].shadow, offset, required[i]) 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
                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;
  end;
end;

var
  chars: TCharset;
  new, old: string;

begin
  chars := LoadCharset(ScriptPath + 'RSCR_Main2\');
  ActivateClient;
  Wait(1000);
  repeat
    new := GetText(Point(6, 5), [65535, 16777215, 16776960, 4231423], 100, 3, chars);
    if (new <> '') then
    begin
      if (new <> old) then
      begin
        ClearDebug;
        WriteLn(new);
        old := new;
      end;
      //Wait(10);
    end;
  until IsKeyDown(VK_F12);
end.