{****************************************************************************

                     Copyright (c) 1993,96 by Florian Klämpfl

 ****************************************************************************}

unit cobjects;

  interface

    uses
       strings,objects;

    { exportiert einen Stringcontainer, in den mit insert Strings }
    { eingefügt und mit get entnommen werden können; wird in      }
    { idlist verwendet                                            }

    type
       pstringitem = ^tstringitem;

       tstringitem = record
          data : pstring;
          next : pstringitem;
       end;

       pstringcontainer = ^tstringcontainer;

       tstringcontainer = object
          wurzel,last : pstringitem;
          doubles : boolean;
          constructor init;
          destructor done;
          procedure insert(const s : string);
          function get : string;
          procedure clear;
       end;

    procedure stringdispose(var p : pstring);
    function stringdup(const s : string) : pstring;
    function strpnew(const s : string) : pchar;
    function lowercasestring(s : string) : string;
    function lowercase(c : char) : char;
    function _2pstring(p : pchar) : pstring;
    function _2pchar(p : pstring) : pchar;

  implementation

    function _2pstring(p : pchar) : pstring;

      var
         w : word;
         i : longint;

      begin
         w:=strlen(p);
         for i:=w-1 downto 0 do
           p[i+1]:=p[i];
         p[0]:=chr(w);
         _2pstring:=pstring(p);
      end;

    function _2pchar(p : pstring) : pchar;

      var
         w : word;
         i : longint;

      begin
         w:=ord(p^[0]);
         for i:=1 to w do
           p^[i-1]:=p^[i];
         p^[w]:=#0;
         _2pchar:=pchar(p);
      end;

    function lowercase(c : char) : char;

       begin
          if (c >= #65) and (c <= #90) then c := chr(ord (c) + 32)
          else if (c >= #128) and (c <= #165) then
            case c of
                 #154 : c := #129;  {D}
                 #142 : c := #132;  {D}
                 #153 : c := #148;  {D}
                 #144 : c := #130;  {F}
                 #128 : c := #135;  {F}
                 #143 : c := #134;  {E}
                 #165 : c := #164;  {E}
            end;
          lowercase := c;
       end;

    function lowercasestring(s : string) : string;

      var i : longint;

      begin
         for i := 1 to length (s) do
           s[i]:=lowercase(s[i]);
         lowercasestring:=s;
      end;

    function strpnew(const s : string) : pchar;

      var
         p : pchar;

      begin
         getmem(p,length(s)+1);
         strpcopy(p,s);
         strpnew:=p;
      end;

    procedure stringdispose(var p : pstring);

      begin
         if p<>nil then
           freemem(p,length(p^)+1);
         p:=nil;
      end;

    function stringdup(const s : string) : pstring;

      var
         p : pstring;

      begin
         getmem(p,length(s)+1);
         p^:=s;
         stringdup:=p;
      end;

    constructor tstringcontainer.init;

      begin
         wurzel:=nil;
         last:=nil;
         doubles:=true;
      end;

    destructor tstringcontainer.done;

      begin
         clear;
      end;

    procedure tstringcontainer.insert(const s : string);

      var
         hp : pstringitem;

      begin
         if not(doubles) then
           begin
              hp:=wurzel;
              while assigned(hp) do
                begin
                   if hp^.data^=s then exit;
                   hp:=hp^.next;
                end;
           end;
         new(hp);
         hp^.next:=nil;
         hp^.data:=stringdup(s);
         if wurzel=nil then wurzel:=hp
           else last^.next:=hp;
         last:=hp;
      end;

    procedure tstringcontainer.clear;

      var
         hp : pstringitem;

      begin
         hp:=wurzel;
         while assigned(hp) do
           begin
              stringdispose(hp^.data);
              wurzel:=hp^.next;
              dispose(hp);
              hp:=wurzel;
           end;
         last:=nil;
         wurzel:=nil;
      end;

    function tstringcontainer.get : string;

      var
         hs : string;
         hp : pstringitem;

      begin
         if wurzel=nil then hs:=''
           else
           begin
              hs:=wurzel^.data^;
              hp:=wurzel;
              wurzel:=wurzel^.next;
              stringdispose(hp^.data);
              dispose(hp);
           end;
         get:=hs;
      end;

end.