home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power Programming
/
powerprogramming1994.iso
/
progtool
/
surfmodl
/
surfm203.arc
/
SURFSRC.ARC
/
CHEKSURF.INC
< prev
next >
Wrap
Text File
|
1987-01-05
|
2KB
|
70 lines
function CHEKSURF (X, Y, Surf: integer): boolean;
{ Check to see if point (X,Y) lies within surface Surf. Function returns
TRUE if surface blocks point, or false otherwise
}
var Npts: integer; { # points on outline of surface }
Xpt, Ypt: points; { coordinates of surface outline }
Nextpt: integer; { next point on outline to look at }
Node1, Node2: integer;{ endpoints of line segment to store }
Vert: integer; { vertex number }
begin
{$ifdef BIGMEM}
with ptrd^ do with ptre^ do with ptrh^ do
begin
{$endif}
if (inlimits (X, Y, Surf)) then begin
Npts := 0;
for Vert := 1 to Nvert[Surf]-1 do begin
Node1 := konnec (Surf, Vert);
Node2 := konnec (Surf, Vert+1);
storline (round(Xtran[Node1]), round(Ytran[Node1]),
round(Xtran[Node2]), round(Ytran[Node2]), Xpt, Ypt, Npts);
if (Npts < 0) then
badsurf;
end; { for Vert }
{ One last line to close the polygon }
Node1 := konnec (Surf, Nvert[Surf]); { last node }
Node2 := konnec (Surf, 1); { first node }
storline (round(Xtran[Node1]), round(Ytran[Node1]),
round(Xtran[Node2]), round(Ytran[Node2]), Xpt, Ypt, Npts);
if (Npts < 0) then
badsurf;
{ Sort the line segment points, first by Y, then by X }
Shellpts (Xpt, Ypt, Npts);
{ Now check every point in the interior of the surface to find (X,Y) }
Nextpt := 1;
while (Nextpt < Npts) and (Nextpt > 0) do begin
if (Ypt[Nextpt] = Y) then begin
if (abs(Xpt[Nextpt] - Xpt[Nextpt+1]) > 1) and
(Ypt[Nextpt] = Ypt[Nextpt+1]) then begin
if (Xpt[Nextpt] <= X) and (Xpt[Nextpt+1] >= X) then
{ Point found; flag to stop the while loop }
Nextpt := -1
else
Nextpt := Nextpt + 2;
end else if (Xpt[Nextpt] = X) then
{ Point found; flag to stop the while loop }
Nextpt := -1
else
Nextpt := Nextpt + 1;
end else { if Ypt }
Nextpt := Nextpt + 1;
end; { while }
if (Nextpt = Npts) then
if (Xpt[Nextpt] = X) then
{ Point found; flag to stop the while loop }
Nextpt := -1;
if (Nextpt = -1) then
Cheksurf := TRUE
else
Cheksurf := FALSE;
end else { if onscreen }
Cheksurf := FALSE;
{$ifdef BIGMEM}
end; {with}
{$endif}
end; { function CHEKSURF }