blinklist.pas

   1 \r
   2 { Copyright (C) 2005 Bas Steendijk\r
   3   For conditions of distribution and use, see copyright notice in zlib_license.txt\r
   4     which is included in the package\r
   5       ----------------------------------------------------------------------------- }\r
   6 \r
   7 unit blinklist;\r
   8 {$ifdef fpc}\r
   9   {$mode delphi}\r
  10 {$endif}\r
  11 \r
  12 \r
  13 interface\r
  14 \r
  15 type\r
  16   tlinklist=class(tobject)\r
  17     next:tlinklist;\r
  18     prev:tlinklist;\r
  19     constructor create;\r
  20     destructor destroy; override;\r
  21   end;\r
  22 \r
  23   {linklist with 2 links}\r
  24   tlinklist2=class(tlinklist)\r
  25     next2:tlinklist2;\r
  26     prev2:tlinklist2;\r
  27   end;\r
  28 \r
  29   {linklist with one pointer}\r
  30   tplinklist=class(tlinklist)\r
  31     p:pointer\r
  32   end;\r
  33 \r
  34   tstringlinklist=class(tlinklist)\r
  35     s:string;\r
  36   end;\r
  37 \r
  38   tthing=class(tlinklist)\r
  39     name:string;      {name/nick}\r
  40     hashname:integer; {hash of name}\r
  41   end;\r
  42 \r
  43 {\r
  44 adding new block to list (baseptr)\r
  45 }\r
  46 procedure linklistadd(var baseptr:tlinklist;newptr:tlinklist);\r
  47 procedure linklistdel(var baseptr:tlinklist;item:tlinklist);\r
  48 \r
  49 \r
  50 procedure linklist2add(var baseptr,newptr:tlinklist2);\r
  51 procedure linklist2del(var baseptr:tlinklist2;item:tlinklist2);\r
  52 \r
  53 var\r
  54   linklistdebug:integer;\r
  55 \r
  56 implementation\r
  57 \r
  58 procedure linklistadd(var baseptr:tlinklist;newptr:tlinklist);\r
  59 var\r
  60   p:tlinklist;\r
  61 begin\r
  62   p := baseptr;\r
  63   baseptr := newptr;\r
  64   baseptr.prev := nil;\r
  65   baseptr.next := p;\r
  66   if p <> nil then p.prev := baseptr;\r
  67 end;\r
  68 \r
  69 procedure linklistdel(var baseptr:tlinklist;item:tlinklist);\r
  70 begin\r
  71   if item = baseptr then baseptr := item.next;\r
  72   if item.prev <> nil then item.prev.next := item.next;\r
  73   if item.next <> nil then item.next.prev := item.prev;\r
  74 end;\r
  75 \r
  76 procedure linklist2add(var baseptr,newptr:tlinklist2);\r
  77 var\r
  78   p:tlinklist2;\r
  79 begin\r
  80   p := baseptr;\r
  81   baseptr := newptr;\r
  82   baseptr.prev2 := nil;\r
  83   baseptr.next2 := p;\r
  84   if p <> nil then p.prev2 := baseptr;\r
  85 end;\r
  86 \r
  87 procedure linklist2del(var baseptr:tlinklist2;item:tlinklist2);\r
  88 begin\r
  89   if item = baseptr then baseptr := item.next2;\r
  90   if item.prev2 <> nil then item.prev2.next2 := item.next2;\r
  91   if item.next2 <> nil then item.next2.prev2 := item.prev2;\r
  92 end;\r
  93 \r
  94 constructor tlinklist.create;\r
  95 begin\r
  96   inherited create;\r
  97   inc(linklistdebug);\r
  98 end;\r
  99 \r
 100 destructor tlinklist.destroy;\r
 101 begin\r
 102   dec(linklistdebug);\r
 103   inherited destroy;\r
 104 end;\r
 105 \r
 106 end.\r