1 {
2 /***************************************************************************
3 packagedefs.pas
4 ---------------
5
6
7 ***************************************************************************/
8
9 ***************************************************************************
10 * *
11 * This source is free software; you can redistribute it and/or modify *
12 * it under the terms of the GNU General Public License as published by *
13 * the Free Software Foundation; either version 2 of the License, or *
14 * (at your option) any later version. *
15 * *
16 * This code is distributed in the hope that it will be useful, but *
17 * WITHOUT ANY WARRANTY; without even the implied warranty of *
18 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
19 * General Public License for more details. *
20 * *
21 * A copy of the GNU General Public License is available on the World *
22 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
23 * obtain it by writing to the Free Software Foundation, *
24 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
25 * *
26 ***************************************************************************
27
28 Author: Mattias Gaertner
29
30 Abstract:
31 Classes to associate objects/pointers with objects/pointers.
32 }
33 unit ObjectLists;
34
35 {$mode objfpc}{$H+}
36
37 interface
38
39 uses
40 Classes, SysUtils;
41
42 type
43 T2Pointer = record
44 Item, Associated: Pointer;
45 end;
46 P2Pointer = ^T2Pointer;
47
48 TObjectArray = class
49 private
50 FCapacity: Integer;
51 FCount: Integer;
52 FList: P2Pointer;
53 protected
Getnull54 function Get(Index: Integer): Pointer;
55 procedure Put(Index: Integer; const AValue: Pointer);
GetObjectnull56 function GetObject(Index: Integer): Pointer;
57 procedure PutObject(Index: Integer; const AValue: Pointer);
58 procedure SetCapacity(const AValue: Integer);
59 procedure SetCount(const AValue: Integer);
60 procedure Grow;
61 procedure Shrink;
62 public
63 destructor Destroy; override;
Addnull64 function Add(Item: Pointer): Integer;
AddObjectnull65 function AddObject(Item, Associated: Pointer): Integer;
66 procedure Clear; virtual;
67 procedure Delete(Index: Integer);
68 procedure Exchange(Index1, Index2: Integer);
Firstnull69 function First: Pointer;
IndexOfnull70 function IndexOf(Item: Pointer): Integer;
71 procedure Insert(Index: Integer; Item: Pointer);
72 procedure InsertObject(Index: Integer; Item, Associated: Pointer);
Lastnull73 function Last: Pointer;
74 procedure Move(CurIndex, NewIndex: Integer);
75 procedure Assign(SrcList: TList);
Removenull76 function Remove(Item: Pointer): Integer;
77 procedure Pack;
78 property Capacity: Integer read FCapacity write SetCapacity;
79 property Count: Integer read FCount write SetCount;
80 property Items[Index: Integer]: Pointer read Get write Put; default;
81 property Objects[Index: Integer]: Pointer read GetObject write PutObject;
82 property List: P2Pointer read FList;
83 end;
84
85 implementation
86
87 { TObjectArray }
88
TObjectArray.GetObjectnull89 function TObjectArray.GetObject(Index: Integer): Pointer;
90 begin
91 Result:=FList[Index].Associated;
92 end;
93
94 procedure TObjectArray.PutObject(Index: Integer; const AValue: Pointer);
95 begin
96 FList[Index].Associated:=AValue;
97 end;
98
TObjectArray.Getnull99 function TObjectArray.Get(Index: Integer): Pointer;
100 begin
101 Result:=FList[Index].Item;
102 end;
103
104 procedure TObjectArray.Put(Index: Integer; const AValue: Pointer);
105 begin
106 FList[Index].Item:=AValue;
107 end;
108
109 procedure TObjectArray.SetCapacity(const AValue: Integer);
110 begin
111 if FCapacity=AValue then exit;
112 FCapacity:=AValue;
113 ReallocMem(FList,SizeOf(T2Pointer)*FCapacity);
114 if FCount>FCapacity then FCount:=FCapacity;
115 end;
116
117 procedure TObjectArray.SetCount(const AValue: Integer);
118 begin
119 if FCount=AValue then exit;
120 FCount:=AValue;
121 if FCount>FCapacity then SetCapacity(AValue);
122 end;
123
124 procedure TObjectArray.Grow;
125 begin
126 if FCapacity<5 then Capacity:=5
127 else Capacity:=Capacity*2;
128 end;
129
130 procedure TObjectArray.Shrink;
131 begin
132 Capacity:=Capacity div 2;
133 end;
134
135 destructor TObjectArray.Destroy;
136 begin
137 ReallocMem(FList,0);
138 inherited Destroy;
139 end;
140
Addnull141 function TObjectArray.Add(Item: Pointer): Integer;
142 begin
143 Result:=AddObject(Item,nil);
144 end;
145
AddObjectnull146 function TObjectArray.AddObject(Item, Associated: Pointer): Integer;
147 begin
148 if FCount=FCapacity then Grow;
149 FList[FCount].Item:=Item;
150 FList[FCount].Associated:=Associated;
151 Result:=FCount;
152 inc(FCount);
153 end;
154
155 procedure TObjectArray.Clear;
156 begin
157 FCount:=0;
158 ReallocMem(FList,0);
159 FCapacity:=0;
160 end;
161
162 procedure TObjectArray.Delete(Index: Integer);
163 begin
164 if FCount>Index+1 then
165 System.Move(FList[Index+1],FList[Index],SizeOf(T2Pointer)*(FCount-Index-1));
166 dec(FCount);
167 if FCapacity>FCount*4 then Shrink;
168 end;
169
170 procedure TObjectArray.Exchange(Index1, Index2: Integer);
171 var
172 SwapDummy: T2Pointer;
173 begin
174 if Index1=Index2 then exit;
175 SwapDummy:=FList[Index1];
176 FList[Index1]:=FList[Index2];
177 FList[Index2]:=SwapDummy;
178 end;
179
Firstnull180 function TObjectArray.First: Pointer;
181 begin
182 if FCount>0 then
183 Result:=FList[0].Item
184 else
185 Result:=nil;
186 end;
187
IndexOfnull188 function TObjectArray.IndexOf(Item: Pointer): Integer;
189 begin
190 Result:=FCount-1;
191 while (Result>=0) and (FList[Result].Item<>Item) do dec(Result);
192 end;
193
194 procedure TObjectArray.Insert(Index: Integer; Item: Pointer);
195 begin
196 InsertObject(Index,Item,nil);
197 end;
198
199 procedure TObjectArray.InsertObject(Index: Integer; Item, Associated: Pointer);
200 begin
201 if FCount=FCapacity then Grow;
202 if Index<FCount then
203 System.Move(FList[Index],FList[Index+1],SizeOf(T2Pointer)*(FCount-Index));
204 inc(FCount);
205 FList[Index].Item:=Item;
206 FList[Index].Associated:=Associated;
207 end;
208
Lastnull209 function TObjectArray.Last: Pointer;
210 begin
211 if FCount>0 then
212 Result:=FList[FCount-1].Item
213 else
214 Result:=nil;
215 end;
216
217 procedure TObjectArray.Move(CurIndex, NewIndex: Integer);
218 var
219 SwapDummy: T2Pointer;
220 begin
221 if CurIndex=NewIndex then exit;
222 SwapDummy:=FList[CurIndex];
223 if CurIndex<NewIndex then
224 System.Move(FList[CurIndex+1],FList[CurIndex],
225 SizeOf(T2Pointer)*(NewIndex-CurIndex))
226 else
227 System.Move(FList[NewIndex],FList[NewIndex+1],
228 SizeOf(T2Pointer)*(CurIndex-NewIndex));
229 FList[NewIndex]:=SwapDummy;
230 end;
231
232 procedure TObjectArray.Assign(SrcList: TList);
233 var
234 i: Integer;
235 begin
236 Clear;
237 Count:=SrcList.Count;
238 for i:=0 to SrcList.Count-1 do begin
239 FList[i].Item:=SrcList[i];
240 FList[i].Associated:=nil;
241 end;
242 end;
243
Removenull244 function TObjectArray.Remove(Item: Pointer): Integer;
245 begin
246 Result:=IndexOf(Item);
247 if Result>=0 then Delete(Result);
248 end;
249
250 procedure TObjectArray.Pack;
251 var
252 SrcID: Integer;
253 DestID: Integer;
254 begin
255 SrcID:=0;
256 DestID:=0;
257 while SrcID<FCount do begin
258 if (FList[SrcID].Item<>nil) then begin
259 if SrcID<>DestID then
260 FList[DestID]:=FList[SrcID];
261 inc(DestID);
262 end;
263 inc(SrcID);
264 end;
265 FCount:=DestID;
266 end;
267
268 end.
269
270