lasarus_compotents/ATSynEdit/atsynedit/atstringproc_textbuffer.pas

unit ATStringProc_TextBuffer;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,
  Dialogs,
  ATStringProc;

type
  TTextChangedEvent = procedure(Sender: TObject; Pos, Count, LineChange: integer) of object;

type
  { TATStringBuffer }

  TATStringBuffer = class
  private
    FStarts: TList; //contains offsets of lines
    FLenEol: integer;
    FOnChange: TTextChangedEvent;
  public
    FText: atString;
    constructor Create; virtual;
    destructor Destroy; override;
    procedure Setup(const AText: atString; ALineLens: TList; ALenEol: integer);
    procedure SetupSlow(const AText: atString);
    procedure Clear;
    function CaretToStr(APnt: TPoint): integer;
    function StrToCaret(APos: integer): TPoint;
    function SubString(AFrom, ALen: integer): atString;
    function TextLength: integer;
    function LineIndex(N: integer): integer;
    function LineLength(N: integer): integer;
    function LineSpace(N: integer): integer;
    function Count: integer;
    property OnChange: TTextChangedEvent read FOnChange write FOnChange;
  end;

implementation

const
  cInitListCapacity = 10000;

{ TATStringBuffer }

constructor TATStringBuffer.Create;
begin
  FText:= '';
  FStarts:= TList.Create;
  FStarts.Capacity:= cInitListCapacity;
  FLenEol:= 1;
end;

destructor TATStringBuffer.Destroy;
begin
  FStarts.Clear;
  FreeAndNil(FStarts);
  inherited;
end;

procedure TATStringBuffer.Setup(const AText: atString; ALineLens: TList;
  ALenEol: integer);
var
  Pos, NLen, i: integer;
begin
  FText:= AText;
  FLenEol:= ALenEol;

  FStarts.Clear;
  Pos:= 0;
  FStarts.Add(nil);
  for i:= 0 to ALineLens.Count-1 do
  begin
    NLen:= integer(ALineLens[i]);
    Inc(Pos, NLen+FLenEol);
    FStarts.Add(pointer(Pos));
  end;
end;

procedure TATStringBuffer.SetupSlow(const AText: atString);
var
  STextFinal: atString;
  L: TStringList;
  Lens: TList;
  i: integer;
begin
  if Trim(AText)='' then
  begin
    FText:= '';
    FStarts.Clear;
    Exit
  end;

  L:= TStringList.Create;
  Lens:= TList.Create;
  try
    L.TextLineBreakStyle:= tlbsLF;
    L.Text:= UTF8Encode(AText);
    STextFinal:= UTF8Decode(L.Text); //this converts eol to LF
    for i:= 0 to L.Count-1 do
      Lens.Add(pointer(Length(UTF8Decode(L[i]))));
    Setup(STextFinal, Lens, 1);
  finally
    FreeAndNil(Lens);
    FreeAndNil(L);
  end;
end;

procedure TATStringBuffer.Clear;
begin
  FText:= '';
  FStarts.Clear;
end;

function TATStringBuffer.CaretToStr(APnt: TPoint): integer;
var
  Len: integer;
begin
  Result:= -1;
  if (APnt.Y<0) then Exit;
  if (APnt.X<0) then Exit;
  if (APnt.Y>=FStarts.Count) then Exit;

  //handle caret pos after eol
  Len:= LineLength(APnt.Y);
  if APnt.X>Len then
    APnt.X:= Len;

  Result:= integer(FStarts[APnt.Y])+APnt.X;
end;

function TATStringBuffer.StrToCaret(APos: integer): TPoint;
var
  a, b, m, dif: integer;
begin
  Result.Y:= -1;
  Result.X:= 0;
  if APos<=0 then
    begin Result.Y:= 0; Exit end;

  a:= 0;
  b:= FStarts.Count-1;
  if b<0 then Exit;

  repeat
    dif:= integer(FStarts[a])-APos;
    if dif=0 then begin m:= a; Break end;

    //middle, which is near b if not exact middle
    m:= (a+b+1) div 2;

    dif:= integer(FStarts[m])-APos;
    if dif=0 then Break;

    if Abs(a-b)<=1 then begin m:= a; Break end;
    if dif>0 then b:= m else a:= m;
  until false;

  Result.Y:= m;
  Result.X:= APos-integer(FStarts[Result.Y]);
end;

function TATStringBuffer.SubString(AFrom, ALen: integer): atString;
begin
  Result:= Copy(FText, AFrom, ALen);
end;

function TATStringBuffer.TextLength: integer;
begin
  Result:= Length(FText);
end;

function TATStringBuffer.LineIndex(N: integer): integer;
begin
  if N<0 then Result:= 0
  else
  if N>=FStarts.Count then Result:= TextLength-1
  else
    Result:= integer(FStarts[N]);
end;

function TATStringBuffer.LineLength(N: integer): integer;
begin
  if N<0 then Result:= 0
  else
  if N>=FStarts.Count-1 then Result:= 0
  else
    Result:= integer(FStarts[N+1])-integer(FStarts[N])-FLenEol;
end;

function TATStringBuffer.LineSpace(N: integer): integer;
begin
  Result:= LineLength(N)+FLenEol;
end;

function TATStringBuffer.Count: integer;
begin
  Result:= FStarts.Count;
end;

end.