blinklist.pas

   1 (*\r
   2  *  beware IRC services, blinklist.pas\r
   3  *  Copyright (C) 2002 Bas Steendijk\r
   4  *\r
   5  *  This program is free software; you can redistribute it and/or modify\r
   6  *  it under the terms of the GNU General Public License as published by\r
   7  *  the Free Software Foundation; either version 2 of the License, or\r
   8  *  (at your option) any later version.\r
   9  *\r
  10  *  This program is distributed in the hope that it will be useful,\r
  11  *  but WITHOUT ANY WARRANTY; without even the implied warranty of\r
  12  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\r
  13  *  GNU General Public License for more details.\r
  14  *\r
  15  *  You should have received a copy of the GNU General Public License\r
  16  *  along with this program; if not, write to the Free Software\r
  17  *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA\r
  18  *)\r
  19 unit blinklist;\r
  20 {$ifdef fpc}\r
  21   {$mode delphi}\r
  22 {$endif}\r
  23 \r
  24 \r
  25 interface\r
  26 \r
  27 type\r
  28   tlinklist=class(tobject)\r
  29     next:tlinklist;\r
  30     prev:tlinklist;\r
  31     constructor create;\r
  32     destructor destroy; override;\r
  33   end;\r
  34 \r
  35   {linklist with 2 links}\r
  36   tlinklist2=class(tlinklist)\r
  37     next2:tlinklist2;\r
  38     prev2:tlinklist2;\r
  39   end;\r
  40 \r
  41   {linklist with one pointer}\r
  42   tplinklist=class(tlinklist)\r
  43     p:pointer\r
  44   end;\r
  45 \r
  46   tstringlinklist=class(tlinklist)\r
  47     s:string;\r
  48   end;\r
  49 \r
  50   tthing=class(tlinklist)\r
  51     name:string;      {name/nick}\r
  52     hashname:integer; {hash of name}\r
  53   end;\r
  54 \r
  55 {\r
  56 adding new block to list (baseptr)\r
  57 }\r
  58 procedure linklistadd(var baseptr:tlinklist;newptr:tlinklist);\r
  59 procedure linklistdel(var baseptr:tlinklist;item:tlinklist);\r
  60 \r
  61 \r
  62 procedure linklist2add(var baseptr,newptr:tlinklist2);\r
  63 procedure linklist2del(var baseptr:tlinklist2;item:tlinklist2);\r
  64 \r
  65 var\r
  66   linklistdebug:integer;\r
  67 \r
  68 implementation\r
  69 \r
  70 procedure linklistadd(var baseptr:tlinklist;newptr:tlinklist);\r
  71 var\r
  72   p:tlinklist;\r
  73 begin\r
  74   p := baseptr;\r
  75   baseptr := newptr;\r
  76   baseptr.prev := nil;\r
  77   baseptr.next := p;\r
  78   if p <> nil then p.prev := baseptr;\r
  79 end;\r
  80 \r
  81 procedure linklistdel(var baseptr:tlinklist;item:tlinklist);\r
  82 begin\r
  83   if item = baseptr then baseptr := item.next;\r
  84   if item.prev <> nil then item.prev.next := item.next;\r
  85   if item.next <> nil then item.next.prev := item.prev;\r
  86 end;\r
  87 \r
  88 procedure linklist2add(var baseptr,newptr:tlinklist2);\r
  89 var\r
  90   p:tlinklist2;\r
  91 begin\r
  92   p := baseptr;\r
  93   baseptr := newptr;\r
  94   baseptr.prev2 := nil;\r
  95   baseptr.next2 := p;\r
  96   if p <> nil then p.prev2 := baseptr;\r
  97 end;\r
  98 \r
  99 procedure linklist2del(var baseptr:tlinklist2;item:tlinklist2);\r
 100 begin\r
 101   if item = baseptr then baseptr := item.next2;\r
 102   if item.prev2 <> nil then item.prev2.next2 := item.next2;\r
 103   if item.next2 <> nil then item.next2.prev2 := item.prev2;\r
 104 end;\r
 105 \r
 106 constructor tlinklist.create;\r
 107 begin\r
 108   inherited create;\r
 109   inc(linklistdebug);\r
 110 end;\r
 111 \r
 112 destructor tlinklist.destroy;\r
 113 begin\r
 114   dec(linklistdebug);\r
 115   inherited destroy;\r
 116 end;\r
 117 \r
 118 end.\r