Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/OPBONUS.ZIP/DUPFIND.LZH/OPUNIQUE.PAS

Pascal/Delphi Source File | 1990-10-25 | 5.8 KB | 214 lines

{$S-,R-,V-,I-,B-,F+,O-,A-}

{Conditional defines that may affect this unit}
{$I OPDEFINE.INC}

{*********************************************************}
{*                  OPUNIQUE.PAS 1.03                    *}
{*      Copyright (c) TurboPower Software 1987,1989.     *}
{*                 All rights reserved.                  *}
{*********************************************************}

unit OpUnique;
  {-String array that stores only unique copies of strings}

interface

uses
  OpString, OpRoot, OpTree;

type
  IndexTreeNodePtr = ^IndexTreeNode;
  IndexTreeNode =
    object(TreeNode)
      itnIndex : Word;  {Index into StringArray for the string}

      constructor Init(Index : Word);
        {-Set initial index}
    end;

  IndexTreePtr = ^IndexTree;
  IndexTree =
    object(Tree)
      itSP : StringArrayPtr;

      constructor Init(SAP : StringArrayPtr);
        {-Initialize and connect to StringArray}
      function Compare(Key1, Key2 : Pointer) : CompareType; virtual;
        {-Compare two keys, returning Less, Equal, Greater}
      function GetKey(N : TreeNodePtr) : Pointer; virtual;
        {-Return a pointer to the key value for node N}
    end;

  UniqueStringArrayPtr = ^UniqueStringArray;
  UniqueStringArray =
    object(StringArray)
      usTP : IndexTreePtr; {Pointer to IndexTree}

      constructor Init(StrMax, Amount : Word);
        {-Allocate space for StrMax strings in Amount space}
      destructor Done; virtual;
        {-Deallocate array}
      function AddString(St : String) : Word; virtual;
        {-Add a new string, returning its index, or 0 if error}
      procedure RemoveString(Which : Word); virtual;
        {-Remove specified string from array and pack character table}
      procedure RemoveStringByName(St : String);
        {-Remove named string}
      procedure Clear;
        {-Remove all strings from array}
      function GetTreePtr : IndexTreePtr;
        {-Return address of associated IndexTree}

    {$IFDEF UseStreams}
      constructor Load(var S : IdStream);
        {-Load a binary packed array from a stream. NOT SUPPORTED}
      procedure Store(var S : IdStream);
        {-Write a packed array to a stream. NOT SUPPORTED}
    {$ENDIF}
    end;

  {====================================================================}

implementation

  constructor IndexTreeNode.Init(Index : Word);
    {-Set initial index}
  begin
    if not TreeNode.Init then
      Fail;
    itnIndex := Index;
  end;

  {--------------------------------------------------------------------}

  constructor IndexTree.Init(SAP : StringArrayPtr);
    {-Initialize and connect to StringArray}
  begin
    if not Tree.Init then
      Fail;
    itSP := SAP;
  end;

  function IndexTree.Compare(Key1, Key2 : Pointer) : CompareType;
    {-Compare two keys, returning Less, Equal, Greater}
  begin
    Compare := CompString(StringPtr(Key1)^, StringPtr(Key2)^);
  end;

  function IndexTree.GetKey(N : TreeNodePtr) : Pointer;
    {-Return a pointer to the key value for node N}
  begin
    GetKey := itSP^.GetStringPtr(IndexTreeNodePtr(N)^.itnIndex);
  end;

  {--------------------------------------------------------------------}

  constructor UniqueStringArray.Init(StrMax, Amount : Word);
    {-Allocate space for StrMax strings in Amount space}
  begin
    usTP := nil;

    if not StringArray.Init(StrMax, Amount) then
      Fail;

    new(usTP, Init(@Self));
    if usTP = nil then begin
      Done;
      InitStatus := epFatal+ecOutOfMemory;
      Fail;
    end;
  end;

  destructor UniqueStringArray.Done;
    {-Deallocate array}
  begin
    if usTP <> nil then
      Dispose(usTP, Done);
    StringArray.Done;
  end;

  function UniqueStringArray.AddString(St : String) : Word;
    {-Add a new string, returning its index, or 0 if error}
  var
    ITNP : IndexTreeNodePtr;
    Index : Word;
  begin
    ITNP :=IndexTreeNodePtr(usTP^.Find(@St));
    if ITNP = nil then begin
      {String is not in the array, add it now}
      Index := StringArray.AddString(St);
      if Index = 0 then begin
        AddString := 0;
        Exit;
      end;
      {Create new tree node for the string}
      new(ITNP, Init(Index));
      if ITNP = nil then begin
        AddString := 0;
        Exit;
      end;
      {Insert it into binary tree}
      usTP^.Insert(ITNP);
    end;
    {Return the index}
    AddString := ITNP^.itnIndex;
  end;

  procedure UniqueStringArray.RemoveString(Which : Word);
    {-Remove specified string from array and pack character table}
  var
    ITNP : IndexTreeNodePtr;
    Index : Word;
  begin
    ITNP :=IndexTreeNodePtr(usTP^.Find(GetStringPtr(Which)));
    if ITNP <> nil then begin
      usTP^.Remove(ITNP);
      Dispose(ITNP, Done);
    end;
    StringArray.RemoveString(Which);
  end;

  procedure UniqueStringArray.RemoveStringByName(St : String);
    {-Remove named string}
  var
    ITNP : IndexTreeNodePtr;
    Index : Word;
  begin
    ITNP :=IndexTreeNodePtr(usTP^.Find(@St));
    if ITNP <> nil then begin
      Index := ITNP^.itnIndex;
      usTP^.Remove(ITNP);
      Dispose(ITNP, Done);
      StringArray.RemoveString(Index);
    end;
  end;

  procedure UniqueStringArray.Clear;
    {-Remove all strings from array}
  begin
    StringArray.Clear;
    usTP^.Clear;
  end;

  function UniqueStringArray.GetTreePtr : IndexTreePtr;
    {-Return address of associated IndexTree}
  begin
    GetTreePtr := usTP;
  end;

{$IFDEF UseStreams}
  constructor UniqueStringArray.Load(var S : IdStream);
    {-Load a binary packed array from a stream. NOT SUPPORTED}
  begin
    Fail;
  end;

  procedure UniqueStringArray.Store(var S : IdStream);
    {-Write a packed array to a stream. NOT SUPPORTED}
  begin
  end;
{$ENDIF}

end.