/[lcore]/trunk/blinklist.pas
ViewVC logotype

Contents of /trunk/blinklist.pas

Parent Directory Parent Directory | Revision Log Revision Log


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

Properties

Name Value
svn:eol-style CRLF

No admin address has been configured">No admin address has been configured
ViewVC Help
Powered by ViewVC 1.1.5