Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:

курсач / DynStruct

.pas
Скачиваний:
17
Добавлен:
08.03.2015
Размер:
3.38 Кб
Скачать
unit DynStruct;

interface

type

tPoint = record
X, Y : integer;
end;

tSquare = array[ 1..4 ] of tPoint;

// POINTS ////////////////////////////
pPointNode = ^tPointNode;
tPointNode = record
Next : pPointNode;
Point : tPoint;
end;

// SQUARES ///////////////////////////
pSquareNode = ^tSquareNode;
tSquareNode = record
Next : pSquareNode;
Square : tSquare;
end;

// POINTS ////////////////////////////
function InitPointList : pPointNode;
procedure DestroyPointList( var root : pPointNode );
procedure AddPointNode( root: pPointNode; X, Y : integer );

// SQUARES ///////////////////////////
function InitSquareList : pSquareNode;
procedure DestroySquareList( var root : pSquareNode );
procedure AddSquareNode( root: pSquareNode; P1, P2, P3, P4 : tPoint );

implementation

function InitPointList : pPointNode;
var root : pPointNode;
begin
new(root);
root^.Next := nil;
result := root;
end;

procedure DestroyPointList( var root : pPointNode );
var tz : pPointNode;
begin

while root^.Next <> nil do
begin
tz := root^.Next;
root^.Next := tz^.Next;
dispose( tz );
end;

dispose( root );
root := nil;
end;

procedure AddPointNode( root : pPointNode; X, Y : integer );
var tz : pPointNode;
equalityFlag : boolean;
begin
tz := root;
equalityFlag := false;
while ( tz^.Next <> nil ) and ( not equalityFlag ) do
begin
if ( tz^.Point.X = X ) and ( tz^.Point.Y = Y ) then equalityFlag := true;
tz := tz^.Next;
end;

if ( not equalityFlag ) then
begin
new( tz^.Next );
tz := tz^.Next;
tz^.Point.X := X;
tz^.Point.Y := Y;
tz^.Next := nil;
end;
end;

function InitSquareList : pSquareNode;
var root : pSquareNode;
begin
new(root);
root^.Next := nil;
result := root;
end;

procedure DestroySquareList( var root : pSquareNode );
var tz : pSquareNode;
begin

while root^.Next <> nil do
begin
tz := root^.Next;
root^.Next := tz^.Next;
dispose( tz );
end;

dispose( root );
root := nil;
end;

function SquaresAreEqual( pts1, pts2 : tSquare ) : boolean;
var i, j : integer;
equal : boolean;
begin
result := true;
for i := 1 to 4 do
begin
equal := false;
for j := 1 to 4 do
if ( pts1[ i ].X = pts2[ j ].X ) and ( pts1[ i ].Y = pts2[ j ].Y ) then equal := true;
result := result and equal;
end;
end;

procedure AddSquareNode( root: pSquareNode; P1, P2, P3, P4 : tPoint );
var tz : pSquareNode;
pts : tSquare;
equalityFlag : boolean;
begin
pts[ 1 ] := P1;
pts[ 2 ] := P2;
pts[ 3 ] := P3;
pts[ 4 ] := P4;

tz := root;
equalityFlag := false;
while ( tz^.Next <> nil ) and ( not equalityFlag ) do
begin
if ( tz <> root ) and SquaresAreEqual( tz^.Square, pts ) then
equalityFlag := true;

tz := tz^.Next;
end;
equalityFlag := equalityFlag or SquaresAreEqual( tz^.Square, pts );

if not equalityFlag then
begin
new( tz^.Next );
tz := tz^.Next;
tz^.Square := pts;
tz^.Next := nil;
end;
end;

end.
Соседние файлы в папке курсач