pascalabcnet/TestSuite/CompilationSamples/DMCollect.pas
Бондарев Иван 59169b5168 ...
2015-06-27 18:33:50 +02:00

336 lines
8.2 KiB
ObjectPascal

// Copyright (c) Ivan Bondarev, Stanislav Mihalkovich (for details please see \doc\copyright.txt)
// This code is distributed under the GNU LGPL (for details please see \doc\license.txt)
unit DMCollect;
{$reference 'System.Drawing.dll'}
interface
uses
System.Drawing,
System.Collections;
type
Vector = Point;
Cell = record
p: Point;
v: Vector;
procedure Init(x1,y1,x2,y2: integer);
procedure InitAB(a,b: Point);
function ToString: string; override;
begin
Result := IntToStr(p.x)+','+IntToStr(p.y)+','+IntToStr(v.x)+','+IntToStr(v.y);
end;
end;
SortedCollection = class
private
a: ArrayList;
function GetCount: integer;
begin
Result := a.Count;
end;
function GetItem(i: integer): Cell;
begin
Result := Cell(a[i]); //!! Íå áóäåò ðàáîòàòü äëÿ Item[i].a.x := 1; !!!!!!!
end;
procedure SetItem(i: integer; c: Cell);
begin
a[i] := c;
end;
public
property Count: integer read GetCount;
property Items[i: integer]: Cell read GetItem write SetItem; default;
constructor Create;
destructor Done;
procedure Insert (x1,y1,x2,y2: integer);
procedure InsertAB (A,B: Point);
procedure Print;
procedure Normalize;
procedure Clear;
function IsEmpty: boolean;
end;
function InitVector(a,b: Point): Vector;
function Len2(v: Vector): longint;
function IsBetweenPP (P,A,B: Point): boolean;
function IsEqualPP (P1,P2: Point): boolean;
function IsEqualPxy (P: Point; x,y: integer): boolean;
function LessThenPP (P1,P2: Point): boolean;
function LessThenPxy (P: Point; x,y: integer): boolean;
function LessThenVV (A,B: Vector): boolean;
function IsParallel (A,B: Vector): boolean;
function IsEqualCC (C1,C2: Cell): boolean;
function LessThenCC (C1,C2: Cell): boolean;
function LessEqualCC (C1,C2: Cell): boolean;
function IsEqualSC(SC1,SC2: SortedCollection): boolean;
{--------------------------------------------}
implementation
{--------------------------------------------}
function IsEqualPP (P1,P2: Point): boolean;
begin
IsEqualPP := (P1.x=P2.x) and (P1.y=P2.y)
end;
function IsEqualPxy (P: Point; x,y: integer): boolean;
begin
IsEqualPxy := (x=P.x) and (y=P.y)
end;
function LessThenPP (P1,P2: Point): boolean;
begin
LessThenPP := (P1.x<P2.x) or ((P1.x=P2.x) and (P1.y<P2.y))
end;
function LessEqualPP (P1,P2: Point): boolean;
begin
LessEqualPP := (P1.x<P2.x) or ((P1.x=P2.x) and (P1.y<=P2.y))
end;
function LessThenPxy (P: Point; x,y: integer): boolean;
begin
LessThenPxy := (P.x<x) or ((P.x=x) and (P.y<y))
end;
function IsBetweenPP (P,A,B: Point): boolean;
var
C: Point;
AP,AB: Vector;
begin
if LessThenPP(B,A) then begin
C := A;
A := B;
B := C
end;
AP := InitVector(A,P);
AB := InitVector(A,B);
IsBetweenPP := IsParallel(AB,AP) and
LessEqualPP(A,P) and
LessEqualPP(P,B)
end;
function LessThenVV (A,B: Vector): boolean;
begin
LessThenVV := longint(A.x)*longint(B.y) -
longint(A.y)*longint(B.x) > 0
end;
function LessEqualVV (A,B: Vector): boolean;
begin
LessEqualVV := longint(A.x)*longint(B.y) -
longint(A.y)*longint(B.x) >= 0
end;
function IsParallel (A,B: Vector): boolean;
begin
IsParallel := longint(A.x)*longint(B.y) =
longint(A.y)*longint(B.x)
end;
function IsEqualCC (C1,C2: Cell): boolean;
begin
IsEqualCC := isequalPP(C1.p,C2.p) and
isequalPP(C1.v,C2.v)
end;
function LessThenCC (C1,C2: Cell): boolean;
var
vv: vector;
ip: boolean;
{Ñàìîå ñëîæíîå óñëîâèå}
begin
vv := initVector(C1.p,C2.p);
ip := IsParallel(C1.v,C2.v);
{C1<C2 åñëè âåêòîð1<âåêòîðà2 èëè
âåêòîð1 ïàðàëëåëåí âåêòîðó2 è âåêòîð1<P1P2 èëè
âåêòîð1 ïàðàëëåëåí âåêòîðó2
è âåêòîð1 ïàðàëëåëåí P1P2 è ÍÅÏÎÍßÒÍÎÅ ÓÑËÎÂÈÅ!!!!!!???????!!
}
LessThenCC := LessThenVV(C1.v,C2.v) or
(ip and LessThenVV(C1.v,vv)) or
(ip and IsParallel(C1.v,vv) and
{ LessThenPP(C1.v,C2.v)); ÍÅÏÎÍßÒÍÎÅ ÓÑËÎÂÈÅ! - vector lengths are comparing?}
LessThenPP(C1.p,C2.p)); {change on this 27.5.99 - i dont know am i right.}
{ The idea - to compare origins of vectors}
end;
function LessEqualCC (C1,C2: Cell): boolean;
begin
LessEqualCC := LessThenCC(C1,C2) or IsEqualCC(C1,C2)
end;
function IsEqualSC (SC1,SC2: SortedCollection): boolean;
var i: integer;
begin
Result := SC1.Count = SC2.Count;
if not Result then
exit;
for i:=0 to SC1.Count-1 do
if not IsEqualCC(SC1[i],SC2[i]) then
begin
Result := False;
break;
end;
end;
function InitVector(a,b: Point): Vector;
begin
Result := new Point(b.x-a.x,b.y-a.y);
end;
function Len2(v: Vector): longint;
begin
Result := v.x*v.x + v.y*v.y;
end;
{--------------------------------------------}
{ Cell }
{--------------------------------------------}
procedure Cell.Init(x1,y1,x2,y2: integer);
begin
if (x1<x2) or ((x1=x2) and (y1<y2)) then
begin
v := new Vector(x2-x1, y2-y1);
p := new Point(x1,y1);
end
else
begin
v := new Vector(x1-x2, y1-y2);
p := new Point(x2,y2);
end;
end;
procedure Cell.InitAB(A,B: Point);
begin
Init(A.x,A.y,B.x,B.y)
end;
{--------------------------------------------}
{ SortedCollection }
{--------------------------------------------}
constructor SortedCollection.Create;
begin
a := new ArrayList;
end;
procedure SortedCollection.Insert(x1,y1,x2,y2: integer);
var
CC: Cell;
i: integer;
begin
if (x1=x2) and (y1=y2) then Exit; {Íå âñòàâëÿòü òî÷êó}
CC.Init(x1,y1,x2,y2);
for i:=0 to Count-1 do
if LessEqualCC(CC,Self[i]) then
begin
if not IsEqualCC(CC,Self[i]) then // Íå äóáëèðîâàòü
a.Insert(i,CC);
Exit;
end;
a.Add(CC); // Åñëè áîëüøå âñåõ, òî äîáàâèòü â êîíåö
end;
procedure SortedCollection.InsertAB(A,B: Point);
begin
Insert(A.x,A.y,B.x,B.y)
end;
procedure SortedCollection.Print;
var i: integer;
begin
for i:=0 to Count-1 do
writeln(Items[i]);
end;
procedure SortedCollection.Normalize;
// Cëèâàòü ñîñåäíèå ïàðû
var
pend,p1end,pnew,pnewend: Point;
CC: Cell;
i: integer;
begin
for i:=Count-2 downto 0 do
if IsParallel(Items[i].v,Items[i+1].v) then
begin
pend := new Point(Items[i].p.x+Items[i].v.x,Items[i].p.y+Items[i].v.y);
p1end := new Point(Items[i+1].p.x+Items[i+1].v.x,Items[i+1].p.y+Items[i+1].v.y);
if IsBetweenPP(Items[i+1].p,Items[i].p,pend) {åñëè P1 ìåæäó P è P+v} or
IsBetweenPP(Items[i].p,Items[i+1].p,p1end) {åñëè P ìåæäó P1 è P1+v} then
begin
if LessThenPP(Items[i].p,Items[i+1].p) then
pnew:=Items[i].p
else pnew:=Items[i+1].p;
if LessThenPP(pend,p1end) then
pnewend:=p1end
else pnewend:=pend;
// Ñëèòü
// Items[i].p := pnew; Ýòî íå ðàáîòàåò èç-çà óïàêîâêè!!!
// Items[i].v := vv;
CC.InitAB(pnew,pnewend);
Items[i] := CC;
a.RemoveAt(i+1);
end;
end;
(*1:
b:=false;
H := Head;
if H=nil then Exit;
while H^.next<>nil do
begin
H1 := H^.next;
k := 0;
if IsParallel(H^.v,H1^.v) then
begin
pend.init(H^.p.x+H^.v.x,H^.p.y+H^.v.y);
p1end.init(H1^.p.x+H1^.v.x,H1^.p.y+H1^.v.y);
if IsBetweenPP(H1^.p,H^.p,Pend) {åñëè P1 ìåæäó P è P+v} or
IsBetweenPP(H^.p,H1^.p,P1end) {åñëè P ìåæäó P1 è P1+v}
then
begin
{íàéòè íà÷àëî è êîíåö íîâîãî âåêòîðà}
if LessThenPP(H^.p,H1^.p) then pnew:=H^.p
else pnew:=H1^.p;
if LessThenPP(pend,p1end) then pnewend:=p1end
else pnewend:=pend;
{ Ñëèòü }
H^.p.init(pnew.x,pnew.y);
H^.v.InitVector(pnew,pnewend);
H^.next := H1^.next;
dispose(H1);
b:=True;
k := 1;
{À åñëè v1 öåëèêîì âíóòðè v ???}
{Ïî ìîåìó, òîãäà íà ñëåäóþùåì ïðîõîäå è äëÿ ýòîãî k}
end;
end;
if k=0 then H := H^.next;
end;
if b then goto 1; {ïîñêîëüêó íå âñå ìîãëè ñëèòüñÿ}
{íå ëó÷øèé àëãîðèòì, íî...}*)
end;
procedure SortedCollection.Clear;
begin
a.Clear;
end;
destructor SortedCollection.Done;
begin
Clear;
end;
function SortedCollection.IsEmpty: boolean;
begin
Result := a.Count = 0;
end;
end.