Добавил:
Upload
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз:
Предмет:
Файл:курсач / DynStruct
.pas 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.
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.
Соседние файлы в папке курсач