unit textcoll;
{$I define.pas}
interface
uses objects, tvtype, mathu, mylib, stru, mcollect;
type

  PTextCollection = ^TTextCollection;
  TTextCollection = object(TMCollection)  {UNSORTED TEXT, PStrings}
    procedure FreeItem(Item: Pointer); virtual;
    function FindText(AText:string; var Index:integer):boolean;
    function AppendText(AText:string):boolean;
    function GetLine(AIndex:integer):string;
    function ReplaceLine(AIndex:integer; ALine:string):boolean;
    function MoveSubstringTo(AIndex:integer; APos:byte; ASubString:string):boolean;
  end;

  PTextLinesCollection = ^TTextLinesCollection;
  TTextLinesCollection = object(TStringCollection)
    constructor Init(ALimit, ADelta : Integer);
    function Compare(AKey1, AKey2 : Pointer): integer; virtual;
    function GetSubStr(Index:Integer; Start, Len:byte):string;
    function MaxWidth:byte;virtual;
    procedure SetSort(OnOff : boolean);
    function Sorted : boolean;
    function IndexOf(Item:Pointer):integer;virtual;
    function AppendLine(ALine:string):boolean;
    private
    sort: boolean;
  end;{textfile}

implementation

{************************************************************************}
{************************************************************************}
procedure TTextCollection.FreeItem(Item: Pointer);
begin
  if Item <> nil then
    DisposeStr(Item);
end;

function TTextCollection.FindText(AText:string; var Index:integer):boolean;
  function Match(Item:PString):boolean;far;
  begin
    Match := GetString(Item) = AText;
  end;
var p:pointer;
begin
  FindText := false;
  p := FirstThat(@Match);
  if p <> nil then begin
    FindText := true;
    index := IndexOf(p);
  end;
end;

function TTextCollection.AppendText(AText:string):boolean;
var
  P:PString;
  cnt:integer;
begin
  AppendText := false;
  P := NewStr(AText);
  if (P = nil) and (AText <> '') then
    exit;
  cnt := Count;
  Insert(P);
  AppendText := (cnt <> Count);
end;

function TTextCollection.GetLine(AIndex:integer):string;
begin
  GetLine := '';
  if (AIndex >= 0) and (AIndex <= Count) then
    GetLine := GetString(PString(At(AIndex)));
end;

function TTextCollection.ReplaceLine(AIndex:integer; ALine:string):boolean;
var item:PString;
begin
  ReplaceLine := false;
  if (AIndex < 0) or (AIndex >= Count) then
    exit;
  item := At(AIndex);
  FreeItem(Item);
  AtPut(AIndex, NewStr(ALine));
  ReplaceLine := true;
end;

function TTextCollection.MoveSubstringTo(AIndex:integer; APos:byte; ASubString:string):boolean;
var
  s:PString;
begin
  MoveSubstringTo := false;
  if APos = 0 then
    exit;
  if (AIndex < 0) or (AIndex >= Count) then
    exit;
  S := PString(At(AIndex));
  if S = nil then
    exit;
  if length(S^) < APos then begin
    exit;
  end;
  if length(ASubString) + APos - 1 > length(S^) then
    ASubString := copy(ASubString, 1, length(S^) - APos + 1);
  Move(ASubString[1], S^[APos], length(ASubString));
  MoveSubstringTo := true;
end;
{************************************************************************}

function TTextLinesCollection.MaxWidth: byte;
var i:byte;j:word;s:pstring;
begin
  i:=0;
  if count=0 then MaxWidth:=0 else begin
    for j:=0 to count-1 do begin
      s:=items^[j];
      if s<>nil then if length(S^)>i then i:= length(S^);
    end;
    MaxWidth:=i;
  end;
end;

constructor TTextLinesCollection.Init(ALimit, ADelta : Integer);
begin
  if not inherited Init(ALimit, ADelta) then Fail;
  SetSort(false);
end;

function TTextLinesCollection.IndexOf(Item:Pointer):integer;
var i:integer;
begin
  if Sorted then
    IndexOf := inherited IndexOf(Item)
  else begin
    IndexOf := -1;
    if Count = 0 then
      exit;
    for i := 0 to Count - 1 do begin
      if At(i) = Item then begin
        IndexOf := i;
        exit;
      end;
    end;
  end;
end;

function TTextLinesCollection.Compare(AKey1, AKey2 : Pointer): integer;
var
  c:integer;
  i, l, l1, l2:byte;
  s1:PString absolute AKey1;
  s2:PString absolute AKey2;
begin
  if Sorted then begin
    c := -1;
    l1 := length(s1^);
    l2 := length(s2^);
    l := min(l1, l2);
    for i := 1 to l do begin
      c := integer(ord(s1^[i])) - ord(s2^[i]);{integer(CollateOrder(s1^[i])) - CollateOrder(s2^[i])};
      if c <> 0 then
        break;
    end;
    if c = 0 then begin
      c := l1 - l2;
    end;
{    Compare := inherited Compare(AKey1, AKey2)}
    Compare := c;
  end else begin
    Compare := -1;
  end;
end;

procedure TTextLinesCollection.SetSort(OnOff : boolean);
begin
  sort := OnOff;
end;

function TTextLinesCollection.Sorted : boolean;
begin
  Sorted := sort;
end;

function TTextLinesCollection.GetSubStr(Index:Integer; Start, Len:byte):string;
var
  s:string;
begin
  s := '';
  if (Index < Count) and (Index >= 0) and (At(Index) <> nil) then
    s := Copy(PString(At(Index))^, Start, Len);
  GetSubStr := s;
end;

function TTextLinesCollection.AppendLine(ALine:string):boolean;
var
  P:PString;
begin
  AppendLine := false;
  P := NewStr(ALine);
  if (P = nil) and (ALine <> '') then
    exit;
  Insert(P);
end;

{************************************************************************}
end.