source: branches/AS8051toC/Packages/TemplateGenerics/Generic/GenericMatrix.inc

Last change on this file was 26, checked in by chronos, 12 years ago
  • Upraveno: Překlad rozdělen do fáze zpracování maker a druhé fáze zpracování instrukcí.
File size: 15.6 KB
Line 
1// Work in progress...
2
3{$IFDEF INTERFACE}
4
5 // TGMatrix<TGMatrixIndex, TGMatrixIndex, TGMatrixItem> = class
6 TGMatrix = class
7 public
8 type
9 TSortCompare = function(const Item1, Item2: TGMatrixItem): Integer of object;
10 TToStringConverter = function(Item: TGMatrixItem): string;
11 TFromStringConverter = function(Text: string): TGMatrixItem;
12 TRow = array of TGMatrixItem;
13 TMerge = function(Item1, Item2: TGMatrixItem): TGMatrixItem of object;
14
15 TIndex = record
16 X: TGMatrixIndexX;
17 Y: TGMatrixIndexY;
18 end;
19 private
20 FItems: array of array of TGMatrixItem;
21 FCount: TIndex;
22 function GetItemXY(X: TGMatrixIndexX; Y: TGMatrixIndexY): TGMatrixItem;
23 function GetItem(Index: TIndex): TGMatrixItem;
24 function GetCapacity: TIndex;
25 function GetLast: TGMatrixItem;
26 function GetFirst: TGMatrixItem;
27 procedure SetCapacity(const AValue: TIndex);
28 procedure SetLast(AValue: TGMatrixItem);
29 procedure SetFirst(AValue: TGMatrixItem);
30 procedure PutItemXY(X: TGMatrixIndexX; Y: TGMatrixIndexY; const AValue: TGMatrixItem); virtual;
31 procedure PutItem(Index: TIndex; const AValue: TGMatrixItem); virtual;
32 procedure SetCount(const AValue: TIndex);
33 public
34 function Add(Item: TGMatrixItem): TIndex;
35 procedure AddMatrix(Values: array of TRow);
36 procedure AddList(List: TGMatrix);
37 procedure Assign(Source: TGMatrix);
38 procedure Clear; virtual;
39 procedure Contract;
40 function CreateIndex(X: TGMatrixIndexY; Y: TGMatrixIndexX): TIndex;
41 procedure Delete(Index: TIndex); virtual;
42 procedure DeleteItems(Index, Count: TIndex);
43 function EqualTo(List: TGMatrix): Boolean;
44 procedure Expand;
45 function Extract(Item: TGMatrixItem): TGMatrixItem;
46 procedure Exchange(Index1, Index2: TIndex);
47 property First: TGMatrixItem read GetFirst write SetFirst;
48 procedure FillAll(Value: TGMatrixItem);
49 procedure Fill(Start, Count: TIndex; Value: TGMatrixItem);
50 function Implode(RowSeparator, ColSeparator: string; Converter: TToStringConverter): string;
51 procedure Explode(Text, Separator: string; Converter: TFromStringConverter; SlicesCount: Integer = -1);
52 function IndexOf(Item: TGMatrixItem; Start: TIndex = 0): TIndex;
53 function IndexOfList(List: TGMatrix; Start: TIndex = 0): TIndex;
54 procedure Insert(Index: TIndex; Item: TGMatrixItem);
55 procedure InsertList(Index: TIndex; List: TGMatrix);
56 procedure InsertArray(Index: TIndex; Values: array of TGMatrixItem);
57 procedure Move(CurIndex, NewIndex: TIndex);
58 procedure MoveItems(CurIndex, NewIndex, Count: TIndex);
59 procedure Merge(Index: TIndex; Source: TGMatrix; Proc: TMerge);
60 procedure Replace(Index: TIndex; Source: TGMatrix);
61 function Remove(Item: TGMatrixItem): TIndex;
62 procedure Reverse;
63 procedure ReverseHorizontal;
64 procedure ReverseVertical;
65 procedure Sort(Compare: TSortCompare);
66 procedure SetArray(Values: array of TGMatrixItem);
67 property Count: TIndex read FCount write SetCount;
68 property Capacity: TIndex read GetCapacity write SetCapacity;
69 property ItemsXY[X: TGMatrixIndexX; Y: TGMatrixIndexY]: TGMatrixItem
70 read GetItemXY write PutItemXY; default;
71 property Items[Index: TIndex]: TGMatrixItem
72 read GetItem write PutItem;
73 property Last: TGMatrixItem read GetLast write SetLast;
74 end;
75
76{$UNDEF INTERFACE}
77{$ENDIF}
78
79{$IFDEF IMPLEMENTATION_USES}
80
81uses
82 RtlConsts;
83
84resourcestring
85 SMatrixIndexError = 'Matrix index error [X: %d, Y: %d]';
86
87{$UNDEF IMPLEMENTATION_USES}
88{$ENDIF}
89
90{$IFDEF IMPLEMENTATION}
91
92{ TGMatrix }
93
94procedure TGMatrix.Replace(Index: TIndex; Source: TGMatrix);
95var
96 X: TGMatrixIndexX;
97 Y: TGMatrixIndexY;
98begin
99 Y := 0;
100 while Y < Source.Count.Y do begin
101 X := 0;
102 while X < Source.Count.X do begin
103 ItemsXY[Index.X + X, Index.Y + Y] := Source.ItemsXY[X, Y];
104 X := X + 1;
105 end;
106 Y := Y + 1;
107 end;
108end;
109
110procedure TGMatrix.Merge(Index: TIndex; Source: TGMatrix; Proc: TMerge);
111var
112 X: TGMatrixIndexX;
113 Y: TGMatrixIndexY;
114begin
115 Y := 0;
116 while Y < Source.Count.Y do begin
117 X := 0;
118 while X < Source.Count.X do begin
119 ItemsXY[Index.X + X, Index.Y + Y] := Proc(ItemsXY[Index.X + X, Index.Y + Y], Source.ItemsXY[X, Y]);
120 X := X + 1;
121 end;
122 Y := Y + 1;
123 end;
124end;
125
126function TGMatrix.CreateIndex(X: TGMatrixIndexY; Y: TGMatrixIndexX): TIndex;
127begin
128 Result.X := X;
129 Result.Y := Y;
130end;
131
132function TGMatrix.GetCapacity: TIndex;
133begin
134 Result.Y := Length(FItems);
135 if Result.Y > 0 then Result.X := Length(FItems[0]) else Result.X := 0;
136end;
137
138procedure TGMatrix.SetCapacity(const AValue: TIndex);
139var
140 Y: TGMatrixIndexY;
141begin
142 if (Capacity.X <> AValue.X) and (Capacity.Y <> AValue.Y) then begin
143(* SetLength(FItems, AValue.Y);
144 Y := 0;
145 while Y < Length(FItems) do begin
146 SetLength(FItems[Y], AValue.X);
147 Y := Y + 1;
148 end;
149 end;
150 *)
151 SetLength(FItems, AValue.Y, AValue.X);
152 end;
153end;
154
155function TGMatrix.GetItemXY(X: TGMatrixIndexX; Y: TGMatrixIndexY): TGMatrixItem;
156begin
157 if (X < 0) or (X >= Count.X) or
158 (Y < 0) or (Y >= Count.Y) then
159 raise EListError.CreateFmt(SMatrixIndexError, [X, Y]);
160 Result := FItems[Y, X];
161end;
162
163function TGMatrix.GetItem(Index: TIndex): TGMatrixItem;
164begin
165 if (Index.X < 0) or (Index.X >= Count.X) or
166 (Index.Y < 0) or (Index.Y >= Count.Y) then
167 raise EListError.CreateFmt(SMatrixIndexError, [Index.X, Index.Y]);
168 Result := FItems[Index.Y, Index.X];
169end;
170
171procedure TGMatrix.PutItemXY(X: TGMatrixIndexX; Y: TGMatrixIndexY; const AValue: TGMatrixItem);
172begin
173 if (X < 0) or (X >= Count.X) or
174 (Y < 0) or (Y >= Count.Y) then
175 raise EListError.CreateFmt(SMatrixIndexError, [X, Y]);
176 FItems[Y, X] := AValue;
177end;
178
179procedure TGMatrix.PutItem(Index: TIndex; const AValue: TGMatrixItem);
180begin
181 if (Index.X < 0) or (Index.X >= Count.X) or
182 (Index.Y < 0) or (Index.Y >= Count.Y) then
183 raise EListError.CreateFmt(SMatrixIndexError, [Index.X, Index.Y]);
184 FItems[Index.Y, Index.X] := AValue;
185end;
186
187procedure TGMatrix.SetCount(const AValue: TIndex);
188begin
189 Capacity := AValue;
190 FCount := AValue;
191end;
192
193procedure TGMatrix.Assign(Source: TGMatrix);
194var
195 Index: TIndex;
196begin
197 Count := Source.Count;
198 Index.Y := 0;
199 while Index.Y < Count.Y do begin
200 Index.X := 0;
201 while Index.X < Count.X do begin
202 Items[Index] := Source.Items[Index];
203 Index.X := Index.X + 1;
204 end;
205 Index.Y := Index.Y + 1;
206 end;
207end;
208
209procedure TGMatrix.Expand;
210var
211 IncSize: TIndex;
212 NewCapacity: TIndex;
213begin
214 if (FCount.X = Capacity.X) then begin
215 IncSize.X := 4;
216 if Capacity.X > 3 then IncSize.X := IncSize.X + 4;
217 if Capacity.X > 8 then IncSize.X := IncSize.X + 8;
218 if Capacity.X > 63 then IncSize.X := IncSize.X + Capacity.X shr 2;
219 NewCapacity.X := Capacity.X + IncSize.X;
220 end;
221 if (FCount.Y = Capacity.Y) then begin
222 IncSize.Y := 4;
223 if Capacity.Y > 3 then IncSize.Y := IncSize.Y + 4;
224 if Capacity.Y > 8 then IncSize.Y := IncSize.Y + 8;
225 if Capacity.Y > 63 then IncSize.Y := IncSize.Y + Capacity.Y shr 2;
226 NewCapacity.Y := Capacity.Y + IncSize.Y;
227 end;
228 Capacity := NewCapacity;
229end;
230
231procedure TGMatrix.Contract;
232var
233 NewCapacity: TIndex;
234begin
235 if (Capacity.X > 256) and (FCount.X < Capacity.X shr 2) then
236 begin
237 NewCapacity.X := Capacity.X shr 1;
238 end;
239 if (Capacity.Y > 256) and (FCount.Y < Capacity.Y shr 2) then
240 begin
241 NewCapacity.Y := Capacity.Y shr 1;
242 end;
243 Capacity := NewCapacity;
244end;
245
246function TGMatrix.Extract(Item: TGMatrixItem): TGMatrixItem;
247var
248 I: TIndex;
249begin
250(* I := IndexOf(Item);
251 if I >= 0 then begin
252 Result := Item;
253 Delete(I);
254 end else
255 raise EListError.CreateFmt(SListIndexError, [0]);
256 *)
257end;
258
259function TGMatrix.IndexOf(Item: TGMatrixItem; Start: TIndex): TIndex;
260begin
261(* Result := Start;
262 while (Result < FCount) and
263 not CompareMem(Addr(FItems[Result]), Addr(Item), SizeOf(TGMatrixItem)) do
264 Result := Result + 1;
265 if Result = FCount then Result := -1;
266 *)
267end;
268
269procedure TGMatrix.Insert(Index: TIndex; Item: TGMatrixItem);
270begin
271(* if (Index < 0) or (Index > FCount ) then
272 raise EListError.CreateFmt(SListIndexError, [Index]);
273 if FCount = Capacity then Expand;
274 if Index < FCount then
275 System.Move(FItems[Index], FItems[Index + 1], (FCount - Index) * SizeOf(TGMatrixItem));
276 FItems[Index] := Item;
277 FCount := FCount + 1;
278 *)
279end;
280
281procedure TGMatrix.InsertList(Index: TIndex; List: TGMatrix);
282var
283 I: TIndex;
284begin
285(* I := 0;
286 while (I < List.Count) do begin
287 Insert(Index + I, List[I]);
288 I := I + 1;
289 end;
290 *)
291end;
292
293function TGMatrix.IndexOfList(List: TGMatrix; Start: TIndex): TIndex;
294var
295 I: TIndex;
296begin
297(* if List.Count > 0 then begin
298 Result := IndexOf(List[0], Start);
299 if Result <> -1 then begin
300 I := 1;
301 while I < List.Count do begin
302 if not CompareMem(Addr(FItems[Result + I]), Addr(List.FItems[I]), SizeOf(TGMatrixItem)) then begin
303 Result := -1;
304 Break;
305 end;
306 I := I + 1;
307 end;
308 end;
309 end else Result := -1;
310 *)
311end;
312
313function TGMatrix.GetLast: TGMatrixItem;
314begin
315(* if FCount = 0 then
316 raise EListError.CreateFmt(SListIndexError, [0])
317 else
318 Result := Items[FCount - 1];
319 *)
320end;
321
322procedure TGMatrix.SetLast(AValue: TGMatrixItem);
323begin
324(* if FCount = 0 then
325 raise EListError.CreateFmt(SListIndexError, [0])
326 else
327 Items[FCount - 1] := AValue;
328 *)
329end;
330
331function TGMatrix.GetFirst: TGMatrixItem;
332begin
333(* if FCount = 0 then
334 raise EListError.CreateFmt(SListIndexError, [0])
335 else
336 Result := Items[0];
337 *)
338end;
339
340procedure TGMatrix.SetFirst(AValue: TGMatrixItem);
341begin
342(* if FCount = 0 then
343 raise EListError.CreateFmt(SListIndexError, [0])
344 else
345 Items[0] := AValue;
346 *)
347end;
348
349procedure TGMatrix.Move(CurIndex, NewIndex: TIndex);
350var
351 Temp: TGMatrixItem;
352begin
353(* if ((CurIndex < 0) or (CurIndex > Count - 1)) then
354 raise EListError.CreateFmt(SListIndexError, [CurIndex]);
355 if ((NewIndex < 0) or (NewIndex > Count -1)) then
356 raise EListError.CreateFmt(SlistIndexError, [NewIndex]);
357 Temp := FItems[CurIndex];
358 if NewIndex > CurIndex then begin
359 System.Move(FItems[CurIndex + 1], FItems[CurIndex], (NewIndex - CurIndex) * SizeOf(TGMatrixItem));
360 end else
361 if NewIndex < CurIndex then begin
362 System.Move(FItems[NewIndex], FItems[NewIndex + 1], (CurIndex - NewIndex) * SizeOf(TGMatrixItem));
363 end;
364 FItems[NewIndex] := Temp;
365 //Delete(CurIndex);
366 //Insert(NewIndex, Temp);*)
367end;
368
369procedure TGMatrix.MoveItems(CurIndex, NewIndex, Count: TIndex);
370var
371 S: Integer;
372 D: Integer;
373begin
374(* if CurIndex < NewIndex then begin
375 S := CurIndex + Count - 1;
376 D := NewIndex + Count - 1;
377 while S >= CurIndex do begin
378 Move(S, D);
379 S := S - 1;
380 D := D - 1;
381 end;
382 end else
383 if CurIndex > NewIndex then begin
384 S := CurIndex;
385 D := NewIndex;
386 while S < (CurIndex + Count) do begin
387 Move(S, D);
388 S := S + 1;
389 D := D + 1;
390 end;
391 end;*)
392end;
393
394function TGMatrix.Remove(Item: TGMatrixItem): TIndex;
395begin
396(* Result := IndexOf(Item);
397 if Result <> -1 then
398 Delete(Result); *)
399end;
400
401function TGMatrix.EqualTo(List: TGMatrix): Boolean;
402var
403 I: TIndex;
404begin
405(* Result := Count = List.Count;
406 if Result then begin
407 I := 0;
408 while I < Count do begin
409 if not CompareMem(Addr(FItems[I]), Addr(List.FItems[I]), SizeOf(TGMatrixItem)) then begin
410 Result := False;
411 Break;
412 end;
413 I := I + 1;
414 end;
415 end; *)
416end;
417
418procedure TGMatrix.Reverse;
419var
420 X: TGMatrixIndexX;
421 Y: TGMatrixIndexY;
422begin
423 Y := 0;
424 while Y < (Count.Y - 1) do begin
425 X := 1 + Y;
426 while X < Count.X do begin
427 Exchange(CreateIndex(X, Y), CreateIndex(Y, X));
428 X := X + 1;
429 end;
430 Y := Y + 1;
431 end;
432end;
433
434procedure TGMatrix.ReverseHorizontal;
435var
436 X: TGMatrixIndexX;
437 Y: TGMatrixIndexY;
438begin
439 Y := 0;
440 while Y < Count.Y do begin
441 X := 0;
442 while X < (Count.X div 2) do begin
443 Exchange(CreateIndex(X, Y), CreateIndex(Count.X - 1 - X, Y));
444 X := X + 1;
445 end;
446 Y := Y + 1;
447 end;
448end;
449
450procedure TGMatrix.ReverseVertical;
451var
452 X: TGMatrixIndexX;
453 Y: TGMatrixIndexY;
454begin
455 X := 0;
456 while X < Count.X do begin
457 Y := 0;
458 while Y < (Count.Y div 2) do begin
459 Exchange(CreateIndex(X, Y), CreateIndex(X, Count.Y - 1 - Y));
460 Y := Y + 1;
461 end;
462 X := X + 1;
463 end;
464end;
465
466procedure TGMatrix.Sort(Compare: TSortCompare);
467begin
468(* if FCount > 1 then
469 QuickSort(0, FCount - 1, Compare); *)
470end;
471
472procedure TGMatrix.AddMatrix(Values: array of TRow);
473var
474 I: TIndex;
475begin
476(* I := 0;
477 while I <= High(Values) do begin
478 Add(Values[I]);
479 I := I + 1;
480 end; *)
481end;
482
483procedure TGMatrix.SetArray(Values: array of TGMatrixItem);
484var
485 I: TIndex;
486begin
487(* Clear;
488 I := 0;
489 while I <= High(Values) do begin
490 Add(Values[I]);
491 I := I + 1;
492 end; *)
493end;
494
495procedure TGMatrix.InsertArray(Index: TIndex; Values: array of TGMatrixItem);
496var
497 I: TIndex;
498begin
499(* I := 0;
500 while I <= High(Values) do begin
501 Insert(Index + I, Values[I]);
502 I := I + 1;
503 end; *)
504end;
505
506function TGMatrix.Implode(RowSeparator, ColSeparator: string; Converter: TToStringConverter): string;
507var
508 Y: TGMatrixIndexY;
509 X: TGMatrixIndexX;
510begin
511 Result := '';
512 Y := 0;
513 while Y < Count.Y do begin
514 X := 0;
515 while X < Count.X do begin
516 Result := Result + Converter(ItemsXY[X, Y]);
517 if X < (Count.X - 1) then
518 Result := Result + ColSeparator;
519 X := X + 1;
520 end;
521 if Y < (Count.Y - 1) then
522 Result := Result + RowSeparator;
523 Y := Y + 1;
524 end;
525end;
526
527procedure TGMatrix.Explode(Text, Separator: string; Converter: TFromStringConverter; SlicesCount: Integer = -1);
528begin
529(* Clear;
530 while (Pos(Separator, Text) > 0) and
531 ((Count < (SlicesCount - 1)) or (SlicesCount = -1)) do begin
532 Add(Converter(Copy(Text, 1, Pos(Separator, Text) - 1)));
533 System.Delete(Text, 1, Pos(Separator, Text) + Length(Separator) - 1);
534 end;
535 Add(Converter(Text)); *)
536end;
537
538function TGMatrix.Add(Item: TGMatrixItem): TIndex;
539begin
540(* if FCount = Capacity then
541 Self.Expand;
542 FItems[FCount] := Item;
543 Result := FCount;
544 FCount := FCount + 1; *)
545end;
546
547procedure TGMatrix.AddList(List: TGMatrix);
548var
549 I: TIndex;
550begin
551(* I := 0;
552 while I < List.Count do begin
553 Add(List[I]);
554 I := I + 1;
555 end; *)
556end;
557
558procedure TGMatrix.Clear;
559begin
560 Count := CreateIndex(0, 0);
561 Capacity := CreateIndex(0, 0);
562end;
563
564procedure TGMatrix.Delete(Index: TIndex);
565begin
566(* if (Index < 0) or (Index >= FCount) then
567 raise EListError.CreateFmt(SListIndexError, [Index]);
568 FCount := FCount - 1;
569 System.Move(FItems[Index + 1], FItems[Index], (FCount - Index) * SizeOf(TGMatrixItem));
570 Contract;
571 *)
572end;
573
574procedure TGMatrix.DeleteItems(Index, Count: TIndex);
575var
576 I: TIndex;
577begin
578(* I := Index;
579 while I < (Index + Count) do begin
580 Delete(Index);
581 I := I + 1;
582 end;
583 *)
584end;
585
586procedure TGMatrix.Fill(Start, Count: TIndex; Value: TGMatrixItem);
587var
588 X: TGMatrixIndexX;
589 Y: TGMatrixIndexY;
590begin
591 Y := Start.Y;
592 while Y < Count.Y do begin
593 X := Start.X;
594 while X < Count.X do begin
595 ItemsXY[X, Y] := Value;
596 X := X + 1;
597 end;
598 Y := Y + 1;
599 end;
600end;
601
602procedure TGMatrix.FillAll(Value: TGMatrixItem);
603begin
604 Fill(CreateIndex(0, 0), CreateIndex(Count.X - 1, Count.Y - 1), Value);
605end;
606
607procedure TGMatrix.Exchange(Index1, Index2: TIndex);
608var
609 Temp: TGMatrixItem;
610begin
611 if (Index1.X < 0) or (Index1.X >= Count.X) or
612 (Index1.Y < 0) or (Index1.Y >= Count.Y) then
613 raise EListError.CreateFmt(SMatrixIndexError, [Index1.X, Index1.Y]);
614 if (Index2.X < 0) or (Index2.X >= Count.X) or
615 (Index2.Y < 0) or (Index2.Y >= Count.Y) then
616 raise EListError.CreateFmt(SMatrixIndexError, [Index2.X, Index2.Y]);
617 Temp := FItems[Index1.Y, Index1.X];
618 FItems[Index1.Y, Index1.X] := FItems[Index2.Y, Index2.X];
619 FItems[Index2.Y, Index2.X] := Temp;
620end;
621
622{$UNDEF IMPLEMENTATION}
623{$ENDIF}
Note: See TracBrowser for help on using the repository browser.