Support Forum / Форум поддержки

Code: Select all

' testprogram for "in_out" function
option base 1 ! option angle degrees
graphics ! graphics clear ! draw color 0,0,0 ! draw size 3
dim x(10),y(10)
np=6 ! xc=0 ! yc=0
for i=1 to np ! read x(i),y(i) ! xc+=x(i) ! yc+=y(i) ! next i
data 100,500, 100,200, 350,80, 500,600, 200,600, 100,500
draw poly x,y count np
loop:
get touch 0 as xp,yp ! if xp=-1 then loop
pause .1
in=in_out(np,x,y,xp,yp)
if in=1 then out$="in" else out$="out"
button " " title out$ at 300,10 size 100,30
goto loop
end

' check if point (xp,yp) lies inside the convex poly (np,x(),y())
' returns 1 if inside, 0 if outside
'
def in_out(np,x(),y(),xp,yp)
xc=0 ! yc=0 ! in=1
for i=1 to np ! xc+=x(i) ! yc+=y(i) ! next i
p(1)=xc/np ! p(2)=yc/np ! q(1)=xp ! q(2)=yp
for i=1 to np-1
a(1)=x(i) ! a(2)=y(i) ! b(1)=x(i+1) ! b(2)=y(i+1)
if intersect(a,b,p,q)>-1 then ! in=0 ! break ! end if
next i
return in
end def

' check if 2 line segments intersect
' returns -1 if no intersection
' else returns intersection point (x,y)=a()+lab1*b(),  0 <= lab1 <= 1
'
def intersect(a(),b(),p(),q())
dim m(2,2),lab(2),rhs(2)
m(1,1)=b(1)-a(1) ! m(1,2)=p(1)-q(1)
m(2,1)=b(2)-a(2) ! m(2,2)=p(2)-q(2)
rhs(1)=p(1)-a(1) ! rhs(2)=p(2)-a(2)
if lin_eq2(m,lab,rhs)=0 then return -1
if lab(1)<0 or lab(1)>1 or lab(2)<0 or lab(2)>1 then return -1
return lab(1)
end def

' solve 2 linear equations in x and y
' a(,) is coefficient matrix, b() is right hand side
' x() are calculated x and y returned
'
def lin_eq2(a(,),x(),b())
det=a(1,1)*a(2,2)-a(2,1)*a(1,2)
if det=0 then return 0
x(1)=(a(2,2)*b(1)-a(1,2)*b(2))/det
x(2)=(a(1,1)*b(2)-a(2,1)*b(1))/det
return 1
end def